From 4d007f6802246c6411a2838e68e957c2b4d56d3d Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Wed, 4 Mar 2015 23:27:59 +0100 Subject: Adapt the game to elm version 0.14.1 --- src/Cloud.elm | 10 +++-- src/CloudStep.elm | 114 ++++++++++++++++++++++++++++++++------------------- src/Config.elm | 4 +- src/Display.elm | 26 ++++++++---- src/Game.elm | 17 +++++--- src/Input.elm | 44 ++++++-------------- src/Main.elm | 16 +++++++- src/Player.elm | 2 +- src/Point.elm | 2 +- src/RandomValues.elm | 12 ------ src/Step.elm | 26 +++++++----- src/Vec2.elm | 2 +- 12 files changed, 153 insertions(+), 122 deletions(-) delete mode 100644 src/RandomValues.elm (limited to 'src') diff --git a/src/Cloud.elm b/src/Cloud.elm index 99a4949..0916bf6 100644 --- a/src/Cloud.elm +++ b/src/Cloud.elm @@ -1,12 +1,14 @@ module Cloud where +import List + import Point (..) import Player (..) import Config (..) import Geometry (distance) -type Cloud = - { points : Config -> [Point] +type alias Cloud = + { points : Config -> List Point , spawn : Float , lastSpawn : Float } @@ -22,10 +24,10 @@ initCloud = , lastSpawn = -spawn } -playerPointsCollision : Float -> Player -> [Point] -> Bool +playerPointsCollision : Float -> Player -> List Point -> Bool playerPointsCollision time player points = let collision = playerPointCollision time player - in length (filter collision points) > 0 + in List.length (List.filter collision points) > 0 playerPointCollision : Float -> Player -> Point -> Bool playerPointCollision time player point = diff --git a/src/CloudStep.elm b/src/CloudStep.elm index 65609cb..033c3c5 100644 --- a/src/CloudStep.elm +++ b/src/CloudStep.elm @@ -1,70 +1,98 @@ module CloudStep where +import List +import Random (..) + import Vec2 (..) import Geometry (..) import Player (..) import Board (boardSize, boardDiagonal) import Point (..) -import RandomValues (..) import Physics (getMove) import Cloud (..) import Config (..) -cloudStep : Float -> RandomValues -> Player -> Cloud -> (Cloud, Int) -cloudStep time randomValues player {points, spawn, lastSpawn} = +cloudStep : Float -> Seed -> Player -> Cloud -> (Cloud, Int, Seed) +cloudStep time seed player {points, spawn, lastSpawn} = let pointsToCatch = presentPoints time (points player.config) - presentAndNotCaughtPoints = filter (not . (playerPointCollision time player)) pointsToCatch - addScore = (length pointsToCatch) - (length presentAndNotCaughtPoints) + presentAndNotCaughtPoints = List.filter (not << (playerPointCollision time player)) pointsToCatch + addScore = (List.length pointsToCatch) - (List.length presentAndNotCaughtPoints) presentOtherPoints = presentPoints time (points (otherConfig player.config)) - newCloud = + (newCloud, seed''') = if time > lastSpawn + spawn then - let newPoint1 = newPoint time randomValues.point1 - newPoint2 = newPoint time randomValues.point2 - in - { points config = + let (newPoint1, seed') = getNewPoint time seed + (newPoint2, seed'') = getNewPoint time seed' + in ( { points config = + if(config == player.config) + then + newPoint1 :: presentAndNotCaughtPoints + else + newPoint2 :: presentOtherPoints + , spawn = spawn - sqrt(spawn) / 50 + , lastSpawn = time + } + , seed'' + ) + else + ( { points config = if(config == player.config) then - newPoint1 :: presentAndNotCaughtPoints + presentAndNotCaughtPoints else - newPoint2 :: presentOtherPoints - , spawn = spawn - sqrt(spawn) / 50 - , lastSpawn = time + presentOtherPoints + , spawn = spawn + , lastSpawn = lastSpawn } - else - { points config = - if(config == player.config) then - presentAndNotCaughtPoints - else - presentOtherPoints - , spawn = spawn - , lastSpawn = lastSpawn - } - in (newCloud, addScore) + , seed + ) + in (newCloud, addScore, seed''') -presentPoints : Float -> [Point] -> [Point] +presentPoints : Float -> List Point -> List Point presentPoints time points = let isPresent point = (distance (pointMove point time) originVec) < pointAwayDist - in filter isPresent points + in List.filter isPresent points -newPoint : Float -> PointRandomValues -> Point -newPoint time pointRandomValues = - { initTime = time - , initPos = pointInitPos pointRandomValues.angle - , initDest = pointDestination pointRandomValues.x pointRandomValues.y - , move initTime initPos initDest time = - let delta = time - initTime - move = getMove (pointSpeed delta) (initDest `sub` initPos) - in initPos `add` move - } -pointInitPos : Float -> Vec2 -pointInitPos randomAngle = - let angle = randomAngle * (degrees 360) +getNewPoint : Float -> Seed -> (Point, Seed) +getNewPoint time seed = + let (initPos, seed') = pointInitPos seed + (initDest, seed'') = pointDestination seed' + in ( { initTime = time + , initPos = initPos + , initDest = initDest + , move initTime initPos initDest time = + let delta = time - initTime + move = getMove (pointSpeed delta) (initDest `sub` initPos) + in initPos `add` move + } + , seed'' + ) + +pointInitPos : Seed -> (Vec2, Seed) +pointInitPos seed = + let (rand, seed') = generate floatGen seed + angle = rand * (degrees 360) dist = boardDiagonal * 3 / 5 - in polarToCartesian angle dist + in (polarToCartesian angle dist, seed') + +pointDestination : Seed -> (Vec2, Seed) +pointDestination seed = + let ([r1, r2, r3, r4], seed') = generateMany 4 floatGen seed + in ( randomBoardPosition (r1, r2) (r3, r4) + , 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'') -pointDestination : Float -> Float -> Vec2 -pointDestination randomX randomY = - randomBoardPosition (randomX, randomY) (1, 1) +floatGen : Generator Float +floatGen = float 0 1 randomBoardPosition : (Float, Float) -> (Float, Float) -> Vec2 randomBoardPosition (randomX, randomY) (percentX, percentY) = diff --git a/src/Config.elm b/src/Config.elm index 60f4cc3..e02cf3f 100644 --- a/src/Config.elm +++ b/src/Config.elm @@ -1,6 +1,8 @@ module Config where -data Config = White | Black +type Config = + White + | Black otherConfig : Config -> Config otherConfig config = diff --git a/src/Display.elm b/src/Display.elm index c52b9e3..acbc15e 100644 --- a/src/Display.elm +++ b/src/Display.elm @@ -1,5 +1,13 @@ module Display where +import List + +import Graphics.Collage (..) +import Graphics.Element (Element) +import Color (..) +import Text (..) +import Text + import Vec2 (..) import Player (..) import Game (Game) @@ -9,8 +17,8 @@ import Config (..) display : Game -> Element display {time, score, player, cloud, bestScore} = - let whitePointForms = map (pointForm time (configColor White)) (cloud.points White) - blackPointForms = map (pointForm time (configColor Black)) (cloud.points Black) + let whitePointForms = List.map (pointForm time (configColor White)) (cloud.points White) + blackPointForms = List.map (pointForm time (configColor Black)) (cloud.points Black) forms = boardForms ++ playerForms player ++ whitePointForms @@ -19,13 +27,13 @@ display {time, score, player, cloud, bestScore} = ++ bestScoreForms bestScore in collage (truncate boardSize.x) (truncate boardSize.y) forms -boardForms : [Form] +boardForms : List Form boardForms = [filled boardColor (rect boardSize.x boardSize.y)] boardColor : Color boardColor = rgb 103 123 244 -playerForms : Player -> [Form] +playerForms : Player -> List Form playerForms player = let playerColor = configColor player.config in [circleForm player.pos playerSize playerColor] @@ -56,16 +64,16 @@ circleForm pos size color = outlineColor : Color outlineColor = rgb 34 34 34 -scoreForms : Int -> [Form] +scoreForms : Int -> List Form scoreForms score = - let text = (show score) + let text = (toString score) scorePos = { x = 0.0, y = boardSize.y / 2 - 30 } in [textForm text scorePos centered] -bestScoreForms : Int -> [Form] +bestScoreForms : Int -> List Form bestScoreForms bestScore = if(bestScore > 0) then - let text = "Record: " ++ (show bestScore) + let text = "Record: " ++ (toString bestScore) pos = { x = -boardSize.x / 2 + 100 , y = -boardSize.y / 2 + 30 @@ -75,7 +83,7 @@ bestScoreForms bestScore = textForm : String -> Vec2 -> (Text -> Element) -> Form textForm content pos alignment = - let textElement = toText content + let textElement = fromString content |> Text.height 30 |> typeface ["calibri", "arial"] |> Text.color textColor diff --git a/src/Game.elm b/src/Game.elm index 0a12db8..4d68219 100644 --- a/src/Game.elm +++ b/src/Game.elm @@ -1,25 +1,31 @@ module Game where +import Random (..) + import Player (..) import Cloud (..) import Vec2 (Vec2) import Config (..) import Keyboard (KeyCode) -type Game = +type alias Game = { time : Float - , keysDown : [KeyCode] + , keysDown : List KeyCode , score : Int , player : Player , cloud : Cloud , bestScore : Int + , seed : Seed } -initialGame : Vec2 -> Int -> Game -initialGame playerPos bestScore = +initialGame : Seed -> Vec2 -> Int -> Game +initialGame seed playerPos bestScore = let initPlayer = { pos = playerPos - , speed = { x = 0, y = 0 } + , speed = + { x = 0 + , y = 0 + } , config = White } in @@ -29,4 +35,5 @@ initialGame playerPos bestScore = , player = initPlayer , cloud = initCloud , bestScore = bestScore + , seed = seed } diff --git a/src/Input.elm b/src/Input.elm index 8ba43ec..3723ba3 100644 --- a/src/Input.elm +++ b/src/Input.elm @@ -1,51 +1,31 @@ module Input where import Char (toCode) -import RandomValues (RandomValues) -import Keyboard (KeyCode, keysDown, arrows) +import Keyboard (KeyCode, keysDown, arrows, isDown) import Random +import Time (Time, fps) +import Signal (..) import Vec2 (Vec2) -type Input = +type alias Input = { dir : Vec2 - , inputKeysDown : [KeyCode] + , inputKeysDown : List KeyCode , delta : Time - , randomValues : RandomValues } getInput : Signal Input getInput = - let dtSignal = delta - dirSignal = lift recordIntToVec2 arrows - randomFloatsSignal = Random.floatList (lift (\_ -> 6) dtSignal) - randomValuesSignal = lift floatsToRandomValues randomFloatsSignal - in sampleOn dtSignal <| Input <~ dirSignal - ~ keysDown - ~ dtSignal - ~ randomValuesSignal - -delta : Signal Time -delta = lift (\ms -> ms) (fps 25) + let delta = fps 25 + input = + 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 } - -floatsToRandomValues : [Float] -> RandomValues -floatsToRandomValues [angle1, x1, y1, angle2, x2, y2] = - let point1 = - { angle = angle1 - , x = x1 - , y = y1 - } - point2 = - { angle = angle2 - , x = x2 - , y = y2 - } - in { point1 = point1 - , point2 = point2 - } diff --git a/src/Main.elm b/src/Main.elm index 267bb8c..fcafbda 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,10 +1,22 @@ module Main where -import Game (initialGame) +import Signal +import Random +import Graphics.Element (Element) + +import Game (Game, initialGame) import Display (display) import Step (step) import Input (getInput) import Vec2 (originVec) main : Signal Element -main = lift display (foldp step (initialGame originVec 0) getInput) +main = Signal.map display game + +game : Signal Game +game = Signal.foldp step (initialGame initialSeed originVec 0) getInput + +port initialTime : Int + +initialSeed : Random.Seed +initialSeed = Random.initialSeed initialTime diff --git a/src/Player.elm b/src/Player.elm index 56c4e97..2be7229 100644 --- a/src/Player.elm +++ b/src/Player.elm @@ -3,7 +3,7 @@ module Player where import Vec2 (..) import Config (Config) -type Player = +type alias Player = { pos : Vec2 , speed : Vec2 , config : Config diff --git a/src/Point.elm b/src/Point.elm index 086f8a4..a27916c 100644 --- a/src/Point.elm +++ b/src/Point.elm @@ -3,7 +3,7 @@ module Point where import Vec2 (..) import Board (boardDiagonal) -type Point = +type alias Point = { initTime : Float , initPos : Vec2 , initDest : Vec2 diff --git a/src/RandomValues.elm b/src/RandomValues.elm deleted file mode 100644 index 5e40fc5..0000000 --- a/src/RandomValues.elm +++ /dev/null @@ -1,12 +0,0 @@ -module RandomValues where - -type RandomValues = - { point1 : PointRandomValues - , point2 : PointRandomValues - } - -type PointRandomValues = - { angle : Float - , x : Float - , y : Float - } diff --git a/src/Step.elm b/src/Step.elm index 08a5f49..3310339 100644 --- a/src/Step.elm +++ b/src/Step.elm @@ -1,5 +1,9 @@ module Step where +import List +import Keyboard (KeyCode) +import Char (fromCode, toCode) + import Vec2 (..) import Game (..) import Player (..) @@ -7,42 +11,42 @@ import Cloud (..) import Geometry (..) import Player (playerSpeed) import Point (pointSpeed, pointMove, pointAwayDist) -import Input (Input) import Physics (getNewPosAndSpeed) -import RandomValues (..) import CloudStep (cloudStep) import Config (otherConfig) -import Keyboard (KeyCode) -import Char (fromCode, toCode) +import Input (Input) + +import Debug step : Input -> Game -> Game -step {dir, inputKeysDown, delta, randomValues} {time, keysDown, score, player, cloud, bestScore} = +step {dir, inputKeysDown, delta} {time, keysDown, score, player, cloud, bestScore, seed} = let hostilePoints = cloud.points (otherConfig player.config) in if(playerPointsCollision time player hostilePoints) then let newBestScore = if(score > bestScore) then score else bestScore - in initialGame player.pos newBestScore + in initialGame seed player.pos newBestScore else let newTime = time + delta newPlayer = playerStep delta dir (newKeyCode keysDown inputKeysDown) player - (newCloud, addScore) = cloudStep time randomValues newPlayer cloud + (newCloud, addScore, newSeed) = cloudStep time seed newPlayer cloud in { time = newTime - , keysDown = inputKeysDown + , keysDown = Debug.log "keysdown" inputKeysDown , score = score + addScore , player = newPlayer , cloud = newCloud , bestScore = bestScore + , seed = newSeed } playerStep : Float -> Vec2 -> (KeyCode -> Bool) -> Player -> Player playerStep dt dir newKey player = let (pos, speed) = getNewPosAndSpeed dt dir playerSpeed (player.pos, player.speed) - newConfig = if (newKey (toCode 'e')) then otherConfig player.config else player.config + newConfig = if (newKey 69) then otherConfig player.config else player.config in { pos = inBoard playerSize pos , speed = speed , config = newConfig } -newKeyCode : [KeyCode] -> [KeyCode] -> KeyCode -> Bool +newKeyCode : List KeyCode -> List KeyCode -> KeyCode -> Bool newKeyCode lastKeyCodes newKeyCodes keyCode = - let contains = (\l -> l > 0) . length . filter (\kc -> kc == keyCode) + let contains = not << List.isEmpty << List.filter (\kc -> kc == keyCode) in not (contains lastKeyCodes) && (contains newKeyCodes) diff --git a/src/Vec2.elm b/src/Vec2.elm index a77b372..056c657 100644 --- a/src/Vec2.elm +++ b/src/Vec2.elm @@ -1,6 +1,6 @@ module Vec2 where -type Vec2 = +type alias Vec2 = { x : Float , y : Float } -- cgit v1.2.3