Last active
May 18, 2016 19:30
-
-
Save ggb/edcda03567f9e6700d39 to your computer and use it in GitHub Desktop.
A simple (yet funny!) lunar lander simulator written in Elm. Inspiration: Functional Reactive Programming by Blackheath and Jones (Manning, example from the first chapter). Demo: http://examples.ideen-und-soehne.de/lunarlander/
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
elm-stuff/ | |
*.html | |
*.js |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ | |
"version": "1.0.0", | |
"summary": "helpful summary of your project, less than 80 characters", | |
"repository": "https://github.com/user/project.git", | |
"license": "BSD3", | |
"source-directories": [ | |
"." | |
], | |
"exposed-modules": [], | |
"dependencies": { | |
"elm-lang/animation-frame": "1.0.0 <= v < 2.0.0", | |
"elm-lang/core": "4.0.0 <= v < 5.0.0", | |
"elm-lang/html": "1.0.0 <= v < 2.0.0", | |
"elm-lang/keyboard": "1.0.0 <= v < 2.0.0", | |
"elm-lang/window": "1.0.0 <= v < 2.0.0", | |
"evancz/elm-graphics": "1.0.0 <= v < 2.0.0" | |
}, | |
"elm-version": "0.17.0 <= v < 0.18.0" | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module LunarLander exposing (..) | |
import Text | |
import Window exposing (Size, resizes) | |
import Keyboard exposing (KeyCode, downs, ups) | |
import Html.App as App | |
import Color exposing (black, lightGrey, white) | |
import Element exposing (Element, image, toHtml) | |
import Collage exposing (Form, collage, move, rect, filled, toForm, text) | |
import AnimationFrame exposing (times) | |
import Time exposing (Time, every) | |
subscriptions : Lander -> Sub Msg | |
subscriptions model = | |
Sub.batch | |
[ downs Keydown | |
, ups Keyup | |
, times Frame | |
, resizes Resize | |
] | |
main : Program Never | |
main = | |
App.program | |
{ init = (lander, Cmd.none) | |
, view = draw >> toHtml | |
, update = updateLander | |
, subscriptions = subscriptions | |
} | |
{- | |
MODEL | |
-} | |
type Msg | |
= Frame Time | |
| Keydown KeyCode | |
| Keyup KeyCode | |
| Resize Size | |
type Status | |
= Ready | |
| Thrust | |
| Landed | |
| Crashed | |
type alias Lander = | |
{ position: Float | |
, velocity: Float | |
, fuel: Float | |
, status: Status | |
, width: Int | |
, height: Int | |
} | |
lander : Lander | |
lander = { position=500.0, fuel=30, velocity=1, status=Ready, width=800, height=600} | |
{- | |
VIEW | |
-} | |
createText : String -> a -> Form | |
createText pre val = | |
toString val | |
|> Text.fromString | |
|> Text.append (Text.fromString pre) | |
|> Text.monospace | |
|> Text.color white | |
|> text | |
drawLander : Status -> Element | |
drawLander status = | |
case status of | |
Ready -> image 30 30 "lander_ready.png" | |
Thrust -> image 30 30 "lander_thrust.png" | |
Crashed -> image 30 30 "lander_crashed.png" | |
Landed -> image 30 30 "lander_landed.png" | |
draw : Lander -> Element | |
draw {width, height, status, position, fuel, velocity} = | |
let | |
w' = toFloat width | |
h' = toFloat height | |
in | |
collage width height | |
[ move (0, h' / 4) (filled black (rect w' (h' / 2))) | |
, move (0, -h' / 4) (filled lightGrey (rect w' (h' / 2))) | |
, move (0, position) (drawLander status |> toForm) | |
, move (w'/2 - 65, h'/2 - 30) (createText "Fuel: " fuel) | |
, move (w'/2 - 70, h'/2 - 50) (createText "Velocity: " (truncate velocity)) | |
, move (w'/2 - 60, h'/2 - 70) (createText "System: " status) ] | |
{- | |
UPDATE / CONTROL | |
-} | |
calculateVelocity : (Float, Maybe Int) -> Lander -> Lander | |
calculateVelocity (val, arrow) lander = | |
let | |
{position, velocity, fuel} = lander | |
in | |
if position < 0.0 && velocity <= 3 then | |
{ lander | status = Landed } | |
else if position < 0.0 then | |
{ lander | status = Crashed } | |
else if arrow == Just 38 && fuel > 0 then | |
{ lander | velocity = velocity - 1 | |
, fuel = fuel - 1 | |
, status = Thrust } | |
else | |
{ lander | velocity = velocity + val / 200 } | |
calculatePosition : Lander -> Lander | |
calculatePosition lander = | |
case lander.status of | |
Ready -> | |
{ lander | position = lander.position - lander.velocity } | |
_ -> | |
lander | |
updateLander : Msg -> Lander -> (Lander, Cmd Msg) | |
updateLander msg lander = | |
let | |
updatePosition val lander = | |
(calculateVelocity (7, val) lander | |
|> calculatePosition, Cmd.none) | |
in | |
case msg of | |
Frame _ -> | |
updatePosition Nothing lander | |
Keydown val -> | |
updatePosition (Just val) lander | |
Keyup val -> | |
{ lander | status = Ready } | |
|> updatePosition Nothing | |
Resize {width, height} -> | |
{ lander | width = width, height = height } | |
|> updatePosition Nothing |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment