module Graphics.WorldTurtle
(
runTurtle
, TurtleCommand
, runWorld
, WorldCommand
, run
, (>/>)
, (<|>)
, empty
, 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, seqT
, WorldCommand (..), seqW)
import Graphics.WorldTurtle.Shapes
runTurtle :: TurtleCommand ()
-> IO ()
runTurtle :: TurtleCommand () -> IO ()
runTurtle TurtleCommand ()
c = WorldCommand () -> IO ()
runWorld (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
runWorld :: WorldCommand ()
-> IO ()
runWorld :: WorldCommand () -> IO ()
runWorld WorldCommand ()
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 (WorldCommand () -> SequenceCommand (AlmostVal ()) ()
forall a. WorldCommand a -> SeqC a
seqW WorldCommand ()
tc) (World -> Float
elapsedTime World
w)
input :: Event -> World -> World
input Event
e World
w
| Event -> Bool
isResetKey_ Event
e = World
w { elapsedTime :: Float
elapsedTime = Float
0, running :: Bool
running = Bool
True }
| 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 }
| 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 }
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
run :: TurtleCommand a
-> Turtle
-> WorldCommand a
run :: TurtleCommand a -> Turtle -> WorldCommand a
run TurtleCommand a
c = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC a -> WorldCommand a)
-> (Turtle -> SeqC a) -> Turtle -> WorldCommand a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleCommand a -> Turtle -> SeqC a
forall a. TurtleCommand a -> Turtle -> SeqC a
seqT TurtleCommand a
c
(>/>) :: Turtle
-> TurtleCommand a
-> WorldCommand 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 = World { World -> Float
elapsedTime :: !Float
, World -> Bool
running :: !Bool
, World -> ViewState
state :: !G.ViewState
}
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
(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
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
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