-- | GUI programming in Haskell
-- Examples introducing threepenny-gui
-- Functional Programming course 2019.
-- Thomas Hallgren

{-
This started as a skeleton, the definitions were filled in
during the lecture.
-}
-------------------------------------------------------------------------
import Graphics.UI.Threepenny
import ThreepennyPages
import Data.IORef
import Breakout

main :: IO ()
--main = startGUI defaultConfig example1
main = startGUI defaultConfig example2

example2 :: Window -> UI ()
example2 w =
   do getBody w #+ [h2 #+ [string "Breakout"]]
      getBody w # set style [("background-color","lightskyblue")]
      can <- canvas # set width worldWidth # set height worldHeight
                    # set style [("background-color","white")]
      getBody w #+ [p #+ [return can]]

      state <- liftIO (newIORef initialWorld)
      let modifyWorld f = liftIO (modifyIORef state f)

      ti <- timer # set interval 16
      start ti

      on tick ti $ \ _ -> do modifyWorld animateWorld
                             w <- liftIO (readIORef state)
                             drawWorld can w

      on mousedown' can $ \ _ -> modifyWorld startBall

      on mousemove' can $ \ p -> modifyWorld (movePaddle p)
      
      return ()

drawWorld can (World (pos,_) paddle bricks) =
  do clearCanvas can
     set' fillStyle (htmlColor "blue") can
     sequence_ [fillRect p w h can | (p,(w,h)) <- bricks]
     set' fillStyle (htmlColor "purple") can
     fillRect paddle paddleWidth paddleHeight can
     set' fillStyle (htmlColor "red") can
     filledCircle pos ballRadius can

filledCircle pos radius can =
   do beginPath can
      arc pos radius 0 (2*pi) can
      closePath can
      fill can
      
example1 :: Window -> UI ()
example1 w =
   do getBody w #+ [h2 #+ [string "Hello world"]]
      getBody w # set style [("background-color","lightskyblue")]
      display <- input # set value "0"
      getBody w #+ [return display]

      can <- canvas # set width 300 # set height 300
                    # set style [("background-color","white")]

      let makeButton :: String -> (Int->Int) -> UI ()
          makeButton label f =
            do button <- set type_ "button" (set value label input)
               getBody w #+ [return button]
               on click button (\ _ ->do s <- get value display
                                         let n = read s
                                         let new_n = f n
                                         set' value (show new_n) display
                                         drawPolygon can new_n)

      makeButton "Incr" (+1)
      makeButton "Decr" (subtract 1)
      makeButton "Double" (*2)

      getBody w #+ [p #+ [return can]]
      
      return ()

drawPolygon can n =
  do let p:ps = [(150+100*cos a,150+100*sin a) |
                i <- [0..n],
                let a = 2*pi * fromIntegral i / fromIntegral n]
     clearCanvas can
     beginPath can
     moveTo p can
     sequence_ [lineTo p can | p<-ps]
     closePath can
     stroke can