{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}

{-
  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.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)

-- | Bounds information for a parameter UI.  The fields are the
-- left and top coordinate, then the width and height.
type Bounds = (Double, Double, Double, Double)

-- | The source for a parameter that can be adjusted in a parametric
-- drawing.  Parameters can get their values from sliders, buttons,
-- counters, timers, etc.
data Parameter where
  Parameter ::
    Text ->
    Double ->
    Picture ->
    Bounds ->
    (Event -> Parameter) ->
    Parameter

-- | A drawing that depends on parameters.  The first argument is a
-- list of parameters.  The second is a picture, which depends on the
-- values of those parameters.  Each number used to retrieve the picture
-- is the value of the corresponding parameter in the first list.
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)

-- | Wraps a list of parameters in frames to lay them out on the screen.
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

-- | Finds the first element of a list that matches the predicate, if any,
-- and removes it from the list, returning it separately from the remaining
-- elements.
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)

-- | Determines if a point is inside the screen area for a given parameter.
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

-- | Builds a parameter from an explicit state.
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)

-- Puts a simple parameter in a draggable widget that let the user
-- manipulate it on the screen, and displays the name and value.
-- All parameters are enclosed in one of these automatically.
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

-- | The state of a framedParam, which includes the original parameter,
-- its location, whether it's open (expanded) or not, and the anchor if
-- it is currently being dragged.
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

-- | Adjusts the output of a parameter by passing it through a conversion
-- function.  Built-in parameters usually range from 0 to 1, and conversions
-- can be used to rescale the output to a different range.
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)

-- | Changes the name of an existing parameter.
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)

-- | A 'Parameter' with a constant value, and no way to change it.
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))

-- | Builder for 'Parameter' types that are clickable and 5x1 in size.
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)

-- | A 'Parameter' that can be toggled between 0 (off) and 1 (on).
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"

-- | A 'Parameter' that counts how many times it has been clicked.
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")

-- | A 'Parameter' that can be adjusted continuously between 0 and 1.
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

-- | A 'Parameter' that has a randomly chosen value.  It offers a button to
-- regenerate its value.
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)

-- | A 'Parameter' that changes over time. It can be paused or reset.
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")

-- | A 'Parameter' that tracks the current hour, in local time.  The hour
-- is on a scale from 0 (meaning midnight) to 23 (meaning 11:00 pm).
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))

-- | A 'Parameter' that tracks the current minute, in local time.  It
-- ranges from 0 to 59.
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))

-- | A 'Parameter' that tracks the current second, in local time.  It
-- ranges from 0.0 up to (but not including) 60.0.  This includes
-- fractions of a second.  If that's not what you want, you can use
-- 'withConversion' to truncate the number.
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