gistfile1.elm

import Mouse
import Window

radius = 15
data Step = Delta Float | Click (Float,Float) 
toFloat2 (w, h) = (toFloat w, toFloat h)


--Model--
type Ball = { x:Float, y:Float, vx:Float, vy:Float, id:Float }

-- Mouse Logic---
mouseClickPos : Signal (Int, Int)
mouseClickPos = (sampleOn Mouse.clicks Mouse.position)


transformMouseClick : (Int, Int) -> (Int, Int) -> (Float, Float)
transformMouseClick (x,y) (w,h) =
   (toFloat x - toFloat w / 2, (toFloat h / 2 - toFloat y)+200)

getMousePos = lift2 transformMouseClick mouseClickPos Window.dimensions
--Rendering
scene balls (w,h) =
    let drawCircles ball  = 
                circle radius |> filled (hsva  ball.id 1 1 0.7)
                          |> move ( ball.x, ball.y-200)
    in layers [collage w h (map drawCircles balls)]

--Physics--
gravity t b =
    let vy' = if | b.y > 0     -> b.vy - t
                 | b.vy < 0.0001 -> -b.vy*0.91
                 | otherwise   ->  0 
    in { b | vy <- vy', vx <- b.vx*0.999999}

physics t m = 
    let c' = if (m.y + t*m.vy)  < 0 then 0 else 1
    in { m | x <- m.x + t*m.vx
           , y <- ((m.y + t*m.vy)*c') }
          

--Collisions--
--Distance Squared for opitimization--
distance (b1,b2) = (b2.x-b1.x)^2 + (b2.y-b1.y)^2

collision  oldBall newBall = 
    if (not (newBall == oldBall)) && (distance (oldBall,newBall) <= (2*radius)^2)
    then {newBall | vx <- -newBall.vx,
                    vy <- -newBall.vy}
    else newBall

applyCollsion newball oldball = collision newball oldball

update ball balls = foldl step ball balls

--Signals--
input : Signal Step
input = let delta = lift (\t -> t/20) (fps 60)
        in merge (lift Delta delta) (lift Click getMousePos)

--Update--
step step balls =
  case step of
    Delta t -> let update ball = foldl applyCollsion ball balls
                   applyTime ball = physics t (gravity t(ball))                                 
               in map applyTime (map update balls)
    Click dir -> click dir balls

click (w,h) balls =
 { x =  w, y =  h, vx =  3, vy = 2, id = toFloat (length balls)} :: balls


-- Main --
main = lift2 scene (foldp step [] input) Window.dimensions