{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | A very simple Graphical User Interface (GUI) for user interaction with
-- buttons, checkboxes, sliders and a few others.
module Extras.Widget
  ( -- $intro
    guiDrawingOf,
    guiActivityOf,

    -- * Widgets
    Widget,
    toggle,
    button,
    slider,
    randomBox,
    timer,
    counter,

    -- * Convenience functions
    withConversion,
    setConversion,

    -- * Examples
    widgetExample1,
    widgetExample2,
    widgetExample3,
    widgetExample4,
  )
where

import Prelude

--------------------------------------------------------------------------------

-- $intro
-- = Widget API
--
-- To use the extra features in this module, you must begin your code with this
-- line:
--
-- > import Extras.Widget

-- | The function @guiDrawingOf@ is an entry point for drawing that allows
-- access to a simple GUI. It needs two arguments: a list of
-- Widgets and a function to create your drawing. This user-supplied drawing
-- function will have access to the list of the current values of the widgets,
-- which is passed as an argument.
--
-- Example of use:
--
-- > program = guiDrawingOf(widgets,draw)
-- >   where
-- >   widgets = [ withConversion(\v -> 1 + 19 * v   , slider("width"        ,-7,-7))
-- >             , withConversion(\v -> 1 + 19 * v   , slider("height"       ,-7,-9))
-- >             , withConversion(flipflop           , toggle("show circle"  ,-7,-5))
-- >             , withConversion(flipflop           , button("show in green",-7,-3))
-- >             , withConversion(\v -> 0.2 + 0.8 * v, randomBox("radius"    ,-7,-1))
-- >             ]
-- >
-- >   flipflop(v) = truncation(1 + 2 * v)
-- >
-- > draw(values) = blank
-- >   & [blank, circle(r)]#s
-- >   & colored(solidRectangle(w,h),[red,green]#c)
-- >   where
-- >   w = values#1
-- >   h = values#2
-- >   s = values#3
-- >   c = values#4
-- >   r = values#5
--
-- Note that the order in which the widgets are defined is important,
-- because it determines how to access the correct value.
-- Each widget fits in a box 4 units wide and 1 unit high.
guiDrawingOf :: ([Widget], [Number] -> Picture) -> Program
guiDrawingOf (widgetsUser, drawUser) = activityOf (initAll, updateAll, drawAll)
  where
    initAll (rs) = initRandom (widgetsUser, rs)
    updateAll (ws, event) = ws .$ updateWidget (event)
    drawAll (ws) = pictures (ws .$ drawWidget) & drawUser (ws .$ value)

-- | The function @guiActivityOf@ is similar to @activityOf@, but it also
-- takes in a list of widgets. The updating and drawing functions also
-- receive a list of the current values of the widgets.
--
-- Example of use:
--
-- > program = guiActivityOf(widgets,init,update,draw)
-- >   where
-- >   widgets = [ withConversion(\v -> 20 * v, slider("width",-7,-7))
-- >             , withConversion(\v -> 2 + 3 * v, slider("height",-7,-9))
-- >             , withConversion
-- >               (\v -> truncation(1 + 2*v), toggle("show circle",-7,-5))
-- >             , button("restart",-7,-3)
-- >             , randomBox("new color",-7,-1)
-- >             ]
-- >
-- > draw(values,(color@(RGB(r1,r2,r3)),angle,_)) = colored(base,color)
-- >     & [blank, circle(5)]#s
-- >     & translated(lettering(msg),0,9)
-- >     where
-- >     msg = joined(["(",printed(r1),",",printed(r2),",",printed(r3),")"])
-- >     base = rotated(solidRectangle(w,h),angle)
-- >     w = values#1
-- >     h = values#2
-- >     s = values#3
-- >
-- >   init(rs) = (RGB(rs#1,rs#2,rs#3),0,0)
-- >
-- >   update(values,(color@(RGB(r1,r2,r3)),angle,wait),TimePassing(_))
-- >     | values#4 > 0 , wait == 0 = (RGB(r2,r3,r),0,values#4)
-- >     | otherwise = (color,angle+1,wait)
-- >     where
-- >     r = values#5
-- >
-- >   update(values,(color,angle,wait),PointerRelease(_)) = (color,angle,0)
-- >
-- >   update(values,state,event) = state
--
-- Note that pre-defined actions on the widgets take precedence over
-- anything that you define in your updating function, so you cannot
-- alter the default behavior of the widgets.
guiActivityOf ::
  ( [Widget],
    [Number] -> state,
    ([Number], state, Event) -> state,
    ([Number], state) -> Picture
  ) ->
  Program
guiActivityOf (widgetsUser, initUser, updateUser, drawUser) =
  activityOf (initAll, updateAll, drawAll)
  where
    initAll (rs) =
      ( initRandom (widgetsUser, rest (rs, 1)),
        initUser (randomNumbers (rs # 1))
      )
    updateAll ((widgets, state), event) =
      (newWidgets, updateUser (widgets .$ value, state, event))
      where
        newWidgets = widgets .$ updateWidget (event)
    drawAll (widgets, state) =
      pictures (widgets .$ drawWidget) & drawUser (widgets .$ value, state)

initRandom (ws, rs) = [t (w, r) | w <- ws | r <- rs]
  where
    t (w, r)
      | isRandom (w) =
        let rp = randomNumbers (r)
         in w {value_ = rp # 1, randomPool = rest (rp, 1)}
      | otherwise = w

isRandom (Widget {widget = Random}) = True
isRandom (_) = False

-- | A button placed at the given location. While
-- the button is pressed, the value produced is 0.5,
-- but when the button is released, the value reverts
-- back to 0.
button :: (Text, Number, Number) -> Widget
button (p) = (newWidget (p)) {widget = Button}

-- | A toggle (checkbox) with the given label at the given location.
-- When the box is not set, the value produced is 0. When the
-- box is set, the value produced is 0.5
toggle :: (Text, Number, Number) -> Widget
toggle (p) = (newWidget (p)) {widget = Toggle}

-- | A slider with the given label at the given location.
-- The possible values will range from 0 to 1, and the initial
-- value will be 0.
slider :: (Text, Number, Number) -> Widget
slider (p) = (newWidget (p)) {widget = Slider}

-- | A box that produces a random number between 0 and 1.
-- Each time you click on it, the value will change. The
-- value 1 is never produced, so the actual range of
-- values is 0 to 0.99999...
randomBox :: (Text, Number, Number) -> Widget
randomBox (p) = (newWidget (p)) {widget = Random}

-- | A button that keeps incrementing the value each time you press it.
-- The initial value is 1.
counter :: (Text, Number, Number) -> Widget
counter (p) = (newWidget (p)) {widget = Counter, value_ = 1}

-- | A toggle that counts time up when you set it. When you click on
-- the left side of the widget, the current value is reset to 0.
-- You can stop the timer and start it again, and the value will increase
-- from where it was when you stopped it.
--
-- Example:
--
-- > program = guiDrawingOf(widgets,draw)
-- >   where
-- >   widgets = [ withConversion(\v -> 1 + 9 * v , slider("length",-7,-7))
-- >             , withConversion(\v -> v * 30    , timer("angle"  ,-7,-9)) ]
-- >
-- >   draw([l,a]) = rotated(translated(colored(solidRectangle(l,0.25),red),l/2,0),a)
--
-- The timer operates in seconds, including decimals. However, the precision
-- of the timer is not guaranteed beyond one or two decimals.
timer :: (Text, Number, Number) -> Widget
timer (p) = (newWidget (p)) {widget = Timer}

-- | Make the widget use the provided function to convert values from
-- the default range of a widget to a different range.
--
-- Example:
--
-- > newSlider = withConversion(\v -> 20 * v - 10, oldSlider)
--
-- Assuming that the old slider did not have any conversion function applied
-- to it, the example above will make the new slider produce values
-- between -10 and 10, while the old slider will still produce values
-- between 0 and 1
withConversion :: (Number -> Number, Widget) -> Widget
withConversion (conv, w) = w {conversion = conv}

-- | Same functionality as @withConversion@, but using a different convention
-- for the arguments.
setConversion :: (Number -> Number) -> Widget -> Widget
setConversion (conv) (w) = w {conversion = conv}

-- | This is the example shown in the documentation for @guiDrawingOf@
widgetExample1 :: Program
widgetExample1 = guiDrawingOf (widgets, draw)
  where
    widgets =
      [ withConversion (\v -> 1 + 19 * v, slider ("width", -7, -7)),
        withConversion (\v -> 1 + 19 * v, slider ("height", -7, -9)),
        withConversion (flipflop, toggle ("show circle", -7, -5)),
        withConversion (flipflop, button ("show in green", -7, -3)),
        withConversion (\v -> 0.2 + 0.8 * v, randomBox ("radius", -7, -1))
      ]
    flipflop (v) = truncation (1 + 2 * v)
    draw (values) =
      blank
        & [blank, circle (r)] #s
        & colored (solidRectangle (w, h), [red, green] #c)
      where
        w = values # 1
        h = values # 2
        s = values # 3
        c = values # 4
        r = values # 5

-- | This is the example shown in the documentation for @guiActivityOf@
widgetExample2 :: Program
widgetExample2 = guiActivityOf (widgets, init, update, draw)
  where
    widgets =
      [ withConversion (\v -> 20 * v, slider ("width", -7, -7)),
        withConversion (\v -> 2 + 3 * v, slider ("height", -7, -9)),
        withConversion
          (\v -> truncation (1 + 2 * v), toggle ("show circle", -7, -5)),
        button ("restart", -7, -3),
        randomBox ("new color", -7, -1)
      ]
    draw (values, (color@(RGB (r1, r2, r3)), angle, _)) =
      colored (base, color)
        & [blank, circle (5)] #s
        & translated (lettering (msg), 0, 9)
      where
        msg = joined (["(", printed (r1), ",", printed (r2), ",", printed (r3), ")"])
        base = rotated (solidRectangle (w, h), angle)
        w = values # 1
        h = values # 2
        s = values # 3
    init (rs) = (RGB (rs # 1, rs # 2, rs # 3), 0, 0)
    update (values, (color@(RGB (r1, r2, r3)), angle, wait), TimePassing (_))
      | values # 4 > 0, wait == 0 = (RGB (r2, r3, r), 0, values # 4)
      | otherwise = (color, angle + 1, wait)
      where
        r = values # 5
    update (values, (color, angle, wait), PointerRelease (_)) = (color, angle, 0)
    update (values, state, event) = state

-- | This is the example shown in the documentation for @timer@
widgetExample3 = guiDrawingOf (widgets, draw)
  where
    widgets =
      [ withConversion (\v -> 1 + 9 * v, slider ("length", -7, -7)),
        withConversion (\v -> v * 30, timer ("angle", -7, -9))
      ]
    draw ([l, a]) = rotated (translated (colored (solidRectangle (l, 0.25), red), l / 2, 0), a)

-- | This example shows a tree created by a recursive function
widgetExample4 = guiDrawingOf (widgets, draw)
  where
    -- Example copied from code shared by cdsmith

    -- depth = 6   : 6 levels of detail
    -- decay = 0.5 : Each smaller branch decreases in size by 50%.
    -- stem  = 0.5 : Branches occur 50% of the way up the stem.
    -- angle = 30  : Branches point 30 degrees away from the stem.
    widgets =
      [ slider ("depth", -8, 9.5) .# setConversion (\p -> truncation (3 + 4 * p)),
        timer ("decay", -8, 8) .# setConversion (\p -> 0.3 + 0.25 * saw (p, 5)),
        timer ("stem", -8, 6.5) .# setConversion (\p -> saw (p, 17)),
        slider ("angle", -8, 5) .# setConversion (\p -> 5 + 30 * p)
      ]
    draw ([depth, decay, stem, angle]) =
      translated (scaled (branch (depth, decay, stem, angle), 2 * decay, 2 * decay), 0, -5)
    branch (0, _, _, _) = polyline [(0, 0), (0, 5)]
    branch (depth, decay, stem, angle) =
      blank
        & polyline [(0, 0), (0, 5)]
        & translated (smallBranch, 0, 5)
        & translated (rotated (smallBranch, angle), 0, stem * 5)
        & translated (rotated (smallBranch, - angle), 0, stem * 5)
      where
        smallBranch = scaled (branch (depth -1, decay, stem, angle), 1 - decay, 1 - decay)
    saw (t, p) = 1 - abs (2 * abs (remainder (t, p)) / p - 1)

--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

data WidgetType = Button | Toggle | Slider | Random | Counter | Timer

-- | The internal structure of a @Widget@ is not exposed in the user interface. You
-- have access only to the current value of each widget.
data Widget = Widget
  { selected :: Truth,
    highlight :: Truth,
    width :: Number,
    height :: Number,
    centerAt :: (Number, Number),
    label :: Text,
    conversion :: Number -> Number,
    value_ :: Number,
    widget :: WidgetType,
    randomPool :: [Number]
  }

newWidget (l, x, y) =
  Widget
    { selected = False,
      highlight = False,
      width = 4,
      height = 1,
      centerAt = (x, y),
      label = l,
      value_ = 0,
      conversion = (\v -> v),
      widget = Button,
      randomPool = []
    }

-- The value, adjusted according to the conversion function
value :: Widget -> Number
value (Widget {..}) = value_ .# conversion

-- The current value of a widget is set as follows.
-- For sliders, the value is a Number
-- between 0 and 1 (both included). For buttons and checkboxes,
-- the value is 0 when they are not set and 0.5 when they are set.
-- These values allow user programs to work with either
-- @guiDrawingOf@ or @randomDrawingOf@ interchangeably, without having
-- to alter the calculations in the code.

hit (mx, my, Widget {..}) = abs (mx - x) < width / 2 && abs (my - y) < height / 2
  where
    (x, y) = centerAt

hitReset (mx, my, Widget {..}) = mx - xmin < 0.3 && abs (my - y) < height / 2
  where
    (x, y) = centerAt
    xmin = x - width / 2

drawWidget (w) = case w .# widget of
  Button -> drawButton (w)
  Toggle -> drawToggle (w)
  Slider -> drawSlider (w)
  Random -> drawRandom (w)
  Counter -> drawCounter (w)
  Timer -> drawTimer (w)

drawButton (Widget {..}) = drawLabel & drawSelection & drawHighlight
  where
    solid = scaled (solidCircle (0.5), w, h)
    outline = scaled (circle (0.5), w, h)
    (x, y) = centerAt
    msg = dilated (lettering (label), 0.5)
    w = 0.9 * width
    h = 0.9 * height
    drawLabel = translated (msg, x, y)
    drawSelection
      | selected = translated (colored (solid, grey), x, y)
      | otherwise = translated (outline, x, y)
    drawHighlight
      | highlight = translated (colored (rectangle (width, height), light (grey)), x, y)
      | otherwise = blank

drawCounter (Widget {..}) = drawLabel & drawSelection
  where
    solid = scaled (solidPolygon (points), w, h)
    outline = scaled (polygon (points), w, h)
    points = [(0.5, 0.3), (0, 0.5), (-0.5, 0.3), (-0.5, -0.3), (0, -0.5), (0.5, -0.3)]
    (x, y) = centerAt
    msg (txt) = translated (dilated (lettering (txt), 0.5), x, y)
    w = 0.9 * width
    h = 0.9 * height
    drawLabel
      | highlight = msg (printed (value_ .# conversion))
      | otherwise = msg (label)
    drawSelection
      | selected = translated (colored (solid, grey), x, y)
      | highlight = translated (colored (outline, black), x, y)
      | otherwise = translated (colored (outline, grey), x, y)

drawToggle (Widget {..}) = drawSelection & drawLabel & drawHighlight
  where
    w = 0.5
    h = 0.5
    x' = x + 2 / 5 * width
    drawSelection
      | selected = translated (colored (solidRectangle (w, h), grey), x', y)
      | otherwise = translated (rectangle (0.9 * w, 0.9 * h), x', y)
    drawLabel = translated (msg, x - width / 10, y)
    drawHighlight
      | highlight =
        colored (outline, light (grey))
          & translated (rectangle (w, h), x', y)
      | otherwise = colored (outline, light (light (grey)))
    outline = translated (rectangle (width, height), x, y)
    (x, y) = centerAt
    msg = dilated (lettering (label), 0.5)

drawTimer (Widget {..}) = drawLabel & drawSelection & drawReset & drawHighlight
  where
    x' = x + 2 / 5 * width
    xmin = x - width / 2
    drawLabel
      | highlight = msg (printed (value_ .# conversion))
      | otherwise = msg (label)
    drawSelection
      | selected = translated (box (0.5, 0.5), x', y)
      | otherwise = translated (rectangle (0.45, 0.45), x', y)
    drawReset = translated (box (0.3, height), xmin + 0.15, y)
    drawHighlight
      | highlight =
        outline
          & translated (rectangle (0.5, 0.5), x', y)
      | otherwise = colored (outline, light (grey))
    outline = translated (rectangle (width, height), x, y)
    (x, y) = centerAt
    msg (txt) = translated (dilated (lettering (txt), 0.5), x - width / 10, y)
    box (w, h) = colored (solidRectangle (w, h), grey)

drawSlider (Widget {..}) = info & foreground & background
  where
    info = translated (infoMsg, x, y - height / 4)
    foreground =
      translated (solidCircle (height / 4), x', y')
        & translated (colored (solidRectangle (width, height / 4), grey), x, y')
    x' = x - width / 2 + value_ * width
    y' = y + height / 4
    background
      | highlight = translated (colored (rectangle (width, height), light (grey)), x, y)
      | otherwise = blank
    (x, y) = centerAt
    infoMsg = dilated (lettering (label <> ": " <> printed (value_ .# conversion)), 0.5)

drawRandom (Widget {..}) = drawLabel & drawSelection & drawHighlight
  where
    solid = scaled (solidRectangle (1, 1), width, height)
    outline = scaled (rectangle (1, 1), width, height)
    (x, y) = centerAt
    msg (txt) = translated (dilated (lettering (txt), 0.5), x, y)
    drawLabel
      | highlight = msg (printed (value_ .# conversion))
      | otherwise = msg (label)
    drawSelection
      | selected = translated (colored (solid, grey), x, y)
      | otherwise = blank
    drawHighlight
      | highlight = translated (outline, x, y)
      | otherwise = colored (translated (outline, x, y), grey)

updateWidget (PointerPress (mx, my)) w@(Widget {..})
  | widget == Button,
    hit (mx, my, w) =
    w
      { selected = True,
        highlight = False,
        value_ = 0.5
      }
  | widget == Button =
    w
      { selected = False,
        highlight = False,
        value_ = 0
      }
  | widget == Counter,
    hit (mx, my, w) =
    w
      { selected = True,
        highlight = True,
        value_ = 1 + value_
      }
  | widget == Toggle,
    hit (mx, my, w) =
    w
      { selected = not (selected),
        value_ = 0.5 - value_,
        highlight = True
      }
  | widget == Timer, hitReset (mx, my, w) = w {value_ = 0}
  | widget == Timer,
    hit (mx, my, w) =
    w
      { selected = not (selected),
        highlight = True
      }
  | widget == Slider,
    hit (mx, my, w) =
    w
      { selected = True,
        highlight = True,
        value_ = updateSliderValue (mx, w)
      }
  | widget == Random,
    hit (mx, my, w) =
    w
      { selected = True,
        highlight = True,
        value_ = randomPool # 1,
        randomPool = rest (randomPool, 1)
      }
  | otherwise = w
updateWidget (PointerMovement (mx, my)) (w) =
  w .# updateHighlight (mx, my) .# updateSlider (mx)
updateWidget (PointerRelease (_)) w@(Widget {..})
  | widget == Toggle = w
  | widget == Timer = w
  | selected =
    w
      { selected = False,
        highlight = False,
        value_ = if widget == Button then 0 else value_
      }
  | otherwise = w
updateWidget (TimePassing (dt)) w@(Widget {..})
  | widget == Timer, selected = w {value_ = dt + value_}
  | otherwise = w
updateWidget (_) (widget) = widget

updateHighlight (mx, my) (w)
  | hit (mx, my, w) = w {highlight = True}
  | otherwise = w {highlight = False}

updateSlider (mx) w@(Widget {..})
  | widget == Slider, selected = w {value_ = updateSliderValue (mx, w)}
  | otherwise = w

updateSliderValue (mx, s@(Widget {..})) =
  (mx' - x + width / 2) / width
  where
    mx' = max (x - width / 2, min (x + width / 2, mx))
    (x, _) = centerAt

x .# f = f (x)

xs .$ f = [f (x) | x <- xs]
