-- |  Web Fudgets Demo
-- Examples to introduce Web Fudgets (for declarative web programming)
-- Functional Programming course 2016.
-- Thomas Hallgren

{-
This started out as a skeleton, the definitions were filled in
during the lecture.
-}

import WebFudgets
import Haste.Graphics.Canvas

main = runF (mconcat examples)

examples = [ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,ex9,ex10]

shellF title fud = boxF (h2F (textF title) >+ fud)

--------------------------------------------------------------------------------
-- * Hello world example

ex1 = shellF "Hello" (textF "Hello world")


--------------------------------------------------------------------------------
-- * Illustrates parallel composition

ex2 = shellF "Hello world with a button" $
      textF "Hello world!" >+< buttonF "Click me"


--------------------------------------------------------------------------------
-- * Illustrates serial composition and stateless application code

ex3 = shellF "A program to test the factorial function version 1" $
      showF =<= mapF fac =<= readShowF

fac 0 = 1
fac n = n * fac (n-1)
--------------------------------------------------------------------------------
-- * Illustrates layout and decoration

ex4 = shellF "A program to test the factorial function version 2" $
      pF (textF "x = " +< readShowF)
      =>= mapF fac =>=
      pF (textF "x! = " +< showF)

--------------------------------------------------------------------------------
-- * Illustrates stateful application code

ex5 = shellF "An Up Counter" $
      showF =<= stateF incr 0 =<= buttonF "Increment"

incr n BtnClick = (n+1,n+1)

--------------------------------------------------------------------------------
-- * Illustrates how to handle output from a parallel composition

ex6 = shellF "An Up/Down Counter" $
      showF =<= stateF count 0 =<=(buttonF "Up" >+< buttonF "Down")
  where
    count n (Left BtnClick) = (n+1,n+1)
    count n (Right BtnClick) = (n-1,n-1)
  

--------------------------------------------------------------------------------
-- * Illustrates parallel composition of a list of things

data CounterButton = Up | Down | Reset
                     deriving (Eq,Show,Bounded,Enum)

ex7 = shellF "An Up/Down/Reset Counter" $
      showF =<= stateF count 0 =<= listF buttons
  where
    buttons = [(b,buttonF (show b)) | b<-[Up .. Reset]]
    
    count n (b, BtnClick) = (new,new) where new = fn b n

    fn Up    n = n+1
    fn Down  n = n-1
    fn Reset n = 0

--------------------------------------------------------------------------------
-- * Illustrates feedback loops

ex8 = shellF "A Loadable Up/Down Counter" $
      loopLeftF (mapF Left =<= readShowF =<= stateF count 0) =<=
      (buttonF "Up" >+< buttonF "Down")
  where
    count _ (Left n) = (n,n)
    count n (Right (Left BtnClick))  = (n+1,n+1)
    count n (Right (Right BtnClick)) = (n-1,n-1)


--------------------------------------------------------------------------------
-- * A larger example

data CalculatorButton
     = Plus | Minus | Times | Div
     | Enter | Clear | Digit Int
     deriving Eq


ex9 = shellF "A Simple Calculator" $
      showF =<= stateF calc [0] =<= keyboardF
  where
    keyboardF = tableF 4 buttonsF
    buttonsF = listF [d 7, d 8, d 9,op Div,
                      d 4, d 5, d 6,op Times,
                      d 1, d 2, d 3,op Minus,
                      clr,d 0, ent,op Plus]

    d n = (Digit n,buttonF (show n))
    op o = (o,buttonF (opLabel o))
    ent = op Enter
    clr = op Clear

    opLabel Plus  = "+"
    opLabel Minus = "-"
    opLabel Times = "×"
    opLabel Div   = "÷"
    opLabel Enter = "Ent"
    opLabel Clear = "C"

    calc (n:s)   (Digit d,_) = new (n*10+d) s
    calc s       (Enter,_)   = (0:s,head s)
    calc s       (Clear,_)   = ([0],0)
    calc (y:x:s) (Plus,_)    = new (x+y) s
    calc (y:x:s) (Minus,_)   = new (x-y) s
    calc (y:x:s) (Times,_)   = new (x*y) s
    calc (y:x:s) (Div,_)     = new (x `div` y) s
    calc s       _           = (s,head s)

    new n s = (n:s,n)

--------------------------------------------------------------------------------
-- * Illustrates the use of a canvas for graphical output

ex10 = shellF "Canvas example" $
       pF (textF "Draw a polygon with " +< readShowF >+ textF " sides.")
       =>= mapF polygon =>=
       canvasF (300,300)

polygon n = do color (RGB 255 255 128) (fill (path ps))
               color (RGB 0 0 255)     (stroke (path ps))
               text (20,20) "A simple canvas example"
  where
    ps = map corner [0..n]

    c@(cx,cy) = (150,150) -- center
    r = 100 -- radius of enclosing circle
    
    corner i = (cx+r*cos a,cy+r*sin a)
      where
        r = 100
        a = 2*pi*(real i/ real n)

real x = fromIntegral x