Elm Day Three: Heads

elm-day-three-heads.elm

import Color exposing (..)
import Collage exposing (..)
import Element exposing (Element, image, leftAligned, toHtml)
import Html exposing (Html)
import Keyboard exposing (..)
import Key exposing (..)
import List exposing ((::), all, filter, length)
import Mouse exposing (..)
import Random exposing (Seed, step, initialSeed, int)
import Text exposing (color, fromString, height, monospace)
import Time exposing (Time, every, millisecond)

main = Html.program { init = init, view = view, update = update, subscriptions = subscriptions }

-- MODEL
type State = Play | Pause | GameOver

type alias Head =
    {
        x: Float,
        y: Float,
        vx: Float,
        vy: Float,
        img: String
    }
type alias Player =
    {
        x: Float,
        score: Int
    }
type alias Model =
    {
        state: State,
        heads: List Head,
        player: Player,
        seed: Seed
    }

defaultHead n = { x=100.0, y=75, vx=60, vy=0.0, img=headImage n }
defaultGame = { state   = Pause,
                heads   = [],
                player  = {x=0.0, score=0},
                seed    = initialSeed 1234}

headImage n =
    case n of
        0 -> "/img/brucetate.png"
        1 -> "/img/davethomas.png"
        2 -> "/img/evanczaplicki.png"
        3 -> "/img/joearmstrong.png"
        4 -> "/img/josevalim.png"
        _ -> ""

bottom = 550
secsPerFrame = 0.02
init = (defaultGame, Cmd.none)

-- UPDATE

stepGamePlay delta ({state, heads, player, seed} as game) =
    let (rand, seed_) =
        step (int 0 4) seed
    in
        { game | state =  stepGameOver player heads
               , heads =  stepHeads heads delta player.score rand
               , player = stepPlayer player delta heads
               , seed  =  seed_}

stepGameOver player heads =
  if allHeadsSafe player heads then Play else GameOver

allHeadsSafe player heads =
    all (headSafe player) heads

headSafe player head =
    head.y < bottom || abs (head.x - player.x) < 50

stepHeads heads delta score rand = 
  spawnHead score heads rand
  |> bounceHeads
  |> removeComplete
  |> moveHeads delta

spawnHead score heads rand = 
  let addHead = length heads < (score // 5000 + 1)
    && all (\head -> head.x > 107.0) heads in
  if addHead then defaultHead rand :: heads else heads

bounceHeads heads = List.map bounce heads

bounce head =
  { head | vy = if head.y > bottom && head.vy > 0
                 then -head.vy * 0.95
                 else head.vy }

removeComplete heads = filter (\x -> not (complete x)) heads

complete {x} = x > 750

moveHeads delta heads = List.map moveHead heads

moveHead ({x, y, vx, vy} as head) =
  { head | x = x + vx * secsPerFrame
         , y = y + vy * secsPerFrame
         , vy = vy + secsPerFrame * 400 }

stepPlayer player delta heads =
    { player | score = stepScore player heads }

stepPlayerLeft ({player} as model) =
    { model | player = { player | x = player.x - 75 } }

stepPlayerRight ({player} as model) =
    { model | player = { player | x = player.x + 75 } }

stepScore player heads =     -- (11)
  player.score +
  1 +
  1000 * (length (filter complete heads))

stepGameFinished delta ({state, heads, player, seed} as game) =
  if player.score == 0 then defaultGame
  else { game | state = GameOver
              , player = { player |  x = toFloat 0 } }

flipPauseState model =
    case model.state of
        Play -> { model | state = Pause }
        Pause -> { model | state = Play }
        GameOver -> defaultGame

stepGame delta model =
    case model.state of
        Play -> stepGamePlay delta model
        Pause -> model
        GameOver -> stepGameFinished delta model

keyPressed : KeyCode -> Model -> Model
keyPressed keyCode model =
    case Key.fromCode keyCode of
        Space ->
            flipPauseState model

        ArrowLeft ->
            stepPlayerLeft model

        ArrowRight ->
            stepPlayerRight model

        _ ->
            model

type Msg
    = Tick Time
      | KeyDown KeyCode

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Tick delta -> (stepGame delta model, Cmd.none)

        KeyDown keyCode -> (keyPressed keyCode model, Cmd.none)

-- Subscriptions
subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ Time.every (20 * millisecond) Tick
        , Keyboard.downs KeyDown
        ]

-- VIEW

display ({state, heads, player, seed} as game) =
  let (w, h) = (800, 600)
  in collage w h
       ([ drawRoad w h
       , drawBuilding w h
       , drawPaddle w h player.x
       , drawScore w h player
       , drawMessage w h state] ++
       (drawHeads w h heads))

drawRoad w h =
  filled gray (rect (toFloat w) 100)
  |> moveY (-(half h) + 50)

drawBuilding w h =
  filled red (rect 100 (toFloat h))
  |> moveX (-(half w) + 50)

drawHeads w h heads = List.map (drawHead w h) heads

drawHead w h head =
  let x = half w - head.x
      y = half h - head.y
      src = head.img
  in toForm (image 75 75 src)
     |> move (-x, y)
     |> rotate (degrees (x * 2 - 100))

drawPaddle w h x =
  filled black (rect 80 10)
  |> moveX (x +  10 -  half w)
  |> moveY (-(half h - 30))

half x = toFloat x / 2

drawScore w h player =
  toForm (fullScore player)
  |> move (half w - 150, half h - 40)

fullScore player = txt (height 50) (toString player.score)

txt f = leftAligned << f << monospace << color blue << fromString

drawMessage w h state =
  toForm (txt (height 50) (stateMessage state))
  |> move (50, 50)

stateMessage state =
  if state == GameOver then "Game Over" else "Language Head"

view : Model -> Html Msg
view model = toHtml (display model)