hls-0.11: LSystem/Turtle.hs

-- | Standard 'Turtle' graphics.
module LSystem.Turtle where

import Graphics.PS.Pt

-- | Turtle.
data Turtle = Turtle {ta :: Double -- ^ turning angle
                     ,tai :: Double -- ^ turning angle increment
                     ,loc :: Pt -- ^ location
                     ,hdg :: Double -- ^ heading
                     ,ll :: Double -- ^ line length
                     ,ls :: Double -- ^ length scalar
                     ,stk :: [Turtle] -- ^ turtle stack
                    } -- lw = line width,lwi = line width increment,

-- | Right turn by 'ta'.
turnRight :: Turtle -> Turtle
turnRight t = t {hdg = hdg t + (ta t)}

-- | Left turn by 'ta'.
turnLeft :: Turtle -> Turtle
turnLeft t = t {hdg = hdg t - (ta t)}

-- | @180@ degree turn.
turnBack :: Turtle -> Turtle
turnBack t = t {hdg = hdg t + pi}

-- | Increment line length ('ll') by multiplying by line scalar ('ls').
incrLine :: Turtle -> Turtle
incrLine t = t {ll = ll t * ls t}

-- | Decrement line length ('ll') by dividing by line scalar ('ls').
decrLine :: Turtle -> Turtle
decrLine t = t {ll = ll t / ls t}

-- | Move 'loc' of 'Turtle' by 'll' on current 'hdg'.
forward :: Turtle -> Turtle
forward t =
    let shift (Pt x y) r d = Pt (x + r * cos d) (y + r * sin d)
    in t {loc = shift (loc t) (ll t) (hdg t)}

-- | Push 'Turtle' onto 'stk'.
push :: Turtle -> Turtle
push t = t {stk = t : stk t}

-- | Fetch 'Turtle' from 'stk'.
pop :: Turtle -> Turtle
pop t = head (stk t)

-- | Given state processing function /f/, a 'Turtle' and an initial
-- state, step 'Turtle' and state.
stepTurtle :: (t -> Pt -> Pt -> b) -> Turtle -> t -> (Turtle,b)
stepTurtle f t i =
    let p  = loc  t
        t' = forward t
        p' = loc  t'
        i' = f i p p'
    in (t',i')