Koch snowflake code in Haskell. an exercise from Hudak's book The Haskell School of Expression

koch.hs

-- how to run: ghci -i Koch.hs Picture Region Draw Shape Animation SOE EnableGUI

module Koch where

-- infrastructure

import SOE hiding (Region)
import Picture
import Animation (turn)
import EnableGUI
import System.IO.Unsafe (unsafePerformIO)

-- version just using Graphic

run1 :: (Int, Int) -> [Graphic] -> IO ()
run1 dim graphics =
  let draw w g = drawInWindow w (withColor Blue g)
  in runGraphics (
       do enableGUI
          w <- openWindow "" dim
          sequence_ $ map (draw w) graphics
          k <- getKey w
          closeWindow w
     )

main1 :: IO ()
main1 = run1 (600, 600) $ koch1 (300, 300) 250

koch1 :: (Float, Float) -> Float -> [Graphic]
koch1 (x, y) scale =
  if (abs scale < 2) then []
  else let fromPolar theta r =
             let radians = theta * pi / 180
             in (x + r * cos radians, y + r * sin radians)
           triangle theta =
             let roundxy (x, y) = (round x, round y)
                 side turn = fromPolar (theta + turn) scale
             in polygon $ map (roundxy . side) [0, 120, 240]
           recur theta = koch1 (fromPolar theta (scale / 1.5))
                               (scale / 3)
       in triangle 0 : triangle 180 : (recur =<< [0, 60..300])

-- more sophisticated version using Picture

main2 :: IO ()
main2 = draw "Koch #2" $ Region Green $ Scale (2.5, 2.5) $ koch2 5

koch2 :: Int -> Region
koch2 depth =
  if depth == 0 then Empty
  else let fromPolar theta = (cos theta, sin theta)
           triangle = map fromPolar $ [0, pi * 2 / 3, pi * 4 / 3]
           scalePoint s (x, y) = (x * s, y * s)
           points = (map (scalePoint ( 2 / 3)) triangle) ++
                    (map (scalePoint (-2 / 3)) triangle)
           recur = Scale (1 / 3, 1 / 3) $ koch2 (depth - 1)
           recurs = map (\p -> Translate p $ recur) points
           star = (Shape $ Polygon triangle) `Union` (Shape $ turn pi $ Polygon triangle)
       in foldl Union star recurs