import Haste
import Haste.Graphics.Canvas
import Haste.DOM
import Haste.Events

import Data.IORef

import Pages



--------------------------------------------------------------------------------
-- Pure code, the program logic
-- We follow the philosophy of doing as much as possible in the pure code.

type Size = (Double,Double)

radius :: Double
radius = 15

type Ball  = [Point]
type State = [Ball]

bounce :: Size -> Point -> Int -> Ball
bounce (w,h) (x,y) v
   | v == 0 && y >= maxY = replicate 20 (x,y)
   | y' > maxY           = bounce (w,h) (x,y) (2-v)
   | otherwise           = (x,y) : bounce (w,h) (x,y') v'
 where
   maxY = h-radius
   v'   = v + 1
   y'   = y + fromIntegral v

-- We use Int to represent velocity, because we need to compare it to 0, which
-- is generally a bad idea for floating-point numbers (due to rounding errors).

step :: State -> State
step bs = [ ps | _:ps <- bs ]
  -- Two purposes:
  --
  --  * Drop the first point in each ball
  --  * Filter out finished balls (empty lists)



--------------------------------------------------------------------------------
-- Interactive code
-- This part is only concerned with interaction and drawing, not with the logic
-- determining the behavior of the balls.

ballShape :: Ball -> Shape ()
ballShape []      = return ()
ballShape (pos:_) = circle pos radius

drawBall :: Ball -> Picture ()
drawBall ball = do
    color (RGB 255 0 0) $ fill $ ballShape ball
    stroke $ ballShape ball

animate :: Canvas -> IORef State -> IO ()
animate can state = do
    balls <- readIORef state
    writeIORef state $ step balls
    render can $ mapM_ drawBall balls
    setTimer (Once 20) $ animate can state
    return ()

canWidth, canHeight :: Num a => a
canWidth  = 500
canHeight = 500

main = do
    canvas <- mkCanvas canWidth canHeight
    clear  <- mkButton "clear"
    column documentBody [canvas,clear]

    setStyle documentBody "backgroundColor" "lightblue"
    setStyle documentBody "textAlign" "center"

    Just can <- getCanvas canvas

    -- Use an IORef to communicate between the animation and the event handlers
    state <- newIORef []

    -- Start the animation
    animate can state

    -- Set an event handler for clicks in the canvas
    canvas `onEvent` Click $ \mouse -> do
      let (x,y) = mouseCoords mouse
          pos   = (fromIntegral x, fromIntegral y)
          ball  = bounce (canWidth,canHeight) pos 0
      balls <- readIORef state
      writeIORef state (ball:balls)

    -- Set an event handler for the clear button
    clear `onEvent` Click $ \_ -> writeIORef state []

-- Note: The current version of Haste does not run the event handler
-- concurrently with the animation, so there's no risk of a race between the
-- different uses of `writeIORef`. If it was truly concurrent, then atomic
-- operations would have to be used instead (see the Data.IORef documentation).