module Diagrams.TwoD.Path.Turtle
( Turtle, TurtleT
, runTurtle, runTurtleT
, forward, backward, left, right
, heading, setHeading, towards
, pos, setPos
, penHop, penUp, penDown, isDown
, closeCurrent
) where
import Diagrams.Prelude
import qualified Control.Monad.State as ST
import Control.Monad.Identity
type TurtleT = ST.StateT TState
type Turtle = TurtleT Identity
data TState = TState Bool Deg (Path R2)
getPath :: TState -> Path R2
getPath (TState d _ (Path xs))
= Path . reverse
$ map (\(p, (Trail ys c)) -> (p, Trail (reverse ys) c))
$ if d then xs else tail xs
logoseg :: Monad m => (Segment R2) -> TurtleT m ()
logoseg seg = ST.modify
(\(TState d ang p) ->
TState d ang $ modifyTrail
(\(Trail xs c) -> Trail (rotate ang seg:xs) c) p)
modifyAngle :: Monad m => (Deg -> Deg) -> TurtleT m ()
modifyAngle f = ST.modify (\(TState d a p) -> TState d (f a) p)
modifyPath :: (Path R2 -> Path R2) -> TState -> TState
modifyPath f (TState d ang p) = TState d ang $ f p
modifyTrail :: (Trail v -> Trail v) -> Path v -> Path v
modifyTrail f (Path ((p, t) : ps)) = Path $ (p, f t) : ps
modifyTrail _ p = p
runTurtleT :: (Monad m, Functor m) => TurtleT m a -> m (Path R2)
runTurtleT t = getPath . snd
<$> ST.runStateT t (TState True 0 (Path [(origin, Trail [] False)]))
runTurtle :: Turtle a -> Path R2
runTurtle t = getPath . snd . ST.runState t
$ TState True 0 (Path [(origin, Trail [] False)])
forward :: Monad m => Double -> TurtleT m ()
forward x = logoseg $ Linear (r2 (x, 0))
backward :: Monad m => Double -> TurtleT m ()
backward x = logoseg $ Linear (r2 ((negate x), 0))
left :: Monad m => Double -> TurtleT m ()
left a = modifyAngle (+ (Deg a))
right :: Monad m => Double -> TurtleT m ()
right a = modifyAngle (subtract (Deg a))
setHeading :: Monad m => Double -> TurtleT m ()
setHeading a = modifyAngle (const (Deg a))
heading :: Monad m => TurtleT m Double
heading = ST.gets (\(TState _ (Deg x) _) -> x)
towards :: Monad m => P2 -> TurtleT m ()
towards pt = do
p <- pos
setHeading . (*360) . (/tau) . uncurry atan2 . unr2 $ pt .-. p
setPos :: Monad m => P2 -> TurtleT m ()
setPos p = ST.modify helper
where
helper (TState d a (Path ps))
= TState d a $ Path $ (p, Trail [] False)
: if d then ps else tail ps
pos :: Monad m => TurtleT m P2
pos = ST.gets f
where f (TState _ _ (Path ((p, t) : _))) = p .+^ trailOffset t
f _ = error "Diagrams.TwoD.Path.Turtle.pos: no path. Please report this as a bug."
penHop :: Monad m => TurtleT m ()
penHop = pos >>= setPos
penUp :: Monad m => TurtleT m ()
penUp = penHop >> ST.modify (\(TState _ a p) -> TState False a p)
penDown :: Monad m => TurtleT m ()
penDown = penHop >> ST.modify (\(TState _ a p) -> TState True a p)
isDown :: Monad m => TurtleT m Bool
isDown = ST.gets (\(TState d _ _) -> d)
closeCurrent :: Monad m => TurtleT m ()
closeCurrent = do
p <- pos
ST.modify $ modifyPath $ modifyTrail close
setPos p