Permalink
Cannot retrieve contributors at this time
import Keyboard | |
import Window | |
import Debug | |
(gameWidth,gameHeight) = (600,800) | |
(halfWidth,halfHeight) = (300,400) | |
type Input = {space:Bool, dir:Int, delta:Time, pulse:Time} | |
type Spaceship = {x:Float, y:Float, rotation:Float} | |
type Ball = {x:Float, y:Float, vx:Float, vy:Float, angle:Float, status:FlyingElementState} | |
type Enemy = {x:Float, y:Float, vx:Float, vy:Float, status:FlyingElementState} | |
type Game = {spaceship:Spaceship, balls:[Ball], enemies:[Enemy], state:State, lastPulse:Maybe Time, isGameOver:Bool} | |
data State = Shooting | NotShooting | |
data FlyingElementState = Flying | OutOfBounds | Colliding | ReadyToFly | |
positionEnemies : [Float] | |
positionEnemies = [-290, -250, -200, -150, -100, -50, 0, 50, 100, 150, 200, 250, 290] | |
-- default elements | |
defaultBall : Float -> Ball | |
defaultBall a = {x=0, y=-halfHeight+40, vx=600, vy=600, angle=a, status=Flying} | |
defaultSpaceship : Float -> Spaceship | |
defaultSpaceship h = {x=0, y=h + 40, rotation=90} | |
defaultEnemy : Int -> Time -> Enemy | |
defaultEnemy index lastPulse = let indexToSelect = if (index == 0) then (((truncate lastPulse) + 10) `mod` (length positionEnemies)) else (index `mod` (length positionEnemies)) | |
in {x=(getXEnemy indexToSelect positionEnemies), y=halfHeight-40, vx=200, vy=200, status=Flying} | |
defaultGame : Game | |
defaultGame = | |
{ spaceship = {x=0, y=-halfHeight+40, rotation=90}, | |
balls = [], | |
enemies = [defaultEnemy 3 0], | |
state = NotShooting, | |
lastPulse = Nothing, | |
isGameOver = False | |
} | |
-- signals | |
delta = inSeconds <~ fps 35 | |
pulse = every (0.5 * second) | |
input = sampleOn delta (Input <~ Keyboard.space | |
~ lift .x Keyboard.arrows | |
~ delta | |
~ pulse) | |
-- update | |
stepGame : Input -> Game -> Game | |
stepGame ({space, dir, delta, pulse} as input) ({spaceship, balls, enemies, state, lastPulse, isGameOver} as game) = | |
let spaceship' = moveSpaceship spaceship dir | |
balls' = addBall balls space delta spaceship.rotation state enemies | |
enemies' = addEnemy enemies balls delta pulse lastPulse | |
state' = updateState state space | |
lastPulse' = updateLastPulse lastPulse pulse | |
isGameOver' = checkIfGameOver enemies | |
in { game | spaceship <- if isGameOver then spaceship else spaceship', | |
balls <- if isGameOver then balls else balls', | |
enemies <- if isGameOver then enemies else enemies', | |
state <- if isGameOver then state else state', | |
lastPulse <- lastPulse', | |
isGameOver <- isGameOver' | |
} | |
-- helpers | |
checkIfGameOver : [Enemy] -> Bool | |
checkIfGameOver enemies = any (\e -> e.status == OutOfBounds) enemies | |
getXEnemy : Int -> [Float] -> Float | |
getXEnemy index indexes = case index | |
of 0 -> head indexes | |
1 -> head indexes | |
_ -> last (take index indexes) | |
createEnemy : Float -> Enemy | |
createEnemy posX = {x=posX, y=halfHeight+10, vx=200, vy=200, status=Flying} | |
createEnemies : [Float] -> [Enemy] | |
createEnemies positions = map (\px -> createEnemy px) positions | |
addBall : [Ball] -> Bool -> Time -> Float -> State -> [Enemy] -> [Ball] | |
addBall balls isSpacePressed delta angle state enemies = let balls' = if isSpacePressed then balls ++ [defaultBall angle] else balls | |
in updateAllBalls balls' delta angle state enemies | |
addEnemy : [Enemy] -> [Ball] -> Time -> Time -> Maybe Time -> [Enemy] | |
addEnemy enemies balls delta pulse lastPulse = let enemies' = case (pulse, lastPulse) | |
of (_, Nothing) -> enemies | |
(p, Just lp) -> if (p /= lp) then enemies ++ [(defaultEnemy (length balls) lp)] else enemies | |
in updateAllEnemies enemies' balls delta | |
updateLastPulse : Maybe Time -> Time -> Maybe Time | |
updateLastPulse lastPulse newPulse = case (lastPulse, newPulse) | |
of (Nothing, np) -> Just newPulse | |
(Just lp, np) -> if lp /= np then Just np else lastPulse | |
updateAllEnemies : [Enemy] -> [Ball] -> Time -> [Enemy] | |
updateAllEnemies enemies balls delta = filter (\e -> e.status /= Colliding) (map (\e -> updateEnemy e balls delta) enemies) | |
updateEnemy : Enemy -> [Ball] -> Time -> Enemy | |
updateEnemy enemy balls delta = let y' = updateYEnemy enemy delta | |
state' = updateStatusEnemy enemy balls | |
in {enemy | y <- y', status <- state'} | |
updateYEnemy : Enemy -> Time -> Float | |
updateYEnemy enemy delta = enemy.y - enemy.vy * delta | |
updateStatusEnemy : Enemy -> [Ball] -> FlyingElementState | |
updateStatusEnemy enemy balls = if checkCollisions enemy balls then Colliding | |
else if enemy.y <= -halfHeight then OutOfBounds | |
else Flying | |
updateAllBalls : [Ball] -> Time -> Float -> State -> [Enemy] -> [Ball] | |
updateAllBalls balls delta angle state enemies = filter (\b -> b.status /= Colliding && b.status /= OutOfBounds) (map (\b -> moveBall b delta state angle (checkCollisionsWithEnemies b enemies)) balls) | |
updateState : State -> Bool -> State | |
updateState state isSpacePressed = case (state, isSpacePressed) of | |
(Shooting, _) -> Shooting | |
(NotShooting, True) -> Shooting | |
(NotShooting, False) -> NotShooting | |
(_,_) -> NotShooting | |
updateBallState : Ball -> Bool -> FlyingElementState | |
updateBallState ball isColliding = if isColliding then Colliding | |
else if ball.y > halfHeight || ball.x < -halfWidth || ball.x > halfWidth then OutOfBounds | |
else if ball.status == ReadyToFly then Flying | |
else Flying | |
updateBallPosition : Ball -> State -> Time -> (Float,Float) | |
updateBallPosition ({x,y,vx,vy,angle,status} as ball) state delta= case (x, y, status, state) of | |
(_,_,ReadyToFly, Shooting) -> (0, -halfHeight+40) | |
(_,_,Flying,NotShooting) -> (0, -halfHeight+40) | |
(_,_,Flying,Shooting) -> (x + vx * delta * cos (convertDegreesToRadian angle), y + vy * delta * sin (convertDegreesToRadian ball.angle)) | |
moveBall : Ball -> Time -> State -> Float -> Bool -> Ball | |
moveBall ({x,y,vx,vy} as ball) delta state angle isColliding = let (x',y') = updateBallPosition ball state delta | |
status' = updateBallState ball isColliding | |
angle' = if state == NotShooting || ball.status == ReadyToFly then angle else ball.angle | |
in {ball | x <- x', y <- y', angle <- angle', status <- status' } | |
convertDegreesToRadian : Float -> Float | |
convertDegreesToRadian angleInDegree = angleInDegree / 180 * pi | |
moveSpaceship : Spaceship -> Int -> Spaceship | |
moveSpaceship spaceship angle = let rotation' = spaceship.rotation - ((toFloat angle) * 5) | |
in {spaceship | rotation <- rotation'} | |
moveEnemy : Enemy -> Time -> [Ball] -> Enemy | |
moveEnemy ({x,y,vx,vy} as enemy) delta balls = let y' = if (y > -halfHeight && y < halfHeight && not (checkCollisions enemy balls)) | |
then y - vy * delta | |
else halfHeight-40 | |
in {enemy | y <- y'} | |
checkCollisions : Enemy -> [Ball] -> Bool | |
checkCollisions enemy balls = any (\b -> isColliding enemy b) balls | |
checkCollisionsWithEnemies : Ball -> [Enemy] -> Bool | |
checkCollisionsWithEnemies b enemies = any (\e -> isColliding e b) enemies | |
isColliding : Enemy -> Ball -> Bool | |
isColliding enemy ball = (abs (enemy.x - ball.x)) < 30 && (abs (enemy.y - ball.y)) < 30 | |
display : (Int, Int) -> Game -> Input -> Element | |
display (w,h) {spaceship, balls, enemies, state, lastPulse, isGameOver} i = collage w h [ | |
move (0, 0) (filled yellow (rect gameWidth gameHeight)), | |
(drawSpaceship spaceship red), | |
(displayBalls balls), | |
(drawEnemies enemies), | |
(displayGameOverOverlay isGameOver w h) | |
] | |
displayBalls : [Ball] -> Form | |
displayBalls balls = group (map (\b -> drawBall b blue) balls) | |
drawEnemies : [Enemy] -> Form | |
drawEnemies enemies = group (map (\b -> drawEnemy b brown) enemies) | |
drawSpaceship : Spaceship -> Color -> Form | |
drawSpaceship spaceship clr = (rotate (degrees spaceship.rotation) ( move (spaceship.x, spaceship.y) (filled clr (ngon 3 20)))) | |
drawEnemy : Enemy -> Color -> Form | |
drawEnemy enemy clr = move (enemy.x, enemy.y) (filled clr (ngon 4 15)) | |
drawBall : Ball -> Color -> Form | |
drawBall ball clr = ( move (ball.x, ball.y) (filled clr (circle 4))) | |
displayGameOverOverlay : Bool -> Int -> Int -> Form | |
displayGameOverOverlay isGameOver w h = let w' = if isGameOver then w else 0 | |
h' = if isGameOver then h else 0 | |
text' = if isGameOver then "GAME OVER" else "" | |
in group [filled (rgba 255 255 255 0.8) (rect (toFloat w') (toFloat h')), | |
move (0,0) (toForm (plainText text'))] | |
-- entry point | |
gameState : Signal Game | |
gameState = foldp stepGame defaultGame input | |
main = lift3 display Window.dimensions gameState input |