{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
module CodeWorld.Parameter
{-# WARNING "This is an experimental API. It can change at any time." #-}
( Parameter,
parametricDrawingOf,
slider,
toggle,
counter,
constant,
random,
timer,
currentHour,
currentMinute,
currentSecond,
converted,
renamed,
)
where
import CodeWorld
import CodeWorld.Driver (runInspect)
import Data.Function (on)
import Data.List (sortBy)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.LocalTime
import Numeric (showFFloatAlt)
import System.IO.Unsafe (unsafePerformIO)
import System.Random (newStdGen, randomR)
type Bounds = (Double, Double, Double, Double)
data Parameter where
Parameter ::
Text ->
Double ->
Picture ->
Bounds ->
(Event -> Parameter) ->
Parameter
parametricDrawingOf :: [Parameter] -> ([Double] -> Picture) -> IO ()
parametricDrawingOf :: [Parameter] -> ([Double] -> Picture) -> IO ()
parametricDrawingOf [Parameter]
initialParams [Double] -> Picture
mainPic =
forall s.
s
-> (Double -> s -> s)
-> (Event -> s -> s)
-> (s -> Picture)
-> (s -> Picture)
-> IO ()
runInspect
(forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] (Double -> Double -> Double -> [Parameter] -> [Parameter]
layoutParams Double
0 (-Double
9.5) Double
9.5 [Parameter]
initialParams), Bool
True, Double
5)
(forall a b. a -> b -> a
const forall a. a -> a
id)
forall {a}.
Event
-> ([(a, Parameter)], Bool, Double)
-> ([(a, Parameter)], Bool, Double)
change
([(Int, Parameter)], Bool, Double) -> Picture
picture
([(Int, Parameter)], Bool, Double) -> Picture
rawPicture
where
change :: Event
-> ([(a, Parameter)], Bool, Double)
-> ([(a, Parameter)], Bool, Double)
change (KeyPress Text
" ") ([(a, Parameter)]
params, Bool
vis, Double
_) = ([(a, Parameter)]
params, Bool -> Bool
not Bool
vis, Double
2)
change (PointerPress Point
pt) ([(a, Parameter)]
params, Bool
vis, Double
t) =
case (Bool
vis, forall a. (a -> Bool) -> [a] -> (Maybe a, [a])
pullMatch (Point -> Parameter -> Bool
hitTest Point
pt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Parameter)]
params) of
(Bool
True, (Just (a, Parameter)
p, [(a, Parameter)]
ps)) -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event -> Parameter -> Parameter
changeParam (Point -> Event
PointerPress Point
pt)) (a, Parameter)
p forall a. a -> [a] -> [a]
: [(a, Parameter)]
ps, Bool
vis, Double
t)
(Bool, (Maybe (a, Parameter), [(a, Parameter)]))
_ -> ([(a, Parameter)]
params, Bool
vis, Double
t)
change Event
event ([(a, Parameter)]
params, Bool
vis, Double
t) =
(forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event -> Parameter -> Parameter
changeParam Event
event)) [(a, Parameter)]
params, Bool
vis, Event -> Double -> Double
changeTime Event
event Double
t)
picture :: ([(Int, Parameter)], Bool, Double) -> Picture
picture ([(Int, Parameter)]
params, Bool
vis, Double
t) =
Double -> Picture
showHideBanner Double
t
HasCallStack => Picture -> Picture -> Picture
& (Bool -> Picture -> Picture
picWhen Bool
vis forall a b. (a -> b) -> a -> b
$ HasCallStack => [Picture] -> Picture
pictures (forall a b. (a -> b) -> [a] -> [b]
map (Parameter -> Picture
showParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, Parameter)]
params))
HasCallStack => Picture -> Picture -> Picture
& ([(Int, Parameter)], Bool, Double) -> Picture
rawPicture ([(Int, Parameter)]
params, Bool
vis, Double
t)
rawPicture :: ([(Int, Parameter)], Bool, Double) -> Picture
rawPicture ([(Int, Parameter)]
params, Bool
_, Double
_) =
[Double] -> Picture
mainPic (forall a b. (a -> b) -> [a] -> [b]
map (Parameter -> Double
getParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [(Int, Parameter)]
params))
changeParam :: Event -> Parameter -> Parameter
changeParam Event
event (Parameter Text
_ Double
_ Picture
_ Bounds
_ Event -> Parameter
handle) = Event -> Parameter
handle Event
event
showParam :: Parameter -> Picture
showParam (Parameter Text
_ Double
_ Picture
pic Bounds
_ Event -> Parameter
_) = Picture
pic
getParam :: Parameter -> Double
getParam (Parameter Text
_ Double
val Picture
_ Bounds
_ Event -> Parameter
_) = Double
val
changeTime :: Event -> Double -> Double
changeTime (TimePassing Double
dt) Double
t = forall a. Ord a => a -> a -> a
max Double
0 (Double
t forall a. Num a => a -> a -> a
- Double
dt)
changeTime Event
_ Double
t = Double
t
showHideBanner :: Double -> Picture
showHideBanner Double
t =
Bool -> Picture -> Picture
picWhen (Double
t forall a. Ord a => a -> a -> Bool
> Double
0)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Double -> Picture -> Picture
translated Double
0 (-Double
9)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Picture -> Picture
dilated Double
0.5
forall a b. (a -> b) -> a -> b
$ HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
t) (HasCallStack => Double -> Double -> Picture
rectangle Double
18 Double
2)
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Color -> Picture -> Picture
colored
(Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
t)
(HasCallStack => Text -> Picture
lettering Text
"Press Space to show/hide parameters.")
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0.75 Double
0.75 Double
0.75 (forall a. Ord a => a -> a -> a
min Double
0.8 Double
t)) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
18 Double
2)
layoutParams :: Double -> Double -> Double -> [Parameter] -> [Parameter]
layoutParams :: Double -> Double -> Double -> [Parameter] -> [Parameter]
layoutParams Double
_ Double
_ Double
_ [] = []
layoutParams Double
maxw Double
x Double
y (Parameter
p : [Parameter]
ps)
| Double
y forall a. Ord a => a -> a -> Bool
> (-Double
9.5) forall a. Num a => a -> a -> a
+ Double
h forall a. Num a => a -> a -> a
+ Double
titleHeight =
Double -> Double -> Parameter -> Parameter
framedParam (Double
x forall a. Num a => a -> a -> a
- Double
left) (Double
y forall a. Num a => a -> a -> a
- Double
top forall a. Num a => a -> a -> a
- Double
titleHeight) Parameter
p
forall a. a -> [a] -> [a]
: Double -> Double -> Double -> [Parameter] -> [Parameter]
layoutParams (forall a. Ord a => a -> a -> a
max Double
maxw Double
w) Double
x (Double
y forall a. Num a => a -> a -> a
- Double
h forall a. Num a => a -> a -> a
- Double
titleHeight forall a. Num a => a -> a -> a
- Double
gap) [Parameter]
ps
| Bool
otherwise = Double -> Double -> Double -> [Parameter] -> [Parameter]
layoutParams Double
0 (Double
x forall a. Num a => a -> a -> a
+ Double
maxw forall a. Num a => a -> a -> a
+ Double
gap) Double
9.5 (Parameter
p forall a. a -> [a] -> [a]
: [Parameter]
ps)
where
Parameter Text
_ Double
_ Picture
_ (Double
left, Double
top, Double
w, Double
h) Event -> Parameter
_ = Parameter
p
gap :: Double
gap = Double
0.5
pullMatch :: (a -> Bool) -> [a] -> (Maybe a, [a])
pullMatch :: forall a. (a -> Bool) -> [a] -> (Maybe a, [a])
pullMatch a -> Bool
_ [] = (forall a. Maybe a
Nothing, [])
pullMatch a -> Bool
p (a
a : [a]
as)
| a -> Bool
p a
a = (forall a. a -> Maybe a
Just a
a, [a]
as)
| Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a forall a. a -> [a] -> [a]
:) (forall a. (a -> Bool) -> [a] -> (Maybe a, [a])
pullMatch a -> Bool
p [a]
as)
hitTest :: Point -> Parameter -> Bool
hitTest :: Point -> Parameter -> Bool
hitTest (Double
x, Double
y) (Parameter Text
_ Double
_ Picture
_ (Double
left, Double
top, Double
w, Double
h) Event -> Parameter
_) =
Double
x forall a. Ord a => a -> a -> Bool
> Double
left Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
< Double
left forall a. Num a => a -> a -> a
+ Double
w Bool -> Bool -> Bool
&& Double
y forall a. Ord a => a -> a -> Bool
< Double
top Bool -> Bool -> Bool
&& Double
y forall a. Ord a => a -> a -> Bool
> Double
top forall a. Num a => a -> a -> a
- Double
h
parameterOf ::
Text ->
state ->
(Event -> state -> state) ->
(state -> Double) ->
(state -> Picture) ->
(state -> Bounds) ->
Parameter
parameterOf :: forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf Text
name state
initial Event -> state -> state
change state -> Double
value state -> Picture
picture state -> Bounds
bounds =
Text
-> Double -> Picture -> Bounds -> (Event -> Parameter) -> Parameter
Parameter
Text
name
(state -> Double
value state
initial)
(state -> Picture
picture state
initial)
(state -> Bounds
bounds state
initial)
(\Event
e -> forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf Text
name (Event -> state -> state
change Event
e state
initial) Event -> state -> state
change state -> Double
value state -> Picture
picture state -> Bounds
bounds)
framedParam :: Double -> Double -> Parameter -> Parameter
framedParam :: Double -> Double -> Parameter -> Parameter
framedParam Double
ix Double
iy Parameter
iparam =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
name
(Parameter
iparam, (Double
ix, Double
iy), Bool
True, forall a. Maybe a
Nothing)
Event -> FrameState -> FrameState
framedHandle
(\(Parameter Text
_ Double
v Picture
_ Bounds
_ Event -> Parameter
_, Point
_, Bool
_, Maybe Point
_) -> Double
v)
FrameState -> Picture
framedPicture
FrameState -> Bounds
framedBounds
where
(Parameter Text
name Double
_ Picture
_ Bounds
_ Event -> Parameter
_) = Parameter
iparam
type FrameState = (Parameter, Point, Bool, Maybe Point)
framedHandle :: Event -> FrameState -> FrameState
framedHandle :: Event -> FrameState -> FrameState
framedHandle (PointerPress (Double
px, Double
py)) (Parameter
param, (Double
x, Double
y), Bool
open, Maybe Point
anchor)
| Bool
onOpenButton = (Parameter
param, (Double
x, Double
y), Bool -> Bool
not Bool
open, Maybe Point
anchor)
| Bool
onTitleBar = (Parameter
param, (Double
x, Double
y), Bool
open, forall a. a -> Maybe a
Just (Double
px, Double
py))
where
Parameter Text
_ Double
_ Picture
_ (Double
left, Double
top, Double
w, Double
h) Event -> Parameter
_ = Parameter
param
onTitleBar :: Bool
onTitleBar =
forall a. Num a => a -> a
abs (Double
px forall a. Num a => a -> a -> a
- Double
x forall a. Num a => a -> a -> a
- (Double
left forall a. Num a => a -> a -> a
+ Double
w forall a. Fractional a => a -> a -> a
/ Double
2)) forall a. Ord a => a -> a -> Bool
< Double
w forall a. Fractional a => a -> a -> a
/ Double
2
Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
py forall a. Num a => a -> a -> a
- Double
y forall a. Num a => a -> a -> a
- Double
top forall a. Num a => a -> a -> a
- Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Ord a => a -> a -> Bool
< Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2
onOpenButton :: Bool
onOpenButton
| Double
w forall a. Num a => a -> a -> a
* Double
h forall a. Ord a => a -> a -> Bool
> Double
0 =
forall a. Num a => a -> a
abs (Double
px forall a. Num a => a -> a -> a
- Double
x forall a. Num a => a -> a -> a
- (Double
left forall a. Num a => a -> a -> a
+ Double
w forall a. Num a => a -> a -> a
- Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2)) forall a. Ord a => a -> a -> Bool
< Double
0.2
Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Double
py forall a. Num a => a -> a -> a
- Double
y forall a. Num a => a -> a -> a
- (Double
top forall a. Num a => a -> a -> a
+ Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2)) forall a. Ord a => a -> a -> Bool
< Double
0.2
| Bool
otherwise = Bool
False
framedHandle (PointerRelease Point
_) (Parameter
param, Point
loc, Bool
open, Just Point
_) =
(Parameter
param, Point
loc, Bool
open, forall a. Maybe a
Nothing)
framedHandle (PointerMovement (Double
px, Double
py)) (Parameter
param, (Double
x, Double
y), Bool
open, Just (Double
ax, Double
ay)) =
(Parameter
param, (Double
x forall a. Num a => a -> a -> a
+ Double
px forall a. Num a => a -> a -> a
- Double
ax, Double
y forall a. Num a => a -> a -> a
+ Double
py forall a. Num a => a -> a -> a
- Double
ay), Bool
open, forall a. a -> Maybe a
Just (Double
px, Double
py))
framedHandle (TimePassing Double
dt) (Parameter Text
_ Double
_ Picture
_ Bounds
_ Event -> Parameter
handle, Point
loc, Bool
open, Maybe Point
anchor) =
(Event -> Parameter
handle (Double -> Event
TimePassing Double
dt), Point
loc, Bool
open, Maybe Point
anchor)
framedHandle Event
event (Parameter Text
_ Double
_ Picture
_ Bounds
_ Event -> Parameter
handle, (Double
x, Double
y), Bool
True, Maybe Point
anchor) =
(Event -> Parameter
handle (Double -> Double -> Event -> Event
untranslated Double
x Double
y Event
event), (Double
x, Double
y), Bool
True, Maybe Point
anchor)
framedHandle Event
_ FrameState
other = FrameState
other
framedPicture :: FrameState -> Picture
framedPicture :: FrameState -> Picture
framedPicture (Parameter Text
n Double
v Picture
pic (Double
left, Double
top, Double
w, Double
h) Event -> Parameter
_, (Double
x, Double
y), Bool
open, Maybe Point
_) =
HasCallStack => Double -> Double -> Picture -> Picture
translated Double
x Double
y forall a b. (a -> b) -> a -> b
$
HasCallStack => Double -> Double -> Picture -> Picture
translated (Double
left forall a. Num a => a -> a -> a
+ Double
w forall a. Fractional a => a -> a -> a
/ Double
2) (Double
top forall a. Num a => a -> a -> a
+ Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2) Picture
titleBar
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture -> Picture
translated (Double
left forall a. Num a => a -> a -> a
+ Double
w forall a. Fractional a => a -> a -> a
/ Double
2) (Double
top forall a. Num a => a -> a -> a
- Double
h forall a. Fractional a => a -> a -> a
/ Double
2) Picture
clientArea
where
titleBar :: Picture
titleBar
| Double
w forall a. Num a => a -> a -> a
* Double
h forall a. Ord a => a -> a -> Bool
> Double
0 =
HasCallStack => Double -> Double -> Picture
rectangle Double
w Double
titleHeight
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture -> Picture
translated
((Double
w forall a. Num a => a -> a -> a
- Double
titleHeight) forall a. Fractional a => a -> a -> a
/ Double
2)
Double
0
(if Bool
open then Picture
collapseButton else Picture
expandButton)
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture -> Picture
translated
(- Double
titleHeight forall a. Fractional a => a -> a -> a
/ Double
2)
Double
0
( HasCallStack => Double -> Double -> Picture -> Picture
clipped
(Double
w forall a. Num a => a -> a -> a
- Double
titleHeight)
Double
titleHeight
(HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 (HasCallStack => Text -> Picture
lettering Text
titleText))
)
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Color -> Picture -> Picture
colored Color
titleColor (HasCallStack => Double -> Double -> Picture
solidRectangle Double
w Double
titleHeight)
| Bool
otherwise =
HasCallStack => Double -> Double -> Picture
rectangle Double
w Double
titleHeight
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture -> Picture
clipped Double
w Double
titleHeight (HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 (HasCallStack => Text -> Picture
lettering Text
titleText))
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Color -> Picture -> Picture
colored Color
titleColor (HasCallStack => Double -> Double -> Picture
solidRectangle Double
w Double
titleHeight)
titleText :: Text
titleText
| Text -> Int
T.length Text
n forall a. Ord a => a -> a -> Bool
> Int
10 = Int -> Text -> Text
T.take Int
8 Text
n forall a. Semigroup a => a -> a -> a
<> Text
"... = " forall a. Semigroup a => a -> a -> a
<> Text
formattedVal
| Bool
otherwise = Text
n forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Text
formattedVal
formattedVal :: Text
formattedVal = String -> Text
pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloatAlt (forall a. a -> Maybe a
Just Int
2) Double
v String
"")
collapseButton :: Picture
collapseButton = HasCallStack => Double -> Double -> Picture
rectangle Double
0.4 Double
0.4 HasCallStack => Picture -> Picture -> Picture
& HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.1, -Double
0.1), (Double
0.1, -Double
0.1), (Double
0, Double
0.1)]
expandButton :: Picture
expandButton = HasCallStack => Double -> Double -> Picture
rectangle Double
0.4 Double
0.4 HasCallStack => Picture -> Picture -> Picture
& HasCallStack => [Point] -> Picture
solidPolygon [(-Double
0.1, Double
0.1), (Double
0.1, Double
0.1), (Double
0, -Double
0.1)]
clientArea :: Picture
clientArea =
Bool -> Picture -> Picture
picWhen (Double
w forall a. Num a => a -> a -> a
* Double
h forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$
HasCallStack => Double -> Double -> Picture
rectangle Double
w Double
h
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture -> Picture
clipped Double
w Double
h Picture
pic
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Color -> Picture -> Picture
colored Color
bgColor (HasCallStack => Double -> Double -> Picture
solidRectangle Double
5 Double
1)
framedBounds :: FrameState -> Bounds
framedBounds :: FrameState -> Bounds
framedBounds (Parameter Text
_ Double
_ Picture
_ (Double
left, Double
top, Double
w, Double
h) Event -> Parameter
_, (Double
x, Double
y), Bool
True, Maybe Point
_) =
(Double
x forall a. Num a => a -> a -> a
+ Double
left, Double
y forall a. Num a => a -> a -> a
+ Double
top forall a. Num a => a -> a -> a
+ Double
titleHeight, Double
w, Double
h forall a. Num a => a -> a -> a
+ Double
titleHeight)
framedBounds (Parameter Text
_ Double
_ Picture
_ (Double
left, Double
top, Double
w, Double
_) Event -> Parameter
_, (Double
x, Double
y), Bool
False, Maybe Point
_) =
(Double
x forall a. Num a => a -> a -> a
+ Double
left, Double
y forall a. Num a => a -> a -> a
+ Double
top forall a. Num a => a -> a -> a
+ Double
titleHeight, Double
w, Double
titleHeight)
titleHeight :: Double
titleHeight :: Double
titleHeight = Double
0.7
untranslated :: Double -> Double -> Event -> Event
untranslated :: Double -> Double -> Event -> Event
untranslated Double
x Double
y (PointerPress (Double
px, Double
py)) = Point -> Event
PointerPress (Double
px forall a. Num a => a -> a -> a
- Double
x, Double
py forall a. Num a => a -> a -> a
- Double
y)
untranslated Double
x Double
y (PointerRelease (Double
px, Double
py)) = Point -> Event
PointerRelease (Double
px forall a. Num a => a -> a -> a
- Double
x, Double
py forall a. Num a => a -> a -> a
- Double
y)
untranslated Double
x Double
y (PointerMovement (Double
px, Double
py)) = Point -> Event
PointerMovement (Double
px forall a. Num a => a -> a -> a
- Double
x, Double
py forall a. Num a => a -> a -> a
- Double
y)
untranslated Double
_ Double
_ Event
other = Event
other
converted :: (Double -> Double) -> Parameter -> Parameter
converted :: (Double -> Double) -> Parameter -> Parameter
converted Double -> Double
c (Parameter Text
name Double
val Picture
pic Bounds
bounds Event -> Parameter
handle) =
Text
-> Double -> Picture -> Bounds -> (Event -> Parameter) -> Parameter
Parameter Text
name (Double -> Double
c Double
val) Picture
pic Bounds
bounds ((Double -> Double) -> Parameter -> Parameter
converted Double -> Double
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Parameter
handle)
renamed :: Text -> Parameter -> Parameter
renamed :: Text -> Parameter -> Parameter
renamed Text
name (Parameter Text
_ Double
val Picture
pic Bounds
bounds Event -> Parameter
handle) =
Text
-> Double -> Picture -> Bounds -> (Event -> Parameter) -> Parameter
Parameter Text
name Double
val Picture
pic Bounds
bounds (Text -> Parameter -> Parameter
renamed Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Parameter
handle)
constant :: Text -> Double -> Parameter
constant :: Text -> Double -> Parameter
constant Text
name Double
n =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
name
Double
n
(forall a b. a -> b -> a
const forall a. a -> a
id)
forall a. a -> a
id
(forall a b. a -> b -> a
const HasCallStack => Picture
blank)
(forall a b. a -> b -> a
const (-Double
2.5, Double
0, Double
5, Double
0))
buttonOf ::
Text ->
state ->
(state -> state) ->
(state -> Double) ->
(state -> Picture) ->
Parameter
buttonOf :: forall state.
Text
-> state
-> (state -> state)
-> (state -> Double)
-> (state -> Picture)
-> Parameter
buttonOf Text
name state
initial state -> state
click state -> Double
value state -> Picture
pic =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
name
(state
initial, Bool
False)
Event -> (state, Bool) -> (state, Bool)
change
(state -> Double
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
( \(state
state, Bool
press) ->
state -> Picture
pic state
state
HasCallStack => Picture -> Picture -> Picture
& Bool -> Picture -> Picture
picWhen Bool
press (HasCallStack => Color -> Picture -> Picture
colored (Double -> Double -> Double -> Double -> Color
RGBA Double
0 Double
0 Double
0 Double
0.3) (HasCallStack => Double -> Double -> Picture
solidRectangle Double
5 Double
1))
)
(forall a b. a -> b -> a
const (-Double
2.5, Double
0.5, Double
5, Double
1))
where
change :: Event -> (state, Bool) -> (state, Bool)
change (PointerPress (Double
px, Double
py)) (state
state, Bool
_)
| forall a. Num a => a -> a
abs Double
px forall a. Ord a => a -> a -> Bool
< Double
2.5, forall a. Num a => a -> a
abs Double
py forall a. Ord a => a -> a -> Bool
< Double
0.5 = (state
state, Bool
True)
change (PointerRelease (Double
px, Double
py)) (state
state, Bool
True)
| forall a. Num a => a -> a
abs Double
px forall a. Ord a => a -> a -> Bool
< Double
2.5, forall a. Num a => a -> a
abs Double
py forall a. Ord a => a -> a -> Bool
< Double
0.5 = (state -> state
click state
state, Bool
False)
| Bool
otherwise = (state
state, Bool
False)
change Event
_ (state
state, Bool
press) = (state
state, Bool
press)
toggle :: Text -> Parameter
toggle :: Text -> Parameter
toggle Text
name = forall state.
Text
-> state
-> (state -> state)
-> (state -> Double)
-> (state -> Picture)
-> Parameter
buttonOf Text
name Bool
False Bool -> Bool
not forall {a}. Num a => Bool -> a
value Bool -> Picture
picture
where
value :: Bool -> a
value Bool
True = a
1
value Bool
False = a
0
picture :: Bool -> Picture
picture Bool
True = HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x2611"
picture Bool
False = HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x2610"
counter :: Text -> Parameter
counter :: Text -> Parameter
counter Text
name = forall state.
Text
-> state
-> (state -> state)
-> (state -> Double)
-> (state -> Picture)
-> Parameter
buttonOf Text
name Double
0 (forall a. Num a => a -> a -> a
+ Double
1) forall a. a -> a
id forall {p}. p -> Picture
picture
where
picture :: p -> Picture
picture p
_ = HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 (HasCallStack => Text -> Picture
lettering Text
"Next")
slider :: Text -> Parameter
slider :: Text -> Parameter
slider Text
name =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
name
(Double
0.5, Bool
False)
Event -> (Double, Bool) -> (Double, Bool)
change
forall a b. (a, b) -> a
fst
forall {b}. (Double, b) -> Picture
picture
(forall a b. a -> b -> a
const (-Double
2.5, Double
0.5, Double
5, Double
1))
where
change :: Event -> (Double, Bool) -> (Double, Bool)
change (PointerPress (Double
px, Double
py)) (Double
_, Bool
_)
| forall a. Num a => a -> a
abs Double
px forall a. Ord a => a -> a -> Bool
< Double
2, forall a. Num a => a -> a
abs Double
py forall a. Ord a => a -> a -> Bool
< Double
0.25 = (forall a. Ord a => a -> a -> a
min Double
1 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ (Double
px forall a. Num a => a -> a -> a
+ Double
2) forall a. Fractional a => a -> a -> a
/ Double
4, Bool
True)
change (PointerRelease Point
_) (Double
v, Bool
_) = (Double
v, Bool
False)
change (PointerMovement (Double
px, Double
_)) (Double
_, Bool
True) =
(forall a. Ord a => a -> a -> a
min Double
1 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ (Double
px forall a. Num a => a -> a -> a
+ Double
2) forall a. Fractional a => a -> a -> a
/ Double
4, Bool
True)
change Event
_ (Double, Bool)
state = (Double, Bool)
state
picture :: (Double, b) -> Picture
picture (Double
v, b
_) =
HasCallStack => Double -> Double -> Picture -> Picture
translated (Double
v forall a. Num a => a -> a -> a
* Double
4 forall a. Num a => a -> a -> a
- Double
2) Double
0 (HasCallStack => Double -> Double -> Picture
solidRectangle Double
0.125 Double
0.5)
HasCallStack => Picture -> Picture -> Picture
& HasCallStack => Double -> Double -> Picture
solidRectangle Double
4 Double
0.1
random :: Text -> Parameter
random :: Text -> Parameter
random Text
name = forall state.
Text
-> state
-> (state -> state)
-> (state -> Double)
-> (state -> Picture)
-> Parameter
buttonOf Text
name (Double, StdGen)
initial (StdGen -> (Double, StdGen)
next forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a, b) -> a
fst forall {p}. p -> Picture
picture
where
initial :: (Double, StdGen)
initial = StdGen -> (Double, StdGen)
next (forall a. IO a -> a
unsafePerformIO forall (m :: * -> *). MonadIO m => m StdGen
newStdGen)
picture :: p -> Picture
picture p
_ = HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x21ba Regenerate"
next :: StdGen -> (Double, StdGen)
next = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
0.0, Double
1.0)
timer :: Text -> Parameter
timer :: Text -> Parameter
timer Text
name =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
name
(Double
0, Double
1)
Event -> Point -> Point
change
forall a b. (a, b) -> a
fst
forall {a} {a}. (Eq a, Num a) => (a, a) -> Picture
picture
(forall a b. a -> b -> a
const (-Double
2.5, Double
0.5, Double
5, Double
1))
where
change :: Event -> Point -> Point
change (TimePassing Double
dt) (Double
t, Double
r) = (Double
t forall a. Num a => a -> a -> a
+ Double
r forall a. Num a => a -> a -> a
* Double
dt, Double
r)
change (PointerPress (Double
px, Double
py)) (Double
t, Double
r)
| forall a. Num a => a -> a
abs (Double
px forall a. Num a => a -> a -> a
- Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) forall a. Ord a => a -> a -> Bool
< Double
5 forall a. Fractional a => a -> a -> a
/ Double
6, forall a. Num a => a -> a
abs Double
py forall a. Ord a => a -> a -> Bool
< Double
0.75 = (Double
t, Double
1 forall a. Num a => a -> a -> a
- Double
r)
| forall a. Num a => a -> a
abs (Double
px forall a. Num a => a -> a -> a
+ Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) forall a. Ord a => a -> a -> Bool
< Double
5 forall a. Fractional a => a -> a -> a
/ Double
6, forall a. Num a => a -> a
abs Double
py forall a. Ord a => a -> a -> Bool
< Double
0.75 = (Double
0, Double
0)
change Event
_ Point
state = Point
state
picture :: (a, a) -> Picture
picture (a
_, a
0) =
(HasCallStack => Double -> Double -> Picture -> Picture
translated (Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) Double
0 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x23e9")
HasCallStack => Picture -> Picture -> Picture
& (HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) Double
0 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x23ee")
picture (a, a)
_ =
(HasCallStack => Double -> Double -> Picture -> Picture
translated (Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) Double
0 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x23f8")
HasCallStack => Picture -> Picture -> Picture
& (HasCallStack => Double -> Double -> Picture -> Picture
translated (-Double
5 forall a. Fractional a => a -> a -> a
/ Double
6) Double
0 forall a b. (a -> b) -> a -> b
$ HasCallStack => Double -> Picture -> Picture
dilated Double
0.5 forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Picture
lettering Text
"\x23ee")
currentHour :: Parameter
currentHour :: Parameter
currentHour =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
"hour"
()
(forall a b. a -> b -> a
const forall a. a -> a
id)
(\()
_ -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> Int
todHour forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeOfDay
getTimeOfDay)
(forall a b. a -> b -> a
const HasCallStack => Picture
blank)
(forall a b. a -> b -> a
const (-Double
2.5, Double
0, Double
5, Double
0))
currentMinute :: Parameter
currentMinute :: Parameter
currentMinute =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
"minute"
()
(forall a b. a -> b -> a
const forall a. a -> a
id)
(\()
_ -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> Int
todMin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeOfDay
getTimeOfDay)
(forall a b. a -> b -> a
const HasCallStack => Picture
blank)
(forall a b. a -> b -> a
const (-Double
2.5, Double
0, Double
5, Double
0))
currentSecond :: Parameter
currentSecond :: Parameter
currentSecond =
forall state.
Text
-> state
-> (Event -> state -> state)
-> (state -> Double)
-> (state -> Picture)
-> (state -> Bounds)
-> Parameter
parameterOf
Text
"second"
()
(forall a b. a -> b -> a
const forall a. a -> a
id)
(\()
_ -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> Pico
todSec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeOfDay
getTimeOfDay)
(forall a b. a -> b -> a
const HasCallStack => Picture
blank)
(forall a b. a -> b -> a
const (-Double
2.5, Double
0, Double
5, Double
0))
getTimeOfDay :: IO TimeOfDay
getTimeOfDay :: IO TimeOfDay
getTimeOfDay = do
UTCTime
now <- IO UTCTime
getCurrentTime
TimeZone
timezone <- IO TimeZone
getCurrentTimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> TimeOfDay
localTimeOfDay (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
timezone UTCTime
now))
titleColor :: Color
titleColor :: Color
titleColor = Double -> Double -> Double -> Double -> Color
RGBA Double
0.7 Double
0.7 Double
0.7 Double
0.9
bgColor :: Color
bgColor :: Color
bgColor = Double -> Double -> Double -> Double -> Color
RGBA Double
0.8 Double
0.85 Double
0.95 Double
0.8
picWhen :: Bool -> Picture -> Picture
picWhen :: Bool -> Picture -> Picture
picWhen Bool
True = forall a. a -> a
id
picWhen Bool
False = forall a b. a -> b -> a
const HasCallStack => Picture
blank