final cog

module Bitmap.Line(line) where
-- code from the Rosetta Code project
 
import Bitmap
import Control.Monad
import Control.Monad.ST
import qualified Data.STRef
 
var = Data.STRef.newSTRef
get = Data.STRef.readSTRef
mutate = Data.STRef.modifySTRef
 
line :: Color c => Image s c -> Pixel -> Pixel -> c -> ST s ()
line i (Pixel (xa, ya)) (Pixel (xb, yb)) c = do
    yV <- var y1
    errorV <- var $ deltax `div` 2
    forM_ [x1 .. x2] (\x -> do
        y <- get yV
        setPix i (Pixel $ if steep then (y, x) else (x, y)) c
        mutate errorV $ subtract deltay
        error <- get errorV
        when (error < 0) (do
            mutate yV (+ ystep)
            mutate errorV (+ deltax)))
  where steep = abs (yb - ya) > abs (xb - xa)
        (xa', ya', xb', yb') = if steep
          then (ya, xa, yb, xb)
          else (xa, ya, xb, yb)
        (x1, y1, x2, y2) = if xa' > xb'
          then (xb', yb', xa', ya')
          else (xa', ya', xb', yb')
        deltax = x2 - x1
        deltay = abs $ y2 - y1
        ystep = if y1 < y2 then 1 else -1

module Line(line) where
 
line :: (Int, Int) -> Int -> [(Int, Int)]
line (x, y) inv_grad = line' (x, y) inv_grad (inv_grad `div` 2)
 
line' :: (Int, Int) -> Int -> Int -> [(Int, Int)]
line' (x, y) inv_grad 0 =     (x, y) : line' (x+1, y+1) inv_grad (inv_grad-1)
line' (x, y) inv_grad err_y = (x, y) : line' (x+1, y) inv_grad (err_y-1)

*Line> :load bresenham
[1 of 1] Compiling Line             ( bresenham.hs, interpreted )
Ok, modules loaded: Line.
*Line> take 10 $ line (0, 0) 3
[(0,0),(1,0),(2,1),(3,1),(4,1),(5,2),(6,2),(7,2),(8,3),(9,3)]