diff --git a/Asteroids-aufgabe.hs b/Asteroids-aufgabe.hs new file mode 100644 --- /dev/null +++ b/Asteroids-aufgabe.hs @@ -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 diff --git a/Asteroids-basic.hs b/Asteroids-basic.hs new file mode 100644 --- /dev/null +++ b/Asteroids-basic.hs @@ -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) + + diff --git a/Asteroids-haskelly.hs b/Asteroids-haskelly.hs new file mode 100644 --- /dev/null +++ b/Asteroids-haskelly.hs @@ -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 ----------------------------------------- + diff --git a/Asteroids-space.hs b/Asteroids-space.hs new file mode 100644 --- /dev/null +++ b/Asteroids-space.hs @@ -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 diff --git a/Asteroids/Geometry.hs b/Asteroids/Geometry.hs new file mode 100644 --- /dev/null +++ b/Asteroids/Geometry.hs @@ -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) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/runhaskell + +import Distribution.Simple + +main = defaultMainWithHooks defaultUserHooks diff --git a/haskell-in-space.cabal b/haskell-in-space.cabal new file mode 100644 --- /dev/null +++ b/haskell-in-space.cabal @@ -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 , University of Bremen students +maintainer: Gwern Branwen +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