worldturtle-0.2.2.0: Graphics/WorldTurtle.hs
{- |
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
, TurtleCommand
-- * Running a world of turtles.
-- $multiturtle
, runWorld
, WorldCommand
, run
, (>/>)
-- * Parallel animation
-- $parallel
, (<|>)
-- * Stop an animation
-- $empty
, empty
-- * Further documentation
, module Graphics.WorldTurtle.Commands
, module Graphics.WorldTurtle.Shapes
, module Graphics.WorldTurtle.Color
) where
import Control.Applicative (empty, (<|>))
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
, WorldCommand (..), seqW
, run)
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 c = runWorld $ makeTurtle >>= run c
{- | `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 tc = G.play display white 30 defaultWorld iterateRender input timePass
where display = InWindow "World Turtle" (800, 600) (400, 300)
iterateRender w = G.applyViewPortToPicture
(G.viewStateViewPort $ state w)
$ renderTurtle (seqW tc) (elapsedTime w)
input e w
-- Reset key resets sim state (including unpausing). We
-- deliberately keep view state the same.
| isResetKey_ e = w { elapsedTime = 0, running = True }
-- Pause prevents any proceeding.
| isPauseKey_ e = w { running = not $ running w }
-- Let Gloss consume the command.
| otherwise = w { state = G.updateViewStateWithEvent e $ state w }
-- Increment simulation time if we are not paused.
timePass f w
| running w = w { elapsedTime = f + elapsedTime w }
| otherwise = 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`
(>/>) = flip run
infixl 4 >/>
data World = World { elapsedTime :: !Float
, running :: !Bool
, state :: G.ViewState
}
defaultWorld :: World
defaultWorld = World 0 True
$ G.viewStateInitWithConfig
-- Easier to do this to have spacebar overwrite R.
$ reverse
$ (G.CRestore, [(G.SpecialKey G.KeySpace, Nothing)])
: G.defaultCommandConfig
-- | Tests to see if a key-event is the reset key.
isResetKey_ :: G.Event -> Bool
isResetKey_ (G.EventKey (G.Char 'r') G.Down _ _) = True
isResetKey_ (G.EventKey (G.Char 'R') G.Down _ _) = True
isResetKey_ _ = False
-- Tests to see if a key event is the pause key
isPauseKey_ :: G.Event -> Bool
isPauseKey_ (G.EventKey (G.Char 'p') G.Down _ _) = True
isPauseKey_ (G.EventKey (G.Char 'P') G.Down _ _) = True
isPauseKey_ _ = False
{- $running
To start animating a single turtle, you just pass your commands to
`runTurtle` like so:
> import Control.Monad (replicateM_)
> import Graphics.WorldTurtle
>
> drawSquare :: Float -> TurtleCommand ()
> drawSquare size = replicateM_ 4 $ forward size >> right 90
>
> main :: IO ()
> main = runTurtle $ drawSquare 100
Which will produce this animation.

-}
{- $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 `(>/>)`.
-}
{- $parallel
#parallel#
While `WorldCommand`s can be combined with `(>>)` to produce sequential
instructions, we can also use the
alternative 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

Note that the result of @x \<|\> y@ is:
>>> x <|> y
x
when @x@ is not `Control.Applicative.empty`, otherwise the result is @y@.
-}
{- $empty
If a `WorldCommand` is `Control.Applicative.empty`, then this stops this
section of animation and it does not progress. To this end
`Control.Monad.guard` can be used to calculate when to stop part of an
animation sequence.
-}