Upgrade to elm 0.17.1

22 files changed, 226 insertions, 222 deletions

diff --git a/src/Input.elm b/src/Input.elm
deleted file mode 100644
index e18d8be..0000000
--- a/src/Input.elm
+++ /dev/null
@@ -1,28 +0,0 @@
-module Input where
-
-import Char exposing (toCode, KeyCode)
-import Keyboard exposing (keysDown, arrows, isDown)
-import Random
-import Time exposing (Time, fps)
-import Signal exposing (..)
-import Set exposing (Set)
-
-import Model.Vec2 exposing (Vec2)
-
-type alias Input =
-  { dir : Vec2
-  , inputKeysDown : Set KeyCode
-  , delta : Time
-  }
-
-getInput : Signal Input
-getInput =
-  let delta = fps 24
-      input = map3 Input (map recordIntToVec2 arrows) keysDown delta
-  in  sampleOn delta input
-
-recordIntToVec2 : {x : Int, y : Int} -> Vec2
-recordIntToVec2 {x, y} =
-  { x = toFloat x
-  , y = toFloat y
-  }
diff --git a/src/Main.elm b/src/Main.elm
index d257b81..c1bebf5 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -1,24 +1,28 @@
-module Main where
-
-import Random
-import Html exposing (Html)
-
-import Model.Game exposing (Game, initialGame)
-
-import Update.Update exposing (update)
-
-import Input exposing (getInput)
-
-import View.Game exposing (renderGame)
-
-main : Signal Html
-main = Signal.map renderGame game
-
-game : Signal Game
-game =
-  Signal.foldp
-    update
-    (initialGame (Random.initialSeed initialTime))
-    getInput
-
-port initialTime : Int
+module Main exposing
+  ( main
+  )
+
+import Html.App exposing (programWithFlags)
+import Time
+import Keyboard
+import Keyboard.Extra as Keyboard
+
+import Model exposing (init)
+import Msg
+import Update exposing (update)
+import View exposing (view)
+
+main : Program Float
+main =
+  programWithFlags
+    { init = init
+    , update = update
+    , subscriptions = (\model ->
+        Sub.batch
+          [ Time.every 40 Msg.Time
+          , Sub.map Msg.Keyboard Keyboard.subscriptions
+          , Keyboard.downs (\keycode -> if keycode == 69 then Msg.Transform else Msg.NoOp)
+          ]
+      )
+    , view = view
+    }
diff --git a/src/Model.elm b/src/Model.elm
new file mode 100644
index 0000000..7e91e87
--- /dev/null
+++ b/src/Model.elm
@@ -0,0 +1,50 @@
+module Model exposing
+  ( Model
+  , init
+  )
+
+import Random.Pcg as Random exposing (Seed)
+import Char exposing (KeyCode)
+import Time exposing (Time)
+import Set
+import Set exposing (Set)
+import Platform.Cmd
+import Keyboard.Extra as Keyboard
+
+import Msg exposing (Msg)
+import Model.Player exposing (..)
+import Model.Cloud exposing (..)
+import Model.Vec2 exposing (Vec2)
+import Model.Config exposing (..)
+import Model.Round exposing (Round)
+import Model.Board exposing (initBoardSize)
+
+type alias Model =
+  { time : Time
+  , elapsedTime : Float
+  , boardSize : Vec2
+  , currentScore : Int
+  , player : Player
+  , cloud : Cloud
+  , rounds : List Round
+  , seed : Seed
+  , keyboard : Keyboard.Model
+  , transform : Bool
+  }
+
+init : Time -> (Model, Cmd Msg)
+init time =
+  let (keyboard, keyboardCmd) = Keyboard.init
+  in  ( { time = time
+        , elapsedTime = 0
+        , boardSize = initBoardSize
+        , currentScore = 0
+        , player = initPlayer
+        , cloud = initCloud
+        , rounds = []
+        , seed = Random.initialSeed (round time)
+        , keyboard = keyboard
+        , transform = False
+        }
+      , Cmd.map Msg.Keyboard keyboardCmd
+      )
diff --git a/src/Model/Board.elm b/src/Model/Board.elm
index fe9ac4e..52c7630 100644
--- a/src/Model/Board.elm
+++ b/src/Model/Board.elm
@@ -1,7 +1,7 @@
-module Model.Board
+module Model.Board exposing
   ( initBoardSize
   , boardDiagonal
-  ) where
+  )
 
 import Model.Vec2 exposing (Vec2)
 
diff --git a/src/Model/Cloud.elm b/src/Model/Cloud.elm
index 26b4104..e397d16 100644
--- a/src/Model/Cloud.elm
+++ b/src/Model/Cloud.elm
@@ -1,9 +1,9 @@
-module Model.Cloud
+module Model.Cloud exposing
   ( Cloud
   , initCloud
   , playerPointsCollision
   , playerPointCollision
-  ) where
+  )
 
 import List
 
diff --git a/src/Model/Color.elm b/src/Model/Color.elm
index 8452efa..49ece2b 100644
--- a/src/Model/Color.elm
+++ b/src/Model/Color.elm
@@ -1,8 +1,8 @@
-module Model.Color
+module Model.Color exposing
   ( Color
   , htmlOutput
   , mergeColors
-  ) where
+  )
 
 type alias Color =
   { red : Int
diff --git a/src/Model/Config.elm b/src/Model/Config.elm
index 2973dc7..ea6f9dc 100644
--- a/src/Model/Config.elm
+++ b/src/Model/Config.elm
@@ -1,7 +1,7 @@
-module Model.Config
+module Model.Config exposing
   ( Config(..)
   , otherConfig
-  ) where
+  )
 
 type Config =
   White
diff --git a/src/Model/Game.elm b/src/Model/Game.elm
deleted file mode 100644
index 97fbc4c..0000000
--- a/src/Model/Game.elm
+++ /dev/null
@@ -1,40 +0,0 @@
-module Model.Game
-  ( Game
-  , initialGame
-  ) where
-
-import Random exposing (..)
-import Char exposing (KeyCode)
-import Time exposing (Time)
-import Set
-import Set exposing (Set)
-
-import Model.Player exposing (..)
-import Model.Cloud exposing (..)
-import Model.Vec2 exposing (Vec2)
-import Model.Config exposing (..)
-import Model.Round exposing (Round)
-import Model.Board exposing (initBoardSize)
-
-type alias Game =
-  { elapsedTime : Float
-  , boardSize : Vec2
-  , keysDown : Set KeyCode
-  , currentScore : Int
-  , player : Player
-  , cloud : Cloud
-  , rounds : List Round
-  , seed : Seed
-  }
-
-initialGame : Seed -> Game
-initialGame seed =
-  { elapsedTime = 0
-  , boardSize = initBoardSize
-  , keysDown = Set.empty
-  , currentScore = 0
-  , player = initPlayer
-  , cloud = initCloud
-  , rounds = []
-  , seed = seed
-  }
diff --git a/src/Model/Level.elm b/src/Model/Level.elm
index d058d53..9a60b9a 100644
--- a/src/Model/Level.elm
+++ b/src/Model/Level.elm
@@ -1,10 +1,10 @@
-module Model.Level
+module Model.Level exposing
   ( currentLevel
   , currentLevelScore
   , currentLevelNumber
   , progressiveColor
   , levelScoreDuration
-  ) where
+  )
 
 import Time exposing (Time)
 import Debug
diff --git a/src/Model/Player.elm b/src/Model/Player.elm
index 6858893..37a1a7f 100644
--- a/src/Model/Player.elm
+++ b/src/Model/Player.elm
@@ -1,9 +1,9 @@
-module Model.Player
+module Model.Player exposing
   ( Player
   , initPlayer
   , getPlayerSize
   , playerSpeed
-  ) where
+  )
 
 import Model.Vec2 exposing (..)
 import Model.Config exposing (..)
diff --git a/src/Model/Point.elm b/src/Model/Point.elm
index c0daeaf..929fda8 100644
--- a/src/Model/Point.elm
+++ b/src/Model/Point.elm
@@ -1,11 +1,11 @@
-module Model.Point
+module Model.Point exposing
   ( Point
   , pointMove
   , pointSize
   , pointSpeed
   , pointSpawnDist
   , pointAwayDist
-  ) where
+  )
 
 import Model.Vec2 exposing (..)
 import Model.Board exposing (boardDiagonal)
diff --git a/src/Model/Round.elm b/src/Model/Round.elm
index 4586ede..c983839 100644
--- a/src/Model/Round.elm
+++ b/src/Model/Round.elm
@@ -1,7 +1,7 @@
-module Model.Round
+module Model.Round exposing
   ( Round
   , maybeBestRound
-  ) where
+  )
 
 import List
 import Time exposing (Time)
diff --git a/src/Model/Vec2.elm b/src/Model/Vec2.elm
index 85ff008..4bb5f31 100644
--- a/src/Model/Vec2.elm
+++ b/src/Model/Vec2.elm
@@ -1,4 +1,4 @@
-module Model.Vec2
+module Model.Vec2 exposing
   ( Vec2
   , add
   , sub
@@ -8,7 +8,7 @@ module Model.Vec2
   , clockwiseRotate90
   , isNull
   , originVec
-  ) where
+  )
 
 type alias Vec2 =
   { x : Float
diff --git a/src/Msg.elm b/src/Msg.elm
new file mode 100644
index 0000000..4b7d32e
--- /dev/null
+++ b/src/Msg.elm
@@ -0,0 +1,13 @@
+module Msg exposing
+  ( Msg(..)
+  )
+
+import Time exposing (Time)
+
+import Keyboard.Extra as Keyboard
+
+type Msg =
+  NoOp
+  | Time Time
+  | Keyboard Keyboard.Msg
+  | Transform
diff --git a/src/Update.elm b/src/Update.elm
new file mode 100644
index 0000000..8aea214
--- /dev/null
+++ b/src/Update.elm
@@ -0,0 +1,79 @@
+module Update exposing
+  ( update
+  )
+
+import List
+import Char exposing (fromCode, toCode, KeyCode)
+import Maybe
+import Set
+import Set exposing (Set)
+import Time exposing (Time)
+import Keyboard.Extra as Keyboard
+
+import Msg exposing (Msg(..))
+import Model.Player exposing (..)
+import Model.Vec2 exposing (..)
+import Model.Config exposing (otherConfig)
+import Model.Cloud exposing (..)
+import Model exposing (..)
+import Model.Round exposing (Round)
+
+import Utils.Geometry exposing (..)
+import Utils.Physics exposing (getNewPosAndSpeed)
+
+import Update.CloudUpdate exposing (cloudUpdate)
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+  case msg of
+    NoOp ->
+      (model, Cmd.none)
+
+    Time time ->
+      (updateTime time model, Cmd.none)
+
+    Keyboard keyboardMsg ->
+      let (keyboard, keyboardCmd) = Keyboard.update keyboardMsg model.keyboard
+      in  ( { model | keyboard = keyboard }
+          , Cmd.map Keyboard keyboardCmd
+          )
+
+    Transform ->
+      ({ model | transform = True }, Cmd.none)
+
+updateTime : Time -> Model -> Model
+updateTime time model =
+  let delta = time - model.time
+      dir = case Keyboard.arrows model.keyboard of {x, y} -> {x = toFloat x, y = toFloat y}
+      hostilePoints = model.cloud.points (otherConfig model.player.config)
+  in  if(playerPointsCollision model.elapsedTime model.player (getPlayerSize model.currentScore) hostilePoints)
+        then
+          { model
+          | time = time
+          , elapsedTime = 0
+          , currentScore = 0
+          , cloud = initCloud
+          , rounds = (Round model.elapsedTime model.currentScore) :: model.rounds
+          }
+        else
+          let newPlayer = updatePlayer delta model.boardSize dir (Debug.log "transform" model.transform) model.player (getPlayerSize model.currentScore)
+              (newCloud, addScore, newSeed) = cloudUpdate model.elapsedTime model.boardSize model.seed newPlayer (getPlayerSize model.currentScore) model.cloud model.currentScore
+          in
+              { model
+              | time = time
+              , elapsedTime = model.elapsedTime + delta
+              , currentScore = model.currentScore + addScore
+              , player = newPlayer
+              , cloud = newCloud
+              , seed = newSeed
+              , transform = False
+              }
+
+updatePlayer : Float -> Vec2 -> Vec2 -> Bool -> Player -> Float -> Player
+updatePlayer dt boardSize dir transform player playerSize =
+  let (pos, speed) = getNewPosAndSpeed dt dir playerSpeed (player.pos, player.speed)
+      newConfig = if transform then otherConfig player.config else player.config
+  in  { pos = inBoard boardSize playerSize pos
+      , speed = speed
+      , config = newConfig
+      }
diff --git a/src/Update/CloudUpdate.elm b/src/Update/CloudUpdate.elm
index 359f02c..559acc9 100644
--- a/src/Update/CloudUpdate.elm
+++ b/src/Update/CloudUpdate.elm
@@ -1,9 +1,9 @@
-module Update.CloudUpdate
+module Update.CloudUpdate exposing
   ( cloudUpdate
-  ) where
+  )
 
 import List
-import Random exposing (..)
+import Random.Pcg as Random exposing (Seed, Generator)
 
 import Model.Vec2 exposing (..)
 import Model.Player exposing (..)
@@ -71,14 +71,14 @@ getNewPoint elapsedTime boardSize seed currentScore =
 
 pointInitPos : Vec2 -> Seed -> (Vec2, Seed)
 pointInitPos boardSize seed =
-  let (rand, seed') = generate floatGen seed
+  let (rand, seed') = Random.step (Random.float 0 1) seed
       angle = rand * (degrees 360)
       dist = pointSpawnDist boardSize
   in  (polarToCartesian angle dist, seed')
 
 pointDestination : Vec2 -> Seed -> (Vec2, Seed)
 pointDestination boardSize seed =
-  case generateMany 4 floatGen seed of
+  case Random.step (Random.list 4 (Random.float 0 1)) seed of
     ([r1, r2, r3, r4], seed') ->
       ( randomBoardPosition boardSize (r1, r2) (r3, r4)
       , seed'
@@ -88,19 +88,6 @@ pointDestination boardSize seed =
       , seed
       )
 
-generateMany : Int -> Generator a -> Seed -> (List a, Seed)
-generateMany count gen seed =
-  if count == 0
-    then
-      ([], seed)
-    else
-      let (rand, seed') = generate gen seed
-          (randList, seed'') = generateMany (count - 1) gen seed'
-      in  (rand :: randList, seed'')
-
-floatGen : Generator Float
-floatGen = float 0 1
-
 randomBoardPosition : Vec2 -> (Float, Float) -> (Float, Float) -> Vec2
 randomBoardPosition boardSize (randomX, randomY) (percentX, percentY) =
   let width = boardSize.x * percentX
diff --git a/src/Update/Update.elm b/src/Update/Update.elm
deleted file mode 100644
index 2514aac..0000000
--- a/src/Update/Update.elm
+++ /dev/null
@@ -1,61 +0,0 @@
-module Update.Update
-  ( update
-  ) where
-
-import List
-import Char exposing (fromCode, toCode, KeyCode)
-import Maybe
-import Set
-import Set exposing (Set)
-
-import Model.Player exposing (..)
-import Model.Vec2 exposing (..)
-import Model.Config exposing (otherConfig)
-import Model.Cloud exposing (..)
-import Model.Game exposing (..)
-import Model.Round exposing (Round)
-
-import Utils.Geometry exposing (..)
-import Utils.Physics exposing (getNewPosAndSpeed)
-
-import Update.CloudUpdate exposing (cloudUpdate)
-
-import Input exposing (Input)
-
-update : Input -> Game -> Game
-update input game =
-  let hostilePoints = game.cloud.points (otherConfig game.player.config)
-  in  if(playerPointsCollision game.elapsedTime game.player (getPlayerSize game.currentScore) hostilePoints)
-        then
-          { game
-          | elapsedTime = 0
-          , currentScore = 0
-          , cloud = initCloud
-          , rounds = (Round game.elapsedTime game.currentScore) :: game.rounds
-          }
-        else
-          let newPlayer = playerStep input.delta game.boardSize input.dir (newKeyCode game.keysDown input.inputKeysDown) game.player (getPlayerSize game.currentScore)
-              (newCloud, addScore, newSeed) = cloudUpdate game.elapsedTime game.boardSize game.seed newPlayer (getPlayerSize game.currentScore) game.cloud game.currentScore
-          in
-              { game
-              | elapsedTime = game.elapsedTime + input.delta
-              , keysDown = input.inputKeysDown
-              , currentScore = game.currentScore + addScore
-              , player = newPlayer
-              , cloud = newCloud
-              , seed = newSeed
-              }
-
-playerStep : Float -> Vec2 -> Vec2 -> (KeyCode -> Bool) -> Player -> Float -> Player
-playerStep dt boardSize dir newKey player playerSize =
-  let (pos, speed) = getNewPosAndSpeed dt dir playerSpeed (player.pos, player.speed)
-      newConfig = if (newKey 69) then otherConfig player.config else player.config
-  in  { pos = inBoard boardSize playerSize pos
-      , speed = speed
-      , config = newConfig
-      }
-
-newKeyCode : Set KeyCode -> Set KeyCode -> KeyCode -> Bool
-newKeyCode lastKeyCodes newKeyCodes keyCode =
-  let contains = not << List.isEmpty << List.filter (\kc -> kc == keyCode) << Set.toList
-  in  not (contains lastKeyCodes) && (contains newKeyCodes)
diff --git a/src/Utils/Geometry.elm b/src/Utils/Geometry.elm
index 5e0d4a2..c4a4539 100644
--- a/src/Utils/Geometry.elm
+++ b/src/Utils/Geometry.elm
@@ -1,8 +1,8 @@
-module Utils.Geometry
+module Utils.Geometry exposing
   ( polarToCartesian
   , distance
   , inBoard
-  ) where
+  )
 
 import Model.Vec2 exposing (..)
 
diff --git a/src/Utils/Physics.elm b/src/Utils/Physics.elm
index acf37ae..5da3737 100644
--- a/src/Utils/Physics.elm
+++ b/src/Utils/Physics.elm
@@ -1,8 +1,8 @@
-module Utils.Physics
+module Utils.Physics exposing
   ( getNewPosAndSpeed
   , getMove
   , getWaveMove
-  ) where
+  )
 
 import Model.Vec2 exposing (..)
 
diff --git a/src/View/Game.elm b/src/View.elm
index 2bef2ae..822c2d2 100644
--- a/src/View/Game.elm
+++ b/src/View.elm
@@ -1,6 +1,6 @@
-module View.Game
-  ( renderGame
-  ) where
+module View exposing
+  ( view
+  )
 
 import Html exposing (Html)
 import Svg exposing (..)
@@ -9,9 +9,9 @@ import List
 
 import Time exposing (Time)
 
+import Model exposing (Model)
 import Model.Vec2 exposing (Vec2)
 import Model.Player exposing (..)
-import Model.Game exposing (Game)
 import Model.Point exposing (..)
 import Model.Config exposing (..)
 import Model.Round exposing (..)
@@ -20,29 +20,29 @@ import Model.Color exposing (htmlOutput)
 
 import View.Round exposing (roundView)
 
-renderGame : Game -> Html
-renderGame game =
-  let renderPoints config = List.map (renderPoint game.boardSize game.elapsedTime config) (game.cloud.points config)
+view : Model -> Html msg
+view model =
+  let renderPoints config = List.map (renderPoint model.boardSize model.elapsedTime config) (model.cloud.points config)
   in  svg
         [ width "100%"
         , height "100%"
         , Svg.Attributes.style ("background-color: " ++ backgroundColor ++ ";")
-        , viewBox ("0 0 " ++ (toString game.boardSize.x) ++ " " ++ (toString (game.boardSize.y + headerHeight)))
+        , viewBox ("0 0 " ++ (toString model.boardSize.x) ++ " " ++ (toString (model.boardSize.y + headerHeight)))
         ]
-        [ renderBoard game.currentScore
-        , renderPlayer game.boardSize game.player (getPlayerSize game.currentScore)
+        [ renderBoard model.currentScore
+        , renderPlayer model.boardSize model.player (getPlayerSize model.currentScore)
         , g [] (renderPoints White)
         , g [] (renderPoints Black)
-        , renderScore game.boardSize game.elapsedTime game.rounds game.currentScore
-        , hideNewPoints game.boardSize
-        , renderHeader game
+        , renderScore model.boardSize model.elapsedTime model.rounds model.currentScore
+        , hideNewPoints model.boardSize
+        , renderHeader model
         ]
 
 headerHeight : Float
 headerHeight = 115
 
-renderHeader : Game -> Svg
-renderHeader game =
+renderHeader : Model -> Svg msg
+renderHeader model =
   g
     []
     [ rect
@@ -65,19 +65,19 @@ renderHeader game =
         , fontStyle "italic"
         ]
         [ tspan
-            [ x (toString (game.boardSize.x / 2))
+            [ x (toString (model.boardSize.x / 2))
             , y "75"
             , textAnchor "middle"
             ]
             [ text "Catch the points of your color, avoid the other points." ]
         , tspan
-            [ x (toString (game.boardSize.x / 2))
+            [ x (toString (model.boardSize.x / 2))
             , y "92"
             , textAnchor "middle"
             ]
             [ text "Use the arrow keys to move and 'e' to change your color." ]
         ]
-    , ( case maybeBestRound game.rounds of
+    , ( case maybeBestRound model.rounds of
           Nothing ->
             text ""
           Just bestRound ->
@@ -97,7 +97,7 @@ renderHeader game =
 backgroundColor : String
 backgroundColor = "#1B203F"
 
-renderBoard : Int -> Svg
+renderBoard : Int -> Svg msg
 renderBoard currentScore =
   rect
     [ y (toString headerHeight)
@@ -107,7 +107,7 @@ renderBoard currentScore =
     ]
     []
 
-renderPlayer : Vec2 -> Player -> Float -> Svg
+renderPlayer : Vec2 -> Player -> Float -> Svg msg
 renderPlayer boardSize player playerSize =
   renderCircle boardSize player.pos playerSize (playerColor player.config)
 
@@ -117,7 +117,7 @@ playerColor config =
     White -> "#F0F0F0"
     Black -> "#0E1121"
 
-renderPoint : Vec2 -> Float -> Config -> Point -> Svg
+renderPoint : Vec2 -> Float -> Config -> Point -> Svg msg
 renderPoint boardSize elapsedTime config point =
   let pos = pointMove point elapsedTime
   in  renderCircle boardSize pos pointSize (playerColor config)
@@ -128,7 +128,7 @@ pointColor config =
     White -> "white"
     Black -> "black"
 
-renderCircle : Vec2 -> Vec2 -> Float -> String -> Svg
+renderCircle : Vec2 -> Vec2 -> Float -> String -> Svg msg
 renderCircle boardSize pos size color =
   circle
     [ cx (toString (pos.x + boardSize.x / 2))
@@ -138,7 +138,7 @@ renderCircle boardSize pos size color =
     ]
     []
 
-renderScore : Vec2 -> Time -> List Round -> Int -> Svg
+renderScore : Vec2 -> Time -> List Round -> Int -> Svg msg
 renderScore boardSize elapsedTime rounds score =
   let scorePos =
         { x = 0.0
@@ -155,7 +155,7 @@ renderScore boardSize elapsedTime rounds score =
         else
           renderText boardSize scorePos scoreText
 
-renderText : Vec2 -> Vec2 -> String -> Svg
+renderText : Vec2 -> Vec2 -> String -> Svg msg
 renderText boardSize pos content =
   text'
     [ x (toString (pos.x + boardSize.x / 2))
@@ -170,7 +170,7 @@ renderText boardSize pos content =
         [ text content ]
     ]
 
-hideNewPoints : Vec2 -> Svg
+hideNewPoints : Vec2 -> Svg msg
 hideNewPoints boardSize =
   let size =
         (pointAwayDist boardSize) + pointSize - (Basics.max boardSize.x boardSize.y) / 2
diff --git a/src/View/Round.elm b/src/View/Round.elm
index 2648aa8..a3f34e2 100644
--- a/src/View/Round.elm
+++ b/src/View/Round.elm
@@ -1,6 +1,6 @@
-module View.Round
+module View.Round exposing
   ( roundView
-  ) where
+  )
 
 import Model.Round exposing (..)
 
diff --git a/src/View/Time.elm b/src/View/Time.elm
index e6cfad6..6e6d261 100644
--- a/src/View/Time.elm
+++ b/src/View/Time.elm
@@ -1,6 +1,6 @@
-module View.Time
+module View.Time exposing
   ( timeView
-  ) where
+  )
 
 import Time exposing (Time)