haskell-in-space (empty) → 0.1
raw patch · 8 files changed
+1715/−0 lines, 8 filesdep +HGLdep +basedep +haskell98setup-changed
Dependencies added: HGL, base, haskell98, random
Files
- Asteroids-aufgabe.hs +304/−0
- Asteroids-basic.hs +270/−0
- Asteroids-haskelly.hs +848/−0
- Asteroids-space.hs +98/−0
- Asteroids/Geometry.hs +129/−0
- LICENSE +28/−0
- Setup.hs +5/−0
- haskell-in-space.cabal +33/−0
+ Asteroids-aufgabe.hs view
@@ -0,0 +1,304 @@+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, overGraphics, withColor) +import Graphics.HGL.Draw.Monad (Graphic()) +import Graphics.HGL.Draw.Text (text) +import Graphics.HGL.Key (isControlLKey, isDownKey, isLeftKey, isRightKey, isUpKey) + +-- to make ghc happy -- delete for hugs +fromInt :: Num a=> Int-> a +fromInt n = fromInteger (toInteger n) + +data State = State { ship :: Ship, bullets :: [Bullet], asteroids :: [Asteroid], game :: Game } + +data Ship = + Ship { pos :: Point, + shp :: Shape, + vel :: Point, + ornt :: Double, + thrust :: Double, + hAcc :: Double, + bbox :: BBox} + deriving (Eq) + +data Bullet = + Bullet { posB :: Point, + shpB :: Shape, + velB :: Point, + time :: Int, + bboxb :: BBox} + deriving (Eq) + +data Asteroid = + Asteroid { posA :: Point, + shpA :: Shape, + velA :: Point, + size :: Int, + bboxa :: BBox} + deriving (Eq) + +data Game = Over | Continue + deriving (Eq) + +type BBox = (Point, Point) + +spaceShip :: Figure +spaceShip = Polygon [(10, 4), (-10, 10), (-15, 0), (-10, -10), (10, -4), (0, -4) , (0, 4), (10, 4)] + +spaceShipBox :: BBox +spaceShipBox = ((-15, -15), (15, 15)) + +asteroid :: [Point] +asteroid = [(8, 0), (2, 6), (-6, 4), (-6, -4), (2, -6), (8, 0)] + +asteroidBox :: BBox +asteroidBox = ((-8, -8), (8, 8)) + +asteroidS :: Figure +asteroidS = Polygon asteroid + +asteroidM :: Figure +asteroidM = Polygon (map (\(x, y) -> (2*x, 2*y)) asteroid) + +asteroidL :: Figure +asteroidL = Polygon (map (\(x, y) -> (4*x, 4*y)) asteroid) + +asteroidList :: [Figure] +asteroidList = asteroidS:asteroidM:asteroidL:[] + +bulletBox :: BBox +bulletBox = ((-2, -2), (2, 2)) + +bullet :: Figure +bullet = Polygon [(2, 0), (-1, -1), (-1, 1), (2, 0)] + +winSize :: (Int, Int) +winSize = (1000, 800) + +aDelta :: Double +aDelta = 1 + +vMax :: Double +vMax = 20 + +hDelta :: Double +hDelta = 0.3 + +maxBTime :: Int +maxBTime = 48 + +maxAsteroids :: Int +maxAsteroids = 6 + +minAstDir :: Double +minAstDir = (- pi) + +maxAstDir :: Double +maxAstDir = pi + +-- asteroidNumber :: IO Int +-- asteroidNumber = randomRIO (1, maxAsteroids) +asteroidNumber :: Int +asteroidNumber = maxAsteroids + +-- asteroidDirection :: IO Double +-- asteroidDirection = randomRIO (minAstDir, maxAstDir) +asteroidDirection :: Double +asteroidDirection = 1.0 + +boxAsteroid :: Point -> Int -> BBox +boxAsteroid p s = translate (resize asteroidBox sze) p + where sze = s + 1 + +translate :: BBox -> Point -> BBox +translate (a, b) c = (addWinMod a c, addWinMod b c) + +resize :: BBox -> Int -> BBox +resize ((xa, ya), (xb, yb)) s = ((s * xa, s * ya), (s * xb, s * yb)) + +initialState :: State +initialState = + State {ship= setShp $ + Ship{pos= shipPos, vel= (0, 0), ornt= pi/2, + thrust= 0, hAcc= 0, bbox = translate spaceShipBox shipPos}, + bullets = [], asteroids = + Asteroid{posA = ast1, velA = (1, 1), + bboxa = boxAsteroid ast1 2, + shpA = shape (Translate ast1 asteroidL), size = 2}: + Asteroid{posA = ast2, velA = (1, -1), + bboxa = boxAsteroid ast2 2, + shpA = shape (Translate ast2 asteroidL), size = 2}: + Asteroid{posA = ast3, velA = (-1, 1), + bboxa = boxAsteroid ast3 2, + shpA = shape (Translate ast3 asteroidL), size = 2}: + Asteroid{posA = ast4, velA = (-1, -1), + bboxa = boxAsteroid ast4 2, + shpA = shape (Translate ast4 asteroidL), size = 2}:[], + game = Continue} + where + minXP = 100 + minYP = 100 + maxXP = fst winSize - 100 + maxYP = snd winSize - 100 + ast1 = (minXP, minYP) + ast2 = (minXP, maxYP) + ast3 = (maxXP, minYP) + ast4 = (maxXP, maxYP) + shipPos = (fst winSize `div` 2, snd winSize `div` 2) + +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 + +setShp :: Ship-> Ship +setShp s = s{shp= shape (Translate (pos s) + (Rotate (ornt s) spaceShip)), + bbox = translate spaceShipBox (pos s)} + +moveAsteroids :: [Asteroid] -> [Asteroid] +moveAsteroids [] = [] +moveAsteroids (Asteroid{posA = pa, velA = va, size = s}:as) = + Asteroid{posA = position, shpA = shape (Translate position (asteroidList !! s)), + velA = va, size = s, bboxa = boxAsteroid position s}:(moveAsteroids as) + where position = addWinMod pa va + +moveBullets :: [Bullet] -> [Bullet] +moveBullets [] = [] +moveBullets (Bullet{posB = pb, velB = vb, time = tb}:bs) + | tb >= maxBTime = moveBullets bs + | otherwise = Bullet{posB = position, shpB = shape (Translate position bullet), + velB = vb, time = tb + 1, bboxb = translate bulletBox position}:(moveBullets bs) + where position = addWinMod pb vb + +addWinMod :: (Int,Int) -> (Int,Int) -> (Int,Int) +addWinMod (a, b) (c, d)= + ((a+ c) `mod` (fst winSize), + (b+ d) `mod` (snd winSize)) + +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 Blue else if thrust s< 0 then Yellow else Green) + (drawShape (shp s)) + +drawAsteroid :: Asteroid -> Graphic +drawAsteroid a = withColor White (drawShape (shpA a)) + +drawBullet :: Bullet -> Graphic +drawBullet b = withColor Red (drawShape (shpB b)) + +lostState :: State -> State +lostState st = st{game = Over} -- nicht komplett + +wonState :: State -> State +wonState st = st{game = Over} -- auch nicht komplett + +bounding :: BBox -> BBox -> Bool +bounding ((xa, ya), (xb, yb)) ((xc, yc), (xd, yd)) + | yd < ya || yc > yb || xd < xa || xc > xb = False + | otherwise = True + +checkIntersections :: State -> State +checkIntersections st@State{ship = s, asteroids = a, bullets = b} + | a == [] = wonState st + | or [intersect (shp s) x | Asteroid{shpA = x, bboxa = xa} <- a, bounding xa (bbox s)] = lostState st + | otherwise = st{asteroids = (interSecAst intersecting) ++ [x | x <- a, not (elem x intersecting)], + bullets = [bul | bul@Bullet{shpB = x} <- b, + not (or [intersect x y | Asteroid{shpA = y} <- intersecting])]} + where intersecting = [x | x@Asteroid{shpA = xa, bboxa = ya} <- a, + or [intersect xa xb| Bullet{shpB = xb, bboxb = yb} <- b, + bounding ya yb]] + +interSecAst :: [Asteroid] -> [Asteroid] +interSecAst [] = [] +interSecAst (a:as) + | s == 0 = interSecAst as + | otherwise = [Asteroid{posA = p, size = (s - 1), + shpA = shape (Translate p (asteroidList !! (s - 1))), + velA = rot (asteroidDirection + (pi - (fromInt (mod n (maxAsteroids + 1))))) (3 - s, 3 - s), + bboxa = translate (resize asteroidBox (s + 1)) p} | n <- [1..asteroidNumber]] ++ + interSecAst as + where + s = (size a) + p = (posA a) + +loop :: Window-> State-> IO () +loop w s = + do setGraphic w (drawState s) + getWindowTick w + evs<- getEvs + t <- nextState evs s + loop w t + where + +-- gameOver :: State -> IO () +-- gameOver s +-- | (game s) == Over = +-- do drawInWindow w (text (fst winSize `div` 2, snd winSize `div` 2) "You lost!!!!") +-- | [(0::Int)| x <- (asteroids s)] == [] = +-- do drawInWindow w (text (fst winSize `div` 2, snd winSize `div` 2) "You won!") +-- | otherwise = loop w s + + nextState :: [Event]-> State-> IO State + nextState evs t = + do return $ checkIntersections s1{ship= moveShip (ship s1), + asteroids = moveAsteroids (asteroids s1), + bullets = moveBullets (bullets s1)} + where + s1= foldl (flip procEv) t evs + + getEvs :: IO [Event] + getEvs = do x<- maybeGetWindowEvent w + 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 + | isDownKey k && down = setThrust (- aDelta) + | isDownKey k && not down = setThrust 0 + | isControlLKey k && down = shoot + 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}} + + shoot :: State -> State + shoot t@State{ship = Ship{pos = pos0, ornt = r}, bullets = b} = + t{bullets= b ++ [Bullet{time = 0, velB = speed, + posB = pos0, shpB = shape (Translate (addWinMod pos0 speed) bullet), + bboxb = translate bulletBox pos0}]} + where speed = (rot r (round (1.5 * vMax), 0)) + +main :: IO () +main = runGraphics $ + do w<- openWindowEx "Starshiptroopers II: Bugwars (ft. Spaceman Spiff)" + Nothing winSize DoubleBuffered + (Just 30) + loop w initialState + closeWindow w
+ Asteroids-basic.hs view
@@ -0,0 +1,270 @@+-- 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)++
+ Asteroids-haskelly.hs view
@@ -0,0 +1,848 @@+module Main (main) where -- Spaceman_Spiff 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 (overGraphics, withRGB)+import Graphics.HGL.Draw.Monad (Graphic())+import Graphics.HGL.Draw.Text (text, RGB(..))+import Graphics.HGL.Key (isCharKey, isDownKey, isEscapeKey, isLeftKey, isReturnKey, isRightKey, isTabKey, isUpKey, keyToChar, Key)++import Random (randomRIO, newStdGen, randomRs)+import System.IO.Unsafe (unsafePerformIO)++-- to make ghc happy -- delete for hugs+fromInt :: Num a=> Int-> a+fromInt n = fromInteger (toInteger n)+toInt :: Integral a=> a-> Int+toInt n = fromInteger(toInteger n)++------------------------------------ Edit Sektion --------------------------------------------++-- Fenstergröße: (Default: 700, 600)+winSize :: (Int, Int)+winSize = (900, 900)++-- Spezialtasten: False=Aus, True=Ein (Default: True)+specKeys :: Bool+specKeys = True++-- Hintergrundbild: False=Aus, True=Ein (Default: False)+backgr :: Bool+backgr = True++-- Head-Up Display HUD Konsole: False=Aus, True=Ein (Default: True)+hud :: Bool+hud = True++-- Weitere Informationen an oder aus: False=Aus, True=An (Default: False)+debuginfo :: Bool+debuginfo = False++-- Asteroidensplitter: True=An, False=Aus (Default True)+shrep :: Bool+shrep = True++-- Geschwindigkeit des Schiffs, Default: 10 (ändert auch Projektilgeschwindigkeit/-reichweite)+vMax :: Double+vMax = 15++-- Maximale Anzahl der Projektile, Default: 7+maxBul :: Int+maxBul = 10++-- Farbe des Raumschiffs: 0=Schwarz,1=Weiss,2=Standard,3=Seltsamgrün,4=Merkwürdiggelb (Default: 2)+shipCol :: Int+shipCol = 3++-- Raumschifftyp: 0=Standard, 1=UFO, 2=Turret, 3=Space Shuttle, 4=Millenium Falcon, 5=X-Wing,+-- 6=F-16 Falcon, 7=SR-71 Blackbird, 8=Fokker Dr I+{-# NOINLINE shipTyp #-}+shipTyp :: Int+shipTyp = unsafePerformIO (randomRIO (0,8))++-- Farbe der Projektile: 0=Blau, 1=Rot/Gelb, 2=Violett, 3=Grün (Default: 0)+bulCol :: Int+bulCol = 3++-- Form der Projektile: 0=Line, 1=Circle (Default: 1)+bulFig :: Int+bulFig = 1++-- Farbe der Asteroiden: 0=Braun, 1=Grau, 2=Dunkel, 3=Hell (Default: 0)+astCol :: Int+astCol = 3++-- Form der Asteroiden: 0=Rund, 1=Eckig, 2=Borg-Kuben (Default: 0)+astFig :: Int+astFig = 2++-- Initialgeschwindigkeit der Asteroiden (Default: 4)+astSpd :: Int+astSpd = 5++-- Waffen-Reichweite in Fensterbreiten (Default 0.7)+wpRange :: Double+wpRange = 0.7++-- Schiff bewegungslos (Turret-Funktion): True=Ja, False=Nein (Default: False)+static :: Bool+static = False++-- Godmode (Kollision Schiff/Asteroid aus): True=Ja, False=Nein (Default: False)+godmode :: Bool+godmode = False++-- Anzahl der Ladungen des Starburst-Streuwaffensystems (Default: 10)+bursts :: Int+bursts = 15++-------------------------------------- Edit Ende ---------------------------------------------+++---------------------------------- Ressourcen Sektion ----------------------------------------+++data State = State { ship :: Ship, -- Schiff+ bullets :: BulletList, -- Liste aller Bullets+ shrepnels :: ShrepList, -- Liste aller Spliter+ asteroids :: AstList, -- Liste aller Asteroiden+ spaces :: SpaceList, -- Liste der Hintergrundgrafiken+ mission :: Mission, -- Zufallszahlen für die Texte+ stats :: Stats, -- Statistikwerte+ end :: Bool, -- Ende?+ rsCnt :: Int -- Neustartverzögerung+ }++data Ship = Ship { -- Schiff+ spos :: Point, -- Position+ sshp :: Shape, -- Form+ svel :: Point, -- Geschwindigkeitsvektor+ ornt :: Double, -- Orientierung+ thrust :: Double, -- Schubwert der Längsrichtig+ hthrust :: Double, -- Schubwert der Querrichtig+ hAcc :: Double, -- Drehwert+ shipDes :: Bool, -- Schiff zerstört?+ sbur :: Int} -- Anzahl der Starbursts++type BulletList = [Bullet]+data Bullet = Bullet { -- Projektil+ bpos :: Point, -- Position+ bshp :: Shape, -- Form+ bvel :: Point, -- Geschwindigkeitsvektor+ bcou :: Double, -- Zähler für das Verschwinden+ bort :: Double, -- Orientierung+ bcol :: Int} -- Farbe++type ShrepList = [Shrepnel]+data Shrepnel = Shrepnel { -- Splitter+ gpos :: Point, -- Position+ gshp :: Shape, -- Form+ gvel :: Point, -- Geschwindigkeitsvektor+ gcnt :: Double, -- Zähler für das Verschwinden+ gcol :: Int} -- Farbe++type AstList = [Asteroid]+data Asteroid = Asteroid { -- Asteroid+ asize :: Int, -- Größe+ apos :: Point, -- Position+ ashp :: Shape, -- Form+ avel :: Point, -- Geschwindigkeitsvektor+ aort :: Double} -- Orientierung++type SpaceList = [Space]+data Space = Space { -- Hintergrundobjekt+ upos :: Point, -- Position+ ushp :: Shape, -- Form+ utyp :: Int, -- Typ+ ucol :: Int} -- Farbe++data Mission = Mission { -- Zufallswerte der Zufallstexte+ rndm1 :: Int, -- Zufallszahl für Textliste 1+ rndm2 :: Int, -- Zufallszahl für Textliste 2+ rndm3 :: Int, -- Zufallszahl für Textliste 3+ rndm4 :: Int} -- Zufallszahl für Textliste 4++data Stats = Stats { -- Statistik+ fails :: Int, -- Fehlschüsse+ spl :: Int, -- Gesamtschüsse+ hits :: Int, -- Treffer+ ratio :: Int} -- Treffer/Fehlschuss-Verhältnis+++aDelta :: Double -- Schubkonstante des Schiffs+aDelta = 1++hDelta :: Double -- Drehkonstante des Schiffs+hDelta = 0.3++bSpeed :: Double -- Höchstgeschwindigkeit des Bullets+bSpeed = (vMax*3)++bMaxFlight :: Double -- Maximalreichweite des Bullets+bMaxFlight = (fromInt(fst winSize)* wpRange )/ bSpeed++addWinMod :: (Int,Int) -> (Int,Int) -> (Int,Int) -- sorgt für Umbruch des Space+addWinMod (a, b) (c, d)= ((a+ c) `mod` (fst winSize), (b+ d) `mod` (snd winSize))++------------- Liste der Schiffsformen+spaceShip :: [Figure]+spaceShip = [sfStdrd,sfSaucr,sfTurrt,sfShutl,sfMilln,sfXWing,sfFalcn,sfBBird,sfBaron,sfDestr]++sfStdrd :: Figure+sfStdrd = (Polygon [(15, 0), (-15, 10), (-20, 0), (-15, -10), (15, 0)])+sfSaucr :: Figure+sfSaucr = (Circle 21)+sfTurrt :: Figure+sfTurrt = (Polygon [(28,2),(7,2),(5,8),(-13,12),(-13,-12),(5,-8),(7,-2),(28,-2),(28,2)])+sfXWing :: Figure+sfXWing = (Polygon [(25,-1),(25,1),(6,3),(6,6),(3,6),(3,16),(12,17),(-1,17),+ (-4,6),(-9,6),(-9,4),(-7,4),(-7,-4),(-9,-4),(-9,-6),(-4,-6),(-1,-17),+ (12,-17),(3,-16),(3,-6),(6,-6),(6,-3),(25,-1)])+sfMilln :: Figure+sfMilln = (Polygon [(14,-3),(14,3), (20,3), (20,3), (8,8),(8,11),(12,11),(12,12),(11,13),+ (5,13),(4,10), (3,11),(-2,11),(-6,9),(-9,6),(-11,2),(-11,-2), (-9,-6),+ (-6,-9),(-2,-11),(3,-11),(8,-9),(20,-3),(20,-3),(14,-3)])+sfShutl :: Figure+sfShutl = (Polygon [(22,2),(4,5),(-3,13),(-5,13),(-7,3),(-11,2),(-11,-2),(-7,-3),(-5,-13),+ (-3,-13),(4,-5),(22,-2),(25,0),(22,2)])+sfFalcn :: Figure+sfFalcn = (Polygon [(24,0),(7,3), (0,13),(4,13),(4,14),(-5,14),(-5,13),(-3,13),(-3,2),+ (-7,2),(-11,6),(-13,6),(-13,-6),(-11,-6),(-7,-2),(-3,-2),(-3,-13),+ (-5,-13),(-5,-14),(4,-14),(4,-13),(0,-13),(7,-3),(24,0)])+sfBBird :: Figure+sfBBird = (Polygon [(23,0),(15,2),(4,2),(4,6),(8,6),(3,7),(-1,7),(-5,10),(-7,10),+ (-8,7),(-5,7),(-6,3),(-9,3),(-10,0),(-9,-3),(-6,-3),(-5,-7),(-8,-7),+ (-7,-10),(-5,-10),(-1,-7),(3,-7),(8,-6),(4,-6),(4,-2),(15,-2),(23,0)])+sfBaron :: Figure+sfBaron = (Polygon [ (6,2),(4,2),(4,16),(1,16),(-1,3),(-7,1),(-13,6),(-14,5),(-14,3),(-12,1),+ (-12,-1),(-14,-3),(-14,-5),(-13,-6),(-7,-1),(-1,-3),(-3,-2),(-3,2),(-1,3),+ (2,2),(2,-2),(-1,-3),(1,-16),(4,-16),(4,-2),(6,-2),(6,0),(10,0),(10,3),+ (10,-3),(10,0),(6,0),(6,2) ])+sfDestr :: Figure+sfDestr = (Circle 0)++------------- Liste der Asteroidenformen+assis :: [[Figure]]+assis = [stds,stda,stdb]++stda :: [Figure]+stda = [ (Polygon [(50,0),(35,35),(-20,35),(-40,0),(-40,-20),(0,-40),(30,-35),(50,0)]),+ (Polygon [(45,0),(0,15),(-15,15),(-20,0),(0,-30),(20,-25),(45,0)]),+ (Polygon [(20,0),(0,15),(-10,0),(-8,-8),(20,0)]) ]++stdb :: [Figure]+stdb = [ (Polygon [(0,50),(80,46),(80,-46),(0,-50),(-40,-35),(-40,35),(0,50)]),+ (Polygon [(30,5),(30,25),(-30,25),(-30,-25),(-10,-25),(0,0),(30,5)]),+ (Polygon [(20,5),(-23,8),(-20,-5),(20,-5),(20,5)]) ]++stds :: [Figure]+stds = [ (Circle 50),(Circle 30),(Circle 15)]++------------- Liste der Projektilformen+bulletFig :: [Figure]+bulletFig = [winBul, linBul]++winBul :: Figure+winBul = Polygon [(4,0),(-4,0),(4,0)]++linBul :: Figure+linBul = Circle 3++------------- Splitterform+shreps :: Figure+shreps = (Circle 2)++------------- Liste der Schiffsfarbpaletten+shipPl :: [[RGB]]+shipPl = [shBlk,shWhi,shStd,shGrn,shYlw]++shBlk :: [RGB]+shBlk = [(RGB 0 0 0), (RGB 0 0 0)]+shStd :: [RGB]+shStd = [(RGB 130 130 150), (RGB 160 130 150)]+shWhi :: [RGB]+shWhi = [(RGB 215 215 215), (RGB 255 205 205)]+shGrn :: [RGB]+shGrn = [(RGB 100 180 100), (RGB 160 200 100)]+shYlw :: [RGB]+shYlw = [(RGB 150 120 0), (RGB 200 150 0)]++------------- Liste der Asteroidenfarbpaletten+astPl :: [RGB]+astPl = [(RGB 90 70 70),(RGB 60 60 65),(RGB 30 30 30),(RGB 150 120 120)]++------------- Liste der Projektilfarbpaletten+firePl :: [[RGB]]+firePl = [elcPl,redPl,bluPl,grnPl]++redPl :: [RGB]+redPl = [(RGB 255 180 0),(RGB 255 140 0),(RGB 255 100 0),(RGB 255 50 0),(RGB 255 100 0),(RGB 255 140 0)]+bluPl :: [RGB]+bluPl = [(RGB 255 0 255),(RGB 200 0 255),(RGB 150 0 255),(RGB 100 0 255),(RGB 150 0 255),(RGB 200 0 255)]+grnPl :: [RGB]+grnPl = [(RGB 255 255 0),(RGB 165 255 0),(RGB 105 205 0),(RGB 0 155 0),(RGB 105 205 0),(RGB 165 255 0)]+elcPl :: [RGB]+elcPl = [(RGB 0 255 255),(RGB 0 200 255),(RGB 0 150 255),(RGB 0 100 255),(RGB 0 150 255),(RGB 0 200 255)]++------------- Liste der Splitterfarbpaletten+shrPl :: [RGB]+shrPl = sred++sred :: [RGB]+sred = [(RGB 255 255 50),(RGB 255 255 00),(RGB 255 215 0),(RGB 245 185 0),(RGB 225 155 0),(RGB 215 115 0),+ (RGB 195 75 15),(RGB 185 65 25),(RGB 155 55 35),(RGB 145 50 50),(RGB 130 70 70),(RGB 120 90 90),+ (RGB 70 50 50),(RGB 50 20 20)]++sgrn :: [RGB]+sgrn = [(RGB 255 255 115),(RGB 255 255 50),(RGB 255 255 0),(RGB 135 255 0),(RGB 70 215 0),(RGB 50 175 0),+ (RGB 15 165 15),(RGB 25 145 25),(RGB 35 125 35),(RGB 50 100 50),(RGB 70 100 70),(RGB 90 90 90),+ (RGB 50 50 50),(RGB 25 25 25)]++------------- Textbausteine für Zufallstexte+mtxt1 :: [String]+mtxt1 = ["Verloren im ", "Gestrandet im ", "Dem Tode nahe im ", "So gut wie erledigt im ", "Verirrt im ",+ "Bald vernichtet im ", "Voellig verminzt im ", "Nur noch 60 Sekunden im ", "Widerstand ist zwecklos im ",+ "Sonnige Gruesse aus dem ", "Die Macht sei mit dir im ", "Schwerer Ausnahmefehler im ", "Schauen Sie mal wieder rein im "]++mtxt2 :: [String]+mtxt2 = ["wilden ", "konvexen ", "dunklen ", "paradiesischen ", "preussischen ", "bayrischen ", "universitaeren ",+ "neu compilierten ", "fluiden ", "traumhaften ", "syntaktischen ", "rechtlich geschuetzen ", "fernen "]++mtxt3 :: [String]+mtxt3 = ["Delta","Schlaraffen","Tackatucka","Microsoft","Morchel","Zucker","Hugs","Linux","Lueth","Semaphoren", "MZH",+ "Mensa", "Todes", "Dijkstra"]++mtxt4 :: [String]+mtxt4 = ["-Quadrant", "-Nebel", "-Guertel", "-Gebiet", "-Areal", "-Territorium", "-Sektor",+ "land", "-System", "-Raum", "-Sonnensystem", "-Nexus", "-Konflux"]++------------- Rangbezeichnungen+ranks :: [String]+ranks = ["Space-Amoeba","Critter","Tribble", "ALF","Commander Keen","E.T.","Spaceball","Chewbacca","Alien",+ "Space-Marine","Captain Kirk","Jedi-Ritter","Spezies 8472","Meister Yoda","Astro-Held","Haskelly","Astrale Gottheit"]++------------- Liste der Hintergrundobjekte+spaceFig :: [Figure]+spaceFig = [(Circle 54), (Circle 48), (Circle 46), (Circle 44),(Circle 42), (Circle 38), (Circle 38), (Circle 1),+ (Circle 10), (Circle 5), (Polygon [(8,0),(-8,0),(0,0),(0,8),(0,-8),(0,0)]),+ (Polygon [(3,0),(-3,0),(0,0),(0,3),(0,-3),(0,0)]),+ (Polygon [(-350,100),(-350,50),(-200,20),(-110,0),(0,-20),(130,-40),(220,-60),(350,-100),(350,30),+ (190,10),(110,40),(-70,55),(-160,70),(-270,85),(-350,100)]),+ (Polygon [(-350,70),(-350,60),(-200,40),(-110,10),(0,-10),(130,-25),(220,-40),(350,-75),(350,-10),+ (190,0),(110,10),(-70,35),(-160,40),(-270,65),(-350,70)]),++ -- Kubus 1+ (Polygon [(6,56),(86,52),(86,-52),(6,-56),(-46,-41),(-46,41),(0,56)]),+ (Polygon [(4,54),(84,50),(84,-50),(4,-54),(-44,-39),(-44,39),(0,54)]),+ (Polygon [(2,52),(82,48),(82,-48),(2,-52),(-42,-37),(-42,37),(0,52)]),+ (Polygon [(0,50),(80,46),(80,-46),(0,-50),(-40,-35),(-40,35),(0,50)]),+ (Polygon [(2,48),(78,44),(78,-44),(2,-48),(2,48)]),++ -- Kubus 2+ (Polygon [(4,-40),(44,-30),(44,30),(4,40),(-44,30),(-44,-30),(4,-40)]),+ (Polygon [(2,-38),(42,-28),(42,28),(2,38),(-42,28),(-42,-28),(2,-38)]),+ (Polygon [(0,-36),(40,-26),(40,26),(0,36),(-40,26),(-40,-26),(0,-36)]),+ (Polygon [(2,-34),(38,-24),(38,24),(2,34),(2,-34)]),++ (Polygon [(30,0),(2,2),(0,30),(-2,2),(-30,0),(-2,-2),(0,-30),(2,-2),(30,0)]),+ (Polygon [(15,0),(2,2),(0,15),(-2,2),(-15,0),(-2,-2),(0,-15),(2,-2),(15,0)]),++ (Circle 25),(Circle 22),(Circle 18),(Circle 14),++ -- Star Destroyer+ (Polygon [(-90,-6),(30,-30),(90,-6),(-90,-6)]),+ (Polygon [(-90,0),(90,0),(30,15),(-90,0)]),+ (Polygon [(90,0),(-90,0),(-90,-6),(90,-6),(90,0)]),+ (Polygon [(-30,-10),(0,-30),(30,-30),(30,-50),(50,-50),(75,-10),(-30,-10)]),+ (Polygon [(30,-51),(11,-47),(11,-43),(30,-38),(49,-43),(49,-47),(30,-51)]),++ -- Turret-Plattform+ (Polygon [(27,0),(13,-22),(-13,-22),(-27,0),(-13,22),(13,22),(27,0)]),+ (Polygon [(30,0),(15,-25),(-15,-25),(-30,0),(-15,25),(15,25),(30,0)])++ ]++------------- Liste der Hintergrundfarbpaletten+spacePl :: [RGB]+spacePl = [(RGB 0 0 0), (RGB 255 255 255), (RGB 180 180 180), (RGB 100 100 225), (RGB 225 0 225), (RGB 50 150 0),+ (RGB 30 0 0), (RGB 50 0 0), (RGB 70 0 0), (RGB 90 0 0), (RGB 150 0 0), -- 6+ (RGB 0 30 0), (RGB 0 50 0), (RGB 0 70 0), (RGB 0 90 0), (RGB 0 150 0), -- 11+ (RGB 0 0 30), (RGB 0 0 50), (RGB 0 0 70), (RGB 0 0 180), (RGB 0 0 225), --16+ (RGB 30 0 30), (RGB 50 0 50), (RGB 70 0 70), (RGB 90 0 90), (RGB 150 0 150), --21+ (RGB 30 30 40), (RGB 40 40 50), (RGB 70 70 80), (RGB 90 90 100), (RGB 110 110 120), --26+ (RGB 30 30 30), (RGB 40 40 40), (RGB 70 70 70), (RGB 90 90 900), (RGB 110 110 110), --30+ (RGB 30 40 30),(RGB 50 60 50),(RGB 70 70 80), (RGB 5 30 0), (RGB 10 40 0)] -- 36++------------- Liste des Sternenfelds+stars :: [Space]+stars = [setSpace (Space{upos= (650,90),utyp=7,ucol=1}),setSpace (Space{upos= (160,150),utyp=7,ucol=2}),+ setSpace (Space{upos= (620,50),utyp=7,ucol=1}),setSpace (Space{upos= (20,250),utyp=7,ucol=2}),+ setSpace (Space{upos= (420,350),utyp=7,ucol=1}),setSpace (Space{upos= (490,450),utyp=7,ucol=2}),+ setSpace (Space{upos= (30,550),utyp=7,ucol=2}),setSpace (Space{upos= (340,250),utyp=7,ucol=1}),+ setSpace (Space{upos= (220,580),utyp=7,ucol=2}),setSpace (Space{upos= (590,350),utyp=7,ucol=1})]++------------- Liste der zusammengesetzten Hintergrundgrafiken+spacePic :: [[Space]]+spacePic = [([]),++ -- Two Star Destroyers, Stars+ ([setSpace (Space{upos= (220,250),utyp=29,ucol=27}), setSpace (Space{upos= (220,250),utyp=30,ucol=26}),+ setSpace (Space{upos= (220,250),utyp=33,ucol=26}), setSpace (Space{upos= (220,250),utyp=32,ucol=27}),++ setSpace (Space{upos= (420,150),utyp=29,ucol=27}), setSpace (Space{upos= (420,150),utyp=30,ucol=26}),+ setSpace (Space{upos= (420,150),utyp=33,ucol=26}), setSpace (Space{upos= (420,150),utyp=32,ucol=27})]+ ++stars),++ -- Shadow Planet Blue, Bright Star I Blue, Stars+ ([setSpace (Space{upos= (217,147),utyp=6,ucol=0}), setSpace (Space{upos= (220,150),utyp=5,ucol=19}),+ setSpace (Space{upos= (220,150),utyp=4,ucol=18}), setSpace (Space{upos= (220,150),utyp=2,ucol=17}),+ setSpace (Space{upos= (220,150),utyp=0,ucol=16}),++ setSpace (Space{upos= (550,480),utyp=11,ucol=1}),setSpace (Space{upos= (550,480),utyp=10,ucol=3}),+ setSpace (Space{upos= (550,480),utyp=9,ucol=20}),setSpace (Space{upos= (550,480),utyp=8,ucol=18})]+ ++stars),++ -- Shadow Planet Star Violet, Bright Star Violet, Stars+ ([setSpace (Space{upos= (323,453),utyp=27,ucol=0}), setSpace (Space{upos= (305,444),utyp=11,ucol=1}),+ setSpace (Space{upos= (305,444),utyp=10,ucol=4}), setSpace (Space{upos= (305,444),utyp=24,ucol=24}),+ setSpace (Space{upos= (320,450),utyp=27,ucol=25}), setSpace (Space{upos= (320,450),utyp=26,ucol=24}),+ setSpace (Space{upos= (305,444),utyp=23,ucol=23}), setSpace (Space{upos= (320,450),utyp=25,ucol=22}),++ setSpace (Space{upos= (550,180),utyp=7,ucol=1}),setSpace (Space{upos= (550,180),utyp=11,ucol=4}),+ setSpace (Space{upos= (550,180),utyp=10,ucol=24})]++stars),++ -- Two Borg Cubes, Nebula, Stars+ ([setSpace (Space{upos= (550,250),utyp=18,ucol=0}), setSpace (Space{upos= (550,250),utyp=17,ucol=32}),+ setSpace (Space{upos= (550,250),utyp=16,ucol=14}), setSpace (Space{upos= (550,250),utyp=15,ucol=12}),++ setSpace (Space{upos= (450,210),utyp=22,ucol=0}), setSpace (Space{upos= (450,210),utyp=21,ucol=32}),+ setSpace (Space{upos= (450,210),utyp=20,ucol=12}), setSpace (Space{upos= (450,210),utyp=19,ucol=11}),++ setSpace (Space{upos= (350,400),utyp=13,ucol=40}), setSpace (Space{upos= (350,400),utyp=12,ucol=39})]+ ++stars),++ -- Green Shadow Planet, Bright Star Green, Stars+ ([setSpace (Space{upos= (510,140),utyp=2,ucol=0}), setSpace (Space{upos= (520,150),utyp=5,ucol=5}),+ setSpace (Space{upos= (520,150),utyp=4,ucol=14}), setSpace (Space{upos= (520,150),utyp=2,ucol=12}),+ setSpace (Space{upos= (520,150),utyp=0,ucol=11}),++ setSpace (Space{upos= (100,430),utyp=10,ucol=5}), setSpace (Space{upos= (100,430),utyp=24,ucol=12}),+ setSpace (Space{upos= (100,430),utyp=23,ucol=11})] ++ stars),++ -- Red Shadow Planet, Stars+ ([setSpace (Space{upos= (210,440),utyp=2,ucol=0}), setSpace (Space{upos= (220,450),utyp=5,ucol=10}),+ setSpace (Space{upos= (220,450),utyp=4,ucol=9}), setSpace (Space{upos= (220,450),utyp=2,ucol=8}),+ setSpace (Space{upos= (220,450),utyp=0,ucol=7})] ++ stars),++ -- Violet Star+ ([setSpace (Space{upos= (650,180),utyp=7,ucol=1}),setSpace (Space{upos= (650,180),utyp=11,ucol=4}),+ setSpace (Space{upos= (650,180),utyp=10,ucol=24})] ++ stars),++ -- Four Stars Blue, Stars+ ([setSpace (Space{upos= (350,150),utyp=7,ucol=1}),setSpace (Space{upos= (350,150),utyp=11,ucol=20}),+ setSpace (Space{upos= (350,150),utyp=10,ucol=18}),++ setSpace (Space{upos= (350,450),utyp=7,ucol=1}),setSpace (Space{upos= (350,450),utyp=11,ucol=20}),+ setSpace (Space{upos= (350,450),utyp=10,ucol=18}),++ setSpace (Space{upos= (200,300),utyp=7,ucol=1}),setSpace (Space{upos= (200,300),utyp=11,ucol=20}),+ setSpace (Space{upos= (200,300),utyp=10,ucol=18}),++ setSpace (Space{upos= (500,300),utyp=7,ucol=1}),setSpace (Space{upos= (500,300),utyp=11,ucol=20}),+ setSpace (Space{upos= (500,300),utyp=10,ucol=18})]++stars)++ ]++turret :: [Space] -- Zusatzhintergrundgrafik für Turret-Mode+turret = if static then [setSpace (Space{upos= (350,300),utyp=28,ucol=38}),+ setSpace (Space{upos= (350,300),utyp=34,ucol=37}),+ setSpace (Space{upos= (350,300),utyp=35,ucol=36})]+ else []++------------------------------------- Ressourcen Ende ----------------------------------------+++------------------------------------ Programm Sektion ----------------------------------------++------------- Initialzustand+initialState :: [Int] ->[Int]-> [Int]-> State+initialState r u m =+ State {+ ship= setShip Ship{spos= (fst winSize `div` 2, snd winSize `div` 2),+ svel= (0,0), ornt= pi/2, thrust= 0, hAcc= 0, sbur = bursts, hthrust = 0, shipDes = False},+ bullets= [],+ shrepnels = [],+ stats = Stats { fails = 0, spl = 0, hits = 0, ratio=0 },+ mission = Mission{rndm1 = (m!!4), rndm2 = (m!!3), rndm3 = (m!!2), rndm4 = (m!!1)},+ spaces = if backgr then ((spacePic!!(u!!1))++turret) else ((spacePic!!0)++turret),+ asteroids = [+ setAst (Asteroid{ asize=0, apos=(0,0), avel = (r!!4,r!!1), aort = pi/3}),+ setAst (Asteroid{ asize=0, apos=(0,0), avel = (r!!6,r!!2), aort = pi/6}),+ setAst (Asteroid{ asize=0, apos=(0,0), avel = (r!!5,r!!8), aort = pi/4})],+ end = False,+ rsCnt = 20}++------------- Bewegung des Schiffs+moveShip :: Ship-> Ship+moveShip(Ship {spos= spos0, svel= svel0, sbur = sbur0,+ hAcc= hAcc, thrust= t, ornt= o, hthrust = ht, shipDes = shipx}) =+ setShip+ Ship{spos= addWinMod spos0 svel1, sbur = sbur0,+ svel= if l> vMax then smult (vMax/l) svel1+ else svel1, shipDes = shipx,+ thrust= t, ornt= o+ hAcc, hAcc= hAcc, hthrust = ht} where+ svel1= add (add (polar t o) (polar ht (o+pi/2))) svel0+ l= len svel1++------------- Bewegung der Asteroiden+moveAsteroid :: Asteroid-> Asteroid+moveAsteroid(Asteroid {apos = apos0, avel = avel0, aort = ao, asize=asize0}) =+ setAst Asteroid{apos = addWinMod apos0 avel0, avel = avel0, aort = ao + 0.05, asize=asize0}++moveAsteroids :: AstList-> AstList+moveAsteroids [] = []+moveAsteroids al = map moveAsteroid al++------------- Bewegung der Projektile und zeitbedingte Beseitigung+moveBullet :: Bullet-> Bullet+moveBullet (Bullet { bpos=bpos0, bvel=bvel0, bcou=bcou0, bort = bort0,bcol = bcol0 }) =+ setBullet Bullet{ bpos= addWinMod bpos0 bvel0, bvel = bvel0, bcou =(bcou0-1), bort = bort0, bcol = (toInt(bcol0+1))}++moveBullets :: BulletList-> BulletList+moveBullets [] = []+moveBullets bl = map moveBullet (kickLast(bl)) where++ kickLast :: BulletList-> BulletList+ kickLast bl = concat (map deleteB bl) where++ deleteB :: Bullet-> BulletList+ deleteB b+ | (bcou b) <= 0 = []+ | otherwise = [b]++------------- Bewegung der Splitter und zeitbedingte Beseitigung+moveShrep :: Shrepnel-> Shrepnel+moveShrep (Shrepnel {gpos=gpos0, gvel=gvel0, gcnt=gcnt0, gcol=gcol0}) =+ setShrep Shrepnel{gpos=addWinMod gpos0 gvel0, gvel=gvel0, gcnt=(gcnt0-1),+ gcol=if (gcol0 < 11) then (gcol0+1) else if ((gcnt0 <5) && (gcol0 <13)) then (gcol0+1) else gcol0}++moveShreps :: ShrepList-> ShrepList+moveShreps [] = []+moveShreps gl = map moveShrep (remShrep(gl)) where++ remShrep :: ShrepList-> ShrepList+ remShrep gl = concat (map deleteG gl) where++ deleteG :: Shrepnel-> ShrepList+ deleteG g+ | (gcnt g) <= 0 = []+ | otherwise = [g]++------------- setzt Schiffs-Shape+setShip :: Ship-> Ship+setShip sh = if (shipDes sh) then sh{sshp= shape (sfDestr)}+ else sh{sshp= shape (Translate (spos sh) (Rotate (ornt sh) (spaceShip!!shipTyp)))}++------------- setzt Asteroiden-Shape+setAst :: Asteroid-> Asteroid+setAst a = if (astFig == 0) then (a{ashp = shape(Translate (apos a) (assis!!(astFig `mod` (length assis))!!(asize a)))})+ else (a{ashp = shape(Translate (apos a) (Rotate (aort a) ((assis!!(astFig `mod` (length assis)))!!(asize a))))})++------------- setzt Bullet-Shape+setBullet :: Bullet-> Bullet+setBullet b = if (bulFig == 0) then b{ bshp = shape (Translate (bpos b) (Rotate (bort b) (bulletFig!!bulFig))) }+ else b{ bshp = shape (Translate (bpos b) (bulletFig!!bulFig)) }++------------- setzt Splitter-Shape+setShrep :: Shrepnel-> Shrepnel+setShrep g = g{gshp=shape (Translate (gpos g) shreps)}++------------- setzt Hintergrund-Shape+setSpace :: Space-> Space+setSpace u = u{ushp= shape (Translate (upos u) (spaceFig!!(utyp u)))}++------------- zeichnet den gesamten State+drawState :: State-> Graphic+drawState s = overGraphics [+ withRGB (RGB 205 155 0) (text (10,5) (show ( (mtxt1!!(rndm3 (mission s)))+++ (mtxt2!!(rndm1 (mission s))) ++ (mtxt3!!(rndm2 (mission s))) ++ (mtxt4!!(rndm4 (mission s))) ))),+ drawHUD s, drawInfo s, drawFail s, (drawShip (ship s)), (drawBullets (bullets s)),(drawShreps (shrepnels s)),+ (drawAsteroids (asteroids s)),(drawSpaces (spaces s)) ]++------------- zeichnet die statistische Informationen+drawHUD :: State-> Graphic+drawHUD s = if hud then overGraphics [(text (10,20) ("Hits/Fails: ")),+ (text (120,20) (show (fromInt(hits (stats s)))++"/"++show (fromInt(fails (stats s))))),+ (text (10,35) ("Hit-Ratio: ")), (text (120,35) (show (fromInt(ratio (stats s)))++"%")),+ (text (10,50) ("Rang: ")), (text (120,50) (show (rank (hits (stats s))))),+ (text (10,65) ("Starbursts: ")), (text (120,65) (show (sbur (ship s))))]+ else overGraphics []+ where+ rank :: Int-> String+ rank k = if (k < 100) then ranks!!(k `div` 10)+ else if (k >= 100) && (k < 200) then ranks!!(((k-100) `div` 25)+10)+ else if (k > 500) then ranks!!16+ else if (k > 300) then ranks!!15+ else ranks!!14++------------- zeichnet den "Game Over"-Bildschirm+drawFail :: State-> Graphic+drawFail s = if (shipDes (ship s)) then overGraphics [+ withRGB (RGB 255 0 0) (text (305,290) ("GAME OVER!")),+ withRGB (RGB 255 0 0) (text (289,305) ("Neustart in ")),+ withRGB (RGB 255 0 0) (text (397,305) (show (rsCnt s)))]+ else overGraphics []++------------- zeichnet Informationsmaske+drawInfo :: State-> Graphic+drawInfo s = if debuginfo then overGraphics [+ (text (260,20) ("Asteroiden: ")), (text (370,20) (show (length (asteroids s)))),+ (text (260,35) ("Splitter: ")), (text (370,35) (show (length (shrepnels s)))),+ (text (260,50) ("Bullets: ")), (text (370,50) (show (length (bullets s)))),+ (text (260,65) ("Speedvect: ")), (text (370,65) (show (svel (ship s))))]+ else overGraphics []++------------- zeichnet das Schiff+drawShip :: Ship-> Graphic+drawShip s = withRGB (if thrust s> 0 then shipPl!!(shipCol `mod`(length shipPl))!!1 else+ shipPl!!(shipCol `mod`(length shipPl))!!0) (drawShape (sshp s))++------------- zeichnen die Asteroiden+drawAsteroid :: Asteroid-> Graphic+drawAsteroid a = withRGB (astPl!!(astCol `mod` (length astPl))) (drawShape (ashp a))++drawAsteroids :: AstList-> Graphic+drawAsteroids al = overGraphics (map drawAsteroid al)++------------- zeichnen die Projektile+drawBullet :: Bullet-> Graphic+drawBullet b = withRGB ((firePl!!(bulCol `mod` (length firePl)))!!((bcol b) `mod` 6)) (drawShape (bshp b))++drawBullets :: BulletList-> Graphic+drawBullets bl = overGraphics (map drawBullet bl)++------------- zeichnen die Splitter+drawShrep :: Shrepnel-> Graphic+drawShrep g = withRGB (shrPl!!(toInt(gcol g))) (drawShape (gshp g))++drawShreps :: ShrepList-> Graphic+drawShreps gl = overGraphics (map drawShrep gl)++------------- zeichnen die Hintergrundgrafiken+drawSpace :: Space-> Graphic+drawSpace u = withRGB (spacePl!!(ucol u)) (drawShape (ushp u))++drawSpaces :: SpaceList-> Graphic+drawSpaces ul = overGraphics (map drawSpace ul)++------------- überprüft den State und erzeugt neue Objekte+checkState :: [Int]-> State-> State+checkState r s =+ s {ship = (checkShip (ship s) (asteroids s)), bullets = concat (map (checkBullet (asteroids s)) (bullets s)),+ shrepnels = if ((not (length (bullets s) == 0) && shrep) || ((shipDes (ship s)) && shrep)) then ((shrepnels s) +++ concat (map (crShreps r (ship s) (bullets s)) (asteroids s))) else (shrepnels s),+ asteroids = if (length (asteroids s) == 0) then (newAst r) else if (length (bullets s) == 0) then (asteroids s) else+ concat (map (checkAst r (bullets s)) (asteroids s)),+ stats = if hud then refreshSt (stats s) (bullets s) else (stats s)+ }++------------- überprüft Bullet-Kollision mit Asteroiden (beides Listen)+checkBullet :: AstList -> Bullet-> BulletList+checkBullet al b = if (collBull b al) then [] else [b]++------------- überprüft Asteroiden-Kollision mit Bullets (beides Listen)+checkAst :: [Int] -> BulletList -> Asteroid-> AstList+checkAst r bl a = if (collAst a bl) then (crAsteroids r a) else [a]++------------- erzeugt aus getroffenen Asteroiden neue Asteroiden+crAsteroids :: [Int]-> Asteroid-> AstList+crAsteroids r a+ | asize a == 2 = []+ | r!!1 < (-2) = [setAst Asteroid{apos= add (apos a) (10,15),avel=add (avel a) ((r!!1), (r!!5)),asize=(asize a+1),aort=pi/4},+ setAst Asteroid{apos=add (apos a) (-15,-15),avel=add (avel a) ((r!!2), (r!!4)),asize=(asize a+1),aort=pi/(-3)}]+ | r!!1 < 1 = [setAst Asteroid{apos=add (apos a) (15,15),avel=add (avel a) ((r!!3), (r!!6)),asize=(asize a+1),aort=pi/6},+ setAst Asteroid{apos=add (apos a) (5,-15),avel=add (avel a) ((r!!5), (r!!4)),asize=(asize a+1),aort=pi/(-7)},+ setAst Asteroid{apos=add (apos a) (-15,10),avel=add (avel a) ((r!!7), (r!!1)),asize= if (asize a) == 0 then (asize a+2) else (asize a+1),aort=pi/2},+ setAst Asteroid{apos=add (apos a) (-10,-15),avel=add (avel a) ((r!!2), (r!!2)),asize= if (asize a) == 0 then (asize a+2) else (asize a+1),aort=pi/(-2)}]+ | otherwise = [setAst Asteroid{apos=add (apos a) (15,10),avel=add (avel a) ((r!!4), (r!!5)),asize=(asize a+1),aort=pi/(-6)},+ setAst Asteroid{apos=add (apos a) (10,-15),avel=add (avel a) ((r!!2), (r!!3)),asize=(asize a+1),aort=pi/7},+ setAst Asteroid{apos=add (apos a) (-15,15),avel=add (avel a) ((r!!7), (r!!6)),asize= if (asize a) == 0 then (asize a+2) else (asize a+1),aort=pi/2}]++------------- überprüft Asteroiden-Kollision mit Bullets und erzeugt Splitter+crShreps :: [Int]-> Ship-> BulletList-> Asteroid-> ShrepList+crShreps r sh bl a = if (collAst a bl) then [setShrep Shrepnel{gpos = (apos a), gvel =((r!!5),(r!!7)),gcnt=15,gcol=0},+ setShrep Shrepnel{gpos = (apos a), gvel =((r!!2),(r!!4)),gcnt=35,gcol=0},+ setShrep Shrepnel{gpos = (apos a), gvel =((r!!6),(r!!3)),gcnt=55,gcol=0}]+ else if (shipDes sh) then [setShrep Shrepnel{gpos = (spos sh), gvel =((r!!5),(r!!7)),gcnt=15,gcol=0},+ setShrep Shrepnel{gpos = (spos sh), gvel =((r!!6),(r!!3)),gcnt=55,gcol=0}]+ else []++------------- überprüft Schiffskolision mit Asteroiden+collShip :: Ship-> AstList-> Bool+collShip sh [] = False+collShip sh al = or (map (collides (sshp sh)) al)+ where collides sp a = intersect sp (ashp a)++------------- überprüft, ob ein Asteroid mit Bullet-Liste kollidiert+collAst :: Asteroid-> BulletList-> Bool+collAst a bl = or (map (collides (ashp a)) bl)+ where collides sp b = intersect sp (bshp b)++------------- überprüft, ob ein Bullet mit Asteroiden-Liste kollidiert+collBull :: Bullet-> AstList-> Bool+collBull b [] = False+collBull b al = or (map (collides (bshp b)) al)+ where collides sp a = intersect sp (ashp a)++------------- berechnet die Statistiken neu+refreshSt :: Stats-> BulletList-> Stats+refreshSt h bl = h { fails = (fails h) + (length [ e | e <- bl, ((bcou e) < 0) ]),+ hits = ((spl h) - (fails h) - (length bl)), ratio = if (spl h)>0 then ((hits h)*100 `div` (spl h)) else 0}++------------- erzeugt neue Asteroiden nach Säuberung des Space+newAst :: [Int]-> AstList+newAst r = [setAst (Asteroid{apos=(0,0), avel=(r!!5,r!!2), asize= 0, aort=pi/3 }),+ setAst (Asteroid{apos=(0,0), avel=(r!!3,r!!4), asize= 0, aort=pi/(-4)}),+ setAst (Asteroid{apos=(0,0), avel=(r!!1,r!!7), asize= 0, aort=pi/2}),+ setAst (Asteroid{apos=(0,0), avel=(r!!6,r!!8), asize= 0, aort=pi})]++------------- überprüft, ob das Schiff getroffen ist, und "zerstört" es+checkShip :: Ship-> AstList-> Ship+checkShip sh a = if (collShip sh a) then sh{shipDes= True, sshp= shape (sfDestr)}+ else sh++------------- wiederholt den gesamten Programmablauf+loop :: Window-> State-> IO ()+loop w s =+ do setGraphic w (drawState s)+ getWindowTick w+ evs<- getEvs+ s<- nextState evs s+ g<- newStdGen++ if (end s) then (closeWindow w)+ else if ((shipDes (ship s)) && not godmode && (rsCnt s) > 0)+ then loop w s{rsCnt= (rsCnt s)-1}+ else if ((shipDes (ship s)) && not godmode)+ then loop w (initialState (randomRs ((-astSpd),astSpd) g) (randomRs (1,8) g) (randomRs (0,12) g))+ else loop w s+ where++ nextState :: [Event]-> State-> IO State+ nextState evs s =+ do g <- newStdGen+ return (+ checkState (randomRs (-(astSpd+(astSpd `div` 2)), (astSpd +(astSpd `div` 2))) g) s1{+ ship= moveShip (ship s1),+ bullets = moveBullets (bullets s1),+ shrepnels = moveShreps (shrepnels s1),+ asteroids = moveAsteroids(asteroids s1)++ }) where+ s1= foldl (flip procEv) s evs++ getEvs :: IO [Event]+ getEvs = do x<- maybeGetWindowEvent w+ case x of+ Nothing -> return []+ Just e -> do rest <- getEvs+ return (e : rest)++------------- Überprüfung der Tasteneingaben+ 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 = fire+ | isEscapeKey k && down = setEnd+ | isDownKey k && down && specKeys = setThrust (- aDelta)+ | isDownKey k && not down && specKeys = setThrust 0+ | isKey 'w' k && down && specKeys = warp+ | isKey 'c' k && down && specKeys = burst+ | isTabKey k && down && specKeys = quickTurn+ | isReturnKey k && down && specKeys = setSpeed 0+ | isReturnKey k && not down && specKeys = setSpeed 0+ | isKey 'y' k && down && specKeys = setStrafe aDelta+ | isKey 'y' k && not down && specKeys = setStrafe 0+ | isKey 'x' k && down && specKeys = setStrafe (- aDelta)+ | isKey 'x' k && not down && specKeys = setStrafe 0+ procEv _ = id++ isKey :: Char-> Key-> Bool+ isKey c k = (isCharKey k) && (keyToChar k == c)++------------- setzt Schiffbeschleunigung+ sethAcc :: Double->State-> State+ sethAcc a s = s{ship= (ship s){hAcc= a}}++------------- setzt Schiffsschub+ setThrust :: Double-> State-> State+ setThrust a s = if (not static ) then s{ship= (ship s){thrust= a}} else s++------------- setzt Schiffsgeschwindigkeit+ setSpeed :: Double-> State-> State+ setSpeed a s = s{ship= (ship s){svel = (0,0)}}++------------- setzt Seitwärtsschub des Schiffs+ setStrafe :: Double-> State-> State+ setStrafe a s = if (not static) then s{ship= (ship s){hthrust= a}} else s++------------- setzt Schiff auf Bildschirmmitte+ warp :: State-> State+ warp s = s{ship=(ship s){svel = (0,0), spos = (fst winSize `div` 2, snd winSize `div` 2), ornt = pi/2}}++------------- wendet das Schiff auf der Stelle+ quickTurn :: State-> State+ quickTurn s = s{ship= (ship s) {ornt = (ornt (ship s))+(pi), svel = (0,0) }}++------------- beendet Spiel+ setEnd :: State-> State+ setEnd s = s{end=True}++------------- feuert ein Projektil ab+ fire :: State-> State+ fire s =+ if (length(bullets s) < maxBul && (not (shipDes (ship s)))) then+ s{ bullets = ( setBullet Bullet{bpos= spos (ship s),+ bort = (ornt (ship s)), bvel= polar bSpeed (ornt (ship s)),+ bcou=bMaxFlight, bcol = 0}):(bullets s),+ stats = (stats s) { spl = ((spl (stats s)) +1)}+ }+ else s++------------- feuert Starburst-Ladung ab+ burst :: State-> State+ burst s = if (length(bullets s) < 3 ) && ((sbur (ship s)) >0 && (not (shipDes (ship s)))) then+ s{ bullets = (bullets s) +++ [setBullet (Bullet{bpos= add (1,0) (spos (ship s)), bort = ((ornt (ship s))+(pi/12)), bcou=(bMaxFlight * 0.8),+ bvel= polar bSpeed ((ornt (ship s))+(pi/12)), bcol = 0}),+ setBullet (Bullet{bpos= add (1,0) (spos (ship s)), bort = ((ornt (ship s))+(pi/6)), bcou=(bMaxFlight * 0.8),+ bvel= polar bSpeed ((ornt (ship s))+(pi/6)), bcol = 0}),+ setBullet (Bullet{bpos= add (1,0) (spos (ship s)), bort = ((ornt (ship s))+(pi/360)), bcou=(bMaxFlight * 0.8),+ bvel= polar bSpeed ((ornt (ship s))), bcol = 0}),+ setBullet (Bullet{bpos= add (1,0) (spos (ship s)), bort = ((ornt (ship s))-(pi/12)), bcou=(bMaxFlight * 0.8),+ bvel= polar bSpeed ((ornt (ship s))-(pi/12)), bcol = 0}),+ setBullet (Bullet{bpos= add (1,0) (spos (ship s)), bort = ((ornt (ship s))-(pi/6)), bcou=(bMaxFlight * 0.8),+ bvel= polar bSpeed ((ornt (ship s))-(pi/6)), bcol = 0})],+ stats = (stats s) { spl = ((spl (stats s)) +5)}, ship = (ship s) {sbur = ((sbur (ship s))-1)} }+ else s++------------- erzeugt Fenster, startet die Programmausführung und schließt Fenster später+main :: IO ()+main = runGraphics $+ do w<- openWindowEx "Spaceman Spiff in War Stars: The Haskell Menace"+ Nothing winSize DoubleBuffered+ (Just 30)+ g<- newStdGen+ loop w (initialState (randomRs ((-astSpd),astSpd) g) (randomRs (1,8) g) (randomRs (0,12) g))+ closeWindow w++-------------------------------------- Programm Ende -----------------------------------------+
+ Asteroids-space.hs view
@@ -0,0 +1,98 @@+module 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(..), withColor)+import Graphics.HGL.Draw.Monad (Graphic())+import Graphics.HGL.Key (isLeftKey, isRightKey, isUpKey)++data State = State { ship :: Ship }+data Ship =+ Ship { pos :: Point,+ shp :: Shape,+ vel :: Point,+ ornt :: Double,+ thrust :: Double,+ hAcc :: Double }+spaceShip :: Figure+spaceShip = Polygon [(15, 0), (-15, 10),+ (-10, 0), (-15, -10), (15, 0)]+winSize :: (Int, Int)+winSize = (1000, 800)+aDelta :: Double+aDelta = 1+vMax :: Double+vMax = 20+hDelta :: Double+hDelta = 0.3+initialState :: State+initialState =+ State {ship= setShp $+ Ship{pos= (fst winSize `div` 2,+ snd winSize `div` 2),+ vel= (0, 0), ornt= pi/2,+ thrust= 0, hAcc= 0}}++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+setShp :: Ship-> Ship+setShp s = s{shp= shape (Translate (pos s)+ (Rotate (ornt s) spaceShip))}+addWinMod :: (Int,Int) -> (Int,Int) -> (Int,Int)+addWinMod (a, b) (c, d)=+ ((a+ c) `mod` (fst winSize),+ (b+ d) `mod` (snd winSize))+drawState :: State-> Graphic+drawState s = drawShip (ship s)+drawShip :: Ship-> Graphic+drawShip s =+ withColor (if thrust s> 0 then Red else Blue)+ (drawShape (shp s))+loop :: Window-> State-> IO ()+loop w s =+ do setGraphic w (drawState s)+ getWindowTick w+ evs<- getEvs+ s<- nextState evs s+ loop w s where+ nextState :: [Event]-> State-> IO State+ nextState evs s =+ do return s1{ship= moveShip (ship s1)} where+ s1= foldl (flip procEv) s evs+ getEvs :: IO [Event]+ getEvs = do x<- maybeGetWindowEvent w+ 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+ procEv _ = id+ sethAcc :: Double->State-> State+ sethAcc a s = s{ship= (ship s){hAcc= a}}+ setThrust :: Double-> State-> State+ setThrust a s = s{ship= (ship s){thrust= a}}+main :: IO ()+main = runGraphics $+ do w<- openWindowEx "Space --- The Final Frontier"+ Nothing winSize DoubleBuffered+ (Just 30)+ loop w initialState+ closeWindow w
+ Asteroids/Geometry.hs view
@@ -0,0 +1,129 @@+module Asteroids.Geometry(+ Figure(..), -- data Figure = Rect Dimension Dimension+ -- | Triangle Dimension Angle Dimension+ -- | Polygon [Point]+ -- | Circle Dimension+ -- | Translate Point Figure+ -- | Scale Double Figure+ -- | Rotate Angle Figure+ -- deriving (Eq, Ord, Show)+ draw, -- :: Figure-> Graphic+ Shape, -- abstract+ shape, -- :: Figure -> Shape+ drawShape, -- :: Figure-> Graphic+ contains, -- :: Shape-> Point-> Bool+ intersect, -- :: Shape-> Shape-> Bool+ polar, -- :: Double-> Angle-> Point+ smult, -- :: Double-> Point-> Point+ add, -- :: Point-> Point-> Point+ len, -- :: Point-> Double+ rot -- :: Angle-> Point-> Point+) where++import Graphics.HGL.Units (Angle(), Point())+import Graphics.HGL.Draw.Picture (ellipse, polygon)+import Graphics.HGL.Draw.Monad (Graphic())+import Data.List (nub)++-- to make ghc happy -- delete for hugs+fromInt :: Num a=> Int-> a+fromInt n = fromInteger $ toInteger n++-- unchanged bits from previous version+type Dimension = Int+data Figure = Rect Dimension Dimension+ | Triangle Dimension Angle Dimension+ | Polygon [Point]+ | Circle Dimension+ | Translate Point Figure+ | Scale Double Figure+ | Rotate Angle Figure+ deriving (Eq, Ord, Show)++smult :: Double-> Point-> Point+smult f (x, y)+ | f == 1 = (x, y)+ | otherwise = (round (f* fromInt x),+ round (f* fromInt y))+add :: Point-> Point-> Point+add (x1, y1) (x2, y2) = (x1+ x2, y1+ y2)++rot :: Angle-> Point-> Point+rot w (x, y)+ | w == 0 = (x, y)+ | otherwise = (round (x'* cos w+ y'* sin w),+ round (-x' * sin w + y'* cos w)) where+ x' = fromInt x; y'= fromInt y+++data Shape = Poly [Point]+ | Circ Point Double+ deriving (Eq, Show)++shape :: Figure-> Shape+shape = fig' ((0, 0), 1, 0) where+ fig' :: (Point, Double, Angle)-> Figure-> Shape+ fig' (m, r, phi) (Translate t f) =+ fig' (add m (smult r (rot phi t)), r, phi) f+ fig' (m, r, phi) (Scale s f) =+ fig' (m, r* s, phi) f+ fig' (m, r, phi) (Rotate w f) =+ fig' (m, r, phi+ w) f+ fig' c (Rect a b) =+ poly c [(x2, y2), (-x2, y2),+ (-x2, -y2), (x2, -y2)] where+ x2= a `div` 2; y2= b `div` 2+ fig' c (Triangle l1 a l2) =+ poly c [(0, 0), (0, l1), rot a (0, l2)]+ fig' c (Polygon pts) = poly c pts+ fig' (m, r, _) (Circle d) =+ Circ m (r*fromInt d)+ poly :: (Point, Double, Angle)-> [Point]-> Shape+ poly (m, p, w) = Poly. chckcls.+ map (add m. smult p. rot w) where+ chckcls [] = []+ chckcls x = if (head x) == (last x)+ then x else x++ [head x]+drawShape :: Shape-> Graphic+drawShape (Poly pts) = polygon pts+drawShape (Circ (mx, my) r) =+ ellipse (mx-r', my- r') (mx+ r', my+ r') where+ r'= round r++draw :: Figure-> Graphic+draw = drawShape . shape++contains :: Shape-> Point-> Bool+contains (Poly pts)= inP pts+contains (Circ c r)= inC c r++inC :: Point-> Double-> Point-> Bool+inC (mx, my) r (px, py) = len (px- mx, py- my) <= r++len :: Point-> Double+len (x, y)= sqrt (fromInt (x^(2::Int)+ y^(2::Int)))++det :: Point-> (Point, Point)-> Int+det (cx,cy) ((ax,ay), (bx,by)) =+ signum ((by-ay)*(cx-bx)-(cy-by)*(bx-ax))++sides :: [Point]-> [(Point, Point)]+sides ps | length ps < 2 = []+ | otherwise = (head ps, head (tail ps)):+ sides (tail ps)++inP :: [Point]-> Point-> Bool+inP ps c = (length. nub. map (det c). sides) ps == 1++intersect :: Shape-> Shape-> Bool+intersect (Poly p) (Circ c r)=+ inP p c || any (inC c r) p+intersect (Circ c r) (Poly p)=+ inP p c || any (inC c r) p+intersect (Poly p1) (Poly p2)=+ any (inP p1) p2 || any (inP p2) p1+intersect (Circ (mx1, my1) r1) (Circ (mx2, my2) r2)=+ len (mx2- mx1, my2- my1) <= r1+ r2++polar :: Double-> Angle-> Point+polar r phi = rot phi (round r, 0)
+ LICENSE view
@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ haskell-in-space.cabal view
@@ -0,0 +1,33 @@+name: haskell-in-space+version: 0.1+synopsis: 'Asteroids' arcade games.+description: A collection of clones of the arcade game 'Asteroids'.+ There are two demos for moving around ('asteroids-space', 'asteroids-aufgabe');+ there is a basic Asteroids game ('asteroids-basic'); and then there is a full+ elaborate one ('asteroids-haskelly').+category: Game+license: BSD3+license-file: LICENSE+author: Christoph Lueth <christoph.lueth@dfki.de>, University of Bremen students+maintainer: Gwern Branwen <gwern0@gmail.com>+homepage: http://www.informatik.uni-bremen.de/~cxl/lehre/pi3.ws01/asteroids/+build-depends: base, haskell98, random, HGL+build-type: Simple+tested-with: GHC==6.8.2++extra-source-files: Asteroids/Geometry.hs++executable: asteroids-space+main-is: Asteroids-space.hs++executable: asteroids-aufgabe+main-is: Asteroids-aufgabe.hs++executable: asteroids-basic+main-is: Asteroids-basic.hs++executable: asteroids-haskelly+main-is: Asteroids-haskelly.hs++ghc-options: -O2 -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all