{-|
Module      : Graphics.WorldTurtle
Description : WorldTurtle
Copyright   : (c) Archibald Neil MacDonald, 2020
License     : BSD3
Maintainer  : FortOyer@hotmail.co.uk
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/FortOyer/worldturtle-haskell#examples) on
Github!

-}
module Graphics.WorldTurtle
     ( 
     -- * Running the turtle

     -- $running

       TurtleCommand 
     , runTurtle 
     -- * Parallel animation

     -- $parallel

     , (<|>)
     -- * Further documentation

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

import Control.Applicative ((<|>))

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.Pure.Game as G

import Graphics.WorldTurtle.Color
import Graphics.WorldTurtle.Commands
import Graphics.WorldTurtle.Internal.Sequence (renderTurtle)
import Graphics.WorldTurtle.Internal.Commands (TurtleCommand, seqT)
import Graphics.WorldTurtle.Shapes

data World = World { World -> Float
elapsedTime :: !Float
                   , World -> Bool
running :: !Bool
                   , World -> ViewState
state :: !G.ViewState 
                   }

{- | `runTurtle` takes a `TurtleCommand` and produces the animation in a new
     window! 

     The simplest way to run `runTurtle` is to execute it directly from 
     your main function like so:

     @
         main :: IO ()
         main = runTurtle yourOwnCoolCommand
     @

     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        |
     +------------------------------------------+-------------------+
-}
runTurtle :: TurtleCommand () -- ^ Command sequence to execute

          -> IO ()
runTurtle :: TurtleCommand () -> IO ()
runTurtle TurtleCommand ()
tc = Display
-> Color
-> Int
-> World
-> (World -> Picture)
-> (Event -> World -> World)
-> (Float -> World -> World)
-> IO ()
forall world.
Display
-> Color
-> Int
-> world
-> (world -> Picture)
-> (Event -> world -> world)
-> (Float -> world -> world)
-> IO ()
G.play Display
display Color
white Int
30 World
defaultWorld World -> Picture
iterateRender Event -> World -> World
input Float -> World -> World
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 -> Picture
iterateRender World
w = ViewPort -> Picture -> Picture
G.applyViewPortToPicture 
                               (ViewState -> ViewPort
G.viewStateViewPort (ViewState -> ViewPort) -> ViewState -> ViewPort
forall a b. (a -> b) -> a -> b
$ World -> ViewState
state World
w)
                        (Picture -> Picture) -> Picture -> Picture
forall a b. (a -> b) -> a -> b
$! SequenceCommand (AlmostVal ()) () -> Float -> Picture
forall a. SequenceCommand (AlmostVal a) a -> Float -> Picture
renderTurtle (TurtleCommand () -> SequenceCommand (AlmostVal ()) ()
forall a. TurtleCommand a -> SeqC a
seqT TurtleCommand ()
tc) (World -> Float
elapsedTime World
w)
        input :: Event -> World -> 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
w { elapsedTime :: Float
elapsedTime = Float
0, running :: Bool
running = Bool
True }
             -- Pause prevents any proceeding.

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

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

        timePass :: Float -> World -> World
timePass Float
f World
w
         | World -> Bool
running World
w = World
w { elapsedTime :: Float
elapsedTime = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
+ World -> Float
elapsedTime World
w }
         | Bool
otherwise = World
w

defaultWorld :: World
defaultWorld :: World
defaultWorld = Float -> Bool -> ViewState -> World
World Float
0 Bool
True 
             (ViewState -> World) -> ViewState -> World
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

It is easy to create and animate your turtle. You just pass your commands to
`runTurtle` like so:

@
     import Control.Monad (replicateM_)
     import Graphics.WorldTurtle

     myCommand :: TurtleCommand ()
     myCommand = do 
       t <- makeTurtle
       replicateM_ 4 $ forward 90 t >> right 90 t

     main :: IO ()
     main = runTurtle myCommand
@

Which will produce this animation

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


{- $parallel

   We already know that `TurtleCommand`s can be combined with `(>>)`, but the
   alternative operation `(<|>)` can alo be used to combine two 
   `TurtleCommand`s. This has a special meaning: do both animations at the 
   same time!

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

   Note that the result of @a \<|\> b@ is:
   
   >>> a <|> b
   a

   when /a/ is not `Control.Monad.mzero`.
-}