diff --git a/Monadius.cabal b/Monadius.cabal --- a/Monadius.cabal +++ b/Monadius.cabal @@ -1,20 +1,22 @@ name: Monadius -version: 0.9.20071204 +version: 0.91 synopsis: 2-D arcade scroller description: A fast-paced 2-D scrolling vector graphics clone of the arcade game Gradius. category: Game license: GPL license-file: LICENSE -extra-source-files: monadius.rc, monadius.ico author: Hideyuki Tanaka & Takayuki Muranushi maintainer: Takayuki Muranushi -build-depends: base, GLUT, OpenGL, array, directory +homepage: http://www.geocities.jp/takascience/haskell/monadius_en.html + +build-depends: base>3, haskell98, GLUT, OpenGL, array, directory build-type: Simple -extra-source-files: readme-e.txt, readme-j.txt +data-files: readme-e.txt, readme-j.txt +tested-with: GHC==6.8.2 executable: monadius main-is: Main.hs -hs-source-dirs: Monadius/ +hs-source-dirs: Monadius other-modules: Demo, Game, Monadius, Recorder, Util ghc-options: -O2 -Wall -optl-Wl,-s diff --git a/Monadius/Demo.hs b/Monadius/Demo.hs --- a/Monadius/Demo.hs +++ b/Monadius/Demo.hs @@ -4,7 +4,7 @@ ) where -- | Demos are automatically played if you let the title scene run for a minute. -data ReplayInfo = ReplayInfo ((Int,Int),String) +newtype ReplayInfo = ReplayInfo ((Int,Int),String) deriving (Show,Read) -- | Infinite list of demos. diff --git a/Monadius/Main.hs b/Monadius/Main.hs --- a/Monadius/Main.hs +++ b/Monadius/Main.hs @@ -5,9 +5,7 @@ This project meant to list up, not to solve, many possible problems that will appear while writing a game in Haskell. Only nushio is responsible to the unreadability of these codes. -} -module Main ( - main - ) where +module Main (main) where import Graphics.UI.GLUT hiding (position) import Graphics.Rendering.OpenGL.GLU @@ -130,7 +128,7 @@ -- | Scene is something that does some IO, -- then returns the Scene that are to be executed in next frame. -data Scene = Scene (IO Scene) +newtype Scene = Scene (IO Scene) openingProc :: Int -> Int -> GlobalVariables -> IORef [Key] -> IO Scene openingProc clock menuCursor vars ks = do diff --git a/Monadius/Monadius.hs b/Monadius/Monadius.hs --- a/Monadius/Monadius.hs +++ b/Monadius/Monadius.hs @@ -19,7 +19,7 @@ render = renderMonadius isGameover = isMonadiusOver -data Monadius = Monadius (GameVariables,[GameObject]) +newtype Monadius = Monadius (GameVariables,[GameObject]) getVariables :: Monadius -> GameVariables getVariables (Monadius (vs,_))=vs @@ -46,7 +46,7 @@ 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 - Probe{ -- this lets missile to fly along the terrian + Probe{ -- this lets missile to fly along the terrain tag :: Maybe Int,position :: Complex Double,hitDisp :: Shape,hp :: Int } | StandardRailgun{ @@ -140,14 +140,13 @@ deriving(Eq) data WeaponType = NormalShot | Missile | DoubleShot | Laser - deriving(Eq) + deriving (Eq) -- WeaponType NormalShot | Missile | DoubleShot | 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 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} @@ -156,14 +155,14 @@ -- initialization -- ------------------------------ -initialMonadius :: GameVariables->Monadius +initialMonadius :: GameVariables -> Monadius initialMonadius initVs = Monadius (initGameVariables,initGameObjects) where initGameVariables = initVs 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 + 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) 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 @@ -279,7 +278,7 @@ where sign = (-grvty) freshTable :: Double -> 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] +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) @@ -306,7 +305,7 @@ -- ----------------------------- -updateMonadius :: [Key]->Monadius->Monadius +updateMonadius :: [Key] -> Monadius -> Monadius updateMonadius realKeys (Monadius (variables,objects)) = Monadius (newVariables,newObjects) where gameVariables = variables @@ -347,7 +346,7 @@ ScoreFragment{score = p} -> p _ -> 0) objects :: [Int]) - updateGameObject :: GameObject->[GameObject] + updateGameObject :: GameObject -> [GameObject] -- update each of the objects and returns list of resulting objects. -- the list usually includes the modified object itself, -- may include several generated objects such as bullets and explosions, @@ -360,7 +359,7 @@ (modifyArray gaugeOfShield (const (if (shieldCount > 0) then 1 else 0))) $ (if doesPowerUp then ( modifyArray (powerUpPointer vic) - (\x->if x if x1.1 then sqrt(0.5) else 1 - isMoving = any (\b-> elem b keys) [rightButton,leftButton,upButton,downButton] + isMoving = any (\b -> elem b keys) [rightButton,leftButton,upButton,downButton] doesPowerUp = (powerUpButton `elem` keys) && (powerUpPointer vic >=0) && (powerUpPointer vic ==0 || powerUpLevels vic!powerUpPointer viccase o of + shieldCount = sum $ map (\o -> case o of Shield{} -> 1 _ -> 0) gameObjects newShields = if (doesPowerUp && powerUpPointer vic==gaugeOfShield) then @@ -396,8 +395,13 @@ reloadTime = max 0 $ reloadTime option - 1 } - updateGameObject miso@StandardMissile{} = [miso{position=newpos,mode = newmode,velocity=v, - probe = (probe miso){position=newpos,hp=1}} ] where + updateGameObject miso@StandardMissile{} = [ + miso{position=newpos, + mode = newmode, + velocity=v, + probe = (probe miso){position=newpos,hp=1} + } + ] where newmode = if hp(probe miso) <= 0 then 1 else if mode miso == 0 then 0 else 2 v = case newmode of @@ -411,8 +415,8 @@ [shot{position=position shot + velocity shot}] updateGameObject laser@StandardLaser{} = if hp laser <=0 then [] else - [laser{position=(\(x:+_)->x:+parentY) $ position laser + velocity laser,age=age laser+1}] where - myParent = head $ filter (\o->tag o==Just (parentTag laser)) gameObjects + [laser{position=(\(x:+_) -> x:+parentY) $ position laser + velocity laser,age=age laser+1}] where + myParent = head $ filter (\o -> tag o==Just (parentTag laser)) gameObjects _:+parentY = position myParent updateGameObject shield@Shield{} = if(hp shield<=0) then [] else [ @@ -460,7 +464,7 @@ updateGameObject me@SquadManager{position=pos,interval=intv,members=membs,age=clock,tag=Just myTag} = if mySquadIsWipedOut then( - if currentScore me >= bonusScore me then map (\o->o{position=pos}) (items me) else [] + if currentScore me >= bonusScore me then map (\o -> o{position=pos}) (items me) else [] )else me{ age = age me + 1, currentScore = currentScore me + todaysDeaths, @@ -468,11 +472,11 @@ }:dispatchedObjects where dispatchedObjects = if (clock `div` intv < length membs && clock `mod` intv == 0) then [(membs!!(clock `div` intv)){position=pos,managerTag=myTag}] else [] - todaysDeaths = sum $ map (\o->if hp o <=0 then 1 else 0) $ mySquad + todaysDeaths = sum $ map (\o -> if hp o <=0 then 1 else 0) $ mySquad mySquadIsWipedOut = clock > releaseTimeOfLastMember && length mySquad <= 0 warFront = position $ head $ mySquad releaseTimeOfLastMember = intv * (length membs-1) - mySquad = filter (\o->case o of + mySquad = filter (\o -> case o of TurnGear{managerTag=hisManagerTag} -> hisManagerTag == myTag -- bad, absolutely bad code _ -> False) gameObjectsAfterCollision @@ -519,7 +523,7 @@ aimX:+aimY = position vicViper - pos aimRate = (-(signum$realPart v))*aimX / (abs(aimY) +0.1) myShots = if charge me `mod` 7 /= 6 then [] else - map (\w->freshDiamondBomb{position=pos,velocity=w}) vs + map (\w -> freshDiamondBomb{position=pos,velocity=w}) vs vs = map (\vy -> (vgun me)*(bacterianShotSpeed:+(1.5*(vy)))) [-duckerShotWay!!gameLevel+1 , -duckerShotWay!!gameLevel+3 .. duckerShotWay!!gameLevel-0.9] updateGameObject me@Jumper{position=pos@(_:+_),velocity = v,age=_,gravity= g,touchedLand = touched} = @@ -588,9 +592,9 @@ me{ fever = if launch then f+1 else f }] - ++ if launch then map (\pos->freshStalk{position = pos,velocity=(-4):+0,hasItem = (realPart pos>0 && (round $ imagPart pos :: Int) `mod` (3*round margin)==0)}) $ - concat $ map (\t->[(340:+t),((-340):+t),(t:+(260)),(t:+(-260))]) $[(-margin*df),(((negate margin) * df) + (margin * 2))..(margin*df+1)] else [] where - launch = (<=0) $ length $ filter (\obj->case obj of + ++ if launch then map (\pos -> freshStalk{position = pos,velocity=(-4):+0,hasItem = (realPart pos>0 && (round $ imagPart pos :: Int) `mod` (3*round margin)==0)}) $ + concat $ map (\t -> [(340:+t),((-340):+t),(t:+(260)),(t:+(-260))]) $[(-margin*df),(((negate margin) * df) + (margin * 2))..(margin*df+1)] else [] where + launch = (<=0) $ length $ filter (\obj -> case obj of Flyer{} -> True _ -> False) objects df = intToDouble f - 1 @@ -599,14 +603,14 @@ updateGameObject x = [x] - makeMetalionShots :: GameObject->[GameObject] + makeMetalionShots :: GameObject -> [GameObject] {- this generates proper playerside bullets according to the current power up state of vicviper. both options and vicviper is updated using this. -} makeMetalionShots obj = obj{reloadTime=reloadTime obj+penalty1+penalty2, - weaponEnergy = max 0 $ min 100 $ weaponEnergy obj + if doesLaser then (-10) else 50 - }:(shots++missiles) where + 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 doesLaser then ([freshStandardLaser{position=position obj+(shotSpeed/2:+0),parentTag=myTag}] ,1) @@ -619,12 +623,12 @@ doesLaser = doesShot && elem Laser types doesMissile = (isJust $tag obj) && elem Missile types && (missileButton `elem` keys) && (missileCount<=0) myTag = fromJust $ tag obj - shotCount = length $ filter (\o->case o of + shotCount = length $ filter (\o -> case o of StandardRailgun{} -> parentTag o==myTag _ -> False) gameObjects - missileCount = length $ filter (\o->case o of - StandardMissile{} -> True - _ -> False) gameObjects + missileCount = length $ filter (\o -> case o of + StandardMissile{} -> True + _ -> False) gameObjects types = weaponTypes vicViper @@ -662,16 +666,16 @@ 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 _ _ = [] - issueTag :: Int -> [GameObject] -> (Int,[GameObject]) -- issue tag so that each objcet has unique tag, -- and every object will continue to hold the same tag. + issueTag :: Int -> [GameObject] -> (Int,[GameObject]) issueTag nt [] = (nt,[]) - issueTag nt (x:xs) = (newNextTag,taggedX:taggedXs) where - (nextTagForXs,taggedX) = if(isNothing $ tag x) then - (nt+1,x{tag = Just nt}) else (nt,x) - (newNextTag,taggedXs) = issueTag nextTagForXs xs + issueTag nt (x:xs) = (newNextTag,taggedX:taggedXs) + where + (nextTagForXs,taggedX) = if(isNothing $ tag x) then (nt+1,x{tag = Just nt}) else (nt,x) + (newNextTag,taggedXs) = issueTag nextTagForXs xs - collide :: [GameObject]->[GameObject] + collide :: [GameObject] -> [GameObject] -- collide a list of GameObjects and return the result. -- it is important NOT to delete any object at the collision -- collide, show then delete collide = map personalCollide @@ -679,14 +683,14 @@ -- each object has its own hitClasses and weakPoints. -- collision is not symmetric: A may crushed by B while B doesn't feel A. -- object X is hit by only objectsWhoseHitClassIsMyWeakPoint X. - personalCollide :: GameObject->GameObject + personalCollide :: GameObject -> GameObject personalCollide obj = foldr check obj $ objectsWhoseHitClassIsMyWeakPoint obj - objectsWhoseHitClassIsMyWeakPoint :: GameObject->[GameObject] + objectsWhoseHitClassIsMyWeakPoint :: GameObject -> [GameObject] objectsWhoseHitClassIsMyWeakPoint me = filter (\him -> not $ null $ (weakPoint me) `intersect` (hitClass him)) gameObjects - hitClass :: GameObject->[HitClass] + hitClass :: GameObject -> [HitClass] hitClass VicViper{} = [MetalionBody,ItemReceiver] hitClass StandardMissile{} = [MetalionShot] hitClass StandardRailgun{} = [MetalionShot] @@ -705,7 +709,7 @@ hitClass LandScapeBlock{} = [LandScape] hitClass _ = [] - weakPoint :: GameObject->[HitClass] + weakPoint :: GameObject -> [HitClass] weakPoint VicViper{} = [PowerUp,BacterianBody,BacterianShot,LandScape] weakPoint StandardMissile{} = [BacterianBody,LandScape] weakPoint Probe{} = [LandScape] @@ -726,7 +730,7 @@ -- after matching hitClass-weakPoint, you must check the shape of the pair of object -- to see if source really hits the target. - check :: GameObject->GameObject->GameObject + check :: GameObject -> GameObject -> GameObject check source target = case (source, target) of (LandScapeBlock{},StandardMissile{}) -> if(hit source target) then (affect source target2) else target2 where target2 = target{probe = if(hit source p) then (affect source p) else p} @@ -737,13 +741,13 @@ -- note that landScapeSensitive objects have special hitDispLand other than hitDisp. -- this allows some weapons to go through narrow land features, and yet -- wipe out wider area of enemies. - hit :: GameObject->GameObject->Bool + hit :: GameObject -> GameObject -> Bool hit a b = case (a,b) of (LandScapeBlock{},c) -> if landScapeSensitive c then (position a +> hitDisp a) >?< (position c +> hitDispLand c) else (position a +> hitDisp a) >?< (position b +> hitDisp b) _ -> (position a +> hitDisp a) >?< (position b +> hitDisp b) - affect :: GameObject->GameObject->GameObject + affect :: GameObject -> GameObject -> GameObject affect VicViper{} obj = case obj of pow@PowerUpCapsule{} -> pow{hp = hp pow-1} x -> x @@ -772,12 +776,12 @@ affect _ t = t - scroll :: GameObject->Maybe GameObject + scroll :: GameObject -> Maybe GameObject -- make an object scroll. -- if the object is to vanish out of the screen, it becomes Nothing. scroll obj = let (x:+y) = position obj - scrollBehavior :: GameObject->ScrollBehavior + scrollBehavior :: GameObject -> ScrollBehavior scrollBehavior VicViper{} = Enclosed False scrollBehavior Option {} = NoRollOut False -- We use the more verbose way of setting records here to guarantee @@ -837,7 +841,7 @@ 1450 -> [(freshGrashia (-1)){position = 340:+(-185),hasItem=True},(freshGrashia 1){position = 340:+(185)}] 1550 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] 1700 -> [(freshVolcano (-1)){position=479:+(-200)}] - 1900 -> map (\(g,x)-> (freshDucker g){position=x:+g*100}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] + 1900 -> map (\(g,x) -> (freshDucker g){position=x:+g*100}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] 1940 -> [(freshLandRoll (1)){position = 340:+(185)}] 1965 -> [(freshLandRoll (1)){position = 340:+(185)}] 1990 -> [(freshLandRoll (1)){position = 340:+(185)}] @@ -854,10 +858,10 @@ 2620 -> [(freshDucker 1){position=(-340):+(200)}] 2640 -> [(freshDucker 1){position=(-340):+(200),hasItem=True}] - 2800 -> map (\(g,x)-> (freshJumper g){position=x:+g*100,velocity=((-3)*signum x):+0}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] + 2800 -> map (\(g,x) -> (freshJumper g){position=x:+g*100,velocity=((-3)*signum x):+0}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] 2999 -> [(freshVolcano 2){position=479:+(20),velocity=(0:+(-0.5))},(freshVolcano (-2)){position=479:+(-20),velocity=(0:+(0.5))}] - 3200 -> concat $ map (\x->[freshLandScapeGround{position=(479-x):+220},freshLandScapeGround{position=(479-x):+(-220)}]) [320,640] + 3200 -> concat $ map (\x -> [freshLandScapeGround{position=(479-x):+220},freshLandScapeGround{position=(479-x):+(-220)}]) [320,640] 3210 -> [freshFlyer{position = 340:+150},freshFlyer{position = 340:+100,hasItem=True}] 3290 -> [freshFlyer{position = 340:+(-150)},freshFlyer{position = 340:+(-100),hasItem=True}] @@ -967,9 +971,9 @@ where clock = gameClock variables - optionCount = length $ filter (\o->case o of - Option{}->True - _ ->False) gameObjects + optionCount = length $ filter (\o -> case o of + Option{} -> True + _ -> False) gameObjects isRevival = optionCount <= 0 isEasy = gameLevel <= 1 @@ -980,7 +984,7 @@ -- things needed both for progress and rendering powerUpLimits :: [Int] powerUpLimits = [5,1,1,1,4,1] -weaponTypes :: GameObject->[WeaponType] +weaponTypes :: GameObject -> [WeaponType] weaponTypes viper@VicViper{} = [if powerUpLevels viper!gaugeOfDouble>0 then DoubleShot else if powerUpLevels viper!gaugeOfLaser>0 then Laser else @@ -1015,7 +1019,7 @@ gameclock = gameClock variables -- returns an IO monad that can render the object. - renderGameObject :: GameObject->IO () + renderGameObject :: GameObject -> IO () renderGameObject gauge@PowerUpGauge{} = preservingMatrix $ do let x:+y = position gauge translate (Vector3 x y 0) @@ -1084,8 +1088,8 @@ 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 = max 0 $ (8*) $ (\z -> z*(1-z)) $ (/20) $ intToDouble $ ageAfterDeath vic + pishaMagnitudeY = max 0 $ (5*) $ (\z -> z*(1-z)) $ (/15) $ intToDouble $ ageAfterDeath vic renderGameObject Option{position = x:+y} = preservingMatrix $ do translate (Vector3 x y 0) @@ -1132,7 +1136,7 @@ rotate 60 (Vector3 0 0 (1 :: Double)) renderTriangle where renderTriangle = do - renderPrimitive LineLoop $ ugoVertices2DFreq 0 0.1 1 $ map (\t->(cos t,sin t)) [0,pi*2/3,pi*4/3] + renderPrimitive LineLoop $ ugoVertices2DFreq 0 0.1 1 $ map (\t -> (cos t,sin t)) [0,pi*2/3,pi*4/3] renderGameObject powerUpCapsule@PowerUpCapsule{} = preservingMatrix $ do let x:+y = position powerUpCapsule @@ -1150,7 +1154,7 @@ (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) >> - (renderPrimitive LineStrip $ ugoVertices2D 0 0.2 $ map (\n-> (cos$n*pi/8,sin$n*pi/8)) [1,15,3,13,5,11,7,9]) + (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) @@ -1178,7 +1182,7 @@ rotate 120 (Vector3 0 0 1 :: Vector3 Double) renderWing where - renderWing = renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map ((\(t:+u)->(t,u)) . (\(r,t)->mkPolar r (pi*t)) ) + renderWing = renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map ((\(t:+u) -> (t,u)) . (\(r,t) -> mkPolar r (pi*t)) ) [(3,0), (3,2/3), (smallBacterianSize,1/3), (smallBacterianSize,0), (smallBacterianSize+3,-1/3)] renderGameObject Flyer{position=x:+y,age=_,velocity = v,hasItem=item} = preservingMatrix $ do @@ -1220,7 +1224,7 @@ color (if item then (Color3 1.0 0.2 0.2 :: Color3 Double) else (Color3 0.3 1.0 0.7 :: Color3 Double)) translate (Vector3 x y 0) renderShape (0:+0) hd - renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map (\r->(nvx*r,nvy*r)) [16,32] + renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map (\r -> (nvx*r,nvy*r)) [16,32] if m == 1 then do renderShape 0 $ Circular (16:+12*gsign) 4 renderShape 0 $ Circular ((-16):+12*gsign) 4 @@ -1271,7 +1275,7 @@ r = mr * decay + whiteout g = mg * decay + whiteout b = mb * decay + whiteout - intCut :: Double->Double + intCut :: Double -> Double intCut = intToDouble.round renderGameObject Star{position = x:+y,particleColor=c} = preservingMatrix $ do @@ -1287,9 +1291,9 @@ VicViper{} -> True _ -> False) objects - renderShape :: Complex Double->Shape->IO () + renderShape :: Complex Double -> Shape -> IO () renderShape (x:+y) s = case s of - Rectangular{bottomLeft = (l:+b), topRight = (r:+t)} -> + 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) @@ -1299,7 +1303,7 @@ Shapes{children=cs} -> mapM_ (renderShape (x:+y)) cs - renderWithShade :: ColorComponent a=>Color3 a->Color3 a->IO ()->IO () + renderWithShade :: ColorComponent a=>Color3 a -> Color3 a -> IO () -> IO () renderWithShade colorA colorB rndrr = do color colorB preservingMatrix $ do @@ -1308,10 +1312,10 @@ color colorA preservingMatrix rndrr --- ugoVertex :: Double->Double->Double->Double->IO () +-- ugoVertex :: Double -> Double -> Double -> Double -> IO () -- ugoVertex x y z r = ugoVertexFreq x y z r standardUgoInterval - ugoVertexFreq :: Double->Double->Double->Double->Int->IO () + ugoVertexFreq :: Double -> Double -> Double -> Double -> 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 @@ -1332,10 +1336,10 @@ vibrator a = 0.5 * (1 + sin a) ugoVertices2D z r xys = ugoVertices2DFreq z r standardUgoInterval xys - ugoVertices2DFreq z r intrvl xys = mapM_ (\(x,y)->ugoVertexFreq x y z r intrvl) xys + ugoVertices2DFreq z r intrvl xys = mapM_ (\(x,y) -> ugoVertexFreq x y z r intrvl) xys vertices2D :: Double -> [(Double,Double)] -> IO () - vertices2D z xys = mapM_ (\(x,y)->vertex $ Vertex3 x y z) xys + vertices2D z xys = mapM_ (\(x,y) -> vertex $ Vertex3 x y z) xys standardUgoInterval :: Int standardUgoInterval = 7 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/runhaskell + +import Distribution.Simple + +main = defaultMainWithHooks defaultUserHooks diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,4 +0,0 @@ -#! /usr/bin/env runhaskell - -> import Distribution.Simple -> main = defaultMain