{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.WorldTurtle.Internal.Sequence
( Turtle
, TSC
, SequenceCommand
, SequencePause
, defaultTSC
, startSequence
, resumeSequence
, renderPause
, decrementSimTime
, addPicture
, pics
, finalPics
, turtles
, generateTurtle
, animate'
, runParallel
) where
import Graphics.WorldTurtle.Internal.Turtle
( defaultTurtle, drawTurtle, TurtleData )
import Graphics.Gloss.Data.Picture (Picture, pictures)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict
( StateT, get, put, evalStateT )
import Control.Lens
( (.~), (&), (+=), (^.), (%=), (.=), use, makeLenses )
import Control.Monad.Coroutine (Coroutine(..))
import Control.Monad.Coroutine.SuspensionFunctors (Request(..), request )
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
type TurtleState = StateT TSC IO
type SequenceCommand a = Coroutine (Request TSC Float) TurtleState a
type SequencePause a = Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC)
newtype Turtle = Turtle Int deriving (Turtle -> Turtle -> Bool
(Turtle -> Turtle -> Bool)
-> (Turtle -> Turtle -> Bool) -> Eq Turtle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Turtle -> Turtle -> Bool
$c/= :: Turtle -> Turtle -> Bool
== :: Turtle -> Turtle -> Bool
$c== :: Turtle -> Turtle -> Bool
Eq, Eq Turtle
Eq Turtle
-> (Turtle -> Turtle -> Ordering)
-> (Turtle -> Turtle -> Bool)
-> (Turtle -> Turtle -> Bool)
-> (Turtle -> Turtle -> Bool)
-> (Turtle -> Turtle -> Bool)
-> (Turtle -> Turtle -> Turtle)
-> (Turtle -> Turtle -> Turtle)
-> Ord Turtle
Turtle -> Turtle -> Bool
Turtle -> Turtle -> Ordering
Turtle -> Turtle -> Turtle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Turtle -> Turtle -> Turtle
$cmin :: Turtle -> Turtle -> Turtle
max :: Turtle -> Turtle -> Turtle
$cmax :: Turtle -> Turtle -> Turtle
>= :: Turtle -> Turtle -> Bool
$c>= :: Turtle -> Turtle -> Bool
> :: Turtle -> Turtle -> Bool
$c> :: Turtle -> Turtle -> Bool
<= :: Turtle -> Turtle -> Bool
$c<= :: Turtle -> Turtle -> Bool
< :: Turtle -> Turtle -> Bool
$c< :: Turtle -> Turtle -> Bool
compare :: Turtle -> Turtle -> Ordering
$ccompare :: Turtle -> Turtle -> Ordering
Ord)
data TSC = TSC
{ TSC -> [Picture]
_pics :: ![Picture]
, TSC -> [Picture]
_finalPics :: ![Picture]
, TSC -> Float
_simTime :: !Float
, TSC -> Map Turtle TurtleData
_turtles :: !(Map Turtle TurtleData)
, TSC -> Int
_nextTurtleId :: !Int
}
$(makeLenses ''TSC)
defaultTSC :: TSC
defaultTSC :: TSC
defaultTSC = TSC :: [Picture]
-> [Picture] -> Float -> Map Turtle TurtleData -> Int -> TSC
TSC
{ _pics :: [Picture]
_pics = [Picture]
forall a. Monoid a => a
mempty
, _finalPics :: [Picture]
_finalPics = [Picture]
forall a. Monoid a => a
mempty
, _simTime :: Float
_simTime = Float
0
, _turtles :: Map Turtle TurtleData
_turtles = Map Turtle TurtleData
forall k a. Map k a
Map.empty
, _nextTurtleId :: Int
_nextTurtleId = Int
0
}
decrementSimTime :: Float
-> SequenceCommand Bool
decrementSimTime :: Float -> SequenceCommand Bool
decrementSimTime Float
d = do
Float
t <- TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float)
-> TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall a b. (a -> b) -> a -> b
$ Getting Float TSC Float -> TurtleState Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float TSC Float
Lens' TSC Float
simTime
let t' :: Float
t' = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
d)
let outOfTime :: Bool
outOfTime = Float
t' Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Float
t'
Bool
-> Coroutine (Request TSC Float) TurtleState ()
-> Coroutine (Request TSC Float) TurtleState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outOfTime (Coroutine (Request TSC Float) TurtleState ()
-> Coroutine (Request TSC Float) TurtleState ())
-> Coroutine (Request TSC Float) TurtleState ()
-> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ do
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ ([Picture] -> Identity [Picture]) -> TSC -> Identity TSC
Lens' TSC [Picture]
finalPics (([Picture] -> Identity [Picture]) -> TSC -> Identity TSC)
-> ([Picture] -> [Picture]) -> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \[Picture]
f -> [[Picture] -> Picture
pictures [Picture]
f]
TSC
s <- StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get
Float
delta <- TSC -> Coroutine (Request TSC Float) TurtleState Float
forall (m :: * -> *) x y.
Monad m =>
x -> Coroutine (Request x y) m y
request TSC
s
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TurtleState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Float
delta
Bool -> SequenceCommand Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outOfTime
addPicture :: Picture
-> SequenceCommand ()
addPicture :: Picture -> Coroutine (Request TSC Float) TurtleState ()
addPicture Picture
p = TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ ([Picture] -> Identity [Picture]) -> TSC -> Identity TSC
Lens' TSC [Picture]
pics (([Picture] -> Identity [Picture]) -> TSC -> Identity TSC)
-> ([Picture] -> [Picture]) -> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Picture] -> [Picture]) -> [Picture] -> [Picture]
forall a b. (a -> b) -> a -> b
($!) (Picture
p Picture -> [Picture] -> [Picture]
forall a. a -> [a] -> [a]
:)
startSequence :: TSC
-> SequenceCommand a
-> IO (SequencePause a)
startSequence :: forall a. TSC -> SequenceCommand a -> IO (SequencePause a)
startSequence TSC
tsc SequenceCommand a
commands = StateT
TSC
IO
(Either
(Request
TSC Float (Coroutine (Request TSC Float) TurtleState (a, TSC)))
(a, TSC))
-> TSC
-> IO
(Either
(Request
TSC Float (Coroutine (Request TSC Float) TurtleState (a, TSC)))
(a, TSC))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Coroutine (Request TSC Float) TurtleState (a, TSC)
-> StateT
TSC
IO
(Either
(Request
TSC Float (Coroutine (Request TSC Float) TurtleState (a, TSC)))
(a, TSC))
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine (Request TSC Float) TurtleState (a, TSC)
commands') TSC
tsc
where commands' :: Coroutine (Request TSC Float) TurtleState (a, TSC)
commands' = do
Bool
_ <- Float -> SequenceCommand Bool
decrementSimTime Float
0
a
a <- SequenceCommand a
commands
TSC
g <- StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get
(a, TSC) -> Coroutine (Request TSC Float) TurtleState (a, TSC)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, TSC
g)
runSequence :: TSC
-> SequenceCommand (a, TSC)
-> IO (SequencePause a)
runSequence :: forall a. TSC -> SequenceCommand (a, TSC) -> IO (SequencePause a)
runSequence TSC
tsc SequenceCommand (a, TSC)
commands = StateT
TSC
IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
-> TSC
-> IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (SequenceCommand (a, TSC)
-> StateT
TSC
IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume SequenceCommand (a, TSC)
commands) TSC
tsc
resumeSequence :: Float -> SequencePause a -> IO (SequencePause a)
resumeSequence :: forall a. Float -> SequencePause a -> IO (SequencePause a)
resumeSequence Float
delta (Left (Request TSC
tsc Float -> SequenceCommand (a, TSC)
response)) = TSC
-> SequenceCommand (a, TSC)
-> IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
forall a. TSC -> SequenceCommand (a, TSC) -> IO (SequencePause a)
runSequence TSC
tsc (SequenceCommand (a, TSC)
-> IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC)))
-> SequenceCommand (a, TSC)
-> IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
forall a b. (a -> b) -> a -> b
$ Float -> SequenceCommand (a, TSC)
response Float
delta
resumeSequence Float
_ Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC)
a = Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC)
-> IO
(Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC))
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Request TSC Float (SequenceCommand (a, TSC))) (a, TSC)
a
renderPause :: SequencePause a -> Picture
renderPause :: forall a. SequencePause a -> Picture
renderPause SequencePause a
sq = TSC -> Picture
renderTurtle (TSC -> Picture) -> TSC -> Picture
forall a b. (a -> b) -> a -> b
$ SequencePause a -> TSC
forall a. SequencePause a -> TSC
stateForPause SequencePause a
sq
stateForPause :: SequencePause a -> TSC
stateForPause :: forall a. SequencePause a -> TSC
stateForPause (Left (Request TSC
s Float -> SequenceCommand (a, TSC)
_)) = TSC
s
stateForPause (Right (a
_, TSC
s)) = TSC
s
renderTurtle :: TSC -> Picture
renderTurtle :: TSC -> Picture
renderTurtle TSC
t = [Picture] -> Picture
forall a. Monoid a => [a] -> a
mconcat ([Picture] -> Picture) -> [Picture] -> Picture
forall a b. (a -> b) -> a -> b
$
(TSC
t TSC -> Getting [Picture] TSC [Picture] -> [Picture]
forall s a. s -> Getting a s a -> a
^. Getting [Picture] TSC [Picture]
Lens' TSC [Picture]
finalPics) [Picture] -> [Picture] -> [Picture]
forall a. [a] -> [a] -> [a]
++
(TSC
t TSC -> Getting [Picture] TSC [Picture] -> [Picture]
forall s a. s -> Getting a s a -> a
^. Getting [Picture] TSC [Picture]
Lens' TSC [Picture]
pics) [Picture] -> [Picture] -> [Picture]
forall a. [a] -> [a] -> [a]
++
Map Turtle TurtleData -> [Picture]
drawTurtles (TSC
t TSC
-> Getting (Map Turtle TurtleData) TSC (Map Turtle TurtleData)
-> Map Turtle TurtleData
forall s a. s -> Getting a s a -> a
^. Getting (Map Turtle TurtleData) TSC (Map Turtle TurtleData)
Lens' TSC (Map Turtle TurtleData)
turtles)
drawTurtles :: Map Turtle TurtleData -> [Picture]
drawTurtles :: Map Turtle TurtleData -> [Picture]
drawTurtles Map Turtle TurtleData
m = TurtleData -> Picture
drawTurtle (TurtleData -> Picture) -> [TurtleData] -> [Picture]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Turtle TurtleData -> [TurtleData]
forall k a. Map k a -> [a]
Map.elems Map Turtle TurtleData
m
generateTurtle :: SequenceCommand Turtle
generateTurtle :: SequenceCommand Turtle
generateTurtle = TurtleState Turtle -> SequenceCommand Turtle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Turtle -> SequenceCommand Turtle)
-> TurtleState Turtle -> SequenceCommand Turtle
forall a b. (a -> b) -> a -> b
$ do
Turtle
t <- Int -> Turtle
Turtle (Int -> Turtle) -> TurtleState Int -> TurtleState Turtle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Int TSC Int -> TurtleState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int TSC Int
Lens' TSC Int
nextTurtleId
(Map Turtle TurtleData -> Identity (Map Turtle TurtleData))
-> TSC -> Identity TSC
Lens' TSC (Map Turtle TurtleData)
turtles ((Map Turtle TurtleData -> Identity (Map Turtle TurtleData))
-> TSC -> Identity TSC)
-> (Map Turtle TurtleData -> Map Turtle TurtleData)
-> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Turtle
-> TurtleData -> Map Turtle TurtleData -> Map Turtle TurtleData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Turtle
t TurtleData
defaultTurtle
(Int -> Identity Int) -> TSC -> Identity TSC
Lens' TSC Int
nextTurtleId ((Int -> Identity Int) -> TSC -> Identity TSC)
-> Int -> TurtleState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
Turtle -> TurtleState Turtle
forall (m :: * -> *) a. Monad m => a -> m a
return Turtle
t
animate' :: Float
-> Float
-> (Float -> SequenceCommand a)
-> SequenceCommand a
animate' :: forall a.
Float -> Float -> (Float -> SequenceCommand a) -> SequenceCommand a
animate' Float
distance Float
turtleSpeed Float -> SequenceCommand a
callback =
let duration :: Float
duration = Float
distance Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
turtleSpeed
d' :: Float
d' = if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
duration Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
duration then Float
0 else Float
duration
in do
a
t <- Float -> (Float -> SequenceCommand a) -> SequenceCommand a
forall a.
Float -> (Float -> SequenceCommand a) -> SequenceCommand a
animate (Float -> Float
forall a. Num a => a -> a
abs Float
d') Float -> SequenceCommand a
callback
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ do
[Picture]
p <- Getting [Picture] TSC [Picture] -> TurtleState [Picture]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [Picture] TSC [Picture]
Lens' TSC [Picture]
pics
([Picture] -> Identity [Picture]) -> TSC -> Identity TSC
Lens' TSC [Picture]
finalPics (([Picture] -> Identity [Picture]) -> TSC -> Identity TSC)
-> ([Picture] -> [Picture]) -> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Picture] -> [Picture]) -> [Picture] -> [Picture]
forall a b. (a -> b) -> a -> b
($!) ([Picture] -> [Picture] -> [Picture]
forall a. [a] -> [a] -> [a]
++ [Picture]
p)
([Picture] -> Identity [Picture]) -> TSC -> Identity TSC
Lens' TSC [Picture]
pics (([Picture] -> Identity [Picture]) -> TSC -> Identity TSC)
-> [Picture] -> TurtleState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Picture]
forall a. Monoid a => a
mempty
a -> SequenceCommand a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t
animate :: Float
-> (Float -> SequenceCommand a)
-> SequenceCommand a
animate :: forall a.
Float -> (Float -> SequenceCommand a) -> SequenceCommand a
animate Float
duration Float -> SequenceCommand a
callback = do
TSC
oldState <- StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get
Float
timeRemaining <- TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float)
-> TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall a b. (a -> b) -> a -> b
$ Getting Float TSC Float -> TurtleState Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float TSC Float
Lens' TSC Float
simTime
let availableTime :: Float
availableTime = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
timeRemaining Float
duration
let timeQuot :: Float
timeQuot = if Float
availableTime Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float
1 else Float
availableTime Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
duration
a
t <- Float -> SequenceCommand a
callback Float
timeQuot
Bool
outOfTime <- Float -> SequenceCommand Bool
decrementSimTime Float
availableTime
if Bool
outOfTime then do
let oldTime :: Float
oldTime = TSC
oldState TSC -> Getting Float TSC Float -> Float
forall s a. s -> Getting a s a -> a
^. Getting Float TSC Float
Lens' TSC Float
simTime
Float
newTime <- TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float)
-> TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall a b. (a -> b) -> a -> b
$ Getting Float TSC Float -> TurtleState Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float TSC Float
Lens' TSC Float
simTime
let time :: Float
time = Float
newTime Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oldTime
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ TSC -> TurtleState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TSC -> TurtleState ()) -> TSC -> TurtleState ()
forall a b. (a -> b) -> a -> b
$ TSC
oldState TSC -> (TSC -> TSC) -> TSC
forall a b. a -> (a -> b) -> b
& (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TSC -> TSC
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
time
Float -> (Float -> SequenceCommand a) -> SequenceCommand a
forall a.
Float -> (Float -> SequenceCommand a) -> SequenceCommand a
animate Float
duration Float -> SequenceCommand a
callback
else
a -> SequenceCommand a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t
runParallel :: (a -> b -> SequenceCommand c)
-> SequenceCommand a
-> SequenceCommand b
-> SequenceCommand c
runParallel :: forall a b c.
(a -> b -> SequenceCommand c)
-> SequenceCommand a -> SequenceCommand b -> SequenceCommand c
runParallel a -> b -> SequenceCommand c
f SequenceCommand a
a SequenceCommand b
b =
let a' :: Coroutine (Request TSC Float) TurtleState (a, TSC)
a' = SequenceCommand a
a SequenceCommand a
-> (a -> Coroutine (Request TSC Float) TurtleState (a, TSC))
-> Coroutine (Request TSC Float) TurtleState (a, TSC)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
ax -> StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get Coroutine (Request TSC Float) TurtleState TSC
-> (TSC -> Coroutine (Request TSC Float) TurtleState (a, TSC))
-> Coroutine (Request TSC Float) TurtleState (a, TSC)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TSC
g -> (a, TSC) -> Coroutine (Request TSC Float) TurtleState (a, TSC)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ax, TSC
g)
b' :: Coroutine (Request TSC Float) TurtleState (b, TSC)
b' = SequenceCommand b
b SequenceCommand b
-> (b -> Coroutine (Request TSC Float) TurtleState (b, TSC))
-> Coroutine (Request TSC Float) TurtleState (b, TSC)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
bx -> StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get Coroutine (Request TSC Float) TurtleState TSC
-> (TSC -> Coroutine (Request TSC Float) TurtleState (b, TSC))
-> Coroutine (Request TSC Float) TurtleState (b, TSC)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TSC
g -> (b, TSC) -> Coroutine (Request TSC Float) TurtleState (b, TSC)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
bx, TSC
g)
in (a -> b -> SequenceCommand c)
-> Coroutine (Request TSC Float) TurtleState (a, TSC)
-> Coroutine (Request TSC Float) TurtleState (b, TSC)
-> SequenceCommand c
forall a b c.
(a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
runParallel_ a -> b -> SequenceCommand c
f Coroutine (Request TSC Float) TurtleState (a, TSC)
a' Coroutine (Request TSC Float) TurtleState (b, TSC)
b'
runParallel_ :: (a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
runParallel_ :: forall a b c.
(a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
runParallel_ a -> b -> SequenceCommand c
f SequenceCommand (a, TSC)
a SequenceCommand (b, TSC)
b = do
Float
startSimTime <- TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float)
-> TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall a b. (a -> b) -> a -> b
$ Getting Float TSC Float -> TurtleState Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float TSC Float
Lens' TSC Float
simTime
TSC
s <- StateT TSC IO TSC -> Coroutine (Request TSC Float) TurtleState TSC
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT TSC IO TSC
forall (m :: * -> *) s. Monad m => StateT s m s
get
SequencePause a
aVal <- IO (SequencePause a)
-> Coroutine (Request TSC Float) TurtleState (SequencePause a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SequencePause a)
-> Coroutine (Request TSC Float) TurtleState (SequencePause a))
-> IO (SequencePause a)
-> Coroutine (Request TSC Float) TurtleState (SequencePause a)
forall a b. (a -> b) -> a -> b
$ TSC -> SequenceCommand (a, TSC) -> IO (SequencePause a)
forall a. TSC -> SequenceCommand (a, TSC) -> IO (SequencePause a)
runSequence TSC
s SequenceCommand (a, TSC)
a
let s' :: TSC
s' = SequencePause a -> TSC
forall {request} {response} {x} {a}.
Either (Request request response x) (a, request) -> request
grabState SequencePause a
aVal
let aTime :: Float
aTime = TSC
s' TSC -> Getting Float TSC Float -> Float
forall s a. s -> Getting a s a -> a
^. Getting Float TSC Float
Lens' TSC Float
simTime
let s'' :: TSC
s'' = TSC
s' TSC -> (TSC -> TSC) -> TSC
forall a b. a -> (a -> b) -> b
& (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TSC -> TSC
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
startSimTime
SequencePause b
bVal <- IO (SequencePause b)
-> Coroutine (Request TSC Float) TurtleState (SequencePause b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SequencePause b)
-> Coroutine (Request TSC Float) TurtleState (SequencePause b))
-> IO (SequencePause b)
-> Coroutine (Request TSC Float) TurtleState (SequencePause b)
forall a b. (a -> b) -> a -> b
$ TSC -> SequenceCommand (b, TSC) -> IO (SequencePause b)
forall a. TSC -> SequenceCommand (a, TSC) -> IO (SequencePause a)
runSequence TSC
s'' SequenceCommand (b, TSC)
b
let s''' :: TSC
s''' = SequencePause b -> TSC
forall {request} {response} {x} {a}.
Either (Request request response x) (a, request) -> request
grabState SequencePause b
bVal
let bTime :: Float
bTime = TSC
s''' TSC -> Getting Float TSC Float -> Float
forall s a. s -> Getting a s a -> a
^. Getting Float TSC Float
Lens' TSC Float
simTime
let elapsedTime :: Float
elapsedTime = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
aTime Float
bTime
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ TSC -> TurtleState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TSC
s''' TSC -> (TSC -> TSC) -> TSC
forall a b. a -> (a -> b) -> b
& (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TSC -> TSC
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
elapsedTime)
Bool
outOfTime <- Float -> SequenceCommand Bool
decrementSimTime Float
0
Float
newTime <- TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float)
-> TurtleState Float
-> Coroutine (Request TSC Float) TurtleState Float
forall a b. (a -> b) -> a -> b
$ Getting Float TSC Float -> TurtleState Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float TSC Float
Lens' TSC Float
simTime
if Bool
outOfTime then do
let time :: Float
time = Float
newTime Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
startSimTime
TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TurtleState () -> Coroutine (Request TSC Float) TurtleState ())
-> TurtleState () -> Coroutine (Request TSC Float) TurtleState ()
forall a b. (a -> b) -> a -> b
$ TSC -> TurtleState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (TSC -> TurtleState ()) -> TSC -> TurtleState ()
forall a b. (a -> b) -> a -> b
$ TSC
s TSC -> (TSC -> TSC) -> TSC
forall a b. a -> (a -> b) -> b
& (Float -> Identity Float) -> TSC -> Identity TSC
Lens' TSC Float
simTime ((Float -> Identity Float) -> TSC -> Identity TSC)
-> Float -> TSC -> TSC
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
time
(a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
forall a b c.
(a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
runParallel_ a -> b -> SequenceCommand c
f SequenceCommand (a, TSC)
a SequenceCommand (b, TSC)
b
else do
(a -> b -> SequenceCommand c)
-> Float -> SequencePause a -> SequencePause b -> SequenceCommand c
forall a b c.
(a -> b -> SequenceCommand c)
-> Float -> SequencePause a -> SequencePause b -> SequenceCommand c
combinePauses_ a -> b -> SequenceCommand c
f Float
newTime SequencePause a
aVal SequencePause b
bVal
where grabState :: Either (Request request response x) (a, request) -> request
grabState (Left (Request request
s response -> x
_)) = request
s
grabState (Right (a
_, request
s)) = request
s
combinePauses_ :: (a -> b -> SequenceCommand c) -> Float -> SequencePause a -> SequencePause b -> SequenceCommand c
combinePauses_ :: forall a b c.
(a -> b -> SequenceCommand c)
-> Float -> SequencePause a -> SequencePause b -> SequenceCommand c
combinePauses_ a -> b -> SequenceCommand c
f Float
_ (Right (a
a, TSC
_)) (Right (b
b, TSC
_)) = a -> b -> SequenceCommand c
f a
a b
b
combinePauses_ a -> b -> SequenceCommand c
f Float
d (Right (a
a, TSC
_)) (Left (Request TSC
_ Float -> SequenceCommand (b, TSC)
y)) = Float -> SequenceCommand (b, TSC)
y Float
d SequenceCommand (b, TSC)
-> ((b, TSC) -> SequenceCommand c) -> SequenceCommand c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> b -> SequenceCommand c
f a
a (b -> SequenceCommand c)
-> ((b, TSC) -> b) -> (b, TSC) -> SequenceCommand c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, TSC) -> b
forall a b. (a, b) -> a
fst
combinePauses_ a -> b -> SequenceCommand c
f Float
d (Left (Request TSC
_ Float -> SequenceCommand (a, TSC)
x)) (Right (b
b, TSC
_)) = Float -> SequenceCommand (a, TSC)
x Float
d SequenceCommand (a, TSC)
-> ((a, TSC) -> SequenceCommand c) -> SequenceCommand c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b -> SequenceCommand c
`f` b
b) (a -> SequenceCommand c)
-> ((a, TSC) -> a) -> (a, TSC) -> SequenceCommand c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, TSC) -> a
forall a b. (a, b) -> a
fst
combinePauses_ a -> b -> SequenceCommand c
f Float
d (Left (Request TSC
_ Float -> SequenceCommand (a, TSC)
x)) (Left (Request TSC
_ Float -> SequenceCommand (b, TSC)
y)) = (a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
forall a b c.
(a -> b -> SequenceCommand c)
-> SequenceCommand (a, TSC)
-> SequenceCommand (b, TSC)
-> SequenceCommand c
runParallel_ a -> b -> SequenceCommand c
f (Float -> SequenceCommand (a, TSC)
x Float
d) (Float -> SequenceCommand (b, TSC)
y Float
d)