{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.Turtle
-- Copyright   :  (c) 2011 Michael Sloan
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  Michael Sloan <mgsloan at gmail>
--
-- Stateful domain specific language for diagram paths, modelled after the
-- classic \"turtle\" graphics language.
--
-----------------------------------------------------------------------------
module Diagrams.TwoD.Path.Turtle
  ( Turtle, TurtleT

    -- * Turtle control commands
  , runTurtle, runTurtleT
  , drawTurtle, drawTurtleT
  , sketchTurtle, sketchTurtleT

    -- * Motion commands
  , forward, backward, left, right

    -- * State accessors / setters
  , heading, setHeading, towards, isDown
  , pos, setPos, setPenWidth, setPenColor

    -- * Drawing control
  , penUp, penDown, penHop, closeCurrent
  ) where

import qualified Control.Lens                       as L
import           Control.Monad                      (liftM)
import qualified Control.Monad.State                as ST

import           Diagrams.Prelude
import qualified Diagrams.TwoD.Path.Turtle.Internal as T


type TurtleT n = ST.StateT (T.TurtleState n)

type Turtle n = TurtleT n Identity

-- | A more general way to run the turtle. Returns a computation in the
-- underlying monad @m@ yielding the final turtle state.
runTurtleT :: (OrderedField n, Monad m) => TurtleT n m a -> m (T.TurtleState n)
runTurtleT :: forall n (m :: * -> *) a.
(OrderedField n, Monad m) =>
TurtleT n m a -> m (TurtleState n)
runTurtleT TurtleT n m a
t = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
ST.execStateT TurtleT n m a
t forall n. (Floating n, Ord n) => TurtleState n
T.startTurtle

-- | Run the turtle, yielding the final turtle state.
runTurtle :: (Floating n, Ord n) => Turtle n a -> T.TurtleState n
runTurtle :: forall n a. (Floating n, Ord n) => Turtle n a -> TurtleState n
runTurtle = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *) a.
(OrderedField n, Monad m) =>
TurtleT n m a -> m (TurtleState n)
runTurtleT

-- | A more general way to run the turtle.  Returns a computation in
--   the underlying monad @m@ yielding the final diagram.
drawTurtleT :: (Monad m, Renderable (Path V2 n) b, TypeableFloat n)
            => TurtleT n m a -> m (QDiagram b V2 n Any)
drawTurtleT :: forall (m :: * -> *) n b a.
(Monad m, Renderable (Path V2 n) b, TypeableFloat n) =>
TurtleT n m a -> m (QDiagram b V2 n Any)
drawTurtleT = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
TurtleState n -> QDiagram b V2 n Any
T.getTurtleDiagram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *) a.
(OrderedField n, Monad m) =>
TurtleT n m a -> m (TurtleState n)
runTurtleT

-- | Run the turtle, yielding a diagram.
drawTurtle :: (Renderable (Path V2 n) b, TypeableFloat n) =>
              Turtle n a -> QDiagram b V2 n Any
drawTurtle :: forall n b a.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Turtle n a -> QDiagram b V2 n Any
drawTurtle = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) n b a.
(Monad m, Renderable (Path V2 n) b, TypeableFloat n) =>
TurtleT n m a -> m (QDiagram b V2 n Any)
drawTurtleT

-- | A more general way to run the turtle. Returns a computation in
--   the underlying monad @m@, ignoring any pen style commands and
--   yielding a 2D path.
sketchTurtleT :: (Monad m, Floating n, Ord n) => TurtleT n m a -> m (Path V2 n)
sketchTurtleT :: forall (m :: * -> *) n a.
(Monad m, Floating n, Ord n) =>
TurtleT n m a -> m (Path V2 n)
sketchTurtleT = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall n. (Floating n, Ord n) => TurtleState n -> Path V2 n
T.getTurtlePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *) a.
(OrderedField n, Monad m) =>
TurtleT n m a -> m (TurtleState n)
runTurtleT

-- | Run the turtle, ignoring any pen style commands and yielding a
--   2D path.
sketchTurtle :: (Floating n, Ord n) => Turtle n a -> Path V2 n
sketchTurtle :: forall n a. (Floating n, Ord n) => Turtle n a -> Path V2 n
sketchTurtle = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) n a.
(Monad m, Floating n, Ord n) =>
TurtleT n m a -> m (Path V2 n)
sketchTurtleT

-- Motion commands

-- | Move the turtle forward, along the current heading.
forward :: (OrderedField n, Monad m) => n -> TurtleT n m ()
forward :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
forward n
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n.
(Floating n, Ord n) =>
n -> TurtleState n -> TurtleState n
T.forward n
x

-- | Move the turtle backward, directly away from the current heading.
backward :: (OrderedField n, Monad m) => n -> TurtleT n m ()
backward :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
backward n
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n.
(Floating n, Ord n) =>
n -> TurtleState n -> TurtleState n
T.backward n
x

-- | Modify the current heading to the left by the specified angle in degrees.
left :: (OrderedField n, Monad m) => n -> TurtleT n m ()
left :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
left n
d = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n. Floating n => n -> TurtleState n -> TurtleState n
T.left n
d

-- | Modify the current heading to the right by the specified angle in degrees.
right :: (OrderedField n, Monad m) => n -> TurtleT n m ()
right :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
right n
d = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n. Floating n => n -> TurtleState n -> TurtleState n
T.right n
d

-- State accessors / setters

-- | Set the current turtle angle, in degrees.
setHeading :: (OrderedField n, Monad m) => n -> TurtleT n m ()
setHeading :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
setHeading n
d = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n. Floating n => n -> TurtleState n -> TurtleState n
T.setHeading n
d

-- | Get the current turtle angle, in degrees.
heading :: (OrderedField n, Monad m) => TurtleT n m n
heading :: forall n (m :: * -> *). (OrderedField n, Monad m) => TurtleT n m n
heading = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
L.view forall n. Floating n => Iso' (Angle n) n
deg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. TurtleState n -> Angle n
T.heading)

-- | Sets the heading towards a given location.
towards :: (Monad m, RealFloat n) => P2 n -> TurtleT n m ()
towards :: forall (m :: * -> *) n.
(Monad m, RealFloat n) =>
P2 n -> TurtleT n m ()
towards P2 n
pt = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n. RealFloat n => P2 n -> TurtleState n -> TurtleState n
T.towards P2 n
pt

-- | Set the current turtle X/Y position.
setPos :: (OrderedField n, Monad m) => P2 n -> TurtleT n m ()
setPos :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
P2 n -> TurtleT n m ()
setPos P2 n
p = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Floating n) =>
P2 n -> TurtleState n -> TurtleState n
T.setPenPos P2 n
p

-- | Get the current turtle X/Y position.
pos :: Monad m => TurtleT n m (P2 n)
pos :: forall (m :: * -> *) n. Monad m => TurtleT n m (P2 n)
pos = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets forall n. TurtleState n -> P2 n
T.penPos

-- Drawing control.

-- | Ends the current path, and enters into "penUp" mode
penUp :: (OrderedField n, Monad m) => TurtleT n m ()
penUp :: forall n (m :: * -> *). (OrderedField n, Monad m) => TurtleT n m ()
penUp   = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall n. (Ord n, Floating n) => TurtleState n -> TurtleState n
T.penUp

-- | Ends the current path, and enters into "penDown" mode
penDown :: (OrderedField n, Monad m) => TurtleT n m ()
penDown :: forall n (m :: * -> *). (OrderedField n, Monad m) => TurtleT n m ()
penDown = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall n. (Ord n, Floating n) => TurtleState n -> TurtleState n
T.penDown

-- | Start a new trail at current position
penHop :: (OrderedField n, Monad m) => TurtleT n m ()
penHop :: forall n (m :: * -> *). (OrderedField n, Monad m) => TurtleT n m ()
penHop = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall n. (Ord n, Floating n) => TurtleState n -> TurtleState n
T.penHop

-- | Queries whether the pen is currently drawing a path or not.
isDown :: Monad m => TurtleT n m Bool
isDown :: forall (m :: * -> *) n. Monad m => TurtleT n m Bool
isDown = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets forall n. TurtleState n -> Bool
T.isPenDown

-- | Closes the current path , to the starting position of the current
-- trail. Has no effect when the pen position is up.
closeCurrent :: (OrderedField n, Monad m) => TurtleT n m ()
closeCurrent :: forall n (m :: * -> *). (OrderedField n, Monad m) => TurtleT n m ()
closeCurrent = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall n. (Floating n, Ord n) => TurtleState n -> TurtleState n
T.closeCurrent

-- | Sets the pen color
setPenColor :: (OrderedField n, Monad m) => Colour Double -> TurtleT n m ()
setPenColor :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
Colour Double -> TurtleT n m ()
setPenColor Colour Double
c = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Floating n) =>
Colour Double -> TurtleState n -> TurtleState n
T.setPenColor Colour Double
c

-- | Sets the pen size
setPenWidth  :: (OrderedField n, Monad m) => Measure n -> TurtleT n m ()
setPenWidth :: forall n (m :: * -> *).
(OrderedField n, Monad m) =>
Measure n -> TurtleT n m ()
setPenWidth Measure n
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
ST.modify forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Floating n) =>
Measure n -> TurtleState n -> TurtleState n
T.setPenWidth Measure n
s