Created
September 10, 2013 20:39
-
-
Save flq/6515336 to your computer and use it in GitHub Desktop.
A subset of the Space invaders game with moving left/right, shooting with space. The "game" ends when exiting with x or all enemies being dead.h
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Control.Monad | |
import Data.List (maximumBy,minimumBy,find,(\\)) | |
import Data.Ord | |
import Graphics.UI.SDL as FX | |
type Point = (Int,Int) | |
type MovementPattern = [(Movement, [(Int, Int)] -> Bool)] | |
data WorldItem = Enemy Point Int | Hero Point | Shot Point | |
data Movement = Rght | Dwn | Lft deriving Show | |
instance Eq WorldItem where | |
(==) (Enemy _ pos) (Enemy _ pos') = pos == pos' | |
(==) (Shot p) (Shot p') = p == p' | |
(==) _ _ = False | |
data World = World | |
{ | |
canvas :: Surface, | |
lastKey :: SDLKey, | |
enemyPosition :: Point, | |
enemyMovement :: MovementPattern, | |
mIA :: [WorldItem], | |
heroPosition :: Point, | |
heroShots :: [WorldItem], | |
actors :: [World -> (World,[WorldItem])] | |
} | |
_enemyGrid = (4,8) | |
initWorld canvas = World | |
{ | |
enemyPosition = (5,5), | |
enemyMovement = [(Rght,(<=620) . maxX), (Dwn, \_ -> False), (Lft,(>=0) . minX), (Dwn, \_ -> False)], | |
mIA = [], | |
heroPosition = (310,450), | |
heroShots = [], | |
lastKey = SDLK_UNKNOWN, | |
canvas = canvas, | |
actors = [enemiesActor, heroActor, shotsActor,exitActor] | |
} | |
enemiesActor :: World -> (World,[WorldItem]) | |
enemiesActor w = (newState, enemies) | |
where | |
enemies = enemyGrid (enemyPosition w) _enemyGrid | |
(shotsLeft,deadEnemies) = kill enemies (heroShots w) [] | |
newMovePattern = evaluateMovePattern (map (\(Enemy p _) -> p) enemies) (enemyMovement w) | |
requiredChange = case (fst newMovePattern) of | |
Rght -> changeX (+3) | |
Lft -> changeX (+(-3)) | |
Dwn -> changeY (+10) | |
newState = w | |
{ | |
enemyPosition = requiredChange (enemyPosition w), | |
enemyMovement = snd newMovePattern, | |
heroShots = shotsLeft, | |
mIA = (mIA w) ++ deadEnemies | |
} | |
enemyGrid (originX,originY) (rows, cols) = | |
(zipWith Enemy | |
[ (x,y) | x <- take cols [originX,originX+60..], y <- take rows [originY,originY+30..]] | |
[1..]) \\ (mIA w) | |
heroActor :: World -> (World,[WorldItem]) | |
heroActor w = (newState, (hero newState)) | |
where | |
newState = case (lastKey w) of | |
SDLK_LEFT -> move (+(-10)) | |
SDLK_RIGHT -> move (+10) | |
_ -> w | |
hero (World { heroPosition = p }) = [(Hero p)] | |
move f = w { heroPosition = changeX f (heroPosition w) } | |
shotsActor :: World -> (World,[WorldItem]) | |
shotsActor w = (newState, (heroShots newState)) | |
where | |
newState = case (lastKey w) of | |
SDLK_SPACE -> w { heroShots = (move (heroShots w)) ++ [newShot], lastKey = SDLK_UNKNOWN } | |
_ -> w { heroShots = move (heroShots w) } | |
move = map (\(Shot (x,y)) -> Shot (x, y-10)) | |
newShot = Shot ((+10) $ getX $ heroPosition w,430) | |
exitActor :: World -> (World,[WorldItem]) | |
exitActor w | |
| length (mIA w) == 32 = (w { lastKey = SDLK_x },[]) | |
| otherwise = (w, []) | |
main :: IO () | |
main = init >>= (loop . initWorld) | |
where | |
init = FX.init [InitVideo] >> (FX.setVideoMode 640 480 32 []) >> FX.getVideoSurface | |
loop :: World -> IO () | |
loop world = do | |
if (lastKey world) == SDLK_x then | |
FX.quit | |
else | |
FX.pollEvent >>= handleEvent | |
where | |
handleEvent x = case x of | |
KeyDown (Keysym SDLK_x _ _) -> FX.quit | |
KeyDown (Keysym key _ _) -> render key >>= loop | |
KeyUp _ -> render SDLK_UNKNOWN >>= loop | |
x -> render (lastKey world) >>= loop | |
render e = do | |
let c = canvas world | |
FX.fillRect c Nothing $ Pixel 0x0 | |
let (newWorld,items) = foldl runActor (world { lastKey = e }, []) $ actors world | |
mapM (\wi -> FX.fillRect c (Just $ getRect wi) (getPixel wi)) items | |
FX.flip c | |
FX.delay 40 | |
return newWorld | |
runActor (wld, items) actor = (newWorld, items++moreItems) | |
where (newWorld,moreItems) = actor wld | |
evaluateMovePattern :: [(Int,Int)] -> MovementPattern -> (Movement,MovementPattern) | |
evaluateMovePattern items pattern = | |
case (evaluate items) of | |
True -> next pattern | |
False -> next newPattern | |
where | |
evaluate = snd $ head pattern | |
next p = (nextMove p, p) | |
newPattern = roll pattern | |
nextMove (m:ms) = fst m | |
kill :: [WorldItem] -> [WorldItem] -> [WorldItem] -> ([WorldItem],[WorldItem]) | |
kill [] remainingShots dead = (remainingShots,dead) | |
kill _ [] dead = ([],dead) | |
kill (e:enemies) shots dead = | |
case (find (intersect e) shots) of | |
Just shot -> kill enemies (shots \\ [shot]) (dead++[e]) | |
Nothing -> kill enemies shots dead | |
intersect wi wi' = (getRect wi) # (getRect wi') | |
where | |
(#) (Rect x y w h) (Rect x' y' w' h') = | |
(y + h) > y' && y < (y' + h') && (x + w) > x' && x < (x' + w') | |
changeX f (x,y) = (f x, y) | |
changeY f (x,y) = (x, f y) | |
getX :: Num a => (a,a) -> a | |
getX (x,_) = x | |
roll (x:xs) = xs++[x] | |
boundX f = getX . (f $ comparing getX) | |
maxX = boundX maximumBy | |
minX = boundX minimumBy | |
getRect (Enemy (x,y) _) = Rect x y 20 10 | |
getRect (Hero (x,y)) = Rect x y 25 15 | |
getRect (Shot (x,y)) = Rect x y 5 6 | |
getPixel (Enemy _ _) = Pixel 0xFFFFFF | |
getPixel (Hero _) = Pixel 0xFF0000 | |
getPixel (Shot _) = Pixel 0xFFFF00 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment