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