{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
module Graphics.WorldTurtle.Internal.Sequence
( Turtle
, TSC
, SequenceCommand
, AlmostVal
, renderTurtle
, addPicture
, simTime
, setSimTime
, decrementSimTime
, pics
, totalSimTime
, turtles
, generateTurtle
, animate'
, animate
, combineSequence
, alternateSequence
, failSequence
) where
import Graphics.WorldTurtle.Internal.Turtle
import Graphics.Gloss.Data.Picture (Picture, pictures)
import Control.Monad.Cont
import Control.Monad.State
import Control.Lens
import Data.Void (Void, absurd)
import Data.Maybe (isNothing, isJust)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
type AlmostVal a = Maybe a
type TurtleState b = State (TSC b)
type SequenceCommand b a = ContT b (TurtleState b) a
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
$cp1Ord :: Eq Turtle
Ord)
data TSC b = TSC
{ TSC b -> [Picture]
_pics :: ![Picture]
, TSC b -> SequenceCommand b b
_exitCall :: SequenceCommand b b
, TSC b -> Float
_totalSimTime :: !Float
, TSC b -> Map Turtle TurtleData
_turtles :: Map Turtle TurtleData
, TSC b -> Int
_nextTurtleId :: !Int
}
$(makeLenses ''TSC)
defaultTSC :: Float -> TSC b
defaultTSC :: Float -> TSC b
defaultTSC Float
givenTime = TSC :: forall b.
[Picture]
-> SequenceCommand b b
-> Float
-> Map Turtle TurtleData
-> Int
-> TSC b
TSC
{ _pics :: [Picture]
_pics = []
, _totalSimTime :: Float
_totalSimTime = Float
givenTime
, _exitCall :: SequenceCommand b b
_exitCall = [Char] -> SequenceCommand b b
forall a. HasCallStack => [Char] -> a
error [Char]
"Exit called but not defined in animation."
, _turtles :: Map Turtle TurtleData
_turtles = Map Turtle TurtleData
forall k a. Map k a
Map.empty
, _nextTurtleId :: Int
_nextTurtleId = Int
0
}
simTime :: SequenceCommand b Float
simTime :: SequenceCommand b Float
simTime = Getting Float (TSC b) Float -> SequenceCommand b Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float (TSC b) Float
forall b. Lens' (TSC b) Float
totalSimTime
setSimTime :: Float -> SequenceCommand b ()
setSimTime :: Float -> SequenceCommand b ()
setSimTime Float
newTime = do
let newTime' :: Float
newTime' = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 Float
newTime
(Float -> Identity Float) -> TSC b -> Identity (TSC b)
forall b. Lens' (TSC b) Float
totalSimTime ((Float -> Identity Float) -> TSC b -> Identity (TSC b))
-> Float -> SequenceCommand b ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Float
newTime'
Bool -> SequenceCommand b () -> SequenceCommand b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Float
newTime' Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0) SequenceCommand b ()
forall b a. SequenceCommand b a
failSequence
decrementSimTime :: Float
-> SequenceCommand b ()
decrementSimTime :: Float -> SequenceCommand b ()
decrementSimTime Float
duration = SequenceCommand b Float
forall b. SequenceCommand b Float
simTime SequenceCommand b Float
-> (Float -> SequenceCommand b ()) -> SequenceCommand b ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Float -> SequenceCommand b ()
forall b. Float -> SequenceCommand b ()
setSimTime (Float -> SequenceCommand b ())
-> (Float -> Float) -> Float -> SequenceCommand b ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float) -> Float -> Float -> Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Float
duration
addPicture :: Picture
-> SequenceCommand b ()
addPicture :: Picture -> SequenceCommand b ()
addPicture Picture
p = ([Picture] -> Identity [Picture]) -> TSC b -> Identity (TSC b)
forall b. Lens' (TSC b) [Picture]
pics (([Picture] -> Identity [Picture]) -> TSC b -> Identity (TSC b))
-> ([Picture] -> [Picture]) -> SequenceCommand b ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Picture
p Picture -> [Picture] -> [Picture]
forall a. a -> [a] -> [a]
:)
exitCondition :: SequenceCommand (AlmostVal a) a
-> SequenceCommand (AlmostVal a) (AlmostVal a)
exitCondition :: SequenceCommand (AlmostVal a) a
-> SequenceCommand (AlmostVal a) (AlmostVal a)
exitCondition SequenceCommand (AlmostVal a) a
commands = ((AlmostVal a -> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((AlmostVal a -> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a))
-> ((AlmostVal a -> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a))
-> SequenceCommand (AlmostVal a) (AlmostVal a)
forall a b. (a -> b) -> a -> b
$ \AlmostVal a -> SequenceCommand (AlmostVal a) (AlmostVal a)
exit -> do
(SequenceCommand (AlmostVal a) (AlmostVal a)
-> Identity (SequenceCommand (AlmostVal a) (AlmostVal a)))
-> TSC (AlmostVal a) -> Identity (TSC (AlmostVal a))
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall ((SequenceCommand (AlmostVal a) (AlmostVal a)
-> Identity (SequenceCommand (AlmostVal a) (AlmostVal a)))
-> TSC (AlmostVal a) -> Identity (TSC (AlmostVal a)))
-> SequenceCommand (AlmostVal a) (AlmostVal a)
-> ContT (AlmostVal a) (TurtleState (AlmostVal a)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlmostVal a -> SequenceCommand (AlmostVal a) (AlmostVal a)
exit AlmostVal a
forall a. Maybe a
Nothing
Float -> ContT (AlmostVal a) (TurtleState (AlmostVal a)) ()
forall b. Float -> SequenceCommand b ()
decrementSimTime Float
0
a -> AlmostVal a
forall a. a -> Maybe a
Just (a -> AlmostVal a)
-> SequenceCommand (AlmostVal a) a
-> SequenceCommand (AlmostVal a) (AlmostVal a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceCommand (AlmostVal a) a
commands
processTurtle :: SequenceCommand (AlmostVal a) a
-> TSC (AlmostVal a)
-> (AlmostVal a, TSC (AlmostVal a))
processTurtle :: SequenceCommand (AlmostVal a) a
-> TSC (AlmostVal a) -> (AlmostVal a, TSC (AlmostVal a))
processTurtle SequenceCommand (AlmostVal a) a
commands TSC (AlmostVal a)
tsc =
let drawS :: TurtleState (AlmostVal a) (AlmostVal a)
drawS = ContT (AlmostVal a) (TurtleState (AlmostVal a)) (AlmostVal a)
-> (AlmostVal a -> TurtleState (AlmostVal a) (AlmostVal a))
-> TurtleState (AlmostVal a) (AlmostVal a)
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT (SequenceCommand (AlmostVal a) a
-> ContT (AlmostVal a) (TurtleState (AlmostVal a)) (AlmostVal a)
forall a.
SequenceCommand (AlmostVal a) a
-> SequenceCommand (AlmostVal a) (AlmostVal a)
exitCondition SequenceCommand (AlmostVal a) a
commands) AlmostVal a -> TurtleState (AlmostVal a) (AlmostVal a)
forall (m :: * -> *) a. Monad m => a -> m a
return
in TurtleState (AlmostVal a) (AlmostVal a)
-> TSC (AlmostVal a) -> (AlmostVal a, TSC (AlmostVal a))
forall s a. State s a -> s -> (a, s)
runState TurtleState (AlmostVal a) (AlmostVal a)
drawS TSC (AlmostVal a)
tsc
renderTurtle :: SequenceCommand (AlmostVal a) a -> Float -> Picture
renderTurtle :: SequenceCommand (AlmostVal a) a -> Float -> Picture
renderTurtle SequenceCommand (AlmostVal a) a
c Float
f = let (AlmostVal a
_, TSC (AlmostVal a)
s) = SequenceCommand (AlmostVal a) a
-> TSC (AlmostVal a) -> (AlmostVal a, TSC (AlmostVal a))
forall a.
SequenceCommand (AlmostVal a) a
-> TSC (AlmostVal a) -> (AlmostVal a, TSC (AlmostVal a))
processTurtle SequenceCommand (AlmostVal a) a
c (Float -> TSC (AlmostVal a)
forall b. Float -> TSC b
defaultTSC Float
f)
in [Picture] -> Picture
pictures ([Picture] -> Picture) -> [Picture] -> Picture
forall a b. (a -> b) -> a -> b
$ TSC (AlmostVal a)
s TSC (AlmostVal a)
-> Getting [Picture] (TSC (AlmostVal a)) [Picture] -> [Picture]
forall s a. s -> Getting a s a -> a
^. Getting [Picture] (TSC (AlmostVal a)) [Picture]
forall b. Lens' (TSC b) [Picture]
pics [Picture] -> [Picture] -> [Picture]
forall a. [a] -> [a] -> [a]
++ Map Turtle TurtleData -> [Picture]
drawTurtles (TSC (AlmostVal a)
s TSC (AlmostVal a)
-> Getting
(Map Turtle TurtleData) (TSC (AlmostVal a)) (Map Turtle TurtleData)
-> Map Turtle TurtleData
forall s a. s -> Getting a s a -> a
^. Getting
(Map Turtle TurtleData) (TSC (AlmostVal a)) (Map Turtle TurtleData)
forall b. Lens' (TSC b) (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 b Turtle
generateTurtle :: SequenceCommand b Turtle
generateTurtle = do
Turtle
t <- Int -> Turtle
Turtle (Int -> Turtle)
-> ContT b (TurtleState b) Int -> SequenceCommand b Turtle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Int (TSC b) Int -> ContT b (TurtleState b) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int (TSC b) Int
forall b. Lens' (TSC b) Int
nextTurtleId
(Map Turtle TurtleData -> Identity (Map Turtle TurtleData))
-> TSC b -> Identity (TSC b)
forall b. Lens' (TSC b) (Map Turtle TurtleData)
turtles ((Map Turtle TurtleData -> Identity (Map Turtle TurtleData))
-> TSC b -> Identity (TSC b))
-> (Map Turtle TurtleData -> Map Turtle TurtleData)
-> ContT b (TurtleState b) ()
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 b -> Identity (TSC b)
forall b. Lens' (TSC b) Int
nextTurtleId ((Int -> Identity Int) -> TSC b -> Identity (TSC b))
-> Int -> ContT b (TurtleState b) ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
Turtle -> SequenceCommand b Turtle
forall (m :: * -> *) a. Monad m => a -> m a
return Turtle
t
animate' :: Float
-> Float
-> (Float -> SequenceCommand b a)
-> SequenceCommand b a
animate' :: Float
-> Float -> (Float -> SequenceCommand b a) -> SequenceCommand b a
animate' !Float
distance !Float
turtleSpeed Float -> SequenceCommand b 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 Float -> (Float -> SequenceCommand b a) -> SequenceCommand b a
forall b a.
Float -> (Float -> SequenceCommand b a) -> SequenceCommand b a
animate (Float -> Float
forall a. Num a => a -> a
abs Float
d') Float -> SequenceCommand b a
callback
animate :: Float -> (Float -> SequenceCommand b a) -> SequenceCommand b a
animate :: Float -> (Float -> SequenceCommand b a) -> SequenceCommand b a
animate !Float
duration Float -> SequenceCommand b a
callback = do
Float
timeRemaining <- SequenceCommand b Float
forall b. SequenceCommand b 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 b a
callback Float
timeQuot
Float -> SequenceCommand b ()
forall b. Float -> SequenceCommand b ()
decrementSimTime Float
availableTime
a -> SequenceCommand b a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t
combineSequence :: Semigroup a
=> SequenceCommand b a
-> SequenceCommand b a
-> SequenceCommand b a
combineSequence :: SequenceCommand b a -> SequenceCommand b a -> SequenceCommand b a
combineSequence SequenceCommand b a
a SequenceCommand b a
b = do
(!AlmostVal a
aVal, !AlmostVal a
bVal) <- SequenceCommand b a
-> SequenceCommand b a
-> SequenceCommand b (AlmostVal a, AlmostVal a)
forall c a b.
SequenceCommand c a
-> SequenceCommand c b
-> SequenceCommand c (AlmostVal a, AlmostVal b)
runParallel SequenceCommand b a
a SequenceCommand b a
b
Bool -> ContT b (TurtleState b) () -> ContT b (TurtleState b) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AlmostVal a -> Bool
forall a. Maybe a -> Bool
isNothing AlmostVal a
aVal Bool -> Bool -> Bool
|| AlmostVal a -> Bool
forall a. Maybe a -> Bool
isNothing AlmostVal a
bVal) ContT b (TurtleState b) ()
forall b a. SequenceCommand b a
failSequence
let (Just !a
aVal') = AlmostVal a
aVal
let (Just !a
bVal') = AlmostVal a
bVal
a -> SequenceCommand b a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SequenceCommand b a) -> a -> SequenceCommand b a
forall a b. (a -> b) -> a -> b
$ a
aVal' a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
bVal'
alternateSequence :: SequenceCommand b a
-> SequenceCommand b a
-> SequenceCommand b a
alternateSequence :: SequenceCommand b a -> SequenceCommand b a -> SequenceCommand b a
alternateSequence SequenceCommand b a
a SequenceCommand b a
b = do
(!AlmostVal a
aVal, !AlmostVal a
bVal) <- SequenceCommand b a
-> SequenceCommand b a
-> SequenceCommand b (AlmostVal a, AlmostVal a)
forall c a b.
SequenceCommand c a
-> SequenceCommand c b
-> SequenceCommand c (AlmostVal a, AlmostVal b)
runParallel SequenceCommand b a
a SequenceCommand b a
b
Bool -> ContT b (TurtleState b) () -> ContT b (TurtleState b) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AlmostVal a -> Bool
forall a. Maybe a -> Bool
isNothing AlmostVal a
aVal Bool -> Bool -> Bool
&& AlmostVal a -> Bool
forall a. Maybe a -> Bool
isNothing AlmostVal a
bVal) ContT b (TurtleState b) ()
forall b a. SequenceCommand b a
failSequence
if AlmostVal a -> Bool
forall a. Maybe a -> Bool
isJust AlmostVal a
aVal
then let (Just !a
aVal') = AlmostVal a
aVal in a -> SequenceCommand b a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SequenceCommand b a) -> a -> SequenceCommand b a
forall a b. (a -> b) -> a -> b
$! a
aVal'
else let (Just !a
bVal') = AlmostVal a
bVal in a -> SequenceCommand b a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SequenceCommand b a) -> a -> SequenceCommand b a
forall a b. (a -> b) -> a -> b
$! a
bVal'
runParallel :: SequenceCommand c a
-> SequenceCommand c b
-> SequenceCommand c (AlmostVal a, AlmostVal b)
runParallel :: SequenceCommand c a
-> SequenceCommand c b
-> SequenceCommand c (AlmostVal a, AlmostVal b)
runParallel SequenceCommand c a
a SequenceCommand c b
b = do
Float
startSimTime <- Getting Float (TSC c) Float -> ContT c (TurtleState c) Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float (TSC c) Float
forall b. Lens' (TSC b) Float
totalSimTime
SequenceCommand c c
parentExitCall <- Getting (SequenceCommand c c) (TSC c) (SequenceCommand c c)
-> ContT c (TurtleState c) (SequenceCommand c c)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (SequenceCommand c c) (TSC c) (SequenceCommand c c)
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall
AlmostVal a
aVal <- ((AlmostVal a -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal a))
-> ContT c (TurtleState c) (AlmostVal a)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((AlmostVal a -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal a))
-> ContT c (TurtleState c) (AlmostVal a))
-> ((AlmostVal a -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal a))
-> ContT c (TurtleState c) (AlmostVal a)
forall a b. (a -> b) -> a -> b
$ \ AlmostVal a -> SequenceCommand c c
exitFromA -> do
(SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c)
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall ((SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c))
-> SequenceCommand c c -> ContT c (TurtleState c) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlmostVal a -> SequenceCommand c c
exitFromA AlmostVal a
forall a. Maybe a
Nothing
a -> AlmostVal a
forall a. a -> Maybe a
Just (a -> AlmostVal a)
-> SequenceCommand c a -> ContT c (TurtleState c) (AlmostVal a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceCommand c a
a
Float
aSimTime <- Getting Float (TSC c) Float -> ContT c (TurtleState c) Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float (TSC c) Float
forall b. Lens' (TSC b) Float
totalSimTime
AlmostVal b
bVal <- ((AlmostVal b -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal b))
-> ContT c (TurtleState c) (AlmostVal b)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((AlmostVal b -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal b))
-> ContT c (TurtleState c) (AlmostVal b))
-> ((AlmostVal b -> SequenceCommand c c)
-> ContT c (TurtleState c) (AlmostVal b))
-> ContT c (TurtleState c) (AlmostVal b)
forall a b. (a -> b) -> a -> b
$ \ AlmostVal b -> SequenceCommand c c
exitFromB -> do
(SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c)
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall ((SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c))
-> SequenceCommand c c -> ContT c (TurtleState c) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlmostVal b -> SequenceCommand c c
exitFromB AlmostVal b
forall a. Maybe a
Nothing
(Float -> Identity Float) -> TSC c -> Identity (TSC c)
forall b. Lens' (TSC b) Float
totalSimTime ((Float -> Identity Float) -> TSC c -> Identity (TSC c))
-> Float -> ContT c (TurtleState c) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Float
startSimTime
b -> AlmostVal b
forall a. a -> Maybe a
Just (b -> AlmostVal b)
-> SequenceCommand c b -> ContT c (TurtleState c) (AlmostVal b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceCommand c b
b
Float
bSimTime <- Getting Float (TSC c) Float -> ContT c (TurtleState c) Float
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Float (TSC c) Float
forall b. Lens' (TSC b) Float
totalSimTime
(Float -> Identity Float) -> TSC c -> Identity (TSC c)
forall b. Lens' (TSC b) Float
totalSimTime ((Float -> Identity Float) -> TSC c -> Identity (TSC c))
-> Float -> ContT c (TurtleState c) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
aSimTime Float
bSimTime
(SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c)
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall ((SequenceCommand c c -> Identity (SequenceCommand c c))
-> TSC c -> Identity (TSC c))
-> SequenceCommand c c -> ContT c (TurtleState c) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SequenceCommand c c
parentExitCall
Float -> ContT c (TurtleState c) ()
forall b. Float -> SequenceCommand b ()
decrementSimTime Float
0
(AlmostVal a, AlmostVal b)
-> SequenceCommand c (AlmostVal a, AlmostVal b)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlmostVal a
aVal, AlmostVal b
bVal)
failSequence :: SequenceCommand b a
failSequence :: SequenceCommand b a
failSequence = do
SequenceCommand b b
ex <- Getting (SequenceCommand b b) (TSC b) (SequenceCommand b b)
-> ContT b (TurtleState b) (SequenceCommand b b)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (SequenceCommand b b) (TSC b) (SequenceCommand b b)
forall b b.
Lens (TSC b) (TSC b) (SequenceCommand b b) (SequenceCommand b b)
exitCall
b
_ <- SequenceCommand b b
ex
let (Just Void
x) = (Maybe Void
forall a. Maybe a
Nothing :: Maybe Void)
in Void -> SequenceCommand b a
forall a. Void -> a
absurd Void
x