{- | 
    Module      : Graphics.WorldTurtle
    Description : WorldTurtle
    Copyright   : (c) Archibald Neil MacDonald, 2020
    License     : BSD3
    Maintainer  : archibaldnmac@gmail.com
    Stability   : experimental
    Portability : POSIX
  
    "Graphics.WorldTurtle" is a module for writing and rendering turtle graphics
    in Haskell.
  
    Take a look at the
         [examples](https://github.com/aneilmac/worldturtle-haskell#examples) on
    Github!
-}
module Graphics.WorldTurtle
     (
     -- * Running a WorldTurtle simulation.

     -- * Running on a single turtle.

     -- $running

       runTurtle
     , runTurtle'
     , TurtleCommand
     -- * Running a world of turtles.

     -- $multiturtle

     , runWorld
     , runWorld'
     , WorldCommand
     , run 
     , (>/>)
     -- * Parallel animation

     , (>!>)
     -- * Further documentation

     , module Graphics.WorldTurtle.Commands
     , module Graphics.WorldTurtle.Shapes
     , module Graphics.WorldTurtle.Color
     ) where

import Control.Monad.Parallel

import Graphics.Gloss.Data.Display (Display (..))
import qualified Graphics.Gloss.Data.ViewState as G
import qualified Graphics.Gloss.Data.ViewPort as G
import qualified Graphics.Gloss.Interface.IO.Game as G

import Graphics.WorldTurtle.Color
import Graphics.WorldTurtle.Commands
import Graphics.WorldTurtle.Internal.Sequence (SequencePause, startSequence, resumeSequence, renderPause, defaultTSC)
import Graphics.WorldTurtle.Internal.Commands ( TurtleCommand
                                              , WorldCommand (..)
                                              , run
                                              , seqW
                                              )
import Graphics.WorldTurtle.Shapes

-- | Takes a `TurtleCommand` and executes the command on an implicitly created

--   turtle that starts at position @(0, 0)@ with heading `north`. 

--

--   This is a convenience function written in terms of `runWorld` as:

--

--   > runTurtle c = runWorld $ makeTurtle >>= run c

--

-- See also: `Graphics.WorldTurtle.Commands.makeTurtle`.

runTurtle :: TurtleCommand () -- ^ Command sequence to execute.

          -> IO ()
runTurtle :: TurtleCommand () -> IO ()
runTurtle = Color -> TurtleCommand () -> IO ()
runTurtle' Color
white

-- | Variant of `runTurtle` which takes an additional background color parameter. 

runTurtle' :: Color -- ^ Background color.

          -> TurtleCommand () -- ^ Command sequence to execute.

          -> IO ()
runTurtle' :: Color -> TurtleCommand () -> IO ()
runTurtle' Color
bckCol TurtleCommand ()
c = Color -> WorldCommand () -> IO ()
runWorld' Color
bckCol (WorldCommand () -> IO ()) -> WorldCommand () -> IO ()
forall a b. (a -> b) -> a -> b
$ WorldCommand Turtle
makeTurtle WorldCommand Turtle
-> (Turtle -> WorldCommand ()) -> WorldCommand ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TurtleCommand () -> Turtle -> WorldCommand ()
forall a. TurtleCommand a -> Turtle -> WorldCommand a
run TurtleCommand ()
c

-- | While `WorldCommand`s can be combined with `(>>)` to produce sequential

--   instructions, we can also use the

--   parallel animation operator `(>!>)` to achieve parallel instructions. 

--   That is: animate two turtles at time!

--

--   Here is an example:

--

--   >  import Graphics.WorldTurtle

--   >

--   >  main :: IO ()

--   >  main = runWorld $ do

--   >    t1 <- makeTurtle' (0, 0) north green

--   >    t2 <- makeTurtle' (0, 0) north red

--   >

--   >    -- Draw the anticlockwise and clockwise circles in sequence. 

--   >    t1 >/> circle 90 >> t2 >/> circle (-90)

--   >  

--   >    clear

--   >

--   >    -- Draw the anticlockwise and clockwise circles in parallel.

--   >    t1 >/> circle 90 >!> t2 >/> circle (-90)

--

--   Which would produce an animation like this

--

-- ![parallel and serial gif](docs/images/parallel_serial_turtles_2.gif)

--

-- Note that `(>!>)` is an alias for `bindM2`, and is defined as:

-- 

-- >  (>!>) = bindM2 (const . return)

--

(>!>) :: WorldCommand () -- ^ First command to execute in parallel

      -> WorldCommand () -- ^ Second command to execute in parallel.

      -> WorldCommand () -- ^ Result command

>!> :: WorldCommand () -> WorldCommand () -> WorldCommand ()
(>!>) = (() -> () -> WorldCommand ())
-> WorldCommand () -> WorldCommand () -> WorldCommand ()
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 (WorldCommand () -> () -> WorldCommand ()
forall a b. a -> b -> a
const (WorldCommand () -> () -> WorldCommand ())
-> (() -> WorldCommand ()) -> () -> () -> WorldCommand ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> WorldCommand ()
forall (m :: * -> *) a. Monad m => a -> m a
return)
infixl 3 >!>

{- | `runWorld` takes a `WorldCommand` and produces the animation in a new
      window! 

   ==  Interacting with the window.
   
   While running, you can interact with the window in the following way:
   
   +------------------------------------------+-------------------+
   | Action                                   | Interaction       |
   +==========================================+===================+
   | Pan the viewport.                        | Click and drag    |
   +------------------------------------------+-------------------+
   | Zoom in/out.                             |Mousewheel up/down |
   +------------------------------------------+-------------------+
   | Reset the viewport to initial position.  | Spacebar          |
   +------------------------------------------+-------------------+
   | Reset the animation.                     | @R@ key           |
   +------------------------------------------+-------------------+
   | Pause the animation.                     | @P@ key           |
   +------------------------------------------+-------------------+
   | Quit                                     | Escape key        |
   +------------------------------------------+-------------------+
-}
runWorld :: WorldCommand () -- ^ Command sequence to execute

          -> IO ()
runWorld :: WorldCommand () -> IO ()
runWorld = Color -> WorldCommand () -> IO ()
runWorld' Color
white

-- | Variant of `runWorld` which takes an additional background color parameter. 

runWorld' :: Color -- ^ Background color

          -> WorldCommand () -- ^ Command sequence to execute

          -> IO ()
runWorld' :: Color -> WorldCommand () -> IO ()
runWorld' Color
bckCol WorldCommand ()
cmd = Display
-> Color
-> Int
-> World ()
-> (World () -> IO Picture)
-> (Event -> World () -> IO (World ()))
-> (Float -> World () -> IO (World ()))
-> IO ()
forall world.
Display
-> Color
-> Int
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Float -> world -> IO world)
-> IO ()
G.playIO Display
display Color
bckCol Int
30 (WorldCommand () -> World ()
forall a. WorldCommand a -> World a
defaultWorld WorldCommand ()
cmd) World () -> IO Picture
forall {a}. World a -> IO Picture
iterateRender Event -> World () -> IO (World ())
forall {m :: * -> *}. Monad m => Event -> World () -> m (World ())
input Float -> World () -> IO (World ())
forall {a}. Float -> World a -> IO (World a)
timePass
  where display :: Display
display = String -> (Int, Int) -> (Int, Int) -> Display
InWindow String
"World Turtle" (Int
800, Int
600) (Int
400, Int
300)
        iterateRender :: World a -> IO Picture
iterateRender World a
w = do
           SequencePause a
sq <- World a -> IO (SequencePause a)
forall a. World a -> IO (SequencePause a)
worldComputation World a
w
           let p :: Picture
p = SequencePause a -> Picture
forall a. SequencePause a -> Picture
renderPause SequencePause a
sq -- Render whatever is in the coroutine.

           Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return (Picture -> IO Picture) -> Picture -> IO Picture
forall a b. (a -> b) -> a -> b
$ ViewPort -> Picture -> Picture
G.applyViewPortToPicture (ViewState -> ViewPort
G.viewStateViewPort (ViewState -> ViewPort) -> ViewState -> ViewPort
forall a b. (a -> b) -> a -> b
$ World a -> ViewState
forall a. World a -> ViewState
viewState World a
w) Picture
p
        input :: Event -> World () -> m (World ())
input Event
e World ()
w 
             -- Reset key resets sim state (including unpausing). We 

             -- deliberately keep view state the same.

             | Event -> Bool
isResetKey_ Event
e = World () -> m (World ())
forall (m :: * -> *) a. Monad m => a -> m a
return World ()
w {worldComputation :: IO (SequencePause ())
worldComputation = WorldCommand () -> IO (SequencePause ())
forall a. WorldCommand a -> IO (SequencePause a)
restartSequence WorldCommand ()
cmd, running :: Bool
running = Bool
True }
             -- Pause prevents any proceeding.

             | Event -> Bool
isPauseKey_ Event
e = World () -> m (World ())
forall (m :: * -> *) a. Monad m => a -> m a
return World ()
w { running :: Bool
running = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ World () -> Bool
forall a. World a -> Bool
running World ()
w }
             -- Let Gloss consume the command.

             | Bool
otherwise = World () -> m (World ())
forall (m :: * -> *) a. Monad m => a -> m a
return World ()
w { viewState :: ViewState
viewState = Event -> ViewState -> ViewState
G.updateViewStateWithEvent Event
e (ViewState -> ViewState) -> ViewState -> ViewState
forall a b. (a -> b) -> a -> b
$ World () -> ViewState
forall a. World a -> ViewState
viewState World ()
w } 
        -- Increment simulation time if we are not paused.

        timePass :: Float -> World a -> IO (World a)
timePass Float
f World a
w
         | World a -> Bool
forall a. World a -> Bool
running World a
w = do
               SequencePause a
sq <- World a -> IO (SequencePause a)
forall a. World a -> IO (SequencePause a)
worldComputation World a
w -- Grab previous sequence

               SequencePause a
sq' <- Float -> SequencePause a -> IO (SequencePause a)
forall a. Float -> SequencePause a -> IO (SequencePause a)
resumeSequence Float
f SequencePause a
sq -- Calculate new sequence

               World a -> IO (World a)
forall (m :: * -> *) a. Monad m => a -> m a
return World a
w { worldComputation :: IO (SequencePause a)
worldComputation = SequencePause a -> IO (SequencePause a)
forall (m :: * -> *) a. Monad m => a -> m a
return SequencePause a
sq'}
         | Bool
otherwise = World a -> IO (World a)
forall (m :: * -> *) a. Monad m => a -> m a
return World a
w

-- | This is an infix version of `run` where the arguments are swapped.

--

--   We take a turtle and a command to execute on the turtle.

--   The result of the computation is returned wrapped in a `WorldCommand`.

--

--   To create a turtle and draw a right-angle:

--

--   > myCommand :: WorldCommand ()

--   > myCommand = do

--   >   t <- makeTurtle

--   >   t >/> do 

--   >     forward 10

--   >     right 90

--   >     forward 10

(>/>) :: Turtle -- ^ Turtle to apply the command upon.

      -> TurtleCommand a -- ^ Command to execute

      -> WorldCommand a -- ^ Result as a `WorldCommand`

>/> :: forall a. Turtle -> TurtleCommand a -> WorldCommand a
(>/>) = (TurtleCommand a -> Turtle -> WorldCommand a)
-> Turtle -> TurtleCommand a -> WorldCommand a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TurtleCommand a -> Turtle -> WorldCommand a
forall a. TurtleCommand a -> Turtle -> WorldCommand a
run
infixl 4 >/>

data World a = World { forall a. World a -> Bool
running :: !Bool
                     , forall a. World a -> IO (SequencePause a)
worldComputation:: IO (SequencePause a)
                     , forall a. World a -> ViewState
viewState :: G.ViewState
                     }

restartSequence :: WorldCommand a -> IO (SequencePause a)
restartSequence :: forall a. WorldCommand a -> IO (SequencePause a)
restartSequence WorldCommand a
cmnd = TSC -> SequenceCommand a -> IO (SequencePause a)
forall a. TSC -> SequenceCommand a -> IO (SequencePause a)
startSequence TSC
defaultTSC (WorldCommand a -> SequenceCommand a
forall a. WorldCommand a -> SequenceCommand a
seqW WorldCommand a
cmnd)

defaultWorld :: WorldCommand a -> World a
defaultWorld :: forall a. WorldCommand a -> World a
defaultWorld WorldCommand a
cmd = Bool -> IO (SequencePause a) -> ViewState -> World a
forall a. Bool -> IO (SequencePause a) -> ViewState -> World a
World Bool
True (WorldCommand a -> IO (SequencePause a)
forall a. WorldCommand a -> IO (SequencePause a)
restartSequence WorldCommand a
cmd)
                 (ViewState -> World a) -> ViewState -> World a
forall a b. (a -> b) -> a -> b
$ CommandConfig -> ViewState
G.viewStateInitWithConfig 
                 -- Easier to do this to have spacebar overwrite R.

                 (CommandConfig -> ViewState) -> CommandConfig -> ViewState
forall a b. (a -> b) -> a -> b
$ CommandConfig -> CommandConfig
forall a. [a] -> [a]
reverse 
                (CommandConfig -> CommandConfig) -> CommandConfig -> CommandConfig
forall a b. (a -> b) -> a -> b
$ (Command
G.CRestore, [(SpecialKey -> Key
G.SpecialKey SpecialKey
G.KeySpace, Maybe Modifiers
forall a. Maybe a
Nothing)])
                (Command, [(Key, Maybe Modifiers)])
-> CommandConfig -> CommandConfig
forall a. a -> [a] -> [a]
: CommandConfig
G.defaultCommandConfig

-- | Tests to see if a key-event is the reset key.

isResetKey_ :: G.Event -> Bool
isResetKey_ :: Event -> Bool
isResetKey_ (G.EventKey (G.Char Char
'r') KeyState
G.Down Modifiers
_ (Float, Float)
_)  = Bool
True
isResetKey_ (G.EventKey (G.Char Char
'R') KeyState
G.Down Modifiers
_ (Float, Float)
_)  = Bool
True
isResetKey_ Event
_ = Bool
False

-- Tests to see if a key event is the pause key

isPauseKey_ :: G.Event -> Bool
isPauseKey_ :: Event -> Bool
isPauseKey_ (G.EventKey (G.Char Char
'p') KeyState
G.Down Modifiers
_ (Float, Float)
_)  = Bool
True
isPauseKey_ (G.EventKey (G.Char Char
'P') KeyState
G.Down Modifiers
_ (Float, Float)
_)  = Bool
True
isPauseKey_ Event
_ = Bool
False

{- $running

  To start animating a single turtle, you just pass your commands to
  `runTurtle` like so:

  >    import Graphics.WorldTurtle
  >
  >    drawSquare :: Float -> TurtleCommand ()
  >    drawSquare size = repeatFor 4 $ forward size >> right 90
  >
  >    main :: IO ()
  >    main = runTurtle $ drawSquare 100

   Which will produce this animation.

   ![basic_turtle_square gif](docs/images/basic_turtle_square.gif)
-}

{- $multiturtle
   
   For executing commands on multiple turtles, we use `runWorld` which
   executes on `WorldCommand`s. Here is an example where 2 turtles draw a
   circle independently:

   > import Graphics.WorldTurtle
   >
   > main :: IO ()
   > main = runWorld $ do
   >   t1 <- makeTurtle
   >   t2 <- makeTurtle
   > 
   >   t1 >/> circle 90 
   >   t2 >/> circle (-90)

   Notice that in a `WorldCommand` context we must create our own turtles with 
   `makeTurtle`! We them  apply the `TurtleCommand`
   on our turtles using the run operator `(>/>)`.
-}