Pong

pong.elm

import Basics
import Keyboard
import Random
--MODEL
background = {width = 500.0, height = 500.0, color = black}
paddle1 = {width = background.height/30, height = background.height/7, x = 20-background.width/2, y = 0.0}
paddle2 = {paddle1 | x <- background.width/2 - 20}
ball = {side = paddle1.height/5, x = 0, y = 0, vx = 1, vy = 0.3}

--UPDATE
stepPaddle (t,d) pad = {pad | y <- ((background.height/2 - pad.height/2) `min` (pad.y + t*toFloat d.y)) 
                                    `max` 
                                    (pad.height/2 - background.height/2)}
ballDead b = b.x < (background.width/ -2) || (b.x > background.width/2)
stepBallXY t b = {b | x  <- b.vx * t + b.x, 
                      y  <- b.vy * t + b.y}
collidingBallX collision b = {b | vx <- if (collision b) then b.vx*(-1.1) else b.vx, 
                                  vy <- if (collision b) then b.vy*(1.1) else b.vy}                                
collidingBallY b = {b | vy <- if b.vy > 0 && b.y > (background.height/2 - b.side) || 
                                 b.vy < 0 && b.y < (b.side - background.height/2)     
                              then b.vy * (-1) else b.vy}
randBall rndX rndY = {ball | vx <- if rndX == 0 then -1.0 else 1.0, vy <- toFloat rndY/20}
stepBall (t,collision,rndX,rndY) b = if ballDead b 
                                     then randBall rndX rndY 
                                     else stepBallXY t . collidingBallX collision . collidingBallY <| b                

paddleP1 = foldp stepPaddle paddle1 inputP1
paddleP2 = foldp stepPaddle paddle2 inputP2
randDirX = Random.range 0 1 delta
randDirY = Random.range -15 15 delta
padCollision = collision <~ paddleP1 ~ paddleP2
movingBall = foldp stepBall ball (lift4 (,,,) delta padCollision randDirX randDirY)
ptsP1 = foldp (\ball (accPts, prevXpos) -> 
                if ball.x > paddle2.x && prevXpos < paddle2.x 
                then (accPts+1, ball.x) else (accPts,ball.x) ) (0,0) movingBall
ptsP2 = foldp (\ball (accPts, prevXpos) -> 
                if ball.x < paddle1.x && prevXpos > paddle1.x 
                then (accPts+1, ball.x) else (accPts,ball.x) ) (0,0) movingBall      

--INPUT
delta = lift (\t -> t/6) (fps 90)
inputP1 = sampleOn delta (lift2 (,) delta Keyboard.wasd)
inputP2 = sampleOn delta (lift2 (,) delta Keyboard.arrows)
collision p1 p2 b = let dir = b.vx/(abs b.vx)
                        collisionY p b = b.y < p.y + p.height / 2 && b.y > p.y - p.height/2
                        collisionX p b = let crit = dir*(p.x - b.x) in crit >= 0 && crit <= p.width/2 + b.side/2
                        collision p b = collisionX p b && collisionY p b
                    in  (dir < 0 && collision p1 b || dir > 0 && collision p2 b)
--VIEW
display bg pad1 pad2 b (pts1,_) (pts2, _) = 
           let padToImage pad = filled white <| rect pad.width pad.height
               ptsAsForm pts = toForm <| 
                               leftAligned <| 
                               style {defaultStyle | height <- Just 48, color <- white} (toText . show <| pts)
           in  collage (floor bg.width) (floor bg.height) 
               [filled bg.color <| rect bg.width bg.height, 
                move (pad1.x, pad1.y) (padToImage pad1),
                move (pad2.x, pad2.y) (padToImage pad2),
                move (b.x, b.y) (filled white <| rect b.side b.side),
                move (-100,(bg.height/2 - 20)) <| ptsAsForm pts1,
                move (100,(bg.height/2 - 20)) <| ptsAsForm pts2]
main = lift5 (display background) paddleP1 paddleP2 movingBall ptsP1 ptsP2