{-# 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" #-}

{-
  Copyright 2020 The CodeWorld Authors. All rights reserved.

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}
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

--------------------------------------------------------------------------------
-- Common code for activity, interaction, animation and simulation interfaces

-- | Runs an interactive CodeWorld program that responds to 'Event's.
-- Activities can interact with the user, change over time, and remember
-- information about the past.
--
-- Example: a program which draws a circle and changes its radius when user
-- presses Up or Down keys on her keyboard
--
-- @
--  {-\# LANGUAGE OverloadedStrings \#-}
-- import CodeWorld
--
-- main = activityOf initialRadius updateRadius circle
--    where
--      initialRadius = 1
--
--      updateRadius event radius =
--        case event of
--          KeyPress "Up"   -> radius + 1
--          KeyPress "Down" -> radius - 1
--          _               -> radius
-- @
activityOf ::
  -- | The initial state of the activity.
  world ->
  -- | The event handling function, which updates
  --   the state given an event.
  (Event -> world -> world) ->
  -- | The visualization function, which converts
  --   the state into a picture to display.
  (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], -- reversed list of past states
    forall a. Timeline a -> a
present :: !a, -- present state
    forall a. Timeline a -> [a]
future :: [a] -- list of future states
  }

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 = []

-- | Draws a 'Picture'. This is the simplest CodeWorld entry point.
--
-- Example: a program which draws a circle of radius 1 in the middle of canvas
--
-- @
-- main = drawingOf $ circle 1
-- @
drawingOf ::
  -- | The picture to show on the screen.
  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 = []

-- | Shows an animation, with a picture for each time given by the parameter.
--
-- Example: a program showing a square which rotates once every two seconds
--
-- @
-- main = animationOf rotatingSquare
--
-- rotatingSquare :: Double -> Picture
-- rotatingSquare seconds = rotated angle square
--   where
--     square = rectangle 2 2
--     angle = pi * seconds
-- @
animationOf ::
  -- | A function that produces animation
  --   frames, given the time in seconds.
  (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 = []

-- | A version of 'activityOf' which runs an interactive CodeWorld program
-- in debugging mode.  In this mode, the program gets controls to pause and
-- manipulate time, and even go back in time to look at past states.
debugActivityOf ::
  -- | The initial state of the interaction.
  world ->
  -- | The event handling function, which updates
  --   the state given an event.
  (Event -> world -> world) ->
  -- | The visualization function, which converts
  --   the state into a picture to display.
  (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)

-- | Runs an interactive multi-user CodeWorld program that is joined by several
-- participants over the internet.
--
-- Example: a skeleton of a game for two players
--
-- @
-- &#x7b;-\# LANGUAGE StaticPointers, OverloadedStrings \#-&#x7d;
-- import CodeWorld
--
-- main = groupActivityOf 2 init step view
--   where
--     init = static (\\gen -> {- initialize state of the game world, possibly using random number generator -})
--     step = static (\\playerNumber event world -> {- modify world based on event occuring for given player -})
--     view = static (\\playerNumber world -> {- generate a picture that will be shown to given player in the given state of the world-})
-- @
groupActivityOf ::
  -- | The number of participants to expect.  The participants will be
  -- numbered starting at 0.
  Int ->
  -- | The function to create initial state of the activity. 'System.Random.StdGen' parameter can be used to generate random numbers.
  StaticPtr (StdGen -> world) ->
  -- | The event handling function, which updates the state given a
  --   participant number and user interface event.
  StaticPtr (Int -> Event -> world -> world) ->
  -- | The visualization function, which converts a participant number
  --   and the state into a picture to display.
  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)

-- | A version of 'groupActivityOf' that avoids static pointers, and does not
-- check for consistency.
unsafeGroupActivityOf ::
  -- | The number of participants to expect.  The participants will be
  -- numbered starting at 0.
  Int ->
  -- | The initial state of the activity.
  (StdGen -> world) ->
  -- | The event handling function, which updates the state given a
  --   participant number and user interface event.
  (Int -> Event -> world -> world) ->
  -- | The visualization function, which converts a participant number
  --   and the state into a picture to display.
  (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

-- | Prints a debug message to the CodeWorld console when a value is forced.
-- This is equivalent to the similarly named function in `Debug.Trace`, except
-- that it sets appropriate buffering to use the CodeWorld console.
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