module Main where import System import System.IO import System.Random import Data.List import Sprite import Draw -- import Interact import AnsiInteract type Tick = Int type Gun = Sprite type Bullets = [Sprite] type Invaders = [Sprite] type Explosions = [Sprite] type Score = Int type Lives = Int type Level = Int -- GameState = (time tick, gun sprite, gun bullet sprites, invader sprites, invader bullet sprites explosion sprites) type GameState = (Tick, Gun, Bullets, Invaders, Bullets, Explosions, Score, Lives, Level) getTick :: GameState -> Tick getTick (t, _, _, _, _, _, _, _, _) = t getGun :: GameState -> Gun getGun (_, g, _, _, _, _, _, _, _) = g getGunBullets :: GameState -> Bullets getGunBullets (_, _, bs, _, _, _, _, _, _) = bs getInvaders :: GameState -> Invaders getInvaders (_, _, _, is, _, _, _, _, _) = is getInvBullets :: GameState -> Bullets getInvBullets (_, _, _, _, ib, _, _, _, _) = ib getExplosions :: GameState -> Explosions getExplosions (_, _, _, _, _, es, _, _, _) = es getScore :: GameState -> Score getScore (_, _, _, _, _, _, s, _, _) = s getLives :: GameState -> Lives getLives (_, _, _, _, _, _, _, l, _) = l getLevel :: GameState -> Level getLevel (_, _, _, _, _, _, _, _, l) = l makeGameState :: Tick -> Gun -> Bullets -> Invaders -> Bullets -> Explosions -> Score -> Lives -> Level -> GameState makeGameState tick gun gunBullets invaders invBullets explosions score lives level = (tick, gun, gunBullets, invaders, invBullets, explosions, score, lives, level) modifyTickInState :: GameState -> Tick -> GameState modifyTickInState (_, gun, gunBullets, invaders, invBullets, explosions, score, lives, level) newTick = (newTick, gun, gunBullets, invaders, invBullets, explosions, score, lives, level) modifyGunInState :: GameState -> Gun -> GameState modifyGunInState (tick, _, gunBullets, invaders, invBullets, explosions, score, lives, level) newGun = (tick, newGun, gunBullets, invaders, invBullets, explosions, score, lives, level) modifyGunBulletsInState :: GameState -> Bullets -> GameState modifyGunBulletsInState (tick, gun, _, invaders, invBullets, explosions, score, lives, level) newGunBullets = (tick, gun, newGunBullets, invaders, invBullets, explosions, score, lives, level) modifyInvadersInState :: GameState -> Invaders -> GameState modifyInvadersInState (tick, gun, gunBullets, _, invBullets, explosions, score, lives, level) newInvaders = (tick, gun, gunBullets, newInvaders, invBullets, explosions, score, lives, level) modifyInvBulletsInState :: GameState -> Bullets -> GameState modifyInvBulletsInState (tick, gun, gunBullets, invaders, _, explosions, score, lives, level) newInvBullets = (tick, gun, gunBullets, invaders, newInvBullets, explosions, score, lives, level) modifyExpsInState :: GameState -> Explosions -> GameState modifyExpsInState (tick, gun, gunBullets, invaders, invBullets, _, score, lives, level) newExplosions = (tick, gun, gunBullets, invaders, invBullets, newExplosions, score, lives, level) modifyScoreInState :: GameState -> Score -> GameState modifyScoreInState (tick, gun, gunBullets, invaders, invBullets, explosions, _, lives, level) newScore = (tick, gun, gunBullets, invaders, invBullets, explosions, newScore, lives, level) modifyLivesInState :: GameState -> Lives -> GameState modifyLivesInState (tick, gun, gunBullets, invaders, invBullets, explosions, score, _, level) newLives = (tick, gun, gunBullets, invaders, invBullets, explosions, score, newLives, level) modifyLevelInState :: GameState -> Level -> GameState modifyLevelInState (tick, gun, gunBullets, invaders, invBullets, explosions, score, lives, _) newLevel = (tick, gun, gunBullets, invaders, invBullets, explosions, score, lives, newLevel) -- time delays for various events. The ints correspond to the number of time ticks -- that must occur before an event is triggered. bulletDelay :: Int bulletDelay = 5 explosionDelay :: Int explosionDelay = 10 invaderMoveDelay :: Int invaderMoveDelay = 20 invBulletSpawnDelay :: Int invBulletSpawnDelay = 50 readKeyBoard :: Int -> IO (Maybe Char) readKeyBoard delay = do isInputReady <- hWaitForInput stdin delay if isInputReady then do nextChar <- hGetChar stdin return (Just nextChar) else return Nothing loopInput :: GameState -> IO () loopInput gameState = do nextChar <- readKeyBoard 100 let tick = getTick gameState let newTick = if tick == 100000 then 0 else tick + 1 let newGameState = modifyTickInState gameState newTick case nextChar of Just 'q' -> quit Just ' ' -> do let gunSprite = getGun gameState let bullets = getGunBullets gameState let nb = newGunBullet $ spriteGunXY gunSprite runDraw nb let newGameState' = modifyGunBulletsInState newGameState (nb:bullets) moveGunSprite nextChar newGameState' _ -> moveGunSprite nextChar newGameState moveGunSprite :: Maybe Char -> GameState -> IO () moveGunSprite nextChar gameState = do let gunSprite = getGun gameState case nextChar of Just '.' -> do let rightGunSprite = moveSprite (1,0) gunSprite runBlank gunSprite runDraw rightGunSprite let newGameState = modifyGunInState gameState rightGunSprite collisions newGameState Just ',' -> do let leftGunSprite = moveSprite (-1,0) gunSprite runBlank gunSprite runDraw leftGunSprite let newGameState = modifyGunInState gameState leftGunSprite collisions newGameState _ -> do collisions gameState collisions :: GameState -> IO () collisions gameState = do let tick = getTick gameState case (tick `mod` bulletDelay == 0) of True -> do let gunBullets = getGunBullets gameState let invaders = getInvaders gameState let explosions = getExplosions gameState let gun = getGun gameState let invBullets = getInvBullets gameState let score = getScore gameState let lives = getLives gameState let (remGunBullets, remInvaders, collision) = bulletInvaderCollide gunBullets invaders let newInvExplosions = map (\coord -> newExplosion coord) collision let remInvBullets = bulletGunCollide invBullets gun let isGunHit = length remInvBullets < length invBullets let (newGunExplosion, newLives) = case isGunHit of True -> ([newExplosion $ spriteXY gun], lives - 1) False -> ([], lives) if newLives == 0 then quit else return () if isGunHit then (runI $ writeAt (1,18) ("Lives: " ++ show newLives) end) else return () sequence_ $ map runDraw (newGunExplosion ++ newInvExplosions) let newGameState1 = modifyExpsInState gameState (newGunExplosion ++ newInvExplosions ++ explosions) let newGameState2 = modifyInvadersInState newGameState1 remInvaders let newGameState3 = modifyGunBulletsInState newGameState2 remGunBullets let newScore = 1000 * length collision if newScore /= 0 then (runI $ writeAt (1,19) ("Score: " ++ (show (score + newScore))) end) else return () let newGameState4 = modifyScoreInState newGameState3 (score + newScore) let newGameState5 = modifyLivesInState newGameState4 newLives let newGameState6 = modifyInvBulletsInState newGameState5 remInvBullets updateExplosions newGameState6 False -> updateExplosions gameState updateExplosions :: GameState -> IO () updateExplosions gameState = do let tick = getTick gameState let explosions = getExplosions gameState case (tick `mod` explosionDelay == 0) of True -> do let visibleExplosions = filter (not . explodeFinish) explosions let newExplosions = map changeExplosImg visibleExplosions sequence_ $ map runBlank explosions sequence_ $ map runDraw newExplosions let newGameState = modifyExpsInState gameState newExplosions moveBullets newGameState False -> moveBullets gameState changeExplosImg :: Sprite -> Sprite changeExplosImg (Sprite coord gunOffset images imgIndex maxIndex vis motion motIndex maxMot) = Sprite coord gunOffset images (imgIndex+1) maxIndex vis motion motIndex maxMot explodeFinish :: Sprite -> Bool explodeFinish (Sprite _ _ _ imgIndex maxIndex _ _ _ _) = imgIndex == maxIndex bulletInvaderCollide :: Bullets -> Invaders -> (Bullets, Invaders, [Coordinate]) bulletInvaderCollide [] invaders = ([], invaders, []) bulletInvaderCollide (b:bs) invaders = case collideAny b invaders [] of Nothing -> let (restBs, restInvaders, restColls) = bulletInvaderCollide bs invaders in (b:restBs, restInvaders, restColls) Just (survivers, collision) -> let (restBs, restInvaders, restColls) = bulletInvaderCollide bs survivers in (restBs, restInvaders, collision:restColls) where collideAny :: Sprite -> [Sprite] -> [Sprite] -> Maybe ([Sprite], Coordinate) collideAny _ [] _ = Nothing collideAny bullet (inv:invs) acc = if spriteXY bullet == spriteXY inv then Just ((acc ++ invs), spriteXY inv) else collideAny bullet invs (inv:acc) bulletGunCollide :: Bullets -> Gun -> Bullets bulletGunCollide [] _ = [] bulletGunCollide (b:bs) gun | spriteXY b == spriteXY gun = bs | otherwise = b : bulletGunCollide bs gun moveBullets :: GameState -> IO () moveBullets gameState = do let gunBullets = getGunBullets gameState let invBullets = getInvBullets gameState let tick = getTick gameState let visibleGunBullets = takeWhile (\s -> spriteY s > 0) gunBullets -- let visibleInvBullets = takeWhile (\s -> spriteY s <= 17) invBullets let (visibleInvBullets, invisibleInvBullets) = span (\s -> spriteY s <= 17) invBullets sequence_ $ map runBlank invisibleInvBullets case (tick `mod` bulletDelay == 0) of True -> do let movedGunBullets = moveSprites (0,-1) visibleGunBullets sequence_ $ map runBlank gunBullets sequence_ $ map runDraw movedGunBullets let newGameState1 = modifyGunBulletsInState gameState movedGunBullets let movedInvBullets = moveSprites (0,1) visibleInvBullets sequence_ $ map runBlank invBullets sequence_ $ map runDraw movedInvBullets let newGameState2 = modifyInvBulletsInState newGameState1 movedInvBullets moveInvaders newGameState2 False -> do let newGameState1 = modifyGunBulletsInState gameState visibleGunBullets let newGameState2 = modifyInvBulletsInState newGameState1 visibleInvBullets moveInvaders newGameState2 moveInvaders :: GameState -> IO () moveInvaders gameState = do let invaders = getInvaders gameState let tick = getTick gameState let (visibleInvaders, invisibleInvaders) = partition (\i -> spriteY i < 16) invaders -- = filter (\i -> spriteY i < 18) invaders if visibleInvaders == [] then nextLevel gameState else return () sequence_ $ map runBlank invisibleInvaders case (tick `mod` invaderMoveDelay == 0) of True -> do let invadersMoved = map updateInvaderPosAndImg visibleInvaders sequence_ $ map runBlank invaders sequence_ $ map runDraw invadersMoved let newState = modifyInvadersInState gameState invadersMoved spawnInvaderBullets newState False -> do let newState = modifyInvadersInState gameState visibleInvaders spawnInvaderBullets newState spawnInvaderBullets :: GameState -> IO () spawnInvaderBullets gameState = do let invaders = getInvaders gameState let invBullets = getInvBullets gameState let tick = getTick gameState case (tick `mod` invBulletSpawnDelay == 0) of True -> do randomInvader <- randomInRange 0 ((length invaders) - 1) let bulletCoord = spriteGunXY (invaders !! randomInvader) let newState = modifyInvBulletsInState gameState ((newInvBullet bulletCoord):invBullets) loopInput newState False -> loopInput gameState updateInvaderPosAndImg :: Sprite -> Sprite updateInvaderPosAndImg (Sprite (sx,sy) gunOffset images imageIndex maxImIndex vis mSeq mInd maxInd) = Sprite (sx + xOffset, sy + yOffset) gunOffset images newImgIndex maxImIndex vis mSeq newMotIndex maxInd where newMotIndex = if mInd == maxInd then 0 else mInd + 1 (xOffset, yOffset) = mSeq !! mInd newImgIndex = if imageIndex == maxImIndex then 0 else imageIndex + 1 runBlank :: Sprite -> IO () runBlank s = runI (blankSprite s end) runDraw :: Sprite -> IO () runDraw s = runI (drawSprite s end) moveSprites :: Coordinate -> [Sprite] -> [Sprite] moveSprites (dx,dy) sprites = map (moveSprite (dx,dy)) sprites main :: IO () main = do hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering hSetEcho stdout False let initLives = 3 let initScore = 0 let initLevel = 1 nextLevel $ makeGameState 0 exampleGunSprite2 [] initInvaders [] [] initScore initLives initLevel nextLevel :: GameState -> IO () nextLevel gameState = do let level = getLevel gameState let score = getScore gameState let lives = getLives gameState let gun = getGun gameState let action1 = writeAt (20,10) ("Space Invaders: level " ++ show level) let action2 = writeAt (20,11) "Press any key to start" let action3 = writeAt (20,12) "left = ',', right = '.'" let action4 = writeAt (20,13) "quit = 'q'" let action5 = writeAt (20,14) "fire = spacebar" let action6 = writeAt (20,15) "make sure your screen is 80 cols wide, 20 lines deep" runI $ clearScreen $ action1 $ action2 $ action3 $ action4 $ action5 $ action6 end nextKey <- readKeyBoard 10000 case nextKey of Just 'q' -> quit _ -> do runI $ clearScreen end runDraw gun runI $ writeAt (1,18) ("Lives: " ++ show lives) end runI $ writeAt (1,19) ("Score: " ++ show score) end runI $ writeAt (1,20) ("Level: " ++ show level) end let newGameState1 = modifyLevelInState gameState (level + 1) let newGameState2 = modifyInvadersInState newGameState1 initInvaders loopInput newGameState2 quit :: IO () quit = do let _ = writeAt (20,15) "Game Over" let _ = writeAt (20,16) "Thankyou for playing space invaders" let _ = writeAt (20,17) "The planet is once again safe" let action4 = moveTo (1,1) -- runI $ clearScreen $ action1 $ action2 $ action3 $ action4 end runI $ action4 end exitWith ExitSuccess initInvaders :: [Sprite] initInvaders = row1 ++ row2 ++ row3 where row1 = [newInvader1 (x, 1) | x <- [5,15..65]] row2 = [newInvader2 (x, 3) | x <- [10,20..70]] row3 = [newInvader1 (x, 5) | x <- [5,15..65]] randomInRange :: Int -> Int -> IO Int randomInRange lo hi = getStdRandom (randomR (lo, hi))