Add flavour text, start smoke, support for different reload sounds

app/Main.hs

@@ -10,7 +10,7 @@ import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Dodge.Config.Load
 import Dodge.Config.Update
-import Dodge.LoadSound
+import Dodge.SoundLogic.LoadSound
 import Dodge.Debug.Flag.Data
 import Picture
 import Picture.Render

src/Dodge/Creature.hs

@@ -142,7 +142,8 @@ startCr :: Creature
 startCr = defaultCreature
     { _crPos = (0,0)
     , _crOldPos = (0,0)
-    , _crDir = 0
+    , _crDir = (pi/2)
+    , _crMvDir  = (pi/2)
     , _crID = 0
     , _crPict = basicCrPict black
     , _crUpdate = stateUpdate yourControl

src/Dodge/Creature/Action.hs

@@ -14,6 +14,7 @@ import Dodge.WorldEvent.Shockwave
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 --import Dodge.WorldEvent
 import Dodge.Inventory
 --import Dodge.LightSources

src/Dodge/Creature/Rationality.hs

@@ -7,6 +7,7 @@ import Dodge.Creature.Action
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Geometry
 
 import Data.Maybe

src/Dodge/Creature/State.hs

@@ -7,6 +7,7 @@ import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Test
 import Dodge.Base
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 --import Dodge.WallCreatureCollisions
@@ -122,6 +123,9 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
+    Just Weapon{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs} 
+        | rt == rs -> soundOncePos stype (_crPos cr) w
+        | otherwise -> w
     Just Weapon{_wpReloadState = 0} -> w
     Just Weapon{_wpReloadState = 1} -> stopSoundFrom (CrReloadSound cid) w
     Just Weapon{} -> soundFrom (CrReloadSound cid) reloadSound 1 0 w

src/Dodge/Data.hs

@@ -209,6 +209,7 @@ data Item
         , _wpAmmo :: Ammo
         , _wpReloadTime :: Int
         , _wpReloadState :: Int
+        , _wpReloadType :: ReloadType
         , _itUseRate :: Int
         , _itUseTime :: Int
         , _itUse     :: Item -> Creature -> World -> World
@@ -305,6 +306,9 @@ data Item
         , _itAimStance :: AimStance
         }
      | NoItem
+
+data ReloadType = ActiveReload | PassiveReload Int
+
 data ItEffect = NoItEffect
     | ItInvEffect 
         {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World

src/Dodge/Data/Menu.hs

@@ -11,4 +11,5 @@ data MenuLayer
     | ControlList
     | WaitMessage String Int
     | Terminal String
+    | TerminalMessage Int [(Int,String)]
   deriving (Eq,Ord)

src/Dodge/Default/Weapon.hs

@@ -14,6 +14,7 @@ defaultGun = Weapon
     , _wpAmmo = GenericAmmo
     , _wpReloadTime = 40
     , _wpReloadState = 0
+    , _wpReloadType = ActiveReload
     , _itUseRate = 8
     , _itUseTime = 0
     , _itUse = \_ _ -> id

src/Dodge/Event/Menu.hs

@@ -21,6 +21,8 @@ import SDL.Internal.Numbered
 
 handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
 handlePressedKeyInMenu mState scode w = case mState of
+    TerminalMessage 0 _ -> popMenu w
+    TerminalMessage _ m -> Just $ w & menuLayers %~ ((TerminalMessage 0 m : ) . tail)
     Terminal s -> case scode of
         ScancodeEscape  -> popMenu w
         ScancodeReturn  -> popMenu $ applyTerminalString s w

src/Dodge/Initialisation.hs

@@ -6,6 +6,10 @@ import Dodge.Creature
 --import Dodge.Base
 import Dodge.Floor
 import Dodge.Layout
+import Dodge.Story
+import Dodge.WorldEvent.Cloud
+import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 
 import System.Random
 import qualified Data.Set as S
@@ -17,35 +21,33 @@ initializeWorld w = w
 
 firstWorld :: IO World
 firstWorld = do
---    i <- randomRIO (0,5000)
-    let i = 2
+    i <- randomRIO (0,5000)
+--    let i = 2
     putStrLn $ "Seed for level generation: " ++ show ( i :: Int)
     return $ generateLevelFromRoomList levx $ initialWorld {_randGen = mkStdGen i}
 
 initialWorld :: World
 initialWorld = defaultWorld
-                { _keys = S.empty
-                , _cameraCenter = (0,0)
-                , _cameraRot = 0
-                , _cameraZoom = 1
-                , _creatures = IM.fromList [(0,startCr)]
-                , _projectiles = IM.empty
-                , _walls = IM.empty
-                , _forceFields = IM.empty
-                , _floorItems = IM.empty
-                , _randGen = mkStdGen 2
-                , _mousePos = (0,0)
-                , _testString = []
-                , _yourID = 0
-                , _worldEvents = id
-                , _pressPlates = IM.empty
-                , _buttons = IM.empty
-                , _soundQueue = []
-                , _sounds = M.empty
-                , _decorations = IM.empty
-                , _storedLevel = Nothing
-                , _menuLayers = [LevelMenu 1]
-                , _worldState = M.empty
-                }
-
-
+    { _keys = S.empty
+    , _cameraCenter = (0,0)
+    , _cameraRot = 0
+    , _cameraZoom = 10
+    , _creatures = IM.fromList [(0,startCr)]
+    , _projectiles = IM.empty
+    , _walls = IM.empty
+    , _forceFields = IM.empty
+    , _floorItems = IM.empty
+    , _randGen = mkStdGen 2
+    , _mousePos = (0,0)
+    , _testString = []
+    , _yourID = 0
+    , _worldEvents = soundOncePos foamSprayFadeOutSound (0,0) . foldr ((.) . makeStartCloudAt) id [(x,y) | x <- [-5,-3..5] , y <- [-5,-3..5]]
+    , _pressPlates = IM.empty
+    , _buttons = IM.empty
+    , _soundQueue = []
+    , _sounds = M.empty
+    , _decorations = IM.empty
+    , _storedLevel = Nothing
+    , _menuLayers = [TerminalMessage 300 rezText']
+    , _worldState = M.empty
+    }

src/Dodge/Item/Consumable.hs

@@ -5,6 +5,7 @@ import Dodge.Item.Data
 import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 
 import Dodge.Item.Draw
 

src/Dodge/Item/Weapon.hs

@@ -6,6 +6,7 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.Creature.Action
 import Dodge.RandomHelp
 import Dodge.WorldEvent
@@ -397,6 +398,7 @@ longGun = defaultGun
     , _wpLoadedAmmo = 1
     , _wpReloadTime = 80
     , _wpReloadState = 0
+    , _wpReloadType = PassiveReload sineRaisePitchOneSecSound
     , _itUseRate = 100
     , _itUseTime = 0
     , _itUse = shootWithSound (fromIntegral longGunSound)

src/Dodge/Item/Weapon/Grenade.hs

@@ -5,6 +5,7 @@ import Dodge.Item.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Draw
 import Dodge.Default.Shell

src/Dodge/Item/Weapon/Launcher.hs

@@ -111,8 +111,6 @@ doThrust pj w = w
     r1 = randInCirc 10 & evalState $ _randGen w
     smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
 
-
-
 flameLauncher :: Item
 flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
 poisonLauncher :: Item

src/Dodge/LevelGen/AutoDoor.hs

@@ -8,6 +8,7 @@ import Dodge.Data
 --import Dodge.Creature.State.Data
 import Dodge.Base
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.Creature.Property
 import Geometry
 import Picture

src/Dodge/LevelGen/TriggerDoor.hs

@@ -4,6 +4,7 @@ module Dodge.LevelGen.TriggerDoor
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.LevelGen.Switch
 import Dodge.LevelGen.Pathing
 import Picture

src/Dodge/Render/MenuScreen.hs

@@ -10,6 +10,7 @@ import Dodge.Data.Menu
 import Dodge.Config.Data
 --import Dodge.Base (halfWidth,halfHeight)
 import Picture
+import Geometry
 
 menuScreen 
     :: Configuration 
@@ -51,6 +52,7 @@ menuScreen cfig hw hh mLays = case mLays of
         ]
     (WaitMessage s _ : _) -> optionsList hw hh s []
     (Terminal s : _)    -> optionsList hw hh "SCANCODE INPUT" ['>':s ++ "_"]
+    (TerminalMessage t xs : _) -> displayStringList hw hh $ map snd $ filter (( > t) . fst) xs
     _ -> blank
   where 
     tst x y sc t = translate x y $ scale sc sc $ color white $ text t
@@ -60,6 +62,16 @@ menuScreen cfig hw hh mLays = case mLays of
     f x = show (round $ 10 * x :: Int)
     showShadRes i = "1/"++ show i
 
+displayStringList :: Float -> Float -> [String] -> Picture
+displayStringList hw hh ss = pictures
+    ( polygon (rectNSEW hh (-hh) hw (-hw))
+    : zipWith f ys ss
+    )
+  where
+    ys = [0,22..]
+    f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
+    
+
 optionsList
     :: Float    -- ^ Half screen width
     -> Float    -- ^ Half screen height

src/Dodge/Render/Picture.hs

@@ -50,10 +50,10 @@ customMouseCursor w =
     $ pictures [ line [(-5,0),(5,0)] , line [(0,-5),(0,5)] ]
 
 testPic :: World -> [Picture]
-testPic w = 
-    [ setDepth (-1) . translate 0 0.8
-        . scale 0.001 0.001 . text . show $ _crMvDir $ you w
-    ]
+testPic _ = [blank]
+--    [ setDepth (-1) . translate 0 0.8
+--        . scale 0.001 0.001 . text . show $ _crMvDir $ you w
+--    ]
 
 crDraw :: World -> Creature -> Picture
 crDraw w c = _crPict c c w

src/Dodge/Room/Foreground.hs

@@ -69,8 +69,8 @@ girderZ w x y = setDepth (-0.1) $ color red $ pictures $
     dia = rotateV (pi/4) n
     ps' = map (\p -> intersectSegLine' xt yt p (p +.+ dia)) ps
     ls = catMaybes $ zipWith (fmap . (,)) ps ps'
-girderV :: Float -> Point2 -> Point2 -> Picture
-girderV w x y = setDepth (-0.1) $ color red $ pictures $
+girderV :: Color -> Float -> Point2 -> Point2 -> Picture
+girderV col w x y = setDepth (-0.1) $ color col $ pictures $
     [ thickLine [xt,yt] 3 
     , thickLine [xb,yb] 3
     ]
@@ -83,16 +83,19 @@ girderV w x y = setDepth (-0.1) $ color red $ pictures $
     xt = x -.- n
     yt = y -.- n
     ps = divideLineExact (w*2) xb yb
-    (as,bs) = evenOddSplit ps
+    (as,_) = evenOddSplit ps
     f a = map (\p -> intersectSegLine' xt yt p (p +.+ (rotateV a n)))
     as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
     bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
-girder :: Float -> Point2 -> Point2 -> Picture
-girder w x y = setDepth (-0.1) $ color red $ pictures $
-    [ thickLine [xt,yt] 3 
-    , thickLine [xb,yb] 3
+girder :: Color -> Float -> Point2 -> Point2 -> Picture
+girder col w x y = pictures $
+    [ setDepth (-0.1) $ color col $ pictures $
+        [ thickLine [xt,yt] 3 
+        , thickLine [xb,yb] 3
+        ]
+        ++ map (flip thickLine 3 . flat2) ls
     ]
-    ++ map (flip thickLine 3 . flat2) ls
+    ++ map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
   where
     n = w *.* (normalizeV $ vNormal $ y -.- x)
     xb = x +.+ n

src/Dodge/Room/Start.hs

@@ -1,9 +1,11 @@
 module Dodge.Room.Start
     where
 import Dodge.Room.Data
+import Dodge.Room.Door
 import Dodge.Room.Link
 import Dodge.Room.Procedural
 import Dodge.Room.Foreground
+import Dodge.Layout.Tree.Polymorphic
 import Dodge.LevelGen.Data
 import Picture
 --import Geometry
@@ -13,19 +15,19 @@ import Control.Monad.State
 import Control.Lens
 import System.Random
 
+rezBox :: Room
+rezBox = shiftRoomBy ((-20,-10),0) $ roomRect 40 20 1 1 & rmPS .~ []
+
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
     let fground = sPS (0,0) 0 $ PutForeground $ pictures
-            --[ highDiagonalMesh (0,0) (0,h) w 50
-            ----, setDepth (-0.1) $ color orange $ pictures
-            ----    [ polygon $ rectNSEW 50 40 140 (-20)
-            ----    , translate 60 45 $ scale 0.5 1 $  thickArc 0 pi 75 10
-            ----    , translate (-20) 300 $ polygon $ rectNSEW 10 0 40 0
-            ----    ]
-            --, highDiagonalMesh (w,0) (0,0) h 50
             [ highPipe (0,h/2) (w, h/2)
-            , girderV 10 (0,3*h/4) (w, 3*h/4)
+            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
+            , girder colb 5 (0,5*h/8) (w, 5*h/8)
             ]
-    pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
+    treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
+  where
+    cola = dark . dark . light . light $ light red
+    colb = dark . dark . light . light $ light blue

src/Dodge/SoundLogic.hs

@@ -19,12 +19,8 @@ module Dodge.SoundLogic (
     , haltSound
     , resumeSound
     , pauseSound
-
-    -- * Synonyms for sound identifiers
-    , module Dodge.SoundLogic.Synonyms
     ) where
 import Dodge.Data
-import Dodge.SoundLogic.Synonyms
 import Sound.Data (SoundStatus (..))
 import Geometry.Vector
 import Geometry (dist)

src/Dodge/SoundLogic/LoadSound.hs

@@ -1,4 +1,4 @@
-module Dodge.LoadSound where
+module Dodge.SoundLogic.LoadSound where
 import qualified Data.IntMap.Strict as IM
 import qualified SDL.Mixer as Mix
 
@@ -47,6 +47,9 @@ loadSounds = do
     glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav" 
     glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav" 
     foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav" 
+    foamSprayFadeOut <- Mix.load "./data/sound/foamSprayFadeOut.wav" 
+    sineRaisePitchOneSec <- Mix.load "./data/sound/sineRaisePitchOneSec.wav" 
+    sineRaisePitchTwoSec <- Mix.load "./data/sound/sineRaisePitchTwoSec.wav" 
     return $ IM.fromList $ zip [0..]
         [ pFireSound
         , click
@@ -90,6 +93,9 @@ loadSounds = do
         , glass3'
         , glass4'    --40
         , foamSpray'
+        , foamSprayFadeOut
+        , sineRaisePitchOneSec
+        , sineRaisePitchTwoSec
         ]
 
 loadMusic :: IO (IM.IntMap Mix.Music)

src/Dodge/SoundLogic/Synonyms.hs

@@ -24,6 +24,12 @@ launcherSound = 20
 smokeTrailSound = 21
 foot1Sound = 22
 foot2Sound = 23
+foamSprayFadeOutSound :: Int
+foamSprayFadeOutSound = 42
+sineRaisePitchOneSecSound :: Int
+sineRaisePitchOneSecSound = 43
+sineRaisePitchTwoSecSound :: Int
+sineRaisePitchTwoSecSound = 44
 
 drawWeaponSound = 4
 holsterWeaponSound = 5

src/Dodge/Story.hs

@@ -0,0 +1,18 @@
+module Dodge.Story
+    where
+
+rezText :: [String]
+rezText = 
+    ["INITIALIZING..."
+    ,"COMPLETE"
+    ,"LOADING SUBJECT 288307..."
+    ,"COMPLETE"
+    ,"INITIALIZING RECONSTRUCTION..."
+    ,"WARNING 56684 PARAHIPPOCAMPAL GYRUS"
+    ,"WARNING 57810 DIENCEPHALON"
+    ,"RECONSTRUCTION TERMINATED 1527"
+    ,"PRESS ANY KEY TO CONTINUE"
+    ,">"
+    ]
+rezText' :: [(Int,String)]
+rezText' = reverse $ zip [300,250,248,200,198,100,80,10,1,999] rezText

src/Dodge/Update.hs

@@ -41,6 +41,7 @@ pushSideEffects w = w
 For most menus the only way to change the world is using event handling.  -}
 update' :: World -> World
 update' w = case _menuLayers w of
+    (TerminalMessage t xs:mls) -> w & menuLayers .~ (TerminalMessage (max (t-1) 0) xs:mls)
     (WaitMessage s i: _) 
         | i < 1     -> w & dbArg _worldEvents
         | otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )

src/Dodge/WorldEvent/Cloud.hs

@@ -37,6 +37,10 @@ makeThickSmokeAt = makeCloudAt 3 50 (drawCloudWith 4 50 black)
 makeThinSmokeAt :: Point2 -> World -> World
 makeThinSmokeAt = makeCloudAt 5 400 (drawCloudWith 4 400 (withAlpha 0.05 black))
 
+makeStartCloudAt :: Point2 -> World -> World
+--makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
+makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith (2) 800 white)
+
 makeSmokeCloudAt :: Point2 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
 makeSmokeCloudAt = makeCloudAt 15 400 (drawCloudWith (4/3) 800 (greyN 0.5))

src/Dodge/WorldEvent/Explosion.hs

@@ -9,6 +9,7 @@ import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Flash
 import Dodge.RandomHelp
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.WorldEvent.Shockwave
 import Geometry
 import Picture

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -15,6 +15,7 @@ import Dodge.WorldEvent.Flash
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Dodge.RandomHelp
 --import Dodge.Debug
 import Picture