Commit 4d007f68 authored by Joris Guyonvarch's avatar Joris Guyonvarch

Adapt the game to elm version 0.14.1

parent d37a301e
src/build
src/cache
elm-stuff
elm.js
{
"version": "2.2.1",
"summary": "",
"description": "",
"license": "BSD3",
"source-directories": [
"src"
],
"exposed-modules": [],
"dependencies": {
"elm-lang/core": "1.0.0 <= v < 2.0.0",
"evancz/elm-html": "1.0.0 <= v < 2.0.0"
},
"repository": "https://github.com/guyonvarch/catchvoid.git"
}
......@@ -6,8 +6,7 @@
<title>cAtchVoid</title>
<meta charset="UTF-8">
<link rel="stylesheet" type="text/css" href="style.css">
<script src="resources/elm-runtime.js"></script>
<script src="src/build/Main.js"></script>
<script src="elm.js"></script>
</head>
<body>
......@@ -25,9 +24,10 @@
</p>
<script type="text/javascript">
var myModule = Elm.Main;
var myContainer = document.getElementById('game');
Elm.embed(myModule, myContainer);
var input = {
initialTime: new Date().getTime()
};
Elm.embed(Elm.Main, document.getElementById('game'), input);
</script>
<a href="https://github.com/guyonvarch/catchvoid">
......
This diff is collapsed.
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 =
......
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) =
......
module Config where
data Config = White | Black
type Config =
White
| Black
otherConfig : Config -> Config
otherConfig config =
......
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
......
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
}
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
}
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
......@@ -3,7 +3,7 @@ module Player where
import Vec2 (..)
import Config (Config)
type Player =
type alias Player =
{ pos : Vec2
, speed : Vec2
, config : Config
......
......@@ -3,7 +3,7 @@ module Point where
import Vec2 (..)
import Board (boardDiagonal)
type Point =
type alias Point =
{ initTime : Float
, initPos : Vec2
, initDest : Vec2
......
module RandomValues where
type RandomValues =
{ point1 : PointRandomValues
, point2 : PointRandomValues
}
type PointRandomValues =
{ angle : Float
, x : Float
, y : Float
}
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)
module Vec2 where
type Vec2 =
type alias Vec2 =
{ x : Float
, y : Float
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment