-- A wee asteroids game. module Main (main) where import Asteroids.Geometry import Graphics.HGL.Run (runGraphics) import Graphics.HGL.Window (Event(..), RedrawMode(..), Window(), closeWindow, getWindowTick, maybeGetWindowEvent, openWindowEx, setGraphic) import Graphics.HGL.Units (Point()) import Graphics.HGL.Utils (Color(..), drawInWindow, getKey, overGraphics, withColor, withRGB) import Graphics.HGL.Draw.Monad (Graphic()) import Graphics.HGL.Draw.Text (text, RGB(..)) import Graphics.HGL.Key (isCharKey, isEscapeKey, isLeftKey, isRightKey, isUpKey, keyToChar, Key) import System.Random (Random,randomRIO) -- to make ghc happy -- delete for hugs fromInt :: Num a=> Int-> a fromInt = fromInteger . toInteger type Vector= Point data State = State { bullets :: [Bullet], asteroids :: [Asteroid], ship :: Ship } data Ship = Ship { pos :: Point, -- Position shp :: Shape, -- Shape vel :: Vector, -- Velocity (as a vector) ornt :: Double, -- Orientation (of spaceship) thrust :: Double, -- Thrust hAcc :: Double -- Winkelbeschleungigung } -- deriving Show data Bullet = Bullet { bpos :: Point, -- Position bshp :: Shape, -- Shape bvel :: Vector, -- Velocity (does not change) cnt :: Int -- Counter; when it reaches bTTL, -- the bullet expires and goes away } data Asteroid = Asteroid {fig :: Figure, -- shapely figure :-) ashp :: Shape, -- Shape apos :: Point, -- Position avel :: Vector, -- Velocity (does not change) size :: ASize -- size: large, medium, wee. } data ASize = ALarge | AMedium | AWee initialState :: State initialState = State {ship= -- initial ship position: middle of screen, -- no movement, facing north (i.e. upwards) setShp(Ship { pos= (fst winSize `div` 2, snd winSize `div` 2), vel= (0, 0), ornt= pi/2, thrust= 0, hAcc= 0}), bullets= [], asteroids= []} -- parameters winSize :: (Int, Int) winSize = (1000, 800) aDelta :: Double aDelta = 1 -- thrust vMax :: Double vMax = 20 -- maximal velocity, in pixels per frame hDelta :: Double hDelta = 0.3 -- Winkelbeschleunigung vB :: Double vB = 30 -- velocity of a bullet bTTL :: Int bTTL = 20 -- a single bullet moves that many frames (i.e. vB*bTTL pixels) vAst :: Int vAst = 5 -- all asteroids move that fast -- This is our space ship (drawn with orientation 0) spaceShip :: Figure spaceShip = Polygon [(15, 0), (-15, 10), (-10, 0), (-15, -10), (15, 0)] -- Auxiliary functions addWinMod :: (Int,Int) -> (Int,Int) -> (Int,Int) addWinMod (a, b) (c, d)= ((a+ c) `mod` (fst winSize), (b+ d) `mod` (snd winSize)) setShp :: Ship-> Ship setShp s = s{shp= shape (Translate (pos s) (Rotate (ornt s) spaceShip))} setBShp :: Bullet-> Bullet setBShp b = b{bshp= shape (Translate (bpos b) (Circle 2))} setAShp :: Asteroid-> Asteroid setAShp a = a{ashp= shape (Translate (apos a) (fig a))} -- Drawing stuff drawState :: State-> Graphic drawState s = overGraphics (drawShip (ship s): map drawBullet (bullets s) ++ map drawAsteroid (asteroids s)) drawShip :: Ship-> Graphic drawShip s = withColor (if thrust s> 0 then Red else Blue) (drawShape (shp s)) drawBullet :: Bullet-> Graphic drawBullet b = withColor Red (drawShape (bshp b)) drawAsteroid :: Asteroid-> Graphic drawAsteroid a = withRGB (RGB 100 100 100) (drawShape (ashp a)) -- The asteroids randomPt :: IO Point randomPt = random2IO ((0, fst winSize), (0, snd winSize)) random2IO :: ((Int, Int), (Int, Int))-> IO (Int, Int) random2IO ((xmin, ymin), (xmax, ymax)) = do x<- randomRIO (xmin, xmax) y<- randomRIO (ymin, ymax) return (x, y) newAsteroid :: IO Asteroid newAsteroid = do position <- randomPt cs <- randomRIO (4, 8) -- number of corners pts <- mapM (\angle-> do r <- randomRIO (30::Double, 50) return (polar r angle)) (tail [0::Double, 2*pi/fromInt cs .. 2*pi]) randomRIO (0::Double, 2*pi) ve <- random2IO ((-vAst, -vAst), (vAst, vAst)) return (setAShp(Asteroid{fig= Polygon pts, apos= position, avel= ve, size= ALarge})) createAsteroids :: State-> IO State createAsteroids s = do asts <- sequence (replicate 5 newAsteroid) return s{asteroids= asts} moveAsteroid :: Asteroid-> Asteroid moveAsteroid a = setAShp a{apos= addWinMod (apos a) (avel a)} checkAsteroids :: State-> [Asteroid]-> IO [Asteroid] checkAsteroids _ [] = return [] checkAsteroids s (a:as) = do rest <- checkAsteroids s as if any (contains (ashp a)) (map bpos (bullets s)) then -- asteroid hit, it detonates do dirs <- directions (avel a) return (explode a dirs ++ rest) else return (a:rest) where explode :: Asteroid-> [Point]-> [Asteroid] explode (Asteroid{size= ALarge, apos= p, fig= f}) = map (\v-> setAShp (Asteroid{fig= Scale 0.5 f, apos= p, avel= v, size= AMedium})) explode (Asteroid{size= AMedium, apos= p, fig= f}) = map (\v-> setAShp (Asteroid{fig= Scale 0.75 f, apos= p, avel= v, size= AWee})) explode (Asteroid{size= AWee}) = const [] directions :: Point-> IO [Point] directions (vx, vy) = do num <- randomRIO (1, 3) vxs <- sequence (replicate num (randomRIO (-vx, vx))) vys <- sequence (replicate num (randomRIO (-vy, vy))) return (map (add (vx, vy)) (zip vxs vys)) -- The bullets and the ship -- create a new bullet, starting from the position of the ship newBullet :: State-> State newBullet (s@(State{bullets= b, ship= Ship{pos= position, ornt= o}}))= s{bullets= Bullet{bpos= position, bvel= polar vB o, cnt= 0}: b} -- Move and expire bullets moveBullets :: [Bullet]-> [Bullet] moveBullets bs = filter (\b-> cnt b< bTTL) (map moveOne bs) where moveOne (Bullet{bpos= op, bvel= bv, cnt= c})= Bullet{bpos= addWinMod op bv, bvel= bv, cnt= c+1} -- Calculate ship movement and new position moveShip :: Ship-> Ship moveShip(Ship {pos= pos0, vel= vel0, hAcc= hAcc, thrust= t, ornt= o}) = setShp $ Ship{pos= addWinMod pos0 vel1, vel= if l> vMax then smult (vMax/l) vel1 else vel1, thrust= t, ornt= o+ hAcc, hAcc= hAcc} where vel1= add (polar t o) vel0 l = len vel1 shipCrashed :: State-> Bool shipCrashed (State{ship= Ship{shp=f}, asteroids= ast}) = any (intersect f) (map ashp ast) loop :: Window-> State-> IO () loop w s = do setGraphic w (drawState s) if shipCrashed s then do drawInWindow w (text (pos (ship s)) "BOING!") untl (getKey w >>= return . isEscapeKey) else do getWindowTick w evs<- getEvs t<- nextState evs s loop w t where nextState :: [Event]-> State-> IO State nextState evs t = do ast<- checkAsteroids s2 (asteroids s2) return s2{asteroids= ast} where s2= State {ship= moveShip (ship s1), bullets= map setBShp (moveBullets (bullets s1)), asteroids= map moveAsteroid (asteroids s1)} where s1= foldl (flip procEv) t evs -- get list of all events since last tick getEvs :: IO [Event] getEvs = do x<- maybeGetWindowEvent w -- putStrLn ("Reporting event "++ show x) case x of Nothing -> return [] Just e -> do rest <- getEvs return (e : rest) procEv :: Event-> State-> State procEv (Key {keysym= k, isDown=down}) | isLeftKey k && down = sethAcc hDelta | isLeftKey k && not down = sethAcc 0 | isRightKey k && down = sethAcc (- hDelta) | isRightKey k && not down = sethAcc 0 | isUpKey k && down = setThrust aDelta | isUpKey k && not down = setThrust 0 | isKey ' ' k && down = newBullet procEv _ = id sethAcc :: Double->State-> State sethAcc a t = s{ship= (ship t){hAcc= a}} setThrust :: Double-> State-> State setThrust a t = s{ship= (ship t){thrust= a}} untl :: IO Bool-> IO () untl a = a >>= \ b-> if b then return () else untl a isKey :: Char-> Key-> Bool isKey c k = isCharKey k && (keyToChar k == c) main :: IO () main = runGraphics (do w<- openWindowEx "Asteroids!" Nothing winSize DoubleBuffered (Just 20) s<- createAsteroids initialState loop w s closeWindow w)