spaceinvader.elm

import Keyboard
import Window
import Debug

(gameWidth,gameHeight) = (600,800)
(halfWidth,halfHeight) = (300,400)


type Input = {space:Bool, dir:Int, delta:Time, timestamp:Time}
type Spaceship = {x:Float, y:Float, rotation:Float}
type Ball = {x:Float, y:Float, vx:Float, vy:Float, angle:Float, status:BallState}
type Enemy = {x:Float, y:Float, vx:Float, vy:Float, deltaToWait:Float}
type Game = {spaceship:Spaceship, balls:[Ball], enemy:Enemy, enemies:[Enemy], state:State}

data State = Shooting | NotShooting
data BallState = Flying | OutOfBounds | Colliding | ReadyToFly

data Event = Regular (Bool, Int, Time, Time) | Add


positionEnemies : [Float]
positionEnemies = [-290, -250, -200, -150, -100, -50, 0, 50, 100, 150, 200, 250, 290]

defaultGame : Game
defaultGame = 
  { spaceship = {x=0, y=-halfHeight+40, rotation=90},
    balls = [],
    enemy = {x=0, y=halfHeight-40, vx=200, vy=200, deltaToWait=100},
    enemies = [defaultEnemy 3],
    state = NotShooting
  }


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 index = let posX = if index == 0 then 8 else 4 --last (take ((length positionEnemies) `mod` index) positionEnemies)
                     in {x=posX, y=halfHeight-40, vx=200, vy=200, deltaToWait=100}

delta = inSeconds <~ fps 35
timestamp = foldp (+) 0 <| inSeconds <~ fps 35
input = sampleOn delta (Input <~ Keyboard.space
                               ~ lift .x Keyboard.arrows
                               ~ delta
                               ~ timestamp)
                               

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)))


stepGame : Input -> Game -> Game
stepGame ({space, dir, delta, timestamp} as input) ({spaceship, balls, enemy, enemies, state} as game) =
      let spaceship' = moveSpaceship spaceship delta dir
          balls' = addBall balls space delta spaceship.rotation state enemy
          enemy' = moveEnemy enemy delta balls
          enemies' = addEnemy enemies balls delta timestamp
          state' = updateState state space
      in { game | spaceship <- spaceship',
                  balls      <- balls',
                  enemy     <- enemy',
                  enemies   <- enemies',
                  state     <- state'
                }




addBall : [Ball] -> Bool -> Time -> Float -> State -> Enemy -> [Ball]
addBall balls isSpacePressed delta angle state enemy =  let balls' = if isSpacePressed then balls ++ [defaultBall angle] else balls
                                                        in updateAllBalls balls' delta angle state enemy


addEnemy : [Enemy] -> [Ball] -> Time -> Time  -> [Enemy]
addEnemy enemies balls delta timestamp = let enemies' = if ((truncate timestamp) `mod` 10 == 0) then enemies ++ [(defaultEnemy (length balls))] else enemies
                               in updateAllEnemies enemies' delta

updateAllEnemies : [Enemy] -> Time -> [Enemy]
updateAllEnemies enemies delta = map (\e -> updateEnemy e delta) enemies


updateEnemy enemy delta = let deltaToWait' = if enemy.deltaToWait == 0 then 0 else enemy.deltaToWait-1
                              y' = updateYEnemy enemy delta
                          in {enemy | y <- y', deltaToWait <- deltaToWait'}


updateYEnemy enemy delta = case (enemy.y, enemy.deltaToWait)
                     of (y, 0) -> if y < -halfHeight then halfHeight else y - enemy.vy * delta
                        (_, 1) -> halfHeight
                        (y, _) -> y

updateAllBalls : [Ball] -> Time -> Float -> State -> Enemy -> [Ball]
updateAllBalls balls delta angle state enemy = filter (\b -> b.status /= Colliding && b.status /= OutOfBounds) (map (\b -> moveBall b delta state angle (isColliding enemy b)) balls)

getDeltaToWait : [Enemy] -> Float
getDeltaToWait enemies = if isEmpty enemies then 0 else 5

updateState : State -> Bool -> State
updateState state isSpacePressed = case (state, isSpacePressed) of
                                   (Shooting, _) -> Shooting
                                   (NotShooting, True) -> Shooting
                                   (NotShooting, False) -> NotShooting
                                   (_,_) -> NotShooting


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' }

updateBallState : Ball -> Bool -> BallState 
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 (convertAngleToRadian angle), y + vy * delta * sin (convertAngleToRadian ball.angle))


convertAngleToRadian angleInDegree = angleInDegree / 180 * pi

moveSpaceship : Spaceship -> Time -> Int -> Spaceship
moveSpaceship spaceship delta angle = let rotation' = spaceship.rotation - ((toFloat angle))
                        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 
                       
isColliding : Enemy -> Ball -> Bool                       
isColliding enemy ball = (abs (enemy.x - ball.x)) < 30 && (abs (enemy.y - ball.y)) < 30

gameState : Signal Game
gameState = foldp stepGame defaultGame input


display : (Int, Int) -> Game -> Input -> Element
display (w,h) {spaceship, balls, enemy, enemies, state} i  = collage w h [
                move (0, 0) (filled yellow (rect gameWidth gameHeight)),
                move (0, 0) (filled green (rect 5 5)),
                move (0, 0) (toForm (asText (length enemies))),
                move (0, -20) (toForm (asText ((truncate i.timestamp) `mod` 10 == 0))),
                (drawSpaceship spaceship red),
                (displayBalls balls)
                ]
                --(drawEnemies enemies)]

displayBalls : [Ball] -> Form
displayBalls balls = group (map (\b -> drawBall b blue) balls)

createEnemy : Float -> Enemy
createEnemy posX = {x=posX, y=halfHeight+10, vx=200, vy=200, deltaToWait=10}

createEnemies : [Float] -> [Enemy]
createEnemies positions = map (\px -> createEnemy px) positions

displayEnemies = group (map (\b -> drawEnemy b brown) (createEnemies positionEnemies))
drawEnemies enemies = group (map (\b -> drawEnemy b brown) enemies)


main = lift3 display Window.dimensions gameState input