import Haste
import Haste.Graphics.Canvas

import Data.IORef

------------------------------------------------------------------------
-- Pure code: 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+1)
 where
  maxY = h-radius
  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)

------------------------------------------------------------------------
-- IO code: This part is only concerned with 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 rballs = do
    balls <- readIORef rballs
    modifyIORef rballs step
    render can $ mapM_ drawBall balls
    setTimeout 20 $ animate can rballs

main :: IO ()
main = do
    Just can     <- getCanvasById "canvas"
    Just canElem <- elemById "canvas"
    w            <- getProp canElem "width"
    h            <- getProp canElem "height"
    Just clear   <- elemById "clear"
    rballs       <- newIORef []
    canElem `onEvent` OnClick $ \_ (x,y) -> do
      let pos = (convert x, convert y)
      modifyIORef rballs $ \balls -> bounce (read w, read h) pos 0 : balls
    clear `onEvent` OnClick $ \_ _ -> writeIORef rballs []
    animate can rballs

-- Note: The current version of Haste does not run the event handler concurrently with the
-- animation, so there is no risk of a race between the two uses of `modifyIORef`. But to make the
-- code more platform independent, one should really use `atomicModifyIORef` instead of
-- `modifyIORef`.