From 17a58e0c4c67f27d87635bf1b2ca50fb11795ad3 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Sat, 7 Mar 2015 15:12:02 +0100 Subject: Organizing source code with subdirectories --- src/Board.elm | 15 ----- src/Cloud.elm | 35 ------------ src/CloudStep.elm | 103 ---------------------------------- src/Config.elm | 11 ---- src/Display.elm | 132 -------------------------------------------- src/Game.elm | 39 ------------- src/Geometry.elm | 23 -------- src/Input.elm | 2 +- src/Main.elm | 21 ++++--- src/Model/Board.elm | 17 ++++++ src/Model/Cloud.elm | 41 ++++++++++++++ src/Model/Config.elm | 14 +++++ src/Model/Game.elm | 42 ++++++++++++++ src/Model/Player.elm | 20 +++++++ src/Model/Point.elm | 34 ++++++++++++ src/Model/Vec2.elm | 55 +++++++++++++++++++ src/Physics.elm | 42 -------------- src/Player.elm | 16 ------ src/Point.elm | 27 --------- src/Step.elm | 50 ----------------- src/Update/CloudUpdate.elm | 106 +++++++++++++++++++++++++++++++++++ src/Update/Update.elm | 54 ++++++++++++++++++ src/Utils/Geometry.elm | 27 +++++++++ src/Utils/Physics.elm | 46 ++++++++++++++++ src/Vec2.elm | 45 --------------- src/View/Page.elm | 134 +++++++++++++++++++++++++++++++++++++++++++++ 26 files changed, 605 insertions(+), 546 deletions(-) delete mode 100644 src/Board.elm delete mode 100644 src/Cloud.elm delete mode 100644 src/CloudStep.elm delete mode 100644 src/Config.elm delete mode 100644 src/Display.elm delete mode 100644 src/Game.elm delete mode 100644 src/Geometry.elm create mode 100644 src/Model/Board.elm create mode 100644 src/Model/Cloud.elm create mode 100644 src/Model/Config.elm create mode 100644 src/Model/Game.elm create mode 100644 src/Model/Player.elm create mode 100644 src/Model/Point.elm create mode 100644 src/Model/Vec2.elm delete mode 100644 src/Physics.elm delete mode 100644 src/Player.elm delete mode 100644 src/Point.elm delete mode 100644 src/Step.elm create mode 100644 src/Update/CloudUpdate.elm create mode 100644 src/Update/Update.elm create mode 100644 src/Utils/Geometry.elm create mode 100644 src/Utils/Physics.elm delete mode 100644 src/Vec2.elm create mode 100644 src/View/Page.elm diff --git a/src/Board.elm b/src/Board.elm deleted file mode 100644 index fa544d8..0000000 --- a/src/Board.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Board where - -import Vec2 (Vec2) - -boardSize : Vec2 -boardSize = - { x = 500 - , y = 500 - } - -boardDiagonal : Float -boardDiagonal = - let x = boardSize.x - y = boardSize.y - in sqrt(x^2 + y^2) diff --git a/src/Cloud.elm b/src/Cloud.elm deleted file mode 100644 index 45a1dcb..0000000 --- a/src/Cloud.elm +++ /dev/null @@ -1,35 +0,0 @@ -module Cloud where - -import List - -import Point (..) -import Player (..) -import Config (..) -import Geometry (distance) - -type alias Cloud = - { points : Config -> List Point - , spawn : Float - , lastSpawn : Float - } - -initCloud : Cloud -initCloud = - let spawn = 600 - in { points config = - case config of - White -> [] - Black -> [] - , spawn = spawn - , lastSpawn = -spawn - } - -playerPointsCollision : Float -> Player -> List Point -> Bool -playerPointsCollision time player points = - let collision = playerPointCollision time player - in List.length (List.filter collision points) > 0 - -playerPointCollision : Float -> Player -> Point -> Bool -playerPointCollision time player point = - let pointPos = pointMove point time - in (distance pointPos player.pos) < pointSize + playerSize diff --git a/src/CloudStep.elm b/src/CloudStep.elm deleted file mode 100644 index e6bfc96..0000000 --- a/src/CloudStep.elm +++ /dev/null @@ -1,103 +0,0 @@ -module CloudStep where - -import List -import Random (..) - -import Vec2 (..) -import Geometry (..) -import Player (..) -import Board (boardSize, boardDiagonal) -import Point (..) -import Physics (getMove, getWaveMove) -import Cloud (..) -import Config (..) - -cloudStep : Float -> Seed -> Player -> Cloud -> (Cloud, Int, Seed) -cloudStep time seed player {points, spawn, lastSpawn} = - let pointsToCatch = presentPoints time (points player.config) - presentAndNotCaughtPoints = List.filter (not << (playerPointCollision time player)) pointsToCatch - addScore = (List.length pointsToCatch) - (List.length presentAndNotCaughtPoints) - presentOtherPoints = presentPoints time (points (otherConfig player.config)) - (newCloud, seed''') = - if time > lastSpawn + spawn then - 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 - presentAndNotCaughtPoints - else - presentOtherPoints - , spawn = spawn - , lastSpawn = lastSpawn - } - , seed - ) - in (newCloud, addScore, seed''') - -presentPoints : Float -> List Point -> List Point -presentPoints time points = - let isPresent point = (distance (pointMove point time) originVec) < pointAwayDist - in List.filter isPresent points - - -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 = getWaveMove (pointSpeed delta) (initDest `sub` initPos) 10 10 - 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, 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'') - -floatGen : Generator Float -floatGen = float 0 1 - -randomBoardPosition : (Float, Float) -> (Float, Float) -> Vec2 -randomBoardPosition (randomX, randomY) (percentX, percentY) = - let width = boardSize.x * percentX - height = boardSize.y * percentY - in { x = width * randomX - width / 2 - , y = height * randomY - height / 2 - } diff --git a/src/Config.elm b/src/Config.elm deleted file mode 100644 index e02cf3f..0000000 --- a/src/Config.elm +++ /dev/null @@ -1,11 +0,0 @@ -module Config where - -type Config = - White - | Black - -otherConfig : Config -> Config -otherConfig config = - case config of - White -> Black - Black -> White diff --git a/src/Display.elm b/src/Display.elm deleted file mode 100644 index 48e6cd6..0000000 --- a/src/Display.elm +++ /dev/null @@ -1,132 +0,0 @@ -module Display where - -import List - -import Graphics.Collage (..) -import Graphics.Element (Element) -import Color (..) -import Text (..) -import Text -import Html (..) -import Html.Attributes (..) -import Html.Attributes as A -import Json.Encode (string) - -import Vec2 (Vec2) -import Player (..) -import Game (Game) -import Point (..) -import Board (boardSize) -import Config (..) - -display : Game -> Html -display game = - div - [] - [ h1 [] [ text "cAtchVoid" ] - , div - [ id "game" ] - [ fromElement << displayGame <| game ] - , p - [] - [ text "Catch the points of your color, avoid the other points." ] - , p - [] - [ text "Use the arrow keys to move and 'e' to change your color." ] - , a - [ href "https://github.com/guyonvarch/catchvoid" ] - [ img - [ A.style - [ ("position", "absolute") - , ("top", "0") - , ("right", "0") - , ("border", "0") - ] - , src "https://camo.githubusercontent.com/365986a132ccd6a44c23a9169022c0b5c890c387/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f7265645f6161303030302e706e67" - , alt "Fork me on GitHub" - , property "data-canonical-src" (string "https://s3.amazonaws.com/github/ribbons/forkme_right_red_aa0000.png") - ] - [] - ] - ] - -displayGame : Game -> Element -displayGame {time, score, player, cloud, bestScore} = - 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 - ++ blackPointForms - ++ scoreForms score - ++ bestScoreForms bestScore - in collage (truncate boardSize.x) (truncate boardSize.y) forms - -boardForms : List Form -boardForms = [filled boardColor (rect boardSize.x boardSize.y)] - -boardColor : Color -boardColor = rgb 103 123 244 - -playerForms : Player -> List Form -playerForms player = - let playerColor = configColor player.config - in [circleForm player.pos playerSize playerColor] - -playerColor : Color -playerColor = rgb 224 224 224 - -pointForm : Float -> Color -> Point -> Form -pointForm time color point = - let pos = pointMove point time - in circleForm pos pointSize color - -configColor : Config -> Color -configColor config = - case config of - White -> rgb 240 240 240 - Black -> rgb 14 17 33 - -circleForm : Vec2 -> Float -> Color -> Form -circleForm pos size color = - let outline = circle size - |> filled outlineColor - inside = circle (size - 1) - |> filled color - in group [outline, inside] - |> move (pos.x, pos.y) - -outlineColor : Color -outlineColor = rgb 34 34 34 - -scoreForms : Int -> List Form -scoreForms score = - let text = (toString score) - scorePos = { x = 0.0, y = boardSize.y / 2 - 30 } - in [textForm text scorePos centered] - -bestScoreForms : Int -> List Form -bestScoreForms bestScore = - if(bestScore > 0) then - let text = "Record: " ++ (toString bestScore) - pos = - { x = -boardSize.x / 2 + 100 - , y = -boardSize.y / 2 + 30 - } - in [textForm text pos leftAligned] - else [] - -textForm : String -> Vec2 -> (Text -> Element) -> Form -textForm content pos alignment = - let textElement = fromString content - |> Text.height 30 - |> typeface ["calibri", "arial"] - |> Text.color textColor - |> bold - |> alignment - in textElement - |> toForm - |> move (pos.x, pos.y) - -textColor : Color -textColor = rgb 14 17 33 diff --git a/src/Game.elm b/src/Game.elm deleted file mode 100644 index e294942..0000000 --- a/src/Game.elm +++ /dev/null @@ -1,39 +0,0 @@ -module Game where - -import Random (..) - -import Player (..) -import Cloud (..) -import Vec2 (Vec2) -import Config (..) -import Keyboard (KeyCode) - -type alias Game = - { time : Float - , keysDown : List KeyCode - , score : Int - , player : Player - , cloud : Cloud - , bestScore : Int - , seed : Seed - } - -initialGame : Seed -> Vec2 -> Config -> Int -> Game -initialGame seed playerPos config bestScore = - let initPlayer = - { pos = playerPos - , speed = - { x = 0 - , y = 0 - } - , config = config - } - in - { time = 0 - , keysDown = [] - , score = 0 - , player = initPlayer - , cloud = initCloud - , bestScore = bestScore - , seed = seed - } diff --git a/src/Geometry.elm b/src/Geometry.elm deleted file mode 100644 index 73e8d1f..0000000 --- a/src/Geometry.elm +++ /dev/null @@ -1,23 +0,0 @@ -module Geometry where - -import Vec2 (..) -import Board (boardSize) - -polarToCartesian : Float -> Float -> Vec2 -polarToCartesian angle dist = - { x = dist * (cos angle) - , y = dist * (sin angle) - } - -distance : Vec2 -> Vec2 -> Float -distance v1 v2 = sqrt((v2.x - v1.x)^2 + (v2.y - v1.y)^2) - -inBoard : Float -> Vec2 -> Vec2 -inBoard size pos = - let leftX = -boardSize.x / 2 + size - rightX = boardSize.x / 2 - size - bottomY = -boardSize.y / 2 + size - topY = boardSize.y / 2 - size - in { x = clamp leftX rightX pos.x - , y = clamp bottomY topY pos.y - } diff --git a/src/Input.elm b/src/Input.elm index 3723ba3..28fb2d1 100644 --- a/src/Input.elm +++ b/src/Input.elm @@ -6,7 +6,7 @@ import Random import Time (Time, fps) import Signal (..) -import Vec2 (Vec2) +import Model.Vec2 (Vec2) type alias Input = { dir : Vec2 diff --git a/src/Main.elm b/src/Main.elm index 6be5766..329492a 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -5,18 +5,25 @@ import Random import Graphics.Element (Element) import Html (Html) -import Game (Game, initialGame) -import Display (display) -import Step (step) +import Model.Game (Game, initialGame) +import Model.Vec2 (originVec) +import Model.Config (Config(White)) + +import Update.Update (update) + import Input (getInput) -import Vec2 (originVec) -import Config (Config(White)) + +import View.Page (page) main : Signal Html -main = Signal.map display game +main = Signal.map page game game : Signal Game -game = Signal.foldp step (initialGame initialSeed originVec White 0) getInput +game = + Signal.foldp + update + (initialGame initialSeed originVec White 0) + getInput port initialTime : Int diff --git a/src/Model/Board.elm b/src/Model/Board.elm new file mode 100644 index 0000000..1361cfb --- /dev/null +++ b/src/Model/Board.elm @@ -0,0 +1,17 @@ +module Model.Board + ( boardSize + , boardDiagonal + ) where + +import Model.Vec2 (Vec2) + +boardSize : Vec2 +boardSize = + { x = 500 + , y = 500 + } + +boardDiagonal : Float +boardDiagonal = + boardSize.x ^ 2 + boardSize.y ^ 2 + |> sqrt diff --git a/src/Model/Cloud.elm b/src/Model/Cloud.elm new file mode 100644 index 0000000..11f6311 --- /dev/null +++ b/src/Model/Cloud.elm @@ -0,0 +1,41 @@ +module Model.Cloud + ( Cloud + , initCloud + , playerPointsCollision + , playerPointCollision + ) where + +import List + +import Model.Point (..) +import Model.Player (..) +import Model.Config (..) + +import Utils.Geometry (distance) + +type alias Cloud = + { points : Config -> List Point + , spawn : Float + , lastSpawn : Float + } + +initCloud : Cloud +initCloud = + let spawn = 600 + in { points config = + case config of + White -> [] + Black -> [] + , spawn = spawn + , lastSpawn = -spawn + } + +playerPointsCollision : Float -> Player -> List Point -> Bool +playerPointsCollision time player points = + let collision = playerPointCollision time player + in List.length (List.filter collision points) > 0 + +playerPointCollision : Float -> Player -> Point -> Bool +playerPointCollision time player point = + let pointPos = pointMove point time + in (distance pointPos player.pos) < pointSize + playerSize diff --git a/src/Model/Config.elm b/src/Model/Config.elm new file mode 100644 index 0000000..2973dc7 --- /dev/null +++ b/src/Model/Config.elm @@ -0,0 +1,14 @@ +module Model.Config + ( Config(..) + , otherConfig + ) where + +type Config = + White + | Black + +otherConfig : Config -> Config +otherConfig config = + case config of + White -> Black + Black -> White diff --git a/src/Model/Game.elm b/src/Model/Game.elm new file mode 100644 index 0000000..4ef5d89 --- /dev/null +++ b/src/Model/Game.elm @@ -0,0 +1,42 @@ +module Model.Game + ( Game + , initialGame + ) where + +import Random (..) +import Keyboard (KeyCode) + +import Model.Player (..) +import Model.Cloud (..) +import Model.Vec2 (Vec2) +import Model.Config (..) + +type alias Game = + { time : Float + , keysDown : List KeyCode + , score : Int + , player : Player + , cloud : Cloud + , bestScore : Int + , seed : Seed + } + +initialGame : Seed -> Vec2 -> Config -> Int -> Game +initialGame seed playerPos config bestScore = + let initPlayer = + { pos = playerPos + , speed = + { x = 0 + , y = 0 + } + , config = config + } + in + { time = 0 + , keysDown = [] + , score = 0 + , player = initPlayer + , cloud = initCloud + , bestScore = bestScore + , seed = seed + } diff --git a/src/Model/Player.elm b/src/Model/Player.elm new file mode 100644 index 0000000..c6aac21 --- /dev/null +++ b/src/Model/Player.elm @@ -0,0 +1,20 @@ +module Model.Player + ( Player + , playerSize + , playerSpeed + ) where + +import Model.Vec2 (..) +import Model.Config (Config) + +type alias Player = + { pos : Vec2 + , speed : Vec2 + , config : Config + } + +playerSize : Float +playerSize = 15 + +playerSpeed : Float -> Float +playerSpeed dt = dt / 200 diff --git a/src/Model/Point.elm b/src/Model/Point.elm new file mode 100644 index 0000000..41967b6 --- /dev/null +++ b/src/Model/Point.elm @@ -0,0 +1,34 @@ +module Model.Point + ( Point + , pointMove + , pointSize + , pointSpeed + , pointSpawnDist + , pointAwayDist + ) where + +import Model.Vec2 (..) +import Model.Board (boardDiagonal) + +type alias Point = + { initTime : Float + , initPos : Vec2 + , initDest : Vec2 + , move : Float -> Vec2 -> Vec2 -> Float -> Vec2 + } + +pointMove : Point -> Float -> Vec2 +pointMove {initTime, initPos, initDest, move} time = + move initTime initPos initDest time + +pointSize : Float +pointSize = 10 + +pointSpeed : Float -> Float +pointSpeed dt = dt / 20 + +pointSpawnDist : Float +pointSpawnDist = boardDiagonal * 3 / 5 + +pointAwayDist : Float +pointAwayDist = boardDiagonal * 3 / 4 diff --git a/src/Model/Vec2.elm b/src/Model/Vec2.elm new file mode 100644 index 0000000..85ff008 --- /dev/null +++ b/src/Model/Vec2.elm @@ -0,0 +1,55 @@ +module Model.Vec2 + ( Vec2 + , add + , sub + , mul + , div + , norm + , clockwiseRotate90 + , isNull + , originVec + ) where + +type alias Vec2 = + { x : Float + , y : Float + } + +add : Vec2 -> Vec2 -> Vec2 +add v1 v2 = + { x = v1.x + v2.x + , y = v1.y + v2.y + } + +sub : Vec2 -> Vec2 -> Vec2 +sub v1 v2 = + { x = v1.x - v2.x + , y = v1.y - v2.y + } + +mul : Float -> Vec2 -> Vec2 +mul m v = + { x = m * v.x + , y = m * v.y + } + +div : Vec2 -> Float -> Vec2 +div v d = + { x = v.x / d + , y = v.y / d + } + +norm : Vec2 -> Float +norm v = sqrt(v.x ^ 2 + v.y ^ 2) + +clockwiseRotate90 : Vec2 -> Vec2 +clockwiseRotate90 v = + { x = -v.y + , y = v.x + } + +isNull : Vec2 -> Bool +isNull v = (v.x == 0) && (v.y == 0) + +originVec : Vec2 +originVec = { x = 0, y = 0 } diff --git a/src/Physics.elm b/src/Physics.elm deleted file mode 100644 index c68ab58..0000000 --- a/src/Physics.elm +++ /dev/null @@ -1,42 +0,0 @@ -module Physics where - -import Vec2 (..) - -getNewPosAndSpeed : Float -> Vec2 -> (Float -> Float) -> (Vec2, Vec2) -> (Vec2, Vec2) -getNewPosAndSpeed dt dir computeSpeed (pos, speed) = - let move = getMove (computeSpeed dt) dir - acc = getAcc move speed - newPos = getNewPos dt acc speed pos - newSpeed = getNewSpeed dt acc speed - in ( newPos - , newSpeed - ) - -getMove : Float -> Vec2 -> Vec2 -getMove speed dir = - if (isNull dir) - then {x = 0, y = 0} - else - let angle = atan2 dir.y dir.x - in { x = speed * cos angle - , y = speed * sin angle - } - -getWaveMove : Float -> Vec2 -> Float -> Float -> Vec2 -getWaveMove speed dir amplitude period = - let move = getMove speed dir - perpendMove = - getMove - (amplitude * (sin ((norm move) / period))) - (clockwiseRotate90 move) - in move `add` perpendMove - -getAcc : Vec2 -> Vec2 -> Vec2 -getAcc move speed = (move `div` 300) `sub` (speed `div` 300) - -getNewPos : Float -> Vec2 -> Vec2 -> Vec2 -> Vec2 -getNewPos dt acc speed pos = - ((dt^2 / 2) `mul` acc) `add` ((dt `mul` speed) `add` pos) - -getNewSpeed : Float -> Vec2 -> Vec2 -> Vec2 -getNewSpeed dt acc speed = add (mul dt acc) speed diff --git a/src/Player.elm b/src/Player.elm deleted file mode 100644 index d1c10e0..0000000 --- a/src/Player.elm +++ /dev/null @@ -1,16 +0,0 @@ -module Player where - -import Vec2 (..) -import Config (Config) - -type alias Player = - { pos : Vec2 - , speed : Vec2 - , config : Config - } - -playerSize : Float -playerSize = 15 - -playerSpeed : Float -> Float -playerSpeed dt = dt / 200 diff --git a/src/Point.elm b/src/Point.elm deleted file mode 100644 index e66a5f7..0000000 --- a/src/Point.elm +++ /dev/null @@ -1,27 +0,0 @@ -module Point where - -import Vec2 (..) -import Board (boardDiagonal) - -type alias Point = - { initTime : Float - , initPos : Vec2 - , initDest : Vec2 - , move : Float -> Vec2 -> Vec2 -> Float -> Vec2 - } - -pointMove : Point -> Float -> Vec2 -pointMove {initTime, initPos, initDest, move} time = - move initTime initPos initDest time - -pointSize : Float -pointSize = 10 - -pointSpeed : Float -> Float -pointSpeed dt = dt / 20 - -pointSpawnDist : Float -pointSpawnDist = boardDiagonal * 3 / 5 - -pointAwayDist : Float -pointAwayDist = boardDiagonal * 3 / 4 diff --git a/src/Step.elm b/src/Step.elm deleted file mode 100644 index dd340a5..0000000 --- a/src/Step.elm +++ /dev/null @@ -1,50 +0,0 @@ -module Step where - -import List -import Keyboard (KeyCode) -import Char (fromCode, toCode) - -import Vec2 (..) -import Game (..) -import Player (..) -import Cloud (..) -import Geometry (..) -import Player (playerSpeed) -import Point (pointSpeed, pointMove, pointAwayDist) -import Physics (getNewPosAndSpeed) -import CloudStep (cloudStep) -import Config (otherConfig) -import Input (Input) - -step : Input -> Game -> Game -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 seed player.pos player.config newBestScore - else - let newTime = time + delta - newPlayer = playerStep delta dir (newKeyCode keysDown inputKeysDown) player - (newCloud, addScore, newSeed) = cloudStep time seed newPlayer cloud - in { time = newTime - , 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 69) then otherConfig player.config else player.config - in { pos = inBoard playerSize pos - , speed = speed - , config = newConfig - } - -newKeyCode : List KeyCode -> List KeyCode -> KeyCode -> Bool -newKeyCode lastKeyCodes newKeyCodes keyCode = - let contains = not << List.isEmpty << List.filter (\kc -> kc == keyCode) - in not (contains lastKeyCodes) && (contains newKeyCodes) diff --git a/src/Update/CloudUpdate.elm b/src/Update/CloudUpdate.elm new file mode 100644 index 0000000..86f7e13 --- /dev/null +++ b/src/Update/CloudUpdate.elm @@ -0,0 +1,106 @@ +module Update.CloudUpdate + ( cloudUpdate + ) where + +import List +import Random (..) + +import Model.Vec2 (..) +import Model.Player (..) +import Model.Board (boardSize, boardDiagonal) +import Model.Point (..) +import Model.Cloud (..) +import Model.Config (..) + +import Utils.Geometry (..) +import Utils.Physics (getMove, getWaveMove) + +cloudUpdate : Float -> Seed -> Player -> Cloud -> (Cloud, Int, Seed) +cloudUpdate time seed player {points, spawn, lastSpawn} = + let pointsToCatch = presentPoints time (points player.config) + presentAndNotCaughtPoints = List.filter (not << (playerPointCollision time player)) pointsToCatch + addScore = (List.length pointsToCatch) - (List.length presentAndNotCaughtPoints) + presentOtherPoints = presentPoints time (points (otherConfig player.config)) + (newCloud, seed''') = + if time > lastSpawn + spawn then + 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 + presentAndNotCaughtPoints + else + presentOtherPoints + , spawn = spawn + , lastSpawn = lastSpawn + } + , seed + ) + in (newCloud, addScore, seed''') + +presentPoints : Float -> List Point -> List Point +presentPoints time points = + let isPresent point = (distance (pointMove point time) originVec) < pointAwayDist + in List.filter isPresent points + + +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 = getWaveMove (pointSpeed delta) (initDest `sub` initPos) 10 10 + 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, 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'') + +floatGen : Generator Float +floatGen = float 0 1 + +randomBoardPosition : (Float, Float) -> (Float, Float) -> Vec2 +randomBoardPosition (randomX, randomY) (percentX, percentY) = + let width = boardSize.x * percentX + height = boardSize.y * percentY + in { x = width * randomX - width / 2 + , y = height * randomY - height / 2 + } diff --git a/src/Update/Update.elm b/src/Update/Update.elm new file mode 100644 index 0000000..0187dcf --- /dev/null +++ b/src/Update/Update.elm @@ -0,0 +1,54 @@ +module Update.Update + ( update + ) where + +import List +import Keyboard (KeyCode) +import Char (fromCode, toCode) + +import Model.Player (..) +import Model.Point (pointSpeed, pointMove, pointAwayDist) +import Model.Vec2 (..) +import Model.Config (otherConfig) +import Model.Cloud (..) +import Model.Game (..) + +import Utils.Geometry (..) +import Utils.Physics (getNewPosAndSpeed) + +import Update.CloudUpdate (cloudUpdate) + +import Input (Input) + +update : Input -> Game -> Game +update {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 seed player.pos player.config newBestScore + else + let newTime = time + delta + newPlayer = playerStep delta dir (newKeyCode keysDown inputKeysDown) player + (newCloud, addScore, newSeed) = cloudUpdate time seed newPlayer cloud + in { time = newTime + , 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 69) then otherConfig player.config else player.config + in { pos = inBoard playerSize pos + , speed = speed + , config = newConfig + } + +newKeyCode : List KeyCode -> List KeyCode -> KeyCode -> Bool +newKeyCode lastKeyCodes newKeyCodes keyCode = + let contains = not << List.isEmpty << List.filter (\kc -> kc == keyCode) + in not (contains lastKeyCodes) && (contains newKeyCodes) diff --git a/src/Utils/Geometry.elm b/src/Utils/Geometry.elm new file mode 100644 index 0000000..085026f --- /dev/null +++ b/src/Utils/Geometry.elm @@ -0,0 +1,27 @@ +module Utils.Geometry + ( polarToCartesian + , distance + , inBoard + ) where + +import Model.Vec2 (..) +import Model.Board (boardSize) + +polarToCartesian : Float -> Float -> Vec2 +polarToCartesian angle dist = + { x = dist * (cos angle) + , y = dist * (sin angle) + } + +distance : Vec2 -> Vec2 -> Float +distance v1 v2 = sqrt((v2.x - v1.x)^2 + (v2.y - v1.y)^2) + +inBoard : Float -> Vec2 -> Vec2 +inBoard size pos = + let leftX = -boardSize.x / 2 + size + rightX = boardSize.x / 2 - size + bottomY = -boardSize.y / 2 + size + topY = boardSize.y / 2 - size + in { x = clamp leftX rightX pos.x + , y = clamp bottomY topY pos.y + } diff --git a/src/Utils/Physics.elm b/src/Utils/Physics.elm new file mode 100644 index 0000000..751af6c --- /dev/null +++ b/src/Utils/Physics.elm @@ -0,0 +1,46 @@ +module Utils.Physics + ( getNewPosAndSpeed + , getMove + , getWaveMove + ) where + +import Model.Vec2 (..) + +getNewPosAndSpeed : Float -> Vec2 -> (Float -> Float) -> (Vec2, Vec2) -> (Vec2, Vec2) +getNewPosAndSpeed dt dir computeSpeed (pos, speed) = + let move = getMove (computeSpeed dt) dir + acc = getAcc move speed + newPos = getNewPos dt acc speed pos + newSpeed = getNewSpeed dt acc speed + in ( newPos + , newSpeed + ) + +getMove : Float -> Vec2 -> Vec2 +getMove speed dir = + if (isNull dir) + then {x = 0, y = 0} + else + let angle = atan2 dir.y dir.x + in { x = speed * cos angle + , y = speed * sin angle + } + +getWaveMove : Float -> Vec2 -> Float -> Float -> Vec2 +getWaveMove speed dir amplitude period = + let move = getMove speed dir + perpendMove = + getMove + (amplitude * (sin ((norm move) / period))) + (clockwiseRotate90 move) + in move `add` perpendMove + +getAcc : Vec2 -> Vec2 -> Vec2 +getAcc move speed = (move `div` 300) `sub` (speed `div` 300) + +getNewPos : Float -> Vec2 -> Vec2 -> Vec2 -> Vec2 +getNewPos dt acc speed pos = + ((dt^2 / 2) `mul` acc) `add` ((dt `mul` speed) `add` pos) + +getNewSpeed : Float -> Vec2 -> Vec2 -> Vec2 +getNewSpeed dt acc speed = add (mul dt acc) speed diff --git a/src/Vec2.elm b/src/Vec2.elm deleted file mode 100644 index c980e1a..0000000 --- a/src/Vec2.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Vec2 where - -type alias Vec2 = - { x : Float - , y : Float - } - -add : Vec2 -> Vec2 -> Vec2 -add v1 v2 = - { x = v1.x + v2.x - , y = v1.y + v2.y - } - -sub : Vec2 -> Vec2 -> Vec2 -sub v1 v2 = - { x = v1.x - v2.x - , y = v1.y - v2.y - } - -mul : Float -> Vec2 -> Vec2 -mul m v = - { x = m * v.x - , y = m * v.y - } - -div : Vec2 -> Float -> Vec2 -div v d = - { x = v.x / d - , y = v.y / d - } - -norm : Vec2 -> Float -norm v = sqrt(v.x ^ 2 + v.y ^ 2) - -clockwiseRotate90 : Vec2 -> Vec2 -clockwiseRotate90 v = - { x = -v.y - , y = v.x - } - -isNull : Vec2 -> Bool -isNull v = (v.x == 0) && (v.y == 0) - -originVec : Vec2 -originVec = { x = 0, y = 0 } diff --git a/src/View/Page.elm b/src/View/Page.elm new file mode 100644 index 0000000..ed0dceb --- /dev/null +++ b/src/View/Page.elm @@ -0,0 +1,134 @@ +module View.Page + ( page + ) where + +import List + +import Graphics.Collage (..) +import Graphics.Element (Element) +import Color (..) +import Text (..) +import Text +import Html (..) +import Html.Attributes (..) +import Html.Attributes as A +import Json.Encode (string) + +import Model.Vec2 (Vec2) +import Model.Player (..) +import Model.Game (Game) +import Model.Point (..) +import Model.Board (boardSize) +import Model.Config (..) + +page : Game -> Html +page game = + div + [] + [ h1 [] [ text "cAtchVoid" ] + , div + [ id "game" ] + [ fromElement << displayGame <| game ] + , p + [] + [ text "Catch the points of your color, avoid the other points." ] + , p + [] + [ text "Use the arrow keys to move and 'e' to change your color." ] + , a + [ href "https://github.com/guyonvarch/catchvoid" ] + [ img + [ A.style + [ ("position", "absolute") + , ("top", "0") + , ("right", "0") + , ("border", "0") + ] + , src "https://camo.githubusercontent.com/365986a132ccd6a44c23a9169022c0b5c890c387/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f7265645f6161303030302e706e67" + , alt "Fork me on GitHub" + , property "data-canonical-src" (string "https://s3.amazonaws.com/github/ribbons/forkme_right_red_aa0000.png") + ] + [] + ] + ] + +displayGame : Game -> Element +displayGame {time, score, player, cloud, bestScore} = + 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 + ++ blackPointForms + ++ scoreForms score + ++ bestScoreForms bestScore + in collage (truncate boardSize.x) (truncate boardSize.y) forms + +boardForms : List Form +boardForms = [filled boardColor (rect boardSize.x boardSize.y)] + +boardColor : Color +boardColor = rgb 103 123 244 + +playerForms : Player -> List Form +playerForms player = + let playerColor = configColor player.config + in [circleForm player.pos playerSize playerColor] + +playerColor : Color +playerColor = rgb 224 224 224 + +pointForm : Float -> Color -> Point -> Form +pointForm time color point = + let pos = pointMove point time + in circleForm pos pointSize color + +configColor : Config -> Color +configColor config = + case config of + White -> rgb 240 240 240 + Black -> rgb 14 17 33 + +circleForm : Vec2 -> Float -> Color -> Form +circleForm pos size color = + let outline = circle size + |> filled outlineColor + inside = circle (size - 1) + |> filled color + in group [outline, inside] + |> move (pos.x, pos.y) + +outlineColor : Color +outlineColor = rgb 34 34 34 + +scoreForms : Int -> List Form +scoreForms score = + let text = (toString score) + scorePos = { x = 0.0, y = boardSize.y / 2 - 30 } + in [textForm text scorePos centered] + +bestScoreForms : Int -> List Form +bestScoreForms bestScore = + if(bestScore > 0) then + let text = "Record: " ++ (toString bestScore) + pos = + { x = -boardSize.x / 2 + 100 + , y = -boardSize.y / 2 + 30 + } + in [textForm text pos leftAligned] + else [] + +textForm : String -> Vec2 -> (Text -> Element) -> Form +textForm content pos alignment = + let textElement = fromString content + |> Text.height 30 + |> typeface ["calibri", "arial"] + |> Text.color textColor + |> bold + |> alignment + in textElement + |> toForm + |> move (pos.x, pos.y) + +textColor : Color +textColor = rgb 14 17 33 -- cgit v1.2.3