Slime Volleyball in Elm - go to elm-lang.org/try, paste this in, and compile!

slime-volleyball.elm

import Signal
import Time exposing (Time)
import Keyboard
import Window
import Text
import Color
import Graphics.Collage exposing (Shape, circle, rect, collage, filled, move, toForm)
import Graphics.Element exposing (Element, container, show)

-- MODEL
(gameWidth,gameHeight) = (1000,1000)
(halfWidth,halfHeight) = (gameWidth/2,gameHeight/2)
(poleWidth,poleHeight) = (10,150)

type alias Entity =
  { x : Float
  , y : Float
  , vx : Float
  , vy : Float
  , radius : Float
  }

type alias Game =
  { score : (Int, Int)
  , ball : Entity
  , player1 : Entity
  , player2 : Entity
  }

newGame : (Int, Int) -> Game
newGame score =
  { score = score
  , ball = Entity -250 400 0 0 20
  , player1 = Entity -250 0 0 0 50
  , player2 = Entity 250 0 0 0 50
  }

type alias PlayerInput =
  { jump : Bool
  , direction : Int
  }

type alias Input =
  { player1Input : PlayerInput
  , player2Input : PlayerInput
  , delta : Time
  }

-- UPDATE
update : Input -> Game -> Game
update {delta, player1Input, player2Input} ({score, ball, player1, player2} as game) =
  let
      (score1,score2) = score
      (point1,point2) = points game
  in
      if point1 /= point2
      then newGame (score1 + point1, score2 + point2)
      else
          { game
          | player1 <- updatePlayer delta (-halfWidth, -poleWidth/2) player1Input player1
          , player2 <- updatePlayer delta (poleWidth/2, halfWidth) player2Input player2
          , ball <- updateBall delta game
          }

points {ball} =
  if ball.y - ball.radius <= 0
  then
      if ball.x <= 0 then (0,1) else (1,0)
  else (0,0)

updatePlayer : Time -> (Float, Float) -> PlayerInput -> Entity -> Entity
updatePlayer t bounds {jump, direction} player =
  player |> updateGravity t 0
         |> updateHops jump
         |> updateFootwork direction
         |> updatePosition t bounds 0

updateHops: Bool -> Entity -> Entity
updateHops j ({y, vy} as e) =
  { e | vy <- if j && y <= 0 then 12 else vy }

updateFootwork : Int -> Entity -> Entity
updateFootwork dir player =
  { player | vx <- toFloat dir * 8 }

updateBall : Time -> Game -> Entity
updateBall t {player1, player2, ball} = 
  ball |> updateGravity t ball.radius
       |> updatePlayerCollision player1
       |> updatePlayerCollision player2
       |> updateWallBounce
       |> updatePoleBounce
       |> updatePosition t (-gameWidth/2,gameWidth/2) ball.radius

updateGravity : Time -> Float -> Entity -> Entity
updateGravity t offset ({y, vy} as e) =
  { e | vy <- if y > 0 + offset then vy + t * -0.45 else 0 }

updatePosition : Time -> (Float, Float) -> Float -> Entity -> Entity
updatePosition t (leftBound, rightBound) offset ({x, vx, y, vy, radius} as e) =
  { e
  | x <- clamp (leftBound + radius) (rightBound - radius) (x + vx * t)
  , y <- max offset (y + vy * t)
  }

updatePlayerCollision : Entity -> Entity -> Entity
updatePlayerCollision player ball =
  if player `colliding` ball
  then resolvePlayerCollision player ball
  else ball

colliding : Entity -> Entity -> Bool
colliding e1 e2 =
  (e2.x-e1.x)^2 +(e2.y-e1.y)^2 < (e1.radius+e2.radius)^2 && angle e1 e2 >= 0 -- sqrt is expensive I guess?

resolvePlayerCollision : Entity -> Entity -> Entity
resolvePlayerCollision e1 e2 =
  smackBall (14,14) (e1.vx,e1.vy) (angle e1 e2) e2

updateWallBounce : Entity -> Entity
updateWallBounce ball =
  if ball.x - ball.radius <= -halfWidth || ball.x + ball.radius >= halfWidth
  then { ball | vx <- negate ball.vx }
  else ball

updatePoleBounce : Entity -> Entity
updatePoleBounce ball =
  if (ball.x + ball.radius >= -poleWidth/2) && (ball.x - ball.radius <= poleWidth/2)
  then
      let
          ballBottom = ball.y - ball.radius
      in 
          if | ballBottom > poleHeight -> ball
             | ballBottom >= poleHeight - poleWidth && ballBottom <= poleHeight -> resolvePoleTopCollision ball
             | ballBottom < poleHeight - poleWidth ->
               { ball
               | x <- if ball.x <= 0
                      then -poleWidth - ball.radius
                      else poleWidth + ball.radius
               , vx <- negate ball.vx
               }
  else ball

resolvePoleTopCollision : Entity -> Entity
resolvePoleTopCollision ball =
  let
      theta = angle { x = 0, y = poleHeight - poleWidth } ball
  in
      smackBall (6,6) (ball.vx,-ball.vy) theta ball

angle e1 e2 = atan2 (e2.y - e1.y) (e2.x - e1.x)

smackBall (baseVx, baseVy) (hitVx, hitVy) theta ball =
  { ball
  | vx <- roundToPlace 8 <| (baseVx * cos theta) + hitVx * 0.2
  , vy <- (baseVy * sin theta) + hitVy * 0.2
  }

roundToPlace : Int -> Float -> Float
roundToPlace place n =
  let
      adj = 10^place
      n' = round (n*adj)
  in
      toFloat n' / toFloat adj

-- RENDER
semicircle : Float -> Shape
semicircle r = 
  let n = 30
      t = pi / n 
      f i = (r * cos (t*i), r * sin (t*i))
  in
      List.map f [0..n]

instructions = Text.fromString "WASD for player 1, arrow keys for player 2"
view : (Int, Int) -> Game -> Element
view (w,h) {score, ball,player1,player2} =
  collage gameWidth gameHeight
    [ semicircle player1.radius
      |> filled Color.red
      |> move (player1.x, player1.y)
    , semicircle player2.radius
      |> filled Color.blue
      |> move (player2.x, player2.y)
    , circle ball.radius
      |> filled Color.yellow
      |> move (ball.x, ball.y)
    , rect poleWidth poleHeight
      |> filled Color.black
      |> move (0, poleHeight/2)
    , instructions |> Graphics.Element.centered |> toForm |> move (0, -100)
    , show score |> toForm |> move (0, 400)
    ]

main : Signal Element
main =
  Signal.map2 view Window.dimensions gameState

-- INPUT
gameState : Signal Game
gameState = Signal.foldp update (newGame (0,0)) input

delta : Signal Time
delta = Signal.map (\t -> t/20) (Time.fps 71) -- prime numbers means fewer fps drops???

input : Signal Input
input =
  let
      jumping k = k.y == 1
  in
      Signal.sampleOn delta <|
        Signal.map3 Input
          (Signal.map2 PlayerInput (Signal.map jumping Keyboard.wasd) (Signal.map .x Keyboard.wasd))
          (Signal.map2 PlayerInput (Signal.map jumping Keyboard.arrows) (Signal.map .x Keyboard.arrows))
          delta