Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Elm Day Three: Heads
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.