Monadius 0.95 → 0.96
raw patch · 5 files changed
+210/−209 lines, 5 filesdep ~GLUTdep ~OpenGLdep ~array
Dependency ranges changed: GLUT, OpenGL, array
Files
- Monadius.cabal +4/−4
- Monadius/Main.hs +31/−31
- Monadius/Monadius.hs +160/−160
- Monadius/Recorder.hs +3/−3
- Monadius/Util.hs +12/−11
Monadius.cabal view
@@ -1,5 +1,5 @@ Name: Monadius-Version: 0.95+Version: 0.96 Synopsis: 2-D arcade scroller Description: A fast-paced 2-D scrolling vector graphics clone of the arcade game Gradius;@@ -23,10 +23,10 @@ Executable monadius Build-depends: base >= 4 && < 5- , array >= 0.3 && < 0.4+ , array >= 0.3 && < 0.5 , directory >= 1.1 && < 1.2- , GLUT >= 2.1 && < 2.2- , OpenGL >= 2.2 && < 2.3+ , GLUT >= 2.2 && < 2.3+ , OpenGL >= 2.4 && < 2.5 Hs-source-dirs: Monadius Ghc-options: -Wall
Monadius/Main.hs view
@@ -24,7 +24,7 @@ import Game (isGameover, render, update) import Monadius import Recorder -import Util (intToDouble, padding, putDebugStrLn) +import Util (intToGLdouble, padding, putDebugStrLn) data GlobalVariables = GlobalVariables{ saveState :: (Int,Int) ,isCheat :: Bool, demoIndex :: Int, @@ -116,7 +116,7 @@ matrixMode $= Projection loadIdentity perspective 30.0 (4/3) 600 1400 - lookAt (Vertex3 0 0 (927 :: Double)) (Vertex3 0 0 (0 :: Double)) (Vector3 0 1 (0 :: Double)) + lookAt (Vertex3 0 0 (927 :: GLdouble)) (Vertex3 0 0 (0 :: GLdouble)) (Vector3 0 1 (0 :: GLdouble)) dispProc :: IORef (IO Scene) -> IO () dispProc cp = do @@ -138,45 +138,45 @@ matrixMode $= Modelview 0 loadIdentity - if clock < drawCompleteTime then color $ Color3 (0 :: Double) 0.2 0.8 - else color $ Color3 (0+shine clock :: Double) (0.2+shine clock) (0.8+shine clock) + if clock < drawCompleteTime then color $ Color3 (0 :: GLdouble) 0.2 0.8 + else color $ Color3 (0+shine clock :: GLdouble) (0.2+shine clock) (0.8+shine clock) preservingMatrix $ do - translate (Vector3 0 (120 :: Double) 0) - scale 1.05 1 (1 :: Double) + translate (Vector3 0 (120 :: GLdouble) 0) + scale 1.05 1 (1 :: GLdouble) mapM_ (renderPrimitive LineStrip . renderVertices2D.delayVertices clock) [lambdaLfoot,lambdaRfoot] - color $ Color3 (1.0 :: Double) 1.0 1.0 + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 preservingMatrix $ do - translate $ Vector3 (-195 :: Double) (130) 0 - scale (0.73 :: Double) 0.56 0.56 + translate $ Vector3 (-195 :: GLdouble) (130) 0 + scale (0.73 :: GLdouble) 0.56 0.56 renderStringGrad Roman 0 "Monadius" preservingMatrix $ do - if menuCursor==0 then color $ Color3 (1.0 :: Double) 1.0 0 else color $ Color3 (1.0 :: Double) 1.0 1.0 - translate $ Vector3 (-230 :: Double) (-200) 0 - scale (0.2 :: Double) 0.2 0.3 + if menuCursor==0 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + translate $ Vector3 (-230 :: GLdouble) (-200) 0 + scale (0.2 :: GLdouble) 0.2 0.3 renderStringGrad Roman 60 $ (if menuCursor==0 then ">" else " ") ++ "New Game" preservingMatrix $ do - if menuCursor==1 then color $ Color3 (1.0 :: Double) 1.0 0 else color $ Color3 (1.0 :: Double) 1.0 1.0 - translate $ Vector3 (70 :: Double) (-200) 0 - scale (0.2 :: Double) 0.2 0.3 + if menuCursor==1 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + translate $ Vector3 (70 :: GLdouble) (-200) 0 + scale (0.2 :: GLdouble) 0.2 0.3 renderStringGrad Roman 60 $ (if menuCursor==1 then ">" else " ") ++ "Continue " ++ (show . fst . saveState) vars++ "-" ++ (show . (+1) . snd . saveState) vars - color $ Color3 (1.0 :: Double) 1.0 1.0 + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 preservingMatrix $ do - translate $ Vector3 (-250 :: Double) (75) 0 - scale (0.15 :: Double) 0.10 0.15 + translate $ Vector3 (-250 :: GLdouble) (75) 0 + scale (0.15 :: GLdouble) 0.10 0.15 renderStringGrad Roman 10 "Dedicated to the makers, the players, the history," preservingMatrix $ do - translate $ Vector3 (-250 :: Double) (55) 0 - scale (0.15 :: Double) 0.10 0.15 + translate $ Vector3 (-250 :: GLdouble) (55) 0 + scale (0.15 :: GLdouble) 0.10 0.15 renderStringGrad Roman 20 " and the 20th anniversary of GRADIUS series." mapM_ (\ (y,(strA,strB),i) -> preservingMatrix $ do preservingMatrix $ do - translate $ Vector3 (-180 :: Double) y 0 - scale (0.18 :: Double) 0.18 0.2 + translate $ Vector3 (-180 :: GLdouble) y 0 + scale (0.18 :: GLdouble) 0.18 0.2 renderStringGrad Roman (20 + i*5) strA preservingMatrix $ do - translate $ Vector3 (60 :: Double) y 0 - scale (0.18 :: Double) 0.18 0.2 + translate $ Vector3 (60 :: GLdouble) y 0 + scale (0.18 :: GLdouble) 0.18 0.2 renderStringGrad Roman (25 + i*5) strB ) $ zip3 [0,(-35)..] instructions [1..] @@ -233,7 +233,7 @@ shine t = monoshine (drawCompleteTime + t) + monoshine (drawCompleteTime + t+6) - monoshine t = exp(-0.2*intToDouble(t`mod` 240)) + monoshine t = exp(-0.2*intToGLdouble(t`mod` 240)) drawCompleteTime = length lambdaRfoot @@ -244,12 +244,12 @@ wing = [(30:+0),(200:+0),(216:+16),(208:+24),(224:+24),(240:+40),(232:+48),(248:+48),(272:+72),(168:+72)] - renderVertices2D :: [Complex Double] -> IO () + renderVertices2D :: [Complex GLdouble] -> IO () renderVertices2D xys = mapM_ (\(x:+y) -> vertex $ Vertex3 x y 0) xys demoStartTime = if presentationMode then 480 else 1800 -endingProc :: GlobalVariables -> IORef [Key] -> IORef Double -> IO Scene +endingProc :: GlobalVariables -> IORef [Key] -> IORef GLdouble -> IO Scene endingProc vars ks ctr= do keystate <- readIORef ks counter <- readIORef ctr @@ -258,10 +258,10 @@ matrixMode $= Modelview 0 loadIdentity - color $ Color3 (1.0 :: Double) 1.0 1.0 + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 zipWithM_ (\str pos -> preservingMatrix $ do - translate $ Vector3 (-180 :: Double) (-240+counter-pos) 0 - scale (0.3 :: Double) 0.3 0.3 + translate $ Vector3 (-180 :: GLdouble) (-240+counter-pos) 0 + scale (0.3 :: GLdouble) 0.3 0.3 renderString Roman str) stuffRoll [0,60..] @@ -325,7 +325,7 @@ let currentSave = if mode gamestate == Playback then saveState vars else (currentLevel,currentArea) let currentHi = max (saveHiScore vars) (hiScore$getVariables$gameBody gamestate) if (isGameover gamestate) then do - counter <- newIORef (0.0 :: Double) + counter <- newIORef (0.0 :: GLdouble) if mode gamestate /= Record then return () else do writeReplay vars gamestate $ show (ReplayInfo (recordSaveState vars,(encode2 . preEncodedKeyBuf) gamestate))
Monadius/Monadius.hs view
@@ -31,48 +31,48 @@ data GameObject = -- objects that are actually rendered and moved. VicViper{ -- player's fighter. - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hp :: Int, - trail :: [Complex Double], - speed :: Double, + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int, + trail :: [Complex GLdouble], + speed :: GLdouble, powerUpPointer :: Int, powerUpLevels :: Array Int Int, reloadTime :: Int,weaponEnergy :: Int, ageAfterDeath :: Int } | Option{ -- trailing support device. - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape, + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape, optionTag :: Int, reloadTime :: Int,weaponEnergy :: Int} | StandardMissile{ - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hp :: Int,mode :: Int, - velocity :: Complex Double,parentTag :: Int,probe :: GameObject } | -- missile that fly along the terrain + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,mode :: Int, + velocity :: Complex GLdouble,parentTag :: Int,probe :: GameObject } | -- missile that fly along the terrain Probe{ -- this lets missile to fly along the terrain - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hp :: Int + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int } | StandardRailgun{ - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - velocity :: Complex Double,parentTag :: Int } | -- normal & double shot + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + velocity :: Complex GLdouble,parentTag :: Int } | -- normal & double shot StandardLaser{ - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - velocity :: Complex Double,parentTag :: Int,age :: Int } | -- long blue straight laser + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + velocity :: Complex GLdouble,parentTag :: Int,age :: Int } | -- long blue straight laser Shield{ - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - settled :: Bool,size :: Double,placement :: Complex Double, - angle :: Double,omega :: Double} | -- solid state of Reek power that protects enemy atacks + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + settled :: Bool,size :: GLdouble,placement :: Complex GLdouble, + angle :: GLdouble,omega :: GLdouble} | -- solid state of Reek power that protects enemy atacks PowerUpCapsule{ - tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hp :: Int,age :: Int} | + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,age :: Int} | PowerUpGauge{ - tag :: Maybe Int,position :: Complex Double} | + tag :: Maybe Int,position :: Complex GLdouble} | DiamondBomb{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, hitDisp :: Shape,hp :: Int,age :: Int} | -- Bacterian's most popular warhead TurnGear{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, hitDisp :: Shape,hp :: Int,age :: Int,mode :: Int, managerTag :: Int} | -- one of small Bacterian lifeforms, often seen in a squad. SquadManager{ - tag :: Maybe Int,position :: Complex Double,interval :: Int,age :: Int, + tag :: Maybe Int,position :: Complex GLdouble,interval :: Int,age :: Int, bonusScore :: Int,currentScore :: Int, members :: [GameObject],items :: [GameObject] } | @@ -84,44 +84,44 @@ -- releases <items> if <currentScore> >= <bonusScore>, or -- doesn't ,if not. Jumper{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex Double, + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, touchedLand :: Bool,jumpCounter :: Int } | -- dangerous multi way mine dispenser. Grashia{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex Double, - gunVector :: Complex Double,mode :: Int + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, + gunVector :: Complex GLdouble,mode :: Int } | -- fixed antiaircraft cannon. Ducker{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gVelocity :: Complex Double, - charge :: Int,vgun :: Complex Double,touchedLand :: Bool + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gVelocity :: Complex GLdouble, + charge :: Int,vgun :: Complex GLdouble,touchedLand :: Bool } | -- 2-feet mobile land to air attack device. Flyer{ - tag :: Maybe Int,position :: Complex Double,velocity :: Complex Double, + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,mode :: Int } | -- Baterian's standard interceptor. ScrambleHatch{ - tag :: Maybe Int,position :: Complex Double,gateAngle :: Double,gravity :: Complex Double, + tag :: Maybe Int,position :: Complex GLdouble,gateAngle :: GLdouble,gravity :: Complex GLdouble, hitDisp :: Shape,hp :: Int,age :: Int,launchProgram :: [[GameObject]] } | -- Where Baterian larvae spend last process of maturation. LandScapeBlock{ - tag :: Maybe Int, position :: Complex Double,hitDisp :: Shape,velocity :: Complex Double + tag :: Maybe Int, position :: Complex GLdouble,hitDisp :: Shape,velocity :: Complex GLdouble } | -- landscape that just look like, and hit like its hitDisp. Particle{ - tag :: Maybe Int, position :: Complex Double, velocity :: Complex Double, - size :: Double,particleColor :: Color3 Double,age :: Int,decayTime :: Double,expireAge :: Int + tag :: Maybe Int, position :: Complex GLdouble, velocity :: Complex GLdouble, + size :: GLdouble,particleColor :: Color3 GLdouble,age :: Int,decayTime :: GLdouble,expireAge :: Int } | -- multi purpose particles that vanishes after expireAge. Star{ - tag :: Maybe Int, position :: Complex Double,particleColor :: Color3 Double + tag :: Maybe Int, position :: Complex GLdouble,particleColor :: Color3 GLdouble } | -- background decoration SabbathicAgent{ tag :: Maybe Int, fever :: Int @@ -139,16 +139,16 @@ LandScape deriving(Eq) -data WeaponType = NormalShot | Missile | DoubleShot | Laser +data WeaponType = NormalShot | Missile | GLdoubleShot | Laser deriving (Eq) --- WeaponType NormalShot | Missile | DoubleShot | Laser ... represents function of weapon that player selected, while +-- WeaponType NormalShot | Missile | GLdoubleShot | Laser ... represents function of weapon that player selected, while -- GameObject StandardRailgun | StandardLaser ... represents the object that is actually shot and rendered. -- for example; --- shooting NormalShot :: WeaponType and DoubleShot :: WeaponType both result in StandardRailgun :: GameObject creation, and +-- shooting NormalShot :: WeaponType and GLdoubleShot :: WeaponType both result in StandardRailgun :: GameObject creation, and -- shooting Laser :: WeaponType creates StandardLaser :: GameObject when player is operating VicViper, or RippleLaser :: GameObject when LordBritish ... etc. data ScrollBehavior = Enclosed{doesScroll :: Bool} | NoRollOut{doesScroll :: Bool} - | RollOutAuto{doesScroll :: Bool, range :: Double} | RollOutFold{doesScroll :: Bool} + | RollOutAuto{doesScroll :: Bool, range :: GLdouble} | RollOutFold{doesScroll :: Bool} ----------------------------- -- @@ -162,8 +162,8 @@ initGameObjects = stars ++ [freshVicViper,freshPowerUpGauge] stars = take 26 $ map (\(t,i) -> Star{tag=Nothing,position = (fix 320 t:+fix 201 t),particleColor=colors!!i}) $ zip (map (\x -> square x + x + 41) [2346,19091..]) [1..] - fix :: Int -> Int -> Double - fix limit value = intToDouble $ (value `mod` (2*limit) - limit) + fix :: Int -> Int -> GLdouble + fix limit value = intToGLdouble $ (value `mod` (2*limit) - limit) colors = [Color3 1 1 1,Color3 1 1 0,Color3 1 0 0, Color3 0 1 1] ++ colors -- ++ map (\x -> freshOption{optionTag = x}) [1..4] -- full option inchiki @@ -183,9 +183,9 @@ -- Cuteness to add later -- konamiCommand = [upButton,upButton,downButton,downButton,leftButton,rightButton,leftButton,rightButton,missileButton,shotButton] -gaugeOfMissile,gaugeOfDouble,gaugeOfLaser,gaugeOfShield :: Int +gaugeOfMissile,gaugeOfGLdouble,gaugeOfLaser,gaugeOfShield :: Int gaugeOfMissile = 1 -gaugeOfDouble = 2 +gaugeOfGLdouble = 2 gaugeOfLaser = 3 gaugeOfShield = 5 @@ -193,7 +193,7 @@ stageClearTime = 7800 -- these lists are game rank modifiers. -bacterianShotSpeedList, duckerShotWay, jumperShotFactor, grashiaShotSpeedFactor :: [Double] +bacterianShotSpeedList, duckerShotWay, jumperShotFactor, grashiaShotSpeedFactor :: [GLdouble] bacterianShotSpeedList = [8,4,6,8] ++ cycle [12,8] duckerShotCount = [2,1,1,3] ++ repeat 2 duckerShotWay = [1,1,2,1] ++ cycle [2,2] @@ -217,7 +217,7 @@ landRollShotInterval = [60,120,60,60] ++ cycle [30,60] scrambleHatchLaunchLimitAge = [400,200,400,400] ++ cycle [600,400] -shotSpeed,laserSpeed,laserBreadth :: Double +shotSpeed,laserSpeed,laserBreadth :: GLdouble shotSpeed = 25 laserSpeed = 60 laserBreadth = 20 @@ -228,10 +228,10 @@ landScapeSensitive Shield{} = True landScapeSensitive _ = False -vicViperSize :: Double +vicViperSize :: GLdouble vicViperSize = 6 -shieldPlacementMargin,shieldHitMargin :: Double +shieldPlacementMargin,shieldHitMargin :: GLdouble shieldPlacementMargin = 5 shieldHitMargin = 10 @@ -239,7 +239,7 @@ shieldMaxHp = 16 hatchHP = 15 -diamondBombSize,smallBacterianSize,hatchHeight :: Double +diamondBombSize,smallBacterianSize,hatchHeight :: GLdouble diamondBombSize = 6 hatchHeight = 35 smallBacterianSize = 16 @@ -264,20 +264,20 @@ speed = 1,powerUpPointer=(-1),powerUpLevels=array (0,5) [(x,0)|x<-[0..5]],reloadTime=0,weaponEnergy=100, ageAfterDeath = 0} -freshDucker :: Double -> GameObject +freshDucker :: GLdouble -> GameObject freshDucker vg = Ducker{tag = Nothing, position = 0:+0, velocity= 0:+0, hitDisp = Circular (0:+0) smallBacterianSize, hp = 1, age = 0, hasItem = False, gVelocity = 0:+(8*vg),charge = 0, vgun = 0:+0,touchedLand=False} -freshScrambleHatch :: Double -> GameObject +freshScrambleHatch :: GLdouble -> GameObject freshScrambleHatch sign = ScrambleHatch{tag=Nothing,position=0:+0,hitDisp=regulate $ Rectangular ((-45):+0) (45:+(hatchHeight*(-sign))),gravity=(0:+sign),hp=hatchHP,age=0, launchProgram = cycle $ replicate 40 [] ++ (concat.replicate 6) ([[freshInterceptor{velocity = 0:+(-6)*sign}]]++replicate 9 []),gateAngle=0 } -freshVolcano :: Double -> GameObject +freshVolcano :: GLdouble -> GameObject freshVolcano grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= Shapes $ map (regulate.(\i -> Rectangular ((120 - 33*i + 2*i*i):+ sign*30*i) ((33*i - 2*i*i - 120) :+ sign*30*(i+1)) ) ) [0..4]} where sign = (-grvty) -freshTable :: Double -> GameObject +freshTable :: GLdouble -> GameObject freshTable grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= Shapes $ map (regulate.(\i -> Rectangular ((-2**(i+3)+shiftSinePi i):+sign*30*i) ((2**(i+3)+shiftSinePi i) :+sign*30*(i+1)))) [0..4] } where sign = (- grvty) @@ -285,7 +285,7 @@ shiftSinePi :: (Floating a) => a -> a shiftSinePi a = 5 * sin (a*0.5*pi) -freshGrashia, freshJumper, freshLandRoll :: Double -> GameObject +freshGrashia, freshJumper, freshLandRoll :: GLdouble -> GameObject freshGrashia sign= Grashia{tag=Nothing,position=0:+0,velocity=0:+0, hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,gravity=(0:+sign),gunVector=0:+0,mode=0} freshJumper sign=Jumper{tag=Nothing,position=0:+0,velocity=0:+0, @@ -360,8 +360,8 @@ (if doesPowerUp then ( modifyArray (powerUpPointer vic) (\x -> if x<powerUpLimits!!powerUpPointer vic then x+1 else 0) . -- overpowering-up results in initial powerup level. - (if powerUpPointer vic==gaugeOfDouble then modifyArray gaugeOfLaser (const 0) else id) . -- laser and double are - (if powerUpPointer vic==gaugeOfLaser then modifyArray gaugeOfDouble (const 0) else id) ) -- exclusive equippment. + (if powerUpPointer vic==gaugeOfGLdouble then modifyArray gaugeOfLaser (const 0) else id) . -- laser and double are + (if powerUpPointer vic==gaugeOfLaser then modifyArray gaugeOfGLdouble (const 0) else id) ) -- exclusive equippment. else id) (powerUpLevels vic), powerUpPointer = if doesPowerUp then (-1) else powerUpPointer vic, speed = speeds !! (powerUpLevels vic!0), @@ -422,12 +422,12 @@ updateGameObject shield@Shield{} = if(hp shield<=0) then [] else [ (if settled shield then shield{ - position=target,size=shieldPlacementMargin+intToDouble (hp shield), + position=target,size=shieldPlacementMargin+intToGLdouble (hp shield), hitDisp = Circular (0:+0) (size shield+shieldHitMargin), hitDispLand = Circular (0:+0) (size shield) } else - shield{hp=shieldMaxHp,size=5+intToDouble (hp shield),position=newPosition,settled=chaseFactor>0.6}) + shield{hp=shieldMaxHp,size=5+intToGLdouble (hp shield),position=newPosition,settled=chaseFactor>0.6}) {angle=angle shield + omega shield} ] where newPosition = position shield + v @@ -491,12 +491,12 @@ mode = newMode }]++myShots where newV = case m of - 00 -> (realPart v):+sin(intToDouble myAge / 5) + 00 -> (realPart v):+sin(intToGLdouble myAge / 5) 01 -> v --if magnitude v <= 0.01 then if imagPart (position vicViper-pos)>0 then 0:+10 else 0:+(-10) else v 02 -> (-4):+0 10 -> if (not isEasy) || myAge < 10 then stokeV else v _ -> v - stokeV = angleAccuracy 16 $ (* ((min (speed vicViper*0.75) (intToDouble$round$magnitude v)):+0) ) $ unitVector $ position vicViper-pos + stokeV = angleAccuracy 16 $ (* ((min (speed vicViper*0.75) (intToGLdouble$round$magnitude v)):+0) ) $ unitVector $ position vicViper-pos newMode = case m of 01 -> if myAge > 20 && (position vicViper - pos) `innerProduct` v < 0 then 02 else 01 _ -> m @@ -541,7 +541,7 @@ doesShot = jumpCounter me `mod` 4 == 2 && v`innerProduct` g >0 shots = if doesShot then map (\theta -> freshDiamondBomb{position=pos,velocity=mkPolar (bacterianShotSpeed*jumperShotFactor!!gameLevel) theta}) $ - take way $ iterate (+(2*pi/intToDouble way)) 0 + take way $ iterate (+(2*pi/intToGLdouble way)) 0 else [] way=jumperShotWay!!gameLevel @@ -557,8 +557,8 @@ (map (\obj -> obj{position = pos}) $ launchProgram me!!a) else [] hatchHitBacks = - (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ take way $ iterate (+2*pi/intToDouble way) 0 )++ - (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.4) theta}) $ take way $ iterate (+2*pi/intToDouble way) (pi/intToDouble way) ) + (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) 0 )++ + (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.4) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) (pi/intToGLdouble way) ) way = 16 @@ -568,7 +568,7 @@ me{ age=age me+1, gunVector = unitVector $ position vicViper - pos, - position = position me + ((-3)*sin(intToDouble (age me*mode me)/8):+0) + position = position me + ((-3)*sin(intToGLdouble (age me*mode me)/8):+0) } --V no shotto wo osoku ] ++ if age me `mod` myInterval == 0 && age me `mod` 200 > grashiaShotHalt!!gameLevel then [jikiNeraiDanAc (pos+gunVector me*(16:+0)) (grashiaShotSpeedFactor!!gameLevel*bacterianShotSpeed:+0) 64] else [] where @@ -580,7 +580,7 @@ age = age me + 1, position = position me + (decay:+0) * velocity me }] where - decay = exp $ - intToDouble (age me) / decayTime me + decay = exp $ - intToGLdouble (age me) / decayTime me updateGameObject me@LandScapeBlock{position = pos,velocity = v} = [me{position = pos+v}] @@ -597,8 +597,8 @@ launch = (<=0) $ length $ filter (\obj -> case obj of Flyer{} -> True _ -> False) objects - df = intToDouble f - 1 - margin :: Double + df = intToGLdouble f - 1 + margin :: GLdouble margin = 20 updateGameObject x = [x] @@ -612,14 +612,14 @@ weaponEnergy = max 0 $ min 100 $ weaponEnergy obj + if doesLaser then (-10) else 50 } :(shots ++ missiles) where (shots,penalty1) = if doesNormal then ([freshStandardRailgun{position=position obj,parentTag=myTag}] ,2) - else if doesDouble then ([freshStandardRailgun{position=position obj,parentTag=myTag},freshStandardRailgun{position=position obj,parentTag=myTag,velocity=mkPolar 1 (pi/4)*velocity freshStandardRailgun}] ,2) + else if doesGLdouble then ([freshStandardRailgun{position=position obj,parentTag=myTag},freshStandardRailgun{position=position obj,parentTag=myTag,velocity=mkPolar 1 (pi/4)*velocity freshStandardRailgun}] ,2) else if doesLaser then ([freshStandardLaser{position=position obj+(shotSpeed/2:+0),parentTag=myTag}] ,1) else ([],0) penalty2 = if weaponEnergy obj <= 0 then 8 else 0 missiles = if doesMissile then [freshStandardMissile{position=position obj}] else [] doesShot = (isJust $tag obj) && (reloadTime obj <=0) && (shotButton `elem` keys) doesNormal = doesShot && elem NormalShot types && (shotCount<2) - doesDouble = doesShot && elem DoubleShot types && (shotCount<1) + doesGLdouble = doesShot && elem GLdoubleShot types && (shotCount<1) doesLaser = doesShot && elem Laser types doesMissile = (isJust $tag obj) && elem Missile types && (missileButton `elem` keys) && (missileCount<=0) myTag = fromJust $ tag obj @@ -632,7 +632,7 @@ types = weaponTypes vicViper - jikiNeraiDan :: Complex Double -> Complex Double -> GameObject + jikiNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject -- an enemy bullet starting at position sourcePos and with relative velocity initVelocity. -- bullet goes straight to vicviper if initVelocity is a positive real number. jikiNeraiDanAc sourcePos initVelocity accuracy = freshDiamondBomb{ @@ -641,28 +641,28 @@ } jikiNeraiDan sourcePos initVelocity = jikiNeraiDanAc sourcePos initVelocity 32 - scatteredNeraiDan :: Complex Double -> Complex Double -> GameObject + scatteredNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject -- a rather scattered jikiNeraiDan. scatteredNeraiDan sourcePos initVelocity = freshDiamondBomb{ position = sourcePos, velocity = scatter $ (*initVelocity) $ (angleAccuracy 32) $ unitVector $ position vicViper - sourcePos } where scatter z = let (r,theta)=polar z in - mkPolar r (theta+pi/8*((^(3::Int)).sin)((intToDouble $ gameClock variables) + magnitude sourcePos)) + mkPolar r (theta+pi/8*((^(3::Int)).sin)((intToGLdouble $ gameClock variables) + magnitude sourcePos)) freshExplosionParticle pos vel a = Particle{tag=Nothing,position=pos,velocity=vel,size=8,particleColor=Color3 1 0.5 0,age=a,decayTime=6,expireAge=20} freshExplosions pos = take 5 expls where expls :: [GameObject] expls = makeExp randoms - randoms = [square $ sin(9801*sqrt t*(intToDouble$gameClock variables) + magnitude pos)|t<-[1..]] + randoms = [square $ sin(9801*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] makeExp (a:b:c:xs) = (freshExplosionParticle pos (mkPolar (3*a) (2*pi*b)) (round $ -5*c)):makeExp xs makeExp _ = [] freshMiddleExplosions pos = take 16 expls where expls :: [GameObject] expls = makeExp randoms 0 - randoms = [square $ sin(8086*sqrt t*(intToDouble$gameClock variables) + magnitude pos)|t<-[1..]] + randoms = [square $ sin(8086*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] makeExp (a:b:xs) i = (freshExplosionParticle (pos+mkPolar 5 (pi/8*i)) (mkPolar (6+3*a) (pi/8*i)) (round $ -5*b)){size=16}:makeExp xs (i+1) makeExp _ _ = [] @@ -986,7 +986,7 @@ powerUpLimits = [5,1,1,1,4,1] weaponTypes :: GameObject -> [WeaponType] weaponTypes viper@VicViper{} = - [if powerUpLevels viper!gaugeOfDouble>0 then DoubleShot else + [if powerUpLevels viper!gaugeOfGLdouble>0 then GLdoubleShot else if powerUpLevels viper!gaugeOfLaser>0 then Laser else NormalShot] ++ if powerUpLevels viper!gaugeOfMissile>0 then [Missile] else [] @@ -1003,14 +1003,14 @@ putDebugStrLn $ show $ length objects mapM_ renderGameObject objects preservingMatrix $ do - translate (Vector3 (-300) (220) (0 :: Double)) - renderWithShade (Color3 1 1 (1 :: Double)) (Color3 0 0 (1 :: Double)) $ do - scale (0.2 :: Double) 0.2 0.2 + translate (Vector3 (-300) (220) (0 :: GLdouble)) + renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do + scale (0.2 :: GLdouble) 0.2 0.2 renderString MonoRoman scoreStr preservingMatrix $ do - translate (Vector3 (0) (220) (0 :: Double)) - renderWithShade (Color3 1 1 (1 :: Double)) (Color3 0 0 (1 :: Double)) $ do - scale (0.2 :: Double) 0.2 0.2 + translate (Vector3 (0) (220) (0 :: GLdouble)) + renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do + scale (0.2 :: GLdouble) 0.2 0.2 renderString MonoRoman scoreStr2 where scoreStr = "1P " ++ ((padding '0' 8).show.totalScore) variables @@ -1023,90 +1023,90 @@ renderGameObject gauge@PowerUpGauge{} = preservingMatrix $ do let x:+y = position gauge translate (Vector3 x y 0) - color (Color3 (1.0 :: Double) 1.0 1.0) + color (Color3 (1.0 :: GLdouble) 1.0 1.0) mapM_ (\(i,j) -> (if(i==activeGauge)then renderActive else renderNormal) j (isLimit i) i) $ zip [0..5] [0,90..450] where w=80 h=20 renderNormal x l i = preservingMatrix $ do - color (Color3 0.7 0.8 (0.8 :: Double)) + color (Color3 0.7 0.8 (0.8 :: GLdouble)) preservingMatrix $ do - translate (Vector3 x 0 (0 :: Double)) + translate (Vector3 x 0 (0 :: GLdouble)) renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(w,0),(w,h),(0,h)] if l then renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),(w,h),(w,0),(0,h)] else return() preservingMatrix $ do ugoTranslate x 0 0 3 - translate (Vector3 (w/2) 0 (0 :: Double)) - rotate (3 * sin(intToDouble gameclock/10)) (Vector3 0 0 (1 :: Double)) - translate (Vector3 (-w/2) 0 (0 :: Double)) + translate (Vector3 (w/2) 0 (0 :: GLdouble)) + rotate (3 * sin(intToGLdouble gameclock/10)) (Vector3 0 0 (1 :: GLdouble)) + translate (Vector3 (-w/2) 0 (0 :: GLdouble)) renderPowerUpName i renderActive x l i = preservingMatrix $ do - color (Color3 1 1 (0 :: Double)) + color (Color3 1 1 (0 :: GLdouble)) preservingMatrix $ do translate (Vector3 x 0 0) renderPrimitive LineLoop $ ugoVertices2DFreq 0 5 2 [(0,0),(w,0),(w,h),(0,h)] if l then renderPrimitive Lines $ ugoVertices2DFreq 0 5 2 [(0,0),(w,h),(w,0),(0,h)] else return() preservingMatrix $ do ugoTranslateFreq x 0 0 5 2 - translate (Vector3 (w/2) 0 (0 :: Double)) - rotate (10 * sin(intToDouble gameclock/5)) (Vector3 0 0 (1 :: Double)) - scale 1.2 1.2 (0 :: Double) - translate (Vector3 (-w/2) 0 (0 :: Double)) + translate (Vector3 (w/2) 0 (0 :: GLdouble)) + rotate (10 * sin(intToGLdouble gameclock/5)) (Vector3 0 0 (1 :: GLdouble)) + scale 1.2 1.2 (0 :: GLdouble) + translate (Vector3 (-w/2) 0 (0 :: GLdouble)) renderPowerUpName i activeGauge = powerUpPointer vicViper isLimit i = powerUpLevels vicViper!i>=powerUpLimits!!i renderPowerUpName i = do - translate (Vector3 6 3.5 (0 :: Double)) - scale (0.15 :: Double) 0.13 0.15 + translate (Vector3 6 3.5 (0 :: GLdouble)) + scale (0.15 :: GLdouble) 0.13 0.15 renderString Roman $ ["SPEED","MISSILE","DOUBLE","LASER","OPTION"," ?"]!!i renderGameObject vic@VicViper{position = x:+y} = if hp vic<=0 then preservingMatrix $ do translate (Vector3 x y 0) scale pishaMagnitudeX pishaMagnitudeY 0 - renderWithShade (Color3 (1.0 :: Double) 0 0) (Color3 (1.0 :: Double) 0.6 0.4) $ do + renderWithShade (Color3 (1.0 :: GLdouble) 0 0) (Color3 (1.0 :: GLdouble) 0.6 0.4) $ do renderPrimitive LineLoop $ ugoVertices2DFreq 0 1 1 [(0,12),(8,8),(10,4),(20,0),(10,-4),(8,-8),(0,-12),(-8,-8),(-10,-4),(-20,0),(-10,4),(-8,8)] else preservingMatrix $ do translate (Vector3 x y 0) - renderWithShade (Color3 (1.0 :: Double) 1.0 1.0) (Color3 (0.4 :: Double) 0.4 0.6) $ do + renderWithShade (Color3 (1.0 :: GLdouble) 1.0 1.0) (Color3 (0.4 :: GLdouble) 0.4 0.6) $ do renderPrimitive LineStrip $ ugoVertices2D 0 2 [((-14),(-1)),((-12),5),((-20),13),(-14,13),(2,5),(8,1),(32,1),(32,(-1)),(24,(-3)),(16,(-3))] renderPrimitive LineStrip $ ugoVertices2D 0 2 [((-10),(-1)),(14,(-1)),(18,(-5)),(4,(-9)),((-2),(-9))] renderPrimitive LineLoop $ ugoVertices2D 0 2 [((-18),3),((-16),3),((-16),(-3)),((-18),(-3))] - renderWithShade (Color3 (0.92 :: Double) 0.79 0.62) (Color3 (0.75 :: Double) 0.38 0.19) $ do + renderWithShade (Color3 (0.92 :: GLdouble) 0.79 0.62) (Color3 (0.75 :: GLdouble) 0.38 0.19) $ do renderPrimitive LineStrip $ ugoVertices2D 0 2 [(4,3),(6,5),(14,5),(22,1)] --cockpit - renderWithShade (Color3 (0.6 :: Double) 0.8 1.0) (Color3 0.19 0.38 (0.75 :: Double)) $ do + renderWithShade (Color3 (0.6 :: GLdouble) 0.8 1.0) (Color3 0.19 0.38 (0.75 :: GLdouble)) $ do renderPrimitive LineLoop $ ugoVertices2D 0 2 [((-14),(-1)),((-10),(-1)),((-2),(-9)),((-4),(-9)),((-10),(-7)),((-14),(-3))] -- identification blue coting - renderWithShade (Color3 (0 :: Double) 0 0.8) (Color3 (0.0 :: Double) 0.0 0.4) $ do + renderWithShade (Color3 (0 :: GLdouble) 0 0.8) (Color3 (0.0 :: GLdouble) 0.0 0.4) $ do renderPrimitive LineLoop $ ugoVertices2D 0 4 [((-36),1),((-28),5),((-24),5),((-20),1),((-20),(-1)),((-24),(-5)),((-28),(-5)),((-36),(-1))] -- backfire where - pishaMagnitudeX :: Double - pishaMagnitudeY :: Double - pishaMagnitudeX = max 0 $ (8*) $ (\z -> z*(1-z)) $ (/20) $ intToDouble $ ageAfterDeath vic - pishaMagnitudeY = max 0 $ (5*) $ (\z -> z*(1-z)) $ (/15) $ intToDouble $ ageAfterDeath vic + pishaMagnitudeX :: GLdouble + pishaMagnitudeY :: GLdouble + pishaMagnitudeX = max 0 $ (8*) $ (\z -> z*(1-z)) $ (/20) $ intToGLdouble $ ageAfterDeath vic + pishaMagnitudeY = max 0 $ (5*) $ (\z -> z*(1-z)) $ (/15) $ intToGLdouble $ ageAfterDeath vic renderGameObject Option{position = x:+y} = preservingMatrix $ do translate (Vector3 x y 0) - renderWithShade (Color3 (0.8 :: Double) 0 0) (Color3 (0.4 :: Double) 0 0) $ + renderWithShade (Color3 (0.8 :: GLdouble) 0 0) (Color3 (0.4 :: GLdouble) 0 0) $ renderPrimitive LineLoop $ ugoVertices2D 0 2 [(5,9),(9,7),(13,3),(13,(-3)),(9,(-7)),(5,(-9)), ((-5),(-9)),((-9),(-7)),((-13),(-3)),((-13),3),((-9),7),((-5),9)] - renderWithShade (Color3 (1.0 :: Double) 0.45 0) (Color3 (0.4 :: Double) 0.2 0) $ + renderWithShade (Color3 (1.0 :: GLdouble) 0.45 0) (Color3 (0.4 :: GLdouble) 0.2 0) $ renderPrimitive LineStrip $ ugoVertices2D 0 1 [((-12.0),(3.4)),(0.8,8.7),((-8.1),(-0.9)),(4.0,5.8),(4.3,5.6), ((-4.4),(-6.8)),((-4.1),(-6.9)),(8.3,0.8),(9.0,0.6),(2.0,(-7.2))] renderGameObject StandardMissile{position=x:+y,velocity=v} = preservingMatrix $ do - let dir = (phase v) :: Double + let dir = (phase v) :: GLdouble translate (Vector3 x y 0) - rotate (dir / pi * 180) (Vector3 0 0 (1 :: Double)) - color (Color3 (1.0 :: Double) 0.9 0.5) + rotate (dir / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1.0 :: GLdouble) 0.9 0.5) renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(-7,2),(-7,-2)] renderPrimitive LineStrip $ ugoVertexFreq (-11) 0 0 1 1 >> ugoVertexFreq (-17) 0 0 7 1 @@ -1114,8 +1114,8 @@ preservingMatrix $ do let (_,phse)=polar v translate (Vector3 x y 0) - rotate (phse / pi * 180) (Vector3 0 0 (1 :: Double)) - color (Color3 (1.0 :: Double) 0.9 0.5) + rotate (phse / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1.0 :: GLdouble) 0.9 0.5) renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),((-5),0),((-9),0),((-11),0)] renderGameObject laser@StandardLaser{position=x:+y,velocity=v} = @@ -1123,17 +1123,17 @@ else preservingMatrix $ do let (_,phs)=polar v translate (Vector3 x y 0) - rotate (phs / pi * 180) (Vector3 0 0 (1 :: Double)) - color (Color3 (0.7 :: Double) 0.9 1.0) + rotate (phs / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (0.7 :: GLdouble) 0.9 1.0) renderPrimitive Lines $ ugoVertices2D 0 0 [(12,0),(-laserSpeed,0)] renderGameObject Shield{position=x:+y, size = r,angle = theta} = preservingMatrix $ do translate (Vector3 x y 0) - rotate theta (Vector3 0 0 (1 :: Double)) - renderWithShade (Color3 (0.375 :: Double) 0.75 0.9375) (Color3 (0.86 :: Double) 0.86 0.86) $ do + rotate theta (Vector3 0 0 (1 :: GLdouble)) + renderWithShade (Color3 (0.375 :: GLdouble) 0.75 0.9375) (Color3 (0.86 :: GLdouble) 0.86 0.86) $ do scale r r 0 renderTriangle - rotate 60 (Vector3 0 0 (1 :: Double)) + rotate 60 (Vector3 0 0 (1 :: GLdouble)) renderTriangle where renderTriangle = do renderPrimitive LineLoop $ ugoVertices2DFreq 0 0.1 1 $ map (\t -> (cos t,sin t)) [0,pi*2/3,pi*4/3] @@ -1141,27 +1141,27 @@ renderGameObject powerUpCapsule@PowerUpCapsule{} = preservingMatrix $ do let x:+y = position powerUpCapsule translate (Vector3 x y 0) - renderWithShade (Color3 (0.9 :: Double) 0.9 0.9) (Color3 (0.4 :: Double) 0.4 0.4) $ do + renderWithShade (Color3 (0.9 :: GLdouble) 0.9 0.9) (Color3 (0.4 :: GLdouble) 0.4 0.4) $ do futa >> neji >> toge - rotate (180) (Vector3 1 0 (0 :: Double)) >> toge - rotate (180) (Vector3 0 1 (0 :: Double)) >> futa >> neji >> toge - rotate (180) (Vector3 1 0 (0 :: Double)) >> toge - renderWithShade (Color3 (1.0 :: Double) 0.0 0.0) (Color3 (0.3 :: Double) 0.3 0.0) $ do + rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge + rotate (180) (Vector3 0 1 (0 :: GLdouble)) >> futa >> neji >> toge + rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge + renderWithShade (Color3 (1.0 :: GLdouble) 0.0 0.0) (Color3 (0.3 :: GLdouble) 0.3 0.0) $ do nakami where futa = renderPrimitive LineStrip $ ugoVertices2D 0 1 [((-10),6),((-6),10),(6,10),(10,6)] neji = (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(12,4),(12,(-4))]) >> (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(16,2),(16,(-2))]) toge = renderPrimitive LineStrip $ ugoVertices2D 0 1 [(10,8),(16,14)] - nakami = rotate 145 (Vector3 0.2 0.2 (1 :: Double)) >> scale 9 6 (1 :: Double) >> + nakami = rotate 145 (Vector3 0.2 0.2 (1 :: GLdouble)) >> scale 9 6 (1 :: GLdouble) >> (renderPrimitive LineStrip $ ugoVertices2D 0 0.2 $ map (\n -> (cos$n*pi/8,sin$n*pi/8)) [1,15,3,13,5,11,7,9]) renderGameObject DiamondBomb{position = (x:+y),age=clock} = preservingMatrix $ do translate (Vector3 x y 0) - rotate (90*intToDouble(clock`mod`4)) (Vector3 0 0 (1 :: Double)) - color (Color3 (1 :: Double) 1 1) + rotate (90*intToGLdouble(clock`mod`4)) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1 :: GLdouble) 1 1) renderPrimitive LineLoop $ vertices2D 0 $ [a,b,c] - color (Color3 (0.5 :: Double) 0.5 0.5) + color (Color3 (0.5 :: GLdouble) 0.5 0.5) renderPrimitive Lines $ vertices2D 0 $ [a,d,a,e] renderPrimitive LineStrip $ vertices2D 0 $ [c,d,e,b] where @@ -1174,12 +1174,12 @@ -- e renderGameObject TurnGear{position=x:+y,age=clock} = preservingMatrix $ do translate (Vector3 x y 0) - color (Color3 1.0 0.7 1.0 :: Color3 Double) - rotate (5 * intToDouble clock) (Vector3 0 0 1 :: Vector3 Double) + color (Color3 1.0 0.7 1.0 :: Color3 GLdouble) + rotate (5 * intToGLdouble clock) (Vector3 0 0 1 :: Vector3 GLdouble) renderWing - rotate 120 (Vector3 0 0 1 :: Vector3 Double) + rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) renderWing - rotate 120 (Vector3 0 0 1 :: Vector3 Double) + rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) renderWing where renderWing = renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map ((\(t:+u) -> (t,u)) . (\(r,t) -> mkPolar r (pi*t)) ) @@ -1187,32 +1187,32 @@ renderGameObject Flyer{position=x:+y,age=_,velocity = v,hasItem=item} = preservingMatrix $ do translate (Vector3 x y 0) - color (if item then (Color3 1.0 0.2 0.2 :: Color3 Double) else (Color3 0.3 1.0 0.7 :: Color3 Double)) - rotate (phase v / pi * 180) (Vector3 0 0 (1 :: Double)) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) + rotate (phase v / pi * 180) (Vector3 0 0 (1 :: GLdouble)) renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(-2,0),(-6,4),(-10,0),(-6,-4)] renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,4),(16,4),(4,16),(-10,16)] renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,-4),(16,-4),(4,-16),(-10,-16)] renderGameObject Ducker{position = (x:+y),hitDisp=hd,hasItem=item,velocity = v,gVelocity = g,age = a} = preservingMatrix $ do translate (Vector3 x y 0) - if signum (imagPart g) > 0 then scale 1 (-1) (1 :: Double) else return () - if signum (realPart v) < 0 then scale (-1) 1 (1 :: Double) else return () + if signum (imagPart g) > 0 then scale 1 (-1) (1 :: GLdouble) else return () + if signum (realPart v) < 0 then scale (-1) 1 (1 :: GLdouble) else return () --after this, ducker is on the lower ground, looking right - color (if item then (Color3 1.0 0.2 0.2 :: Color3 Double) else (Color3 0.3 1.0 0.7 :: Color3 Double)) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) renderShape (0:+0) hd renderPrimitive LineStrip $ vertices2D 0 [(0,0),(kx,ky),(fx,fy)] where - fx:+fy=foot $ intToDouble a/2 - kx:+ky=knee $ intToDouble a/2 + fx:+fy=foot $ intToGLdouble a/2 + kx:+ky=knee $ intToGLdouble a/2 foot theta = (16*cos(-theta)):+(-16+8*sin(-theta)) knee theta = foot theta * (0.5 :+ (- sqrt(square(legLen/magnitude(foot theta)) - 0.25))) legLen = 16 renderGameObject Jumper{position = (x:+y),hitDisp=hd,hasItem=item,gravity = g,velocity=v} = preservingMatrix $ do translate (Vector3 x y 0) - color (if item then (Color3 1.0 0.2 0.2 :: Color3 Double) else (Color3 0.3 1.0 0.7 :: Color3 Double)) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) renderShape (0:+0) hd - if gsign >0 then rotate 180 (Vector3 (1 :: Double) 0 0) else return() -- after this you can assume that the object is not upside down + if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(15,-5),(25,-5+absvy*leg),(25,-25+absvy*leg)] renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(-15,-5),(-25,-5+absvy*leg),(-25,-25+absvy*leg)] where @@ -1221,7 +1221,7 @@ leg = 1.5 renderGameObject Grashia{position = (x:+y),hitDisp=hd,hasItem=item,gunVector = nv,gravity = g,mode=m} = preservingMatrix $ do - color (if item then (Color3 1.0 0.2 0.2 :: Color3 Double) else (Color3 0.3 1.0 0.7 :: Color3 Double)) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) translate (Vector3 x y 0) renderShape (0:+0) hd renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map (\r -> (nvx*r,nvy*r)) [16,32] @@ -1235,30 +1235,30 @@ renderGameObject me@ScrambleHatch{position = (x:+y),hitDisp=_,gravity= g,gateAngle = angl} = preservingMatrix $ do translate (Vector3 x y 0) - color (Color3 (1.2*(1-hpRate)) 0.5 (1.6*hpRate) :: Color3 Double) - if gsign >0 then rotate 180 (Vector3 (1 :: Double) 0 0) else return() -- after this you can assume that the object is not upside down + color (Color3 (1.2*(1-hpRate)) 0.5 (1.6*hpRate) :: Color3 GLdouble) + if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*2) 1 $ [(-45,1),(-45,hatchHeight),(45,hatchHeight),(45,1)] preservingMatrix $ do - translate (Vector3 45 hatchHeight (0 :: Double)) - rotate (-angl/pi*180) (Vector3 0 0 (1 :: Double)) + translate (Vector3 45 hatchHeight (0 :: GLdouble)) + rotate (-angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(-45,0),(-45,10)] preservingMatrix $ do - translate (Vector3 (-45) hatchHeight (0 :: Double)) - rotate (angl/pi*180) (Vector3 0 0 (1 :: Double)) + translate (Vector3 (-45) hatchHeight (0 :: GLdouble)) + rotate (angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(45,0),(45,10)] where gsign = signum $ imagPart g - hpRate = (intToDouble $ hp me)/(intToDouble hatchHP) + hpRate = (intToGLdouble $ hp me)/(intToGLdouble hatchHP) renderGameObject LandScapeBlock{position=pos,hitDisp=hd} = preservingMatrix $ do - color (Color3 0.6 0.2 0 :: Color3 Double) + color (Color3 0.6 0.2 0 :: Color3 GLdouble) renderShape pos hd if treasure!!(baseGameLevel variables) then do - color (Color3 0.7 0.23 0 :: Color3 Double) - translate (Vector3 0 0 (60 :: Double)) + color (Color3 0.7 0.23 0 :: Color3 GLdouble) + translate (Vector3 0 0 (60 :: GLdouble)) renderShape pos hd - color (Color3 0.5 0.17 0 :: Color3 Double) - translate (Vector3 0 0 (-120 :: Double)) + color (Color3 0.5 0.17 0 :: Color3 GLdouble) + translate (Vector3 0 0 (-120 :: GLdouble)) renderShape pos hd else return() @@ -1269,14 +1269,14 @@ renderShape (0:+0) $ Circular (0:+0) (size me*extent) else return () where - extent = 0.5 + intCut (intToDouble(age me) / decayTime me) - decay = exp $ intCut $ -intToDouble (age me) / decayTime me - whiteout = exp $ intCut $ -2*intToDouble (age me) / decayTime me + extent = 0.5 + intCut (intToGLdouble(age me) / decayTime me) + decay = exp $ intCut $ -intToGLdouble (age me) / decayTime me + whiteout = exp $ intCut $ -2*intToGLdouble (age me) / decayTime me r = mr * decay + whiteout g = mg * decay + whiteout b = mb * decay + whiteout - intCut :: Double -> Double - intCut = intToDouble.round + intCut :: GLdouble -> GLdouble + intCut = intToGLdouble.round renderGameObject Star{position = x:+y,particleColor=c} = preservingMatrix $ do color c @@ -1291,13 +1291,13 @@ VicViper{} -> True _ -> False) objects - renderShape :: Complex Double -> Shape -> IO () + renderShape :: Complex GLdouble -> Shape -> IO () renderShape (x:+y) s = case s of Rectangular{bottomLeft = (l:+b), topRight = (r:+t)} -> renderPrimitive LineLoop $ vertices2D 0 [(x+l,y+b),(x+l,y+t),(x+r,y+t),(x+r,y+b)] Circular{center=cx:+cy, radius = r} -> preservingMatrix $ do translate (Vector3 (cx+x) (cy+y) 0) - rotate (intToDouble gameclock*(45+pi)) (Vector3 0 0 (1 :: Double)) + rotate (intToGLdouble gameclock*(45+pi)) (Vector3 0 0 (1 :: GLdouble)) scale r r 1 renderPrimitive LineLoop $ vertices2D 0 $ map (\t -> (cos(2/7*t*pi),sin(2/7*t*pi))) [0..6] Shapes{children=cs} -> mapM_ (renderShape (x:+y)) cs @@ -1307,19 +1307,19 @@ renderWithShade colorA colorB rndrr = do color colorB preservingMatrix $ do - translate $ Vector3 1 (-1) (-1 :: Double) + translate $ Vector3 1 (-1) (-1 :: GLdouble) rndrr color colorA preservingMatrix rndrr --- ugoVertex :: Double -> Double -> Double -> Double -> IO () +-- ugoVertex :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO () -- ugoVertex x y z r = ugoVertexFreq x y z r standardUgoInterval - ugoVertexFreq :: Double -> Double -> Double -> Double -> Int -> IO () + ugoVertexFreq :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> Int -> IO () -- renders a vertex at somewhere near (x y z), -- but the point wiggles around in ugoRange when each interval comes. ugoVertexFreq x y z ugoRange intrvl = vertex $ Vertex3 (x+dr*cos theta) (y+dr*sin theta) z where - flipper :: Double + flipper :: GLdouble flipper = fromIntegral $ (gameclock `div` intrvl) `mod` 1024 dr = ugoRange * vibrator(phi) theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper @@ -1328,7 +1328,7 @@ ugoTranslate x y z ugoRange = ugoTranslateFreq x y z ugoRange standardUgoInterval ugoTranslateFreq x y z ugoRange intvl = translate (Vector3 (x+dr*cos theta) (y+dr*sin theta) z) where - flipper :: Double + flipper :: GLdouble flipper = fromIntegral $ (gameclock `div` intvl) `mod` 1024 dr = ugoRange * vibrator(phi) theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper @@ -1338,7 +1338,7 @@ ugoVertices2D z r xys = ugoVertices2DFreq z r standardUgoInterval xys ugoVertices2DFreq z r intrvl xys = mapM_ (\(x,y) -> ugoVertexFreq x y z r intrvl) xys - vertices2D :: Double -> [(Double,Double)] -> IO () + vertices2D :: GLdouble -> [(GLdouble,GLdouble)] -> IO () vertices2D z xys = mapM_ (\(x,y) -> vertex $ Vertex3 x y z) xys standardUgoInterval :: Int
Monadius/Recorder.hs view
@@ -64,9 +64,9 @@ renderRecorder me = do (putDebugStrLn.show.mode) me if age me==0 || mode me /= Record then return () else preservingMatrix $ do - translate (Vector3 300 (-230) (0::Double)) - scale 0.1 0.1 (0.1 :: Double) - color (Color3 0.4 0.4 (0.4 :: Double)) + translate (Vector3 300 (-230) (0::GLdouble)) + scale 0.1 0.1 (0.1 :: GLdouble) + color (Color3 0.4 0.4 (0.4 :: GLdouble)) renderString Roman $ show $ (head.preEncodedKeyBuf) me render $ gameBody me
Monadius/Util.hs view
@@ -7,7 +7,7 @@ filterJust, infinite, innerProduct, - intToDouble, + intToGLdouble, isDebugMode, modifyArray, padding, @@ -20,6 +20,7 @@ import Data.Maybe (fromJust, isJust) import Data.Complex import Data.Array ( (!), (//), Array(), Ix() ) +import Graphics.Rendering.OpenGL -- Types.GLdouble -- | Switch this to True to get debug outputs. Be careful: you get a crash under -- Microsoft Windows, because the console is not available. @@ -40,7 +41,7 @@ -- | Collision check (>?<) :: s -> s -> Bool -- | Translation by a vector - (+>) :: (Complex Double) -> s -> s + (+>) :: (Complex GLdouble) -> s -> s instance ComplexShape Shape where a >?< b = case (a,b) of @@ -57,8 +58,8 @@ Rectangular{} -> a{bottomLeft = bottomLeft a + v, topRight = topRight a + v} Shapes{} -> a{children = map (v +>) $ children a} -data Shape = Circular {center :: Complex Double, radius :: Double} | - Rectangular {bottomLeft :: Complex Double, topRight :: Complex Double} | +data Shape = Circular {center :: Complex GLdouble, radius :: GLdouble} | + Rectangular {bottomLeft :: Complex GLdouble, topRight :: Complex GLdouble} | Shapes {children :: [Shape]} -- | Put a Rectangle coordinates into normal order so that collision will go properly. @@ -67,22 +68,22 @@ regulate ss@Shapes{} = ss{children = map regulate $ children ss} regulate x = x -intToDouble :: Int -> Double -intToDouble = fromIntegral +intToGLdouble :: Int -> GLdouble +intToGLdouble = fromIntegral -unitVector :: Complex Double -> Complex Double +unitVector :: Complex GLdouble -> Complex GLdouble unitVector z | magnitude z <= 0.00000001 = 1:+0 | otherwise = z / abs z -angleAccuracy :: Int -> Complex Double -> Complex Double +angleAccuracy :: Int -> Complex GLdouble -> Complex GLdouble angleAccuracy division z = mkPolar r theta where (r,t)=polar z - theta = (intToDouble $ round (t / (2*pi) * d))/d*2*pi - d = intToDouble division + theta = (intToGLdouble $ round (t / (2*pi) * d))/d*2*pi + d = intToGLdouble division -innerProduct :: Complex Double -> Complex Double -> Double +innerProduct :: Complex GLdouble -> Complex GLdouble -> GLdouble innerProduct a b = realPart $ a * (conjugate b) padding :: Char -> Int -> String -> String