Skip to content

Instantly share code, notes, and snippets.

@flq
Created September 10, 2013 20:39
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save flq/6515336 to your computer and use it in GitHub Desktop.
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
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