commit 06df9e85f53f87c5a074e67c559de3ed24a0e1f4
Author: James Halliday
Date: Sun Mar 21 12:27:56 2010 +0000

The haskell gd module provides bindings to a small but useful subset of a href="http://www.libgd.org/"libgd.

It's a nice enough module and I am grateful that Björn Bringert took the time to put it together but it's just not... functional enough for my tastes. Consider setPixel.

setPixel :: Point -> Color -> Image -> IO ()

This function takes a point, a color, and an image, returning the unit type from the IO monad, which means that somewhere inside of Image there must lie a mutable reference. As good as GHC's garbage collection and algebraic trickery are for optimizing away many sorts of unused intermediate state, I can understand the appeal of these in-place updates, especially considering how much the underlying C library caters to this programming style.

Not all of the actions are performed in-place, however.

rotateImage :: Int -> Image -> IO Image

The rotateImage function creates and returns a new Image type which has been rotated some integer number of degrees. However, this return type is still wrapped up in the IO monad and threading this Image type around looks tedious. Luckily, there is a more functional way to handle both types of updates efficiently while providing a handy way to automatically thread the state at the same time.

-- <a href="http://substack.net/scripts/haskell-gd/State.hs">State.hs</a>
module Graphics.GD.State where

import Control.Monad.State.Lazy (State(..),modify,execState)
import qualified Graphics.GD as GD

data GDCmd = SetPixel GD.Point GD.Color

data GD' = GD' { gdCmds :: [GDCmd] }
type GD a = State GD' a

Here, the GD type lets us create State monads that operate on GD' data. The GD' type contains the image and a list of operations to perform on the image. For simplicity, only SetPixel is defined. With these types, we can write a helper function consCmd that adds a command to the gdCmds of the state and a function setPixel that registers a SetPixel action.

consCmd :: GDCmd -&gt; GD ()
consCmd cmd = modify $ \gd -&gt; gd { gdCmds = cmd : (gdCmds gd) }

setPixel :: GD.Point -&gt; GD.Color -&gt; GD ()
setPixel = (consCmd .) . SetPixel

Finally, a newImage function is defined that takes a size and GD () action and executes the commands in the IO monad using runCmd.

newImage :: GD.Size -&gt; GD () -&gt; IO GD.Image
newImage size f = do
    im &lt;- GD.newImage size
    -- run each of the commands for the image
    mapM_ (flip runCmd $ im) $ gdCmds $ execState f $ GD' []
    return im

runCmd :: GDCmd -&gt; GD.Image -&gt; IO ()
runCmd (SetPixel pt c) = GD.setPixel pt c

With just these pieces, it's possible to build something useful! This program creates a file noise.png filled with random color values.

-- <a href="http://substack.net/scripts/haskell-gd/Main.hs">Main.hs</a>
module Main where 

import Graphics.GD.State
import qualified Graphics.GD as GD
import System.Random (newStdGen,randomRs)
import Control.Monad (mapM_,liftM2)

main = do
    g &lt;- newStdGen
    let (w,h) = (400,300)
    (GD.savePngFile "noise.png" =&lt;&lt;) . newImage (w,h) 
        $ mapM_ (uncurry setPixel)
        $ zip (liftM2 (,) [0..w-1] [0..h-1]) -- all the pixel coordinates
        $ map fromInteger $ randomRs (0,256^3-1) g -- random colors


The code here is just enough to demonstrate a use of the state monad to create a mini-domain specific language on top of another library. I forked dancor's haskell-gd to include a more complete version of this Graphics.GD.State module. You can check out the code here.

With the extended module, here's code that computes a gradient:

import Graphics.GD.State

main = (savePngFile "gradient.png" =&lt;&lt;) . newImage (400,300) $ do
    (w,h) &lt;- getSize
    eachPixel $ \(x,y) -&gt;
        let
            r = ((128 * x) `div` w) + ((128 * y) `div` h)
            g = 127 + ((128 * x) `div` w)
            b = 127
        in rgb r g b


And this one draws a circle and a line:

import Graphics.GD.State

main = (savePngFile "circle.png" =&lt;&lt;) . newImage (400,300) $ do
    (w,h) &lt;- getSize

    fill $ rgb 100 63 127 -- dark purple background

    drawArc
        (w `div` 2,h `div` 2) -- centered
        (180,180) -- (width,height)
        0 360 -- a circle
        (rgb 255 255 255) -- white

    drawLine (0,0) (w-1,h-1) (rgb 127 255 127)


This might seem like a lot of effort for something that doesn't matter very much, but writing beautiful code is important. Clean, abstract interfaces save precious mental horsepower for the bigger, harder problems.

"Beauty is a consequential thing, a product of solving problems correctly." -- Joseph Esherick

more
git clone http://substack.net/blog.git