Data commit

Task/Brownian-tree/Haskell/brownian-tree.hs

@@ -0,0 +1,46 @@
+import Control.Monad
+import Control.Monad.ST
+import Data.STRef
+import Data.Array.ST
+import System.Random
+import Bitmap
+import Bitmap.BW
+import Bitmap.Netpbm
+
+main = do
+    g <- getStdGen
+    (t, _) <- stToIO $ drawTree (50, 50) (25, 25) 300 g
+    writeNetpbm "/tmp/tree.pbm" t
+
+drawTree :: (Int, Int) -> (Int, Int) -> Int -> StdGen -> ST s (Image s BW, StdGen)
+drawTree (width, height) start steps stdgen = do
+    img <- image width height off
+    setPix img (Pixel start) on
+    gen <- newSTRef stdgen
+    let -- randomElem :: [a] -> ST s a
+        randomElem l = do
+            stdgen <- readSTRef gen
+            let (i, stdgen') = randomR (0, length l - 1) stdgen
+            writeSTRef gen stdgen'
+            return $ l !! i
+        -- newPoint :: ST s (Int, Int)
+        newPoint = do
+            p <- randomElem border
+            c <- getPix img $ Pixel p
+            if c == off then return p else newPoint
+        -- wander :: (Int, Int) -> ST s ()
+        wander p = do
+            next <- randomElem $ filter (inRange pointRange) $ adjacent p
+            c <- getPix img $ Pixel next
+            if c == on then setPix img (Pixel p) on else wander next
+    replicateM_ steps $ newPoint >>= wander
+    stdgen <- readSTRef gen
+    return (img, stdgen)
+  where pointRange = ((0, 0), (width - 1, height - 1))
+        adjacent (x, y) = [(x - 1, y - 1), (x, y - 1), (x + 1, y - 1),
+                           (x - 1, y),                 (x + 1, y),
+                           (x - 1, y + 1), (x, y + 1), (x + 1, y + 1)]
+        border = liftM2 (,) [0, width - 1] [0 .. height - 1] ++
+                 liftM2 (,) [1 .. width - 2] [0, height - 1]
+        off = black
+        on = white