Commit 8714c3be authored by Joris's avatar Joris

Upgrade to elm 0.17.1

parent cda08750
elm-stuff
node_modules
npm-debug.log
public/client.js
name: sharedCost
windows:
- main:
layout: fff4,119x58,0,0{94x58,0,0,0,24x58,95,0,1}
panes:
- # Empty
- make install && make && make watch
all: build
clean:
@rm -r node_modules >/dev/null 2>&1 || true
@rm -r elm-stuff >/dev/null 2>&1 || true
install:
@npm install
@elm package install
watch: kill-server launch-server watch-client
# Build and launch
# ----------------
kill-server:
@fuser -k 8080/tcp || true
launch-server:
@./node_modules/http-server/bin/http-server ./public -p 8080 &
build:
@elm make src/Main.elm --output public/client.js || true
watch-client:
@./node_modules/nodemon/bin/nodemon.js --watch src -e elm --exec 'clear && make build --silent'
......@@ -5,10 +5,13 @@
"license": "BSD3",
"source-directories": ["src"],
"exposed-modules": [],
"elm-version": "0.15.1 <= v < 0.16.0",
"elm-version": "0.17.1 <= v < 0.18.0",
"dependencies": {
"elm-lang/core": "3.0.0 <= v < 4.0.0",
"evancz/elm-html": "4.0.2 <= v < 5.0.0",
"evancz/elm-svg": "2.0.1 <= v < 3.0.0"
"elm-lang/core": "4.0.5 <= v < 5.0.0",
"elm-lang/html": "1.1.0 <= v < 2.0.0",
"elm-lang/svg": "1.1.1 <= v < 2.0.0",
"elm-lang/keyboard": "1.0.0 <= v < 2.0.0",
"mgold/elm-random-pcg": "3.0.1 <= v < 4.0.0",
"ohanhi/keyboard-extra": "1.1.0 <= v < 2.0.0"
}
}
......@@ -2,14 +2,5 @@
"devDependencies": {
"nodemon": "1.9.1",
"http-server": "0.8.5"
},
"scripts": {
"start": "npm run watch",
"watch": "npm run launch-server & nodemon --watch src -e elm --exec 'npm run build --silent'",
"build": "elm make src/Main.elm --output public/client.js",
"launch-server": "npm run kill-server && http-server ./public -p 8080",
"kill-server": "fuser -k 8080/tcp || true"
}
}
......@@ -13,9 +13,7 @@
</body>
<script>
Elm.fullscreen(Elm.Main, {
initialTime: new Date().getTime()
});
Elm.Main.fullscreen(new Date().getTime());
</script>
</html>
body { margin: 0; }
body > div {
body {
margin: 0;
position: fixed;
top: 0;
bottom: 0;
......
with import <nixpkgs> {}; {
env = stdenv.mkDerivation {
name = "env";
buildInputs = [
elmPackages.elm
nodejs
tmux
tmuxinator
];
shellHook = ''
tmux kill-session -t catchvoid >/dev/null 2>&1
tmuxinator local
'';
};
}
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
}
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
}
module Model.Game
( Game
, initialGame
) where
module Model exposing
( Model
, init
)
import Random exposing (..)
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)
......@@ -16,25 +19,32 @@ import Model.Config exposing (..)
import Model.Round exposing (Round)
import Model.Board exposing (initBoardSize)
type alias Game =
{ elapsedTime : Float
type alias Model =
{ time : Time
, elapsedTime : Float
, boardSize : Vec2
, keysDown : Set KeyCode
, currentScore : Int
, player : Player
, cloud : Cloud
, rounds : List Round
, seed : Seed
, keyboard : Keyboard.Model
, transform : Bool
}
initialGame : Seed -> Game
initialGame seed =
{ elapsedTime = 0
, boardSize = initBoardSize
, keysDown = Set.empty
, currentScore = 0
, player = initPlayer
, cloud = initCloud
, rounds = []
, seed = seed
}
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
)
module Model.Board
module Model.Board exposing
( initBoardSize
, boardDiagonal
) where
)
import Model.Vec2 exposing (Vec2)
......
module Model.Cloud
module Model.Cloud exposing
( Cloud
, initCloud
, playerPointsCollision
, playerPointCollision
) where
)
import List
......
module Model.Color
module Model.Color exposing
( Color
, htmlOutput
, mergeColors
) where
)
type alias Color =
{ red : Int
......
module Model.Config
module Model.Config exposing
( Config(..)
, otherConfig
) where
)
type Config =
White
......
module Model.Level
module Model.Level exposing
( currentLevel
, currentLevelScore
, currentLevelNumber
, progressiveColor
, levelScoreDuration
) where
)
import Time exposing (Time)
import Debug
......
module Model.Player
module Model.Player exposing
( Player
, initPlayer
, getPlayerSize
, playerSpeed
) where
)
import Model.Vec2 exposing (..)
import Model.Config exposing (..)
......
module Model.Point
module Model.Point exposing
( Point
, pointMove
, pointSize
, pointSpeed
, pointSpawnDist
, pointAwayDist
) where
)
import Model.Vec2 exposing (..)
import Model.Board exposing (boardDiagonal)
......
module Model.Round
module Model.Round exposing
( Round
, maybeBestRound
) where
)
import List
import Time exposing (Time)
......
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
......
module Msg exposing
( Msg(..)
)
import Time exposing (Time)
import Keyboard.Extra as Keyboard
type Msg =
NoOp
| Time Time
| Keyboard Keyboard.Msg
| Transform
module Update.Update
module Update exposing
( update
) where
)
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.Game exposing (..)
import Model exposing (..)
import Model.Round exposing (Round)
import Utils.Geometry exposing (..)
......@@ -20,42 +23,57 @@ import Utils.Physics exposing (getNewPosAndSpeed)
import Update.CloudUpdate exposing (cloudUpdate)
import Input exposing (Input)
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
NoOp ->
(model, Cmd.none)
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)
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
{ game
| elapsedTime = 0
{ model
| time = time
, elapsedTime = 0
, currentScore = 0
, cloud = initCloud
, rounds = (Round game.elapsedTime game.currentScore) :: game.rounds
, rounds = (Round model.elapsedTime model.currentScore) :: model.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
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
{ game
| elapsedTime = game.elapsedTime + input.delta
, keysDown = input.inputKeysDown
, currentScore = game.currentScore + addScore
{ model
| time = time
, elapsedTime = model.elapsedTime + delta
, currentScore = model.currentScore + addScore
, player = newPlayer
, cloud = newCloud
, seed = newSeed
, transform = False
}
playerStep : Float -> Vec2 -> Vec2 -> (KeyCode -> Bool) -> Player -> Float -> Player
playerStep dt boardSize dir newKey player playerSize =
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 (newKey 69) then otherConfig player.config else player.config
newConfig = if transform 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)
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
......
module Utils.Geometry
module Utils.Geometry exposing
( polarToCartesian
, distance
, inBoard
) where
)
import Model.Vec2 exposing (..)
......
module Utils.Physics
module Utils.Physics exposing
( getNewPosAndSpeed
, getMove
, getWaveMove
) where
)
import Model.Vec2 exposing (..)
......
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
......
module View.Round
module View.Round exposing
( roundView
) where
)
import Model.Round exposing (..)
......
module View.Time
module View.Time exposing
( timeView
) where
)
import Time exposing (Time)
......