diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -23,6 +23,9 @@ displayUniverse u = let arena' = arena u in let wmap = Universe.wrapMap arena' in + let pactiv x y = if panelActivationTimer u < x + then Blank + else y in let pship = do lance' <- lance arena' Just (image lance' undefined) in let pship' = fromMaybe Blank pship in @@ -86,8 +89,8 @@ let integrityTextL2 = Translate (-330.0) 365.0 (Scale 0.14 0.14 integrityAssessment) in - let sP = Translate 450.0 330.0 - (sensorPanel arena' (100.0, 100.0)) in + let sP = Translate 420.0 300.0 + (sensorPanel arena' (150.0, 150.0)) in let levelMessage = case levelMessageTimer u of Nothing -> Blank Just mt -> if mt `doubleRem` 0.5 < 0.25 @@ -96,22 +99,59 @@ (Text ("level " ++ show (level u + 1))) in + let sgt x y = if startGameTimer u < x then y else Blank in return $ Pictures $ displayables ++ [ pship' - , lanceLives $ deflectorText' - , lanceLives $ deflectorBar' - , lanceLives $ levelText - , lanceLives $ livesText - , lanceLives $ sP + , lanceLives $ pactiv 0.5 deflectorText' + , lanceLives $ pactiv 0.5 deflectorBar' + , lanceLives $ pactiv 0.5 levelText + , lanceLives $ pactiv 0.5 livesText + , lanceLives $ pactiv 1.5 sP , godText - , lanceLives $ integrityText - , lanceLives $ integrityTextL2 + , lanceLives $ pactiv 1.0 integrityText + , lanceLives $ pactiv 1.0 integrityTextL2 , lanceLives $ Translate (-400.0) 340.0 (inventoryDisplay (lance arena') (resourceTracker u)) , lanceLives $ levelMessage + , pactiv 2.0 $ sgt 20.0 $ Translate + (-100.0) + (-100.0) + helpColumn2 + , pactiv 2.0 $ sgt 20.0 $ Translate + (-120.0) + (-190.0) + helpColumn1 ] + +helpColumn1 = + Color cyan $ + Rotate 270.0 $ + Scale 0.13 0.13 $ + Text "CONTROLS" + +helpColumn2 = + Color white $ + Pictures $ + lineFormatting + [ "A, 0 to fire" + , "L-ARROW, 4 for port" + , "R-ARROW, 6 for starboard" + , "U-ARROW, 8 to accelerate" + , "TAB, 5 to switch weapons" + , "SPACEBAR, ENTER for deflector" + ] + +lineFormatting ys = lineFormatting' 20 0 ys + +lineFormatting' _ _ [] = [] +lineFormatting' x z (y:ys) = + Translate + 0.0 + ((-x) * z) + (Scale 0.14 0.14 + (Text y)) : lineFormatting' x (z + 1) ys inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture inventoryDisplay mLance rt = diff --git a/Resources.hs b/Resources.hs --- a/Resources.hs +++ b/Resources.hs @@ -60,6 +60,7 @@ ] in let imageFiles' = map ("image/" ++) imageFiles in let soundFiles = [ "test.wav" + , "blip.wav" , "energy-shot-02.wav" , "explosion.wav" , "simple-energy-shot.wav" diff --git a/Step.hs b/Step.hs --- a/Step.hs +++ b/Step.hs @@ -26,6 +26,7 @@ import Resources import Sound.ALUT import Common +import ResourceTracker delayOnDeath = 4.0 @@ -58,6 +59,8 @@ (wrappoint wmap (0, 0))) } , delayRemaining = delayOnDeath + , panelActivationTimer = 0.0 + , queueBlipSound = True } ) else return @@ -70,6 +73,8 @@ , level = 0 , lives = 3 , delayRemaining = delayOnDeath + , panelActivationTimer = 0.0 + , queueBlipSound = True } ) @@ -123,17 +128,18 @@ . handlePreUpdates . handleVisionUpdates . fixFocus - . handleUniverseCounters + . handleUniverseTimers ) (t, u) -handleUniverseCounters :: (Time, Universe) -> (Time, Universe) -handleUniverseCounters (t, u) = +handleUniverseTimers :: (Time, Universe) -> (Time, Universe) +handleUniverseTimers (t, u) = let u' = u { levelMessageTimer = case levelMessageTimer u of Nothing -> Nothing Just mt -> if mt > 1.5 then Nothing else Just (mt + t) , panelActivationTimer = panelActivationTimer u + t + , startGameTimer = startGameTimer u + t } in (t, u') @@ -156,17 +162,24 @@ , afterFX = afterFX' } } - -- case lance' of - -- Nothing -> return () - -- Just l -> do let (x, y) = toCoords - -- (Universe.wrapMap arena') - -- (Moving.center l) - -- listenerPosition $= (Vertex3 - -- (double2Float x) - -- (double2Float y) - -- 0) - return (t, u') - + u'' <- handleBlipSound u' + return (t, u'') + +handleBlipSound u = + do u' <- if isNothing (blipSoundSource u) + then initializeBlipSoundSource u + else return u + if not (queueBlipSound u') + then return u' + else if isNothing (lance (arena u)) + then return u' { queueBlipSound = False } + else do play [fromJust $ blipSoundSource u'] + return u' { queueBlipSound = False } + +initializeBlipSoundSource u = + do [source] <- genObjectNames 1 + buffer source $= getSound (resourceTracker u) "blip.wav" + return u { blipSoundSource = Just source } handleExpiration :: (Time, Universe) -> (Time, Universe) handleExpiration (t, u) = diff --git a/Universe.hs b/Universe.hs --- a/Universe.hs +++ b/Universe.hs @@ -11,6 +11,7 @@ import ResourceTracker import Item import Common +import Sound.ALUT data Arena = Arena { lance :: Maybe Lance , lastFocus :: WrapPoint @@ -34,6 +35,9 @@ , skipLevel :: Bool , levelMessageTimer :: Maybe Time , panelActivationTimer :: Time + , startGameTimer :: Time + , queueBlipSound :: Bool + , blipSoundSource :: Maybe Source } blankArena width height = diff --git a/edge.cabal b/edge.cabal --- a/edge.cabal +++ b/edge.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.8.2 +Version: 0.8.4 -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game diff --git a/edge.hs b/edge.hs --- a/edge.hs +++ b/edge.hs @@ -50,5 +50,8 @@ , skipLevel = False , levelMessageTimer = Nothing , panelActivationTimer = 0.0 + , startGameTimer = 0.0 + , queueBlipSound = True + , blipSoundSource = Nothing } diff --git a/sound/blip.wav b/sound/blip.wav new file mode 100644 Binary files /dev/null and b/sound/blip.wav differ