{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-name-shadowing -Wno-star-is-type #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Redundant bracket" #-}
module CodeWorld.EntryPoints where
import CodeWorld.Color
import CodeWorld.Driver
import CodeWorld.Event
import CodeWorld.Picture
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Prim
import GHC.StaticPtr
import GHC.Types
import Numeric (showFFloatAlt)
import System.IO
import System.IO.Unsafe
import System.Random
activityOf ::
world ->
(Event -> world -> world) ->
(world -> Picture) ->
IO ()
activityOf :: forall world.
world -> (Event -> world -> world) -> (world -> Picture) -> IO ()
activityOf world
initial Event -> world -> world
change world -> Picture
picture = do
Handle -> IO ()
hFlush Handle
stdout
forall s.
s
-> (Double -> s -> s)
-> (Event -> s -> s)
-> (s -> Picture)
-> (s -> Picture)
-> IO ()
runInspect world
initial (forall a b. a -> b -> a
const forall a. a -> a
id) Event -> world -> world
change world -> Picture
picture world -> Picture
picture
data Timeline a = Timeline
{ forall a. Timeline a -> [a]
past :: [a],
forall a. Timeline a -> a
present :: !a,
forall a. Timeline a -> [a]
future :: [a]
}
newTimeline :: a -> Timeline a
newTimeline :: forall a. a -> Timeline a
newTimeline a
x = forall a. [a] -> a -> [a] -> Timeline a
Timeline [] a
x []
applyToTimeline :: (a -> a) -> Timeline a -> Timeline a
applyToTimeline :: forall a. (a -> a) -> Timeline a -> Timeline a
applyToTimeline a -> a
f timeline :: Timeline a
timeline@(Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..})
| forall a. a -> a -> Bool
identical a
present a
new = Timeline a
timeline
| Bool
otherwise = forall a. [a] -> a -> [a] -> Timeline a
Timeline (a
present forall a. a -> [a] -> [a]
: [a]
past) a
new []
where
new :: a
new = a -> a
f a
present
undoTimeline :: Timeline a -> Timeline a
undoTimeline :: forall a. Timeline a -> Timeline a
undoTimeline timeline :: Timeline a
timeline@(Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..}) = case [a]
past of
[] -> Timeline a
timeline
(a
x : [a]
xs) -> forall a. [a] -> a -> [a] -> Timeline a
Timeline [a]
xs a
x (a
present forall a. a -> [a] -> [a]
: [a]
future)
redoTimeline :: Timeline a -> Timeline a
redoTimeline :: forall a. Timeline a -> Timeline a
redoTimeline timeline :: Timeline a
timeline@(Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..}) = case [a]
future of
[] -> Timeline a
timeline
(a
x : [a]
xs) -> forall a. [a] -> a -> [a] -> Timeline a
Timeline (a
present forall a. a -> [a] -> [a]
: [a]
past) a
x [a]
xs
restartTimeline :: Timeline a -> Timeline a
restartTimeline :: forall a. Timeline a -> Timeline a
restartTimeline timeline :: Timeline a
timeline@(Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..}) = case forall a. [a] -> [a]
reverse [a]
past of
[] -> Timeline a
timeline
a
x : [a]
xs -> forall a. [a] -> a -> [a] -> Timeline a
Timeline [] a
x ([a]
xs forall a. [a] -> [a] -> [a]
++ a
present forall a. a -> [a] -> [a]
: [a]
future)
timelineLength :: Timeline a -> Int
timelineLength :: forall a. Timeline a -> Int
timelineLength (Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..}) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
past forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
future
travelToTime :: Double -> Timeline a -> Timeline a
travelToTime :: forall a. Double -> Timeline a -> Timeline a
travelToTime Double
t timeline :: Timeline a
timeline@(Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..})
| Int
diff forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. (a -> a) -> a -> [a]
iterate forall a. Timeline a -> Timeline a
redoTimeline Timeline a
timeline forall a. [a] -> Int -> a
!! Int
diff
| Bool
otherwise = forall a. (a -> a) -> a -> [a]
iterate forall a. Timeline a -> Timeline a
undoTimeline Timeline a
timeline forall a. [a] -> Int -> a
!! (- Int
diff)
where
desiredPast :: Int
desiredPast = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Timeline a -> Int
timelineLength Timeline a
timeline forall a. Num a => a -> a -> a
- Int
1)))
actualPast :: Int
actualPast = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
past
diff :: Int
diff = Int
desiredPast forall a. Num a => a -> a -> a
- Int
actualPast
timelinePos :: Timeline a -> Double
timelinePos :: forall a. Timeline a -> Double
timelinePos (Timeline {a
[a]
future :: [a]
present :: a
past :: [a]
future :: forall a. Timeline a -> [a]
present :: forall a. Timeline a -> a
past :: forall a. Timeline a -> [a]
..})
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
past Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
future = Double
1
| Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
past) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
past forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
future)
data Control :: * -> * where
PlayButton :: Point -> Control a
PauseButton :: Point -> Control a
StepButton :: Point -> Control a
RestartButton :: Point -> Control Double
ZoomInButton :: Point -> Control a
ZoomOutButton :: Point -> Control a
PanningLayer :: Control a
ResetViewButton :: Point -> Control a
FastForwardButton :: Point -> Control a
StartOverButton :: Point -> Control (Timeline a)
BackButton :: Point -> Control Double
TimeLabel :: Point -> Control Double
SpeedSlider :: Point -> Control a
ZoomSlider :: Point -> Control a
UndoButton :: Point -> Control (Timeline a)
RedoButton :: Point -> Control (Timeline a)
HistorySlider :: Point -> Control (Timeline a)
data StrictPoint = SP !Double !Double deriving (StrictPoint -> StrictPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrictPoint -> StrictPoint -> Bool
$c/= :: StrictPoint -> StrictPoint -> Bool
== :: StrictPoint -> StrictPoint -> Bool
$c== :: StrictPoint -> StrictPoint -> Bool
Eq, Int -> StrictPoint -> ShowS
[StrictPoint] -> ShowS
StrictPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrictPoint] -> ShowS
$cshowList :: [StrictPoint] -> ShowS
show :: StrictPoint -> String
$cshow :: StrictPoint -> String
showsPrec :: Int -> StrictPoint -> ShowS
$cshowsPrec :: Int -> StrictPoint -> ShowS
Show)
data StrictMaybe a = SNothing | SJust !a deriving (forall a b. a -> StrictMaybe b -> StrictMaybe a
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
$c<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
fmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
$cfmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
Functor, Int -> StrictMaybe a -> ShowS
forall a. Show a => Int -> StrictMaybe a -> ShowS
forall a. Show a => [StrictMaybe a] -> ShowS
forall a. Show a => StrictMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrictMaybe a] -> ShowS
$cshowList :: forall a. Show a => [StrictMaybe a] -> ShowS
show :: StrictMaybe a -> String
$cshow :: forall a. Show a => StrictMaybe a -> String
showsPrec :: Int -> StrictMaybe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StrictMaybe a -> ShowS
Show)
data Wrapped a = Wrapped
{ forall a. Wrapped a -> a
state :: a,
forall a. Wrapped a -> Double
playbackSpeed :: !Double,
forall a. Wrapped a -> Double
lastInteractionTime :: !Double,
forall a. Wrapped a -> Double
zoomFactor :: !Double,
forall a. Wrapped a -> StrictPoint
panCenter :: !StrictPoint,
forall a. Wrapped a -> StrictMaybe StrictPoint
panDraggingAnchor :: !(StrictMaybe StrictPoint),
forall a. Wrapped a -> Bool
isDraggingSpeed :: !Bool,
forall a. Wrapped a -> Bool
isDraggingHistory :: !Bool,
forall a. Wrapped a -> Bool
isDraggingZoom :: !Bool
}
deriving (Int -> Wrapped a -> ShowS
forall a. Show a => Int -> Wrapped a -> ShowS
forall a. Show a => [Wrapped a] -> ShowS
forall a. Show a => Wrapped a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wrapped a] -> ShowS
$cshowList :: forall a. Show a => [Wrapped a] -> ShowS
show :: Wrapped a -> String
$cshow :: forall a. Show a => Wrapped a -> String
showsPrec :: Int -> Wrapped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Wrapped a -> ShowS
Show, forall a b. a -> Wrapped b -> Wrapped a
forall a b. (a -> b) -> Wrapped a -> Wrapped b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Wrapped b -> Wrapped a
$c<$ :: forall a b. a -> Wrapped b -> Wrapped a
fmap :: forall a b. (a -> b) -> Wrapped a -> Wrapped b
$cfmap :: forall a b. (a -> b) -> Wrapped a -> Wrapped b
Functor)
wrappedInitial :: a -> Wrapped a
wrappedInitial :: forall a. a -> Wrapped a
wrappedInitial a
w =
Wrapped
{ state :: a
state = a
w,
playbackSpeed :: Double
playbackSpeed = Double
1,
lastInteractionTime :: Double
lastInteractionTime = Double
1000,
zoomFactor :: Double
zoomFactor = Double
1,
panCenter :: StrictPoint
panCenter = Double -> Double -> StrictPoint
SP Double
0 Double
0,
panDraggingAnchor :: StrictMaybe StrictPoint
panDraggingAnchor = forall a. StrictMaybe a
SNothing,
isDraggingSpeed :: Bool
isDraggingSpeed = Bool
False,
isDraggingHistory :: Bool
isDraggingHistory = Bool
False,
isDraggingZoom :: Bool
isDraggingZoom = Bool
False
}
identical :: a -> a -> Bool
identical :: forall a. a -> a -> Bool
identical !a
x !a
y = Int# -> Bool
isTrue# (forall a. a -> a -> Int#
reallyUnsafePtrEquality# a
x a
y)
toState :: (a -> a) -> (Wrapped a -> Wrapped a)
toState :: forall a. (a -> a) -> Wrapped a -> Wrapped a
toState a -> a
f Wrapped a
w
| forall a. a -> a -> Bool
identical a
s a
s' = Wrapped a
w
| Bool
otherwise = Wrapped a
w {state :: a
state = a
s'}
where
s :: a
s = forall a. Wrapped a -> a
state Wrapped a
w
s' :: a
s' = a -> a
f a
s
wrappedStep :: (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
wrappedStep :: forall a. (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
wrappedStep Double -> a -> a
f Double
dt Wrapped a
w
| forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w forall a. Eq a => a -> a -> Bool
== Double
0 = Wrapped a
w
| Bool
otherwise = forall a. (a -> a) -> Wrapped a -> Wrapped a
toState (Double -> a -> a
f (Double
dt forall a. Num a => a -> a -> a
* forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w)) Wrapped a
w
wrappedEvent ::
(Wrapped a -> [Control a]) ->
(Double -> a -> a) ->
(Event -> a -> a) ->
Event ->
Wrapped a ->
Wrapped a
wrappedEvent :: forall a.
(Wrapped a -> [Control a])
-> (Double -> a -> a)
-> (Event -> a -> a)
-> Event
-> Wrapped a
-> Wrapped a
wrappedEvent Wrapped a -> [Control a]
ctrls Double -> a -> a
stepHandler Event -> a -> a
eventHandler Event
event = Wrapped a -> Wrapped a
markInteraction forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrapped a -> Wrapped a
handleChange
where
markInteraction :: Wrapped a -> Wrapped a
markInteraction Wrapped a
w
| TimePassing Double
_ <- Event
event, forall a. Wrapped a -> Double
lastInteractionTime Wrapped a
w forall a. Ord a => a -> a -> Bool
> Double
5 = Wrapped a
w
| TimePassing Double
dt <- Event
event = Wrapped a
w {lastInteractionTime :: Double
lastInteractionTime = forall a. Wrapped a -> Double
lastInteractionTime Wrapped a
w forall a. Num a => a -> a -> a
+ Double
dt}
| Bool
otherwise = Wrapped a
w {lastInteractionTime :: Double
lastInteractionTime = Double
0}
handleChange :: Wrapped a -> Wrapped a
handleChange Wrapped a
w0
| forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w0 forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
|| Bool
handled = Wrapped a
w1
| Bool
otherwise = forall a. (a -> a) -> Wrapped a -> Wrapped a
toState (Event -> a -> a
eventHandler (Event -> Event
adaptEvent Event
event)) Wrapped a
w1
where
(Wrapped a
w1, Bool
handled) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Control a -> (Wrapped a, Bool) -> (Wrapped a, Bool)
doCtrl (Wrapped a
w0, Bool
False) (Wrapped a -> [Control a]
ctrls Wrapped a
w0)
doCtrl :: Control a -> (Wrapped a, Bool) -> (Wrapped a, Bool)
doCtrl Control a
_ (Wrapped a
w, Bool
True) = (Wrapped a
w, Bool
True)
doCtrl Control a
ctrl (Wrapped a
w, Bool
False) = forall a.
(Double -> a -> a)
-> Event -> Control a -> Wrapped a -> (Wrapped a, Bool)
handleControl Double -> a -> a
fullStep Event
event Control a
ctrl Wrapped a
w
fullStep :: Double -> a -> a
fullStep Double
dt = Double -> a -> a
stepHandler Double
dt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> a -> a
eventHandler (Double -> Event
TimePassing Double
dt)
adaptEvent :: Event -> Event
adaptEvent (PointerMovement Point
p) = Point -> Event
PointerMovement (Point -> Point
adaptPoint Point
p)
adaptEvent (PointerPress Point
p) = Point -> Event
PointerPress (Point -> Point
adaptPoint Point
p)
adaptEvent (PointerRelease Point
p) = Point -> Event
PointerRelease (Point -> Point
adaptPoint Point
p)
adaptEvent (TimePassing Double
dt) = Double -> Event
TimePassing (Double
dt forall a. Num a => a -> a -> a
* forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w0)
adaptEvent Event
other = Event
other
adaptPoint :: Point -> Point
adaptPoint (Double
x, Double
y) = (Double
x forall a. Fractional a => a -> a -> a
/ Double
k forall a. Num a => a -> a -> a
- Double
dx, Double
y forall a. Fractional a => a -> a -> a
/ Double
k forall a. Num a => a -> a -> a
- Double
dy)
SP Double
dx Double
dy = forall a. Wrapped a -> StrictPoint
panCenter Wrapped a
w1
k :: Double
k = forall a. Wrapped a -> Double
zoomFactor Wrapped a
w1
scaleRange :: (Double, Double) -> (Double, Double) -> Double -> Double
scaleRange :: Point -> Point -> Double -> Double
scaleRange (Double
a1, Double
b1) (Double
a2, Double
b2) Double
x = forall a. Ord a => a -> a -> a
min Double
b2 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
a2 forall a b. (a -> b) -> a -> b
$ (Double
x forall a. Num a => a -> a -> a
- Double
a1) forall a. Fractional a => a -> a -> a
/ (Double
b1 forall a. Num a => a -> a -> a
- Double
a1) forall a. Num a => a -> a -> a
* (Double
b2 forall a. Num a => a -> a -> a
- Double
a2) forall a. Num a => a -> a -> a
+ Double
a2
snapSlider :: Double -> [Double] -> Double -> Double
snapSlider :: Double -> [Double] -> Double -> Double
snapSlider Double
eps [Double]
targets Double
val = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Double -> Double -> Double
snap Double
val [Double]
targets
where
snap :: Double -> Double -> Double
snap Double
t Double
v
| forall a. Num a => a -> a
abs (Double
t forall a. Num a => a -> a -> a
- Double
v) forall a. Ord a => a -> a -> Bool
< Double
eps = Double
t
| Bool
otherwise = Double
v
xToPlaybackSpeed :: Double -> Double
xToPlaybackSpeed :: Double -> Double
xToPlaybackSpeed Double
x = Double -> [Double] -> Double -> Double
snapSlider Double
0.2 [Double
1 .. Double
4] forall a b. (a -> b) -> a -> b
$ Point -> Point -> Double -> Double
scaleRange (-Double
1.4, Double
1.4) (Double
0, Double
5) Double
x
playbackSpeedToX :: Double -> Double
playbackSpeedToX :: Double -> Double
playbackSpeedToX = Point -> Point -> Double -> Double
scaleRange (Double
0, Double
5) (-Double
1.4, Double
1.4)
zoomIncrement :: Double
zoomIncrement :: Double
zoomIncrement = Double
8 forall a. Floating a => a -> a -> a
** (Double
1 forall a. Fractional a => a -> a -> a
/ Double
10)
yToZoomFactor :: Double -> Double
yToZoomFactor :: Double -> Double
yToZoomFactor Double
y = Double
zoomIncrement forall a. Floating a => a -> a -> a
** (Point -> Point -> Double -> Double
scaleRange (-Double
1.4, Double
1.4) (-Double
10, Double
10) Double
y)
zoomFactorToY :: Double -> Double
zoomFactorToY :: Double -> Double
zoomFactorToY Double
z = Point -> Point -> Double -> Double
scaleRange (-Double
10, Double
10) (-Double
1.4, Double
1.4) (forall a. Floating a => a -> a -> a
logBase Double
zoomIncrement Double
z)
handleControl ::
(Double -> a -> a) -> Event -> Control a -> Wrapped a -> (Wrapped a, Bool)
handleControl :: forall a.
(Double -> a -> a)
-> Event -> Control a -> Wrapped a -> (Wrapped a, Bool)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (RestartButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {state :: a
state = a
0}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (StartOverButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (forall a. Timeline a -> Timeline a
restartTimeline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (PlayButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {playbackSpeed :: Double
playbackSpeed = Double
1}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (PauseButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {playbackSpeed :: Double
playbackSpeed = Double
0}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (FastForwardButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {playbackSpeed :: Double
playbackSpeed = forall a. Ord a => a -> a -> a
max Double
2 (forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w forall a. Num a => a -> a -> a
+ Double
1)}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (ZoomInButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {zoomFactor :: Double
zoomFactor = forall a. Wrapped a -> Double
zoomFactor Wrapped a
w forall a. Num a => a -> a -> a
* Double
zoomIncrement}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (ZoomOutButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {zoomFactor :: Double
zoomFactor = forall a. Wrapped a -> Double
zoomFactor Wrapped a
w forall a. Fractional a => a -> a -> a
/ Double
zoomIncrement}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (ResetViewButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {zoomFactor :: Double
zoomFactor = Double
1, panCenter :: StrictPoint
panCenter = Double -> Double -> StrictPoint
SP Double
0 Double
0}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (BackButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (forall a. Ord a => a -> a -> a
max a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
subtract a
0.1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (UndoButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (forall a. Timeline a -> Timeline a
undoTimeline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (RedoButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (forall a. Timeline a -> Timeline a
redoTimeline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w, Bool
True)
handleControl Double -> a -> a
f (PointerPress (Double
x, Double
y)) (StepButton (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 = (Wrapped a
w {state :: a
state = Double -> a -> a
f Double
0.1 (forall a. Wrapped a -> a
state Wrapped a
w)}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (SpeedSlider (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
1.5 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 =
(Wrapped a
w {playbackSpeed :: Double
playbackSpeed = Double -> Double
xToPlaybackSpeed (Double
x forall a. Num a => a -> a -> a
- Double
cx), isDraggingSpeed :: Bool
isDraggingSpeed = Bool
True}, Bool
True)
handleControl Double -> a -> a
_ (PointerMovement (Double
x, Double
_)) (SpeedSlider (Double
cx, Double
_)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingSpeed Wrapped a
w = (Wrapped a
w {playbackSpeed :: Double
playbackSpeed = Double -> Double
xToPlaybackSpeed (Double
x forall a. Num a => a -> a -> a
- Double
cx)}, Bool
True)
handleControl Double -> a -> a
_ (PointerRelease (Double
x, Double
_)) (SpeedSlider (Double
cx, Double
_)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingSpeed Wrapped a
w = (Wrapped a
w {playbackSpeed :: Double
playbackSpeed = Double -> Double
xToPlaybackSpeed (Double
x forall a. Num a => a -> a -> a
- Double
cx), isDraggingSpeed :: Bool
isDraggingSpeed = Bool
False}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (ZoomSlider (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
0.4 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
1.5 =
(Wrapped a
w {zoomFactor :: Double
zoomFactor = Double -> Double
yToZoomFactor (Double
y forall a. Num a => a -> a -> a
- Double
cy), isDraggingZoom :: Bool
isDraggingZoom = Bool
True}, Bool
True)
handleControl Double -> a -> a
_ (PointerMovement (Double
_, Double
y)) (ZoomSlider (Double
_, Double
cy)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingZoom Wrapped a
w = (Wrapped a
w {zoomFactor :: Double
zoomFactor = Double -> Double
yToZoomFactor (Double
y forall a. Num a => a -> a -> a
- Double
cy)}, Bool
True)
handleControl Double -> a -> a
_ (PointerRelease (Double
_, Double
y)) (ZoomSlider (Double
_, Double
cy)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingZoom Wrapped a
w = (Wrapped a
w {zoomFactor :: Double
zoomFactor = Double -> Double
yToZoomFactor (Double
y forall a. Num a => a -> a -> a
- Double
cy), isDraggingZoom :: Bool
isDraggingZoom = Bool
False}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) (HistorySlider (Double
cx, Double
cy)) Wrapped a
w
| forall a. Num a => a -> a
abs (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Ord a => a -> a -> Bool
< Double
2.5 Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
y forall a. Num a => a -> a -> a
- Double
cy) forall a. Ord a => a -> a -> Bool
< Double
0.4 =
(forall a. Double -> Timeline a -> Timeline a
travelToTime (Double
1 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Fractional a => a -> a -> a
/ Double
4.8) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w {isDraggingHistory :: Bool
isDraggingHistory = Bool
True}, Bool
True)
handleControl Double -> a -> a
_ (PointerMovement (Double
x, Double
_)) (HistorySlider (Double
cx, Double
_)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingHistory Wrapped a
w = (forall a. Double -> Timeline a -> Timeline a
travelToTime (Double
1 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Fractional a => a -> a -> a
/ Double
4.8) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w, Bool
True)
handleControl Double -> a -> a
_ (PointerRelease (Double
x, Double
_)) (HistorySlider (Double
cx, Double
_)) Wrapped a
w
| forall a. Wrapped a -> Bool
isDraggingHistory Wrapped a
w = (forall a. Double -> Timeline a -> Timeline a
travelToTime (Double
1 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ (Double
x forall a. Num a => a -> a -> a
- Double
cx) forall a. Fractional a => a -> a -> a
/ Double
4.8) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wrapped a
w {isDraggingHistory :: Bool
isDraggingHistory = Bool
False}, Bool
True)
handleControl Double -> a -> a
_ (PointerPress (Double
x, Double
y)) Control a
PanningLayer Wrapped a
w =
(Wrapped a
w {panDraggingAnchor :: StrictMaybe StrictPoint
panDraggingAnchor = forall a. a -> StrictMaybe a
SJust (Double -> Double -> StrictPoint
SP Double
x Double
y)}, Bool
True)
handleControl Double -> a -> a
_ (PointerMovement (Double
x, Double
y)) Control a
PanningLayer Wrapped a
w
| SJust (SP Double
ax Double
ay) <- forall a. Wrapped a -> StrictMaybe StrictPoint
panDraggingAnchor Wrapped a
w,
SP Double
px Double
py <- forall a. Wrapped a -> StrictPoint
panCenter Wrapped a
w =
( Wrapped a
w
{ panCenter :: StrictPoint
panCenter =
Double -> Double -> StrictPoint
SP
(Double
px forall a. Num a => a -> a -> a
+ (Double
x forall a. Num a => a -> a -> a
- Double
ax) forall a. Fractional a => a -> a -> a
/ forall a. Wrapped a -> Double
zoomFactor Wrapped a
w)
(Double
py forall a. Num a => a -> a -> a
+ (Double
y forall a. Num a => a -> a -> a
- Double
ay) forall a. Fractional a => a -> a -> a
/ forall a. Wrapped a -> Double
zoomFactor Wrapped a
w),
panDraggingAnchor :: StrictMaybe StrictPoint
panDraggingAnchor = forall a. a -> StrictMaybe a
SJust (Double -> Double -> StrictPoint
SP Double
x Double
y)
},
Bool
True
)
handleControl Double -> a -> a
_ (PointerRelease Point
_) Control a
PanningLayer Wrapped a
w
| SJust StrictPoint
_ <- forall a. Wrapped a -> StrictMaybe StrictPoint
panDraggingAnchor Wrapped a
w = (Wrapped a
w {panDraggingAnchor :: StrictMaybe StrictPoint
panDraggingAnchor = forall a. StrictMaybe a
SNothing}, Bool
True)
handleControl Double -> a -> a
_ Event
_ Control a
_ Wrapped a
w = (Wrapped a
w, Bool
False)
wrappedDraw ::
(Wrapped a -> [Control a]) -> (a -> Picture) -> Wrapped a -> Picture
wrappedDraw :: forall a.
(Wrapped a -> [Control a])
-> (a -> Picture) -> Wrapped a -> Picture
wrappedDraw Wrapped a -> [Control a]
ctrls a -> Picture
f Wrapped a
w = forall a. (Wrapped a -> [Control a]) -> Wrapped a -> Picture
drawControlPanel Wrapped a -> [Control a]
ctrls Wrapped a
w forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Picture -> Picture
dilated Double
k (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
dx Double
dy (a -> Picture
f (forall a. Wrapped a -> a
state Wrapped a
w)))
where
SP Double
dx Double
dy = forall a. Wrapped a -> StrictPoint
panCenter Wrapped a
w
k :: Double
k = forall a. Wrapped a -> Double
zoomFactor Wrapped a
w
drawControlPanel :: (Wrapped a -> [Control a]) -> Wrapped a -> Picture
drawControlPanel :: forall a. (Wrapped a -> [Control a]) -> Wrapped a -> Picture
drawControlPanel Wrapped a -> [Control a]
ctrls Wrapped a
w
| Double
alpha forall a. Ord a => a -> a -> Bool
> Double
0 = HasCallStack => [Picture] -> Picture
pictures [forall a. Wrapped a -> Double -> Control a -> Picture
drawControl Wrapped a
w Double
alpha Control a
c | Control a
c <- Wrapped a -> [Control a]
ctrls Wrapped a
w]
| Bool
otherwise = HasCallStack => Picture
blank
where
alpha :: Double
alpha
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped a
w forall a. Ord a => a -> a -> Bool
< Double
4.5 = Double
1
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped a
w forall a. Ord a => a -> a -> Bool
< Double
5.0 = Double
10 forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* forall a. Wrapped a -> Double
lastInteractionTime Wrapped a
w
| Bool
otherwise = Double
0
drawControl :: Wrapped a -> Double -> Control a -> Picture
drawControl :: forall a. Wrapped a -> Double -> Control a -> Picture
drawControl Wrapped a
_ Double
alpha (RestartButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Double -> Double -> Picture
thickArc Double
0.1 (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
6) (Double
11 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
6) Double
0.2
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.173 (-Double
0.1) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.17 Double
0.17)
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (StartOverButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Double -> Double -> Picture
thickArc Double
0.1 (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
6) (Double
11 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
6) Double
0.2
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.173 (-Double
0.1) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.17 Double
0.17)
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (PlayButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
(HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.2, Double
0.25), (-Double
0.2, -Double
0.25), (Double
0.2, Double
0)])
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (PauseButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
0.15) Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.6)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.15 Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.6)
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (FastForwardButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.3, Double
0.25), (-Double
0.3, -Double
0.25), (-Double
0.05, Double
0)]
forall a. Semigroup a => a -> a -> a
<> HasCallStack => [Point] -> Picture
solidPolygon [(Double
0.05, Double
0.25), (Double
0.05, -Double
0.25), (Double
0.3, Double
0)]
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (ZoomInButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated
(-Double
0.05)
(Double
0.05)
( HasCallStack => Double -> Double -> Picture
thickCircle Double
0.1 Double
0.22
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.06 Double
0.25
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.25 Double
0.06
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Picture -> Picture
rotated (- forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
4) (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.35 Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.1))
)
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (ZoomOutButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated
(-Double
0.05)
(Double
0.05)
( HasCallStack => Double -> Double -> Picture
thickCircle Double
0.1 Double
0.22
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.25 Double
0.06
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Double -> Picture -> Picture
rotated (- forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
4) (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.35 Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.1))
)
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
_ Control a
PanningLayer = HasCallStack => Picture
blank
drawControl Wrapped a
_ Double
alpha (ResetViewButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.7 Double
0.2)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.7)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.0 Double
0.0 Double
0.0 Double
alpha) (HasCallStack => Double -> Double -> Double -> Picture
thickRectangle Double
0.1 Double
0.5 Double
0.5)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (BackButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.15 Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.5)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.05, Double
0.25), (-Double
0.05, -Double
0.25), (-Double
0.3, Double
0)]
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (UndoButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0.15 Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.5)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.05, Double
0.25), (-Double
0.05, -Double
0.25), (-Double
0.3, Double
0)]
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (StepButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
0.15) Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.5)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => [Point] -> Picture
solidPolygon [(Double
0.05, Double
0.25), (Double
0.05, -Double
0.25), (Double
0.3, Double
0)]
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
_ Double
alpha (RedoButton (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
0.15) Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.5)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => [Point] -> Picture
solidPolygon [(Double
0.05, Double
0.25), (Double
0.05, -Double
0.25), (Double
0.3, Double
0)]
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.8 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.8)
drawControl Wrapped a
w Double
alpha (TimeLabel (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
(HasCallStack => Double -> Double -> Picture -> Picture
scaled Double
0.5 Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering (String -> Text
T.pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloatAlt (forall a. a -> Maybe a
Just Int
4) (forall a. Wrapped a -> a
state Wrapped a
w) String
"s")))
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
3.0 Double
0.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
3.0 Double
0.8)
drawControl Wrapped a
w Double
alpha (SpeedSlider (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated Double
xoff Double
0.75 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Double -> Picture -> Picture
scaled Double
0.5 Double
0.5 forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Picture
lettering (String -> Text
T.pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloatAlt (forall a. a -> Maybe a
Just Int
2) (forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w) String
"x"))
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha) (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
xoff Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.8))
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
2.8 Double
0.25)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
2.8 Double
0.25)
xoff :: Double
xoff = Double -> Double
playbackSpeedToX (forall a. Wrapped a -> Double
playbackSpeed Wrapped a
w)
drawControl Wrapped a
w Double
alpha (ZoomSlider (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
1.1) Double
yoff forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Double -> Picture -> Picture
scaled Double
0.5 Double
0.5 forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Picture
lettering (String -> Text
T.pack (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Wrapped a -> Double
zoomFactor Wrapped a
w forall a. Num a => a -> a -> a
* Double
100) :: Int) forall a. [a] -> [a] -> [a]
++ String
"%"))
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha) (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0 Double
yoff (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.8 Double
0.2))
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
0.25 Double
2.8)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.25 Double
2.8)
yoff :: Double
yoff = Double -> Double
zoomFactorToY (forall a. Wrapped a -> Double
zoomFactor Wrapped a
w)
drawControl Wrapped a
w Double
alpha (HistorySlider (Double
x, Double
y)) = HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y Picture
p
where
p :: Picture
p =
HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
alpha)
( HasCallStack => Double -> Double -> Picture -> Picture
translated Double
xoff Double
0.75 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Double -> Picture -> Picture
scaled Double
0.5 Double
0.5 forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Picture
lettering (String -> Text
T.pack (forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n))
)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.0 Double
0.0 Double
0.0 Double
alpha) (HasCallStack => Double -> Double -> Picture -> Picture
translated Double
xoff Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.2 Double
0.8))
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.2 Double
0.2 Double
0.2 Double
alpha) (HasCallStack => Double -> Double -> Picture
rectangle Double
4.8 Double
0.25)
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.8 Double
0.8 Double
alpha) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
4.8 Double
0.25)
xoff :: Double
xoff = forall a. Timeline a -> Double
timelinePos (forall a. Wrapped a -> a
state Wrapped a
w) forall a. Num a => a -> a -> a
* Double
4.8 forall a. Num a => a -> a -> a
- Double
2.4
i :: Int
i = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Timeline a -> [a]
past (forall a. Wrapped a -> a
state Wrapped a
w))
n :: Int
n = forall a. Timeline a -> Int
timelineLength (forall a. Wrapped a -> a
state Wrapped a
w)
drawingControls :: Wrapped () -> [Control ()]
drawingControls :: Wrapped () -> [Control ()]
drawingControls Wrapped ()
w
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped ()
w forall a. Ord a => a -> a -> Bool
> Double
5 = []
| Bool
otherwise = forall {a}. [Control a]
commonControls forall a. [a] -> [a] -> [a]
++ [Control ()]
resetViewButton
where
commonControls :: [Control a]
commonControls =
[ forall a. Control a
PanningLayer,
forall a. Point -> Control a
ZoomInButton (Double
9, -Double
4),
forall a. Point -> Control a
ZoomOutButton (Double
9, -Double
8),
forall a. Point -> Control a
ZoomSlider (Double
9, -Double
6)
]
resetViewButton :: [Control ()]
resetViewButton
| forall a. Wrapped a -> Double
zoomFactor Wrapped ()
w forall a. Eq a => a -> a -> Bool
/= Double
1 Bool -> Bool -> Bool
|| forall a. Wrapped a -> StrictPoint
panCenter Wrapped ()
w forall a. Eq a => a -> a -> Bool
/= Double -> Double -> StrictPoint
SP Double
0 Double
0 = [forall a. Point -> Control a
ResetViewButton (Double
9, -Double
3)]
| Bool
otherwise = []
drawingOf ::
Picture ->
IO ()
drawingOf :: Picture -> IO ()
drawingOf Picture
pic = do
Handle -> IO ()
hFlush Handle
stdout
forall s.
s
-> (Double -> s -> s)
-> (Event -> s -> s)
-> (s -> Picture)
-> (s -> Picture)
-> IO ()
runInspect
(forall a. a -> Wrapped a
wrappedInitial ())
(forall a. (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
wrappedStep forall {p} {p}. p -> p -> ()
step)
(forall a.
(Wrapped a -> [Control a])
-> (Double -> a -> a)
-> (Event -> a -> a)
-> Event
-> Wrapped a
-> Wrapped a
wrappedEvent Wrapped () -> [Control ()]
drawingControls forall {p} {p}. p -> p -> ()
step forall {p} {p}. p -> p -> ()
event)
(forall a.
(Wrapped a -> [Control a])
-> (a -> Picture) -> Wrapped a -> Picture
wrappedDraw Wrapped () -> [Control ()]
drawingControls () -> Picture
draw)
(() -> Picture
draw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Wrapped a -> a
state)
where
step :: p -> p -> ()
step p
_ p
_ = ()
event :: p -> p -> ()
event p
_ p
_ = ()
draw :: () -> Picture
draw ()
_ = Picture
pic
animationControls :: Wrapped Double -> [Control Double]
animationControls :: Wrapped Double -> [Control Double]
animationControls Wrapped Double
w
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped Double
w forall a. Ord a => a -> a -> Bool
> Double
5 = []
| Bool
otherwise =
[Control Double]
commonControls forall a. [a] -> [a] -> [a]
++ [Control Double]
pauseDependentControls
forall a. [a] -> [a] -> [a]
++ [Control Double]
backButton
forall a. [a] -> [a] -> [a]
++ [Control Double]
resetViewButton
where
commonControls :: [Control Double]
commonControls =
[ forall a. Control a
PanningLayer,
Point -> Control Double
RestartButton (-Double
9, -Double
9),
Point -> Control Double
TimeLabel (Double
8, -Double
9),
forall a. Point -> Control a
SpeedSlider (-Double
3, -Double
9),
forall a. Point -> Control a
FastForwardButton (-Double
1, -Double
9),
forall a. Point -> Control a
ZoomInButton (Double
9, -Double
4),
forall a. Point -> Control a
ZoomOutButton (Double
9, -Double
8),
forall a. Point -> Control a
ZoomSlider (Double
9, -Double
6)
]
pauseDependentControls :: [Control Double]
pauseDependentControls
| forall a. Wrapped a -> Double
playbackSpeed Wrapped Double
w forall a. Eq a => a -> a -> Bool
== Double
0 = [forall a. Point -> Control a
PlayButton (-Double
8, -Double
9), forall a. Point -> Control a
StepButton (-Double
6, -Double
9)]
| Bool
otherwise = [forall a. Point -> Control a
PauseButton (-Double
8, -Double
9)]
backButton :: [Control Double]
backButton
| forall a. Wrapped a -> Double
playbackSpeed Wrapped Double
w forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
&& forall a. Wrapped a -> a
state Wrapped Double
w forall a. Ord a => a -> a -> Bool
> Double
0 = [Point -> Control Double
BackButton (-Double
7, -Double
9)]
| Bool
otherwise = []
resetViewButton :: [Control Double]
resetViewButton
| forall a. Wrapped a -> Double
zoomFactor Wrapped Double
w forall a. Eq a => a -> a -> Bool
/= Double
1 Bool -> Bool -> Bool
|| forall a. Wrapped a -> StrictPoint
panCenter Wrapped Double
w forall a. Eq a => a -> a -> Bool
/= Double -> Double -> StrictPoint
SP Double
0 Double
0 = [forall a. Point -> Control a
ResetViewButton (Double
9, -Double
3)]
| Bool
otherwise = []
animationOf ::
(Double -> Picture) ->
IO ()
animationOf :: (Double -> Picture) -> IO ()
animationOf Double -> Picture
f = do
Handle -> IO ()
hFlush Handle
stdout
forall s.
s
-> (Double -> s -> s)
-> (Event -> s -> s)
-> (s -> Picture)
-> (s -> Picture)
-> IO ()
runInspect
(forall a. a -> Wrapped a
wrappedInitial Double
0)
(forall a. (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
wrappedStep forall a. Num a => a -> a -> a
(+))
(forall a.
(Wrapped a -> [Control a])
-> (Double -> a -> a)
-> (Event -> a -> a)
-> Event
-> Wrapped a
-> Wrapped a
wrappedEvent Wrapped Double -> [Control Double]
animationControls forall a. Num a => a -> a -> a
(+) (forall a b. a -> b -> a
const forall a. a -> a
id))
(forall a.
(Wrapped a -> [Control a])
-> (a -> Picture) -> Wrapped a -> Picture
wrappedDraw Wrapped Double -> [Control Double]
animationControls Double -> Picture
f)
(Double -> Picture
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Wrapped a -> a
state)
simulationControls :: Wrapped w -> [Control w]
simulationControls :: forall w. Wrapped w -> [Control w]
simulationControls Wrapped w
w
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped w
w forall a. Ord a => a -> a -> Bool
> Double
5 = []
| Bool
otherwise = forall {a}. [Control a]
commonControls forall a. [a] -> [a] -> [a]
++ [Control w]
pauseDependentControls forall a. [a] -> [a] -> [a]
++ [Control w]
resetViewButton
where
commonControls :: [Control a]
commonControls =
[ forall a. Control a
PanningLayer,
forall a. Point -> Control a
FastForwardButton (-Double
4, -Double
9),
forall a. Point -> Control a
SpeedSlider (-Double
6, -Double
9),
forall a. Point -> Control a
ZoomInButton (Double
9, -Double
4),
forall a. Point -> Control a
ZoomOutButton (Double
9, -Double
8),
forall a. Point -> Control a
ZoomSlider (Double
9, -Double
6)
]
pauseDependentControls :: [Control w]
pauseDependentControls
| forall a. Wrapped a -> Double
playbackSpeed Wrapped w
w forall a. Eq a => a -> a -> Bool
== Double
0 = [forall a. Point -> Control a
PlayButton (-Double
8, -Double
9), forall a. Point -> Control a
StepButton (-Double
2, -Double
9)]
| Bool
otherwise = [forall a. Point -> Control a
PauseButton (-Double
8, -Double
9)]
resetViewButton :: [Control w]
resetViewButton
| forall a. Wrapped a -> Double
zoomFactor Wrapped w
w forall a. Eq a => a -> a -> Bool
/= Double
1 Bool -> Bool -> Bool
|| forall a. Wrapped a -> StrictPoint
panCenter Wrapped w
w forall a. Eq a => a -> a -> Bool
/= Double -> Double -> StrictPoint
SP Double
0 Double
0 = [forall a. Point -> Control a
ResetViewButton (Double
9, -Double
3)]
| Bool
otherwise = []
statefulDebugControls :: Wrapped (Timeline w) -> [Control (Timeline w)]
statefulDebugControls :: forall w. Wrapped (Timeline w) -> [Control (Timeline w)]
statefulDebugControls Wrapped (Timeline w)
w
| forall a. Wrapped a -> Double
lastInteractionTime Wrapped (Timeline w)
w forall a. Ord a => a -> a -> Bool
> Double
5 = []
| Bool
otherwise =
[Control (Timeline w)]
panningLayer forall a. [a] -> [a] -> [a]
++ [Control (Timeline w)]
pauseDependentControls forall a. [a] -> [a] -> [a]
++ forall {a}. [Control (Timeline a)]
commonControls
forall a. [a] -> [a] -> [a]
++ [Control (Timeline w)]
resetViewButton
where
hasHistory :: Bool
hasHistory = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Timeline a -> [a]
past (forall a. Wrapped a -> a
state Wrapped (Timeline w)
w)))
hasFuture :: Bool
hasFuture = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Timeline a -> [a]
future (forall a. Wrapped a -> a
state Wrapped (Timeline w)
w)))
advance :: [Control (Timeline w)]
advance
| Bool
hasFuture = [forall a. Point -> Control (Timeline a)
RedoButton (Double
6, -Double
9)]
| Bool
otherwise = [forall a. Point -> Control a
StepButton (Double
6, -Double
9)]
regress :: [Control (Timeline w)]
regress
| Bool
hasHistory = [forall a. Point -> Control (Timeline a)
UndoButton (Double
0, -Double
9)]
| Bool
otherwise = []
commonControls :: [Control (Timeline a)]
commonControls =
[ forall a. Point -> Control (Timeline a)
StartOverButton (-Double
1, -Double
9),
forall a. Point -> Control a
FastForwardButton (-Double
4, -Double
9),
forall a. Point -> Control a
SpeedSlider (-Double
6, -Double
9),
forall a. Point -> Control a
ZoomInButton (Double
9, -Double
4),
forall a. Point -> Control a
ZoomOutButton (Double
9, -Double
8),
forall a. Point -> Control a
ZoomSlider (Double
9, -Double
6)
]
pauseDependentControls :: [Control (Timeline w)]
pauseDependentControls
| forall a. Wrapped a -> Double
playbackSpeed Wrapped (Timeline w)
w forall a. Eq a => a -> a -> Bool
== Double
0 =
[forall a. Point -> Control a
PlayButton (-Double
8, -Double
9), forall a. Point -> Control (Timeline a)
HistorySlider (Double
3, -Double
9)] forall a. [a] -> [a] -> [a]
++ [Control (Timeline w)]
advance forall a. [a] -> [a] -> [a]
++ [Control (Timeline w)]
regress
| Bool
otherwise = [forall a. Point -> Control a
PauseButton (-Double
8, -Double
9)]
resetViewButton :: [Control (Timeline w)]
resetViewButton
| forall a. Wrapped a -> Double
zoomFactor Wrapped (Timeline w)
w forall a. Eq a => a -> a -> Bool
/= Double
1 Bool -> Bool -> Bool
|| forall a. Wrapped a -> StrictPoint
panCenter Wrapped (Timeline w)
w forall a. Eq a => a -> a -> Bool
/= Double -> Double -> StrictPoint
SP Double
0 Double
0 = [forall a. Point -> Control a
ResetViewButton (Double
9, -Double
3)]
| Bool
otherwise = []
panningLayer :: [Control (Timeline w)]
panningLayer
| forall a. Wrapped a -> Double
playbackSpeed Wrapped (Timeline w)
w forall a. Eq a => a -> a -> Bool
== Double
0 = [forall a. Control a
PanningLayer]
| Bool
otherwise = []
debugActivityOf ::
world ->
(Event -> world -> world) ->
(world -> Picture) ->
IO ()
debugActivityOf :: forall world.
world -> (Event -> world -> world) -> (world -> Picture) -> IO ()
debugActivityOf world
initial Event -> world -> world
change world -> Picture
picture = do
Handle -> IO ()
hFlush Handle
stdout
forall s.
s
-> (Double -> s -> s)
-> (Event -> s -> s)
-> (s -> Picture)
-> (s -> Picture)
-> IO ()
runInspect
(forall a. a -> Wrapped a
wrappedInitial (forall a. a -> Timeline a
newTimeline world
initial))
(forall a. (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
wrappedStep (forall a b. a -> b -> a
const forall a. a -> a
id))
(forall a.
(Wrapped a -> [Control a])
-> (Double -> a -> a)
-> (Event -> a -> a)
-> Event
-> Wrapped a
-> Wrapped a
wrappedEvent forall w. Wrapped (Timeline w) -> [Control (Timeline w)]
statefulDebugControls (forall a b. a -> b -> a
const forall a. a -> a
id) (forall a. (a -> a) -> Timeline a -> Timeline a
applyToTimeline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> world -> world
change))
(forall a.
(Wrapped a -> [Control a])
-> (a -> Picture) -> Wrapped a -> Picture
wrappedDraw forall w. Wrapped (Timeline w) -> [Control (Timeline w)]
statefulDebugControls (world -> Picture
picture forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timeline a -> a
present))
(world -> Picture
picture forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timeline a -> a
present forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Wrapped a -> a
state)
groupActivityOf ::
Int ->
StaticPtr (StdGen -> world) ->
StaticPtr (Int -> Event -> world -> world) ->
StaticPtr (Int -> world -> Picture) ->
IO ()
groupActivityOf :: forall world.
Int
-> StaticPtr (StdGen -> world)
-> StaticPtr (Int -> Event -> world -> world)
-> StaticPtr (Int -> world -> Picture)
-> IO ()
groupActivityOf Int
numPlayers StaticPtr (StdGen -> world)
initial StaticPtr (Int -> Event -> world -> world)
event StaticPtr (Int -> world -> Picture)
draw = do
Handle -> IO ()
hFlush Handle
stdout
Text
dhash <- IO Text
getDeployHash
let token :: GameToken
token =
SteplessToken
{ tokenDeployHash :: Text
tokenDeployHash = Text
dhash,
tokenNumPlayers :: Int
tokenNumPlayers = Int
numPlayers,
tokenInitial :: StaticKey
tokenInitial = forall a. StaticPtr a -> StaticKey
staticKey StaticPtr (StdGen -> world)
initial,
tokenEvent :: StaticKey
tokenEvent = forall a. StaticPtr a -> StaticKey
staticKey StaticPtr (Int -> Event -> world -> world)
event,
tokenDraw :: StaticKey
tokenDraw = forall a. StaticPtr a -> StaticKey
staticKey StaticPtr (Int -> world -> Picture)
draw
}
forall s.
GameToken
-> Int
-> (StdGen -> s)
-> (Double -> s -> s)
-> (Int -> Event -> s -> s)
-> (Int -> s -> Picture)
-> IO ()
runGame
GameToken
token
Int
numPlayers
(forall a. StaticPtr a -> a
deRefStaticPtr StaticPtr (StdGen -> world)
initial)
(forall a b. a -> b -> a
const forall a. a -> a
id)
(forall a. StaticPtr a -> a
deRefStaticPtr StaticPtr (Int -> Event -> world -> world)
event)
(forall a. StaticPtr a -> a
deRefStaticPtr StaticPtr (Int -> world -> Picture)
draw)
unsafeGroupActivityOf ::
Int ->
(StdGen -> world) ->
(Int -> Event -> world -> world) ->
(Int -> world -> Picture) ->
IO ()
unsafeGroupActivityOf :: forall world.
Int
-> (StdGen -> world)
-> (Int -> Event -> world -> world)
-> (Int -> world -> Picture)
-> IO ()
unsafeGroupActivityOf Int
numPlayers StdGen -> world
initial Int -> Event -> world -> world
event Int -> world -> Picture
draw = do
Handle -> IO ()
hFlush Handle
stdout
Text
dhash <- IO Text
getDeployHash
let token :: GameToken
token = Text -> GameToken
PartialToken Text
dhash
forall s.
GameToken
-> Int
-> (StdGen -> s)
-> (Double -> s -> s)
-> (Int -> Event -> s -> s)
-> (Int -> s -> Picture)
-> IO ()
runGame GameToken
token Int
numPlayers StdGen -> world
initial (forall a b. a -> b -> a
const forall a. a -> a
id) Int -> Event -> world -> world
event Int -> world -> Picture
draw
trace :: Text -> a -> a
trace :: forall a. Text -> a -> a
trace Text
msg a
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
BufferMode
oldMode <- Handle -> IO BufferMode
hGetBuffering Handle
stderr
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr (Maybe Int -> BufferMode
BlockBuffering forall a. Maybe a
Nothing)
Handle -> String -> IO ()
hPutStrLn Handle
stderr (Text -> String
T.unpack Text
msg)
Handle -> IO ()
hFlush Handle
stderr
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
oldMode
forall (m :: * -> *) a. Monad m => a -> m a
return a
x