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 System.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 -----------------------------------------