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