purescript-by-example chapter 9 lsystem problem 1

purescript-confusion.purs

module Example.LSystem where

import Prelude

import Control.Monad.Eff (Eff)
import Data.Array (foldM)
import Data.Maybe (Maybe(..))
import Graphics.Canvas (CANVAS, closePath, fillPath, getCanvasElementById, getContext2D, lineTo, moveTo, setFillStyle, setStrokeStyle, strokePath)
import Math as Math
import Partial.Unsafe (unsafePartial)

lsystem :: forall a m s. Monad m =>
                         Array a ->
                         (a -> Array a) ->
                         (s -> a -> m s) ->
                         Int ->
                         s -> m s
lsystem init prod interpret n state = foldM interpret state $ produce init prod n

produce :: forall a. Array a -> (a -> Array a) -> Int -> Array a
produce arr _ 0 = arr
produce arr rules n = produce (arr >>= rules) rules (n - 1)

data Alphabet = L | R | F

type Sentence = Array Alphabet

type State =
  { x :: Number
  , y :: Number
  , theta :: Number
  }

main :: Eff (canvas :: CANVAS) Unit
main = void $ unsafePartial do
  Just canvas <- getCanvasElementById "canvas"
  ctx <- getContext2D canvas

  let
    initial :: Sentence
    initial = [F, R, R, F, R, R, F, R, R]

    productions :: Alphabet -> Sentence
    productions L = [L]
    productions R = [R]
    productions F = [F, L, F, R, R, F, L, F]

    interpret :: State -> Alphabet -> Eff (canvas :: CANVAS) State
    interpret state L = pure $ state { theta = state.theta - Math.pi / 3.0 }
    interpret state R = pure $ state { theta = state.theta + Math.pi / 3.0 }
    interpret state F = do
      let x = state.x + Math.cos state.theta * 1.5
          y = state.y + Math.sin state.theta * 1.5
      _ <- lineTo ctx x y
      pure { x, y, theta: state.theta }

    initialState :: State
    initialState = { x: 120.0, y: 200.0, theta: 0.0 }

    closeStrokeFill effRow = do
      _ <- closePath ctx
      _ <- strokePath ctx effRow
      fillPath ctx effRow

  _ <- setStrokeStyle "#000000" ctx
  _ <- setFillStyle "#ff00ff" ctx
  _ <- moveTo ctx initialState.x initialState.y
  closeStrokeFill $ lsystem initial productions interpret 5 initialState