Add seagull sounds, remove random generator paramatricity for level gen

src/Dodge/Annotation.hs

@@ -14,22 +14,22 @@ import System.Random
 --import Control.Lens
 import Data.Maybe
 
-addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
+addLock :: Int -> Tree [Annotation] -> State StdGen (Tree [Annotation])
 addLock i t = do
     (beforeLock, afterLock) <- splitTrunk t
     newBefore <- applyToRandomNode (Key i :) beforeLock
     return $ addToTrunk newBefore [Node [Lock i] afterLock]
 {- | Add one corridor between each parent-child link of a tree of annotations.  -}
-padWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
+padWithCorridors :: Tree [Annotation] -> Tree [Annotation]
 padWithCorridors = padWithAno [Corridor]
 
-padWithAno :: [Annotation g] -> Tree [Annotation g] -> Tree [Annotation g]
+padWithAno :: [Annotation] -> Tree [Annotation] -> Tree [Annotation]
 padWithAno ano (Node x xs) = Node ano [Node x (map (padWithAno ano) xs)]
 
-padSucWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
+padSucWithCorridors :: Tree [Annotation] -> Tree [Annotation]
 padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
 
-padSucWithDoors :: RandomGen g => Tree [Annotation g] -> Tree [Annotation g]
+padSucWithDoors :: Tree [Annotation] -> Tree [Annotation]
 padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs)
   where
     thetree = do
@@ -40,7 +40,7 @@ padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs
             ]
 
 {- Add one to three corridors between each parent-child link of a tree of annotations.  -}
-randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
+randomPadCorridors :: Tree [Annotation] -> State StdGen (Tree [Annotation])
 randomPadCorridors  (Node x xs) = do
     n <- state $ randomR (1, 3)
     xs' <- mapM randomPadCorridors xs
@@ -52,7 +52,7 @@ roomThenCorridor theRoom = fmap
     (shuffleLinks corridor)
 
 {- | Create a random room tree structure from a list of annotations.  -}
-anoToRoomTree :: RandomGen g => [Annotation g] -> State g (SubCompTree Room)
+anoToRoomTree :: [Annotation] -> State StdGen (SubCompTree Room)
 anoToRoomTree anos = case anos of
     [AnoApplyInt i f] -> f i
     [ChainAnos ass] -> do

src/Dodge/Annotation/Data.hs

@@ -7,22 +7,23 @@ import Dodge.Tree.Compose.Data
 
 import Control.Monad.State
 import Control.Lens
-data Annotation g
+import System.Random
+data Annotation
     = Lock Int
     | Key  Int
     | Corridor
     | AirlockAno
-    | OrAno [[Annotation g]]
+    | OrAno [[Annotation]]
-    | SpecificRoom (State g (SubCompTree Room))
+    | SpecificRoom (State StdGen (SubCompTree Room))
     | BossAno Creature
     | TreasureAno [Creature] [Item]
-    | AnoApplyInt Int (Int -> State g (SubCompTree Room))
+    | AnoApplyInt Int (Int -> State StdGen (SubCompTree Room))
-    | AnoNewInt (Int -> State g (SubCompTree Room))
+    | AnoNewInt (Int -> State StdGen (SubCompTree Room))
     | PassthroughLockKeyLists Int 
-        [(Int -> State g (SubCompTree Room), State g CombineType)]
+        [(Int -> State StdGen (SubCompTree Room), State StdGen CombineType)]
-        [(CombineType, State g (SubCompTree Room))]
+        [(CombineType, State StdGen (SubCompTree Room))]
 --    | SetLabel Int (State g Room)
 --    | UseLabel Int (State g Room)
-    | ChainAnos [[Annotation g]]
+    | ChainAnos [[Annotation]]
 
 makeLenses ''Annotation

src/Dodge/Creature/ChaseCrit.hs

@@ -54,6 +54,7 @@ chaseCrit = defaultCreature
         ,seagullWhistle1S
         ,seagullCryS
         ,seagullCry1S
+        ,seagullCry2S
         ] 50 0
     , _crMvType = defaultChaseMvType
     }

src/Dodge/Creature/Perception.hs

@@ -18,6 +18,7 @@ import Sound.Data
 import Control.Monad.State
 import Data.Maybe
 import Control.Lens
+import System.Random
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 
@@ -85,8 +86,9 @@ chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
             | becomesCognizant -- && randBool 
                 && cr ^? crVocalization . vcCoolDown == Just 0 
                 = let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
+                      numjits = fst $ randomR (15,25) (_randGen w)
                   in crActionPlan . crStrategy .~ StrategyActions WarningCry 
-                        [ImpulsesList ([Bark soundid]: replicate 20 [RandomImpulse thejitter]++
+                        [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
                             [[ChangeStrategy $ CloseToMelee 0] ])
                         , AimAt 0 (_crPos $ _creatures w IM.! 0)
                         ]

src/Dodge/Floor.hs

@@ -35,7 +35,7 @@ import System.Random
 --import Data.Maybe
 --import qualified Data.IntMap.Strict as IM
 
-initialAnoTree :: RandomGen g => Tree [Annotation g]
+initialAnoTree :: Tree [Annotation]
 initialAnoTree = padSucWithDoors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
     , [SpecificRoom $ return . return . UseAll $ roomRectAutoLinks 400 400
@@ -92,6 +92,6 @@ initialAnoTree = padSucWithDoors $ treeFromTrunk
     [SpecificRoom $ fmap (pure . UseAll) (telRoomLev 1)]
 
 {- | A test level tree. -}
-initialRoomTree :: RandomGen g => State g (Tree Room)
+initialRoomTree :: State StdGen (Tree Room)
 initialRoomTree = do
     expandTree <$> mapM anoToRoomTree initialAnoTree

src/Dodge/LevelGen.hs

@@ -31,11 +31,11 @@ layoutLevelFromSeed i seed = do
     putStrLn $ "Generating level with seed " ++ show seed
     let g = mkStdGen seed
     let rmtree = inorderNumberTree $ evalState initialRoomTree g
-    putStrLn "Abstract layout: "
+    putStrLn "Compact layout: "
     putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
     let nameshow (r,rid) = _rmName r ++ "-" ++ show rid
     writeFile "aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree
-    putStrLn "Layout with room names written to aGeneratedRoomLayout"
+    putStrLn "Layout with room names (also written to aGeneratedRoomLayout):"
     mrs <- positionRoomsFromTree rmtree
     case mrs of
         Just (PosRooms bounds rs) -> do

src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs

@@ -1,4 +1,4 @@
--- generated at 2022-05-19 13:12:07.606387989 UTC
+-- generated at 2022-05-19 16:16:01.090595039 UTC
 module Dodge.SoundLogic.ExternallyGeneratedSounds where
 import Sound.Data
 soundToVol :: SoundID -> Float
@@ -38,44 +38,45 @@ soundToVol v = case _getSoundID v of
     32 -> 500
     33 -> 5000
     34 -> 8000
-    35 -> 8000
+    35 -> 5000
     36 -> 8000
-    37 -> 5000
+    37 -> 8000
-    38 -> 10000
+    38 -> 5000
-    39 -> 8000
+    39 -> 10000
-    40 -> 4000
+    40 -> 8000
-    41 -> 3000
+    41 -> 4000
-    42 -> 8000
+    42 -> 3000
-    43 -> 2000
+    43 -> 8000
-    44 -> 10000
+    44 -> 2000
-    45 -> 5000
+    45 -> 10000
-    46 -> 2000
+    46 -> 5000
-    47 -> 3000
+    47 -> 2000
-    48 -> 5000
+    48 -> 3000
-    49 -> 10000
+    49 -> 5000
-    50 -> 12000
+    50 -> 10000
-    51 -> 5000
+    51 -> 12000
     52 -> 5000
-    53 -> 10000
+    53 -> 5000
-    54 -> 12000
+    54 -> 10000
-    55 -> 2000
+    55 -> 12000
-    56 -> 3000
+    56 -> 2000
-    57 -> 8000
+    57 -> 3000
-    58 -> 5000
+    58 -> 8000
-    59 -> 2000
+    59 -> 5000
-    60 -> 3000
+    60 -> 2000
-    61 -> 10000
+    61 -> 3000
-    62 -> 500
+    62 -> 10000
-    63 -> 10000
+    63 -> 500
-    64 -> 3000
+    64 -> 10000
-    65 -> 15000
+    65 -> 3000
-    66 -> 10000
+    66 -> 15000
-    67 -> 3000
+    67 -> 10000
-    68 -> 1000
+    68 -> 3000
-    69 -> 15000
+    69 -> 1000
-    70 -> 10000
+    70 -> 15000
-    71 -> 5000
+    71 -> 10000
-    72 -> 8000
+    72 -> 5000
+    73 -> 8000
     _ -> 50
 soundToOnomato :: SoundID -> String
 soundToOnomato v = case _getSoundID v of
@@ -88,7 +89,7 @@ soundToOnomato v = case _getSoundID v of
     6 -> "KRTNKL"
     7 -> "DWAAH"
     8 -> "DEDEDUM"
-    9 -> "CR-UH"
+    9 -> "CREUH"
     10 -> "BWAH"
     11 -> "TIPTOP"
     12 -> "DEDEDA"
@@ -114,44 +115,45 @@ soundToOnomato v = case _getSoundID v of
     32 -> "CLICK"
     33 -> "FWUMP"
     34 -> "RINGGG"
-    35 -> "BRAP"
+    35 -> "CRH"
-    36 -> "CRUMPLE"
+    36 -> "BRAP"
-    37 -> "TRINKL"
+    37 -> "CRUMPLE"
-    38 -> "PEW"
+    38 -> "TRINKL"
-    39 -> "TAK"
+    39 -> "PEW"
-    40 -> "SMACK"
+    40 -> "TAK"
-    41 -> "DRR"
+    41 -> "SMACK"
-    42 -> "CRASH"
+    42 -> "DRR"
-    43 -> "SWSH"
+    43 -> "CRASH"
-    44 -> "CRAKLE"
+    44 -> "SWSH"
-    45 -> "CRTINK"
+    45 -> "CRAKLE"
-    46 -> "FHP"
+    46 -> "CRTINK"
-    47 -> "CHPCHPCHP"
+    47 -> "FHP"
-    48 -> "BIPBIPBIP"
+    48 -> "CHPCHPCHP"
-    49 -> "CHUGUGUG"
+    49 -> "BIPBIPBIP"
-    50 -> "BRPBRPBRP"
+    50 -> "CHUGUGUG"
-    51 -> "CRUH"
+    51 -> "BRPBRPBRP"
-    52 -> "CHNKCHNKCHUNK"
+    52 -> "CRUH"
-    53 -> "WRRR"
+    53 -> "CHNKCHNKCHUNK"
-    54 -> "BRDBRDBRD"
+    54 -> "WRRR"
-    55 -> "PHF"
+    55 -> "BRDBRDBRD"
-    56 -> "BWAAH"
+    56 -> "PHF"
-    57 -> "BEP"
+    57 -> "BWAAH"
-    58 -> "HSSS"
+    58 -> "BEP"
-    59 -> "SHUHP"
+    59 -> "HSSS"
-    60 -> "THUD"
+    60 -> "SHUHP"
-    61 -> "WHSSH"
+    61 -> "THUD"
-    62 -> "HMM"
+    62 -> "WHSSH"
-    63 -> "BRAHCHCH"
+    63 -> "HMM"
-    64 -> "TIP"
+    64 -> "BRAHCHCH"
-    65 -> "BANGG"
+    65 -> "TIP"
-    66 -> "ZHM"
+    66 -> "BANGG"
-    67 -> "TAP"
+    67 -> "ZHM"
-    68 -> "BLPCHCH"
+    68 -> "TAP"
-    69 -> "BANG"
+    69 -> "BLPCHCH"
-    70 -> "CHUGUGUG"
+    70 -> "BANG"
-    71 -> "DEDA"
+    71 -> "CHUGUGUG"
-    72 -> "CRISH"
+    72 -> "DEDA"
+    73 -> "CRISH"
     _ -> error "unitialised sound"
 soundPathList :: [String]
 soundPathList =
@@ -164,7 +166,7 @@ soundPathList =
     , "smallGlass2.KRTNKL.5000.wav"
     , "skwareFadeTwoSec.DWAAH.3000.wav"
     , "dededum.DEDEDUM.5000.wav"
-    , "seagullCry1.CR-UH.5000.wav"
+    , "seagullCry2.CREUH.5000.wav"
     , "sineRaisePitchOneSec.BWAH.3000.wav"
     , "twoStepSlow.TIPTOP.4000.wav"
     , "dededa.DEDEDA.5000.wav"
@@ -190,6 +192,7 @@ soundPathList =
     , "click1.CLICK.500.wav"
     , "tap4.FWUMP.5000.wav"
     , "tinitus.RINGGG.8000.wav"
+    , "seagullCry1.CRH.5000.wav"
     , "tap3.BRAP.8000.wav"
     , "impact3.CRUMPLE.8000.wav"
     , "smallGlass1.TRINKL.5000.wav"
@@ -247,8 +250,8 @@ skwareFadeTwoSecS :: SoundID
 skwareFadeTwoSecS = SoundID 7
 dededumS :: SoundID
 dededumS = SoundID 8
-seagullCry1S :: SoundID
+seagullCry2S :: SoundID
-seagullCry1S = SoundID 9
+seagullCry2S = SoundID 9
 sineRaisePitchOneSecS :: SoundID
 sineRaisePitchOneSecS = SoundID 10
 twoStepSlowS :: SoundID
@@ -299,79 +302,81 @@ tap4S :: SoundID
 tap4S = SoundID 33
 tinitusS :: SoundID
 tinitusS = SoundID 34
+seagullCry1S :: SoundID
+seagullCry1S = SoundID 35
 tap3S :: SoundID
-tap3S = SoundID 35
+tap3S = SoundID 36
 impact3S :: SoundID
-impact3S = SoundID 36
+impact3S = SoundID 37
 smallGlass1S :: SoundID
-smallGlass1S = SoundID 37
+smallGlass1S = SoundID 38
 seagullWhistle1S :: SoundID
-seagullWhistle1S = SoundID 38
+seagullWhistle1S = SoundID 39
 tap1S :: SoundID
-tap1S = SoundID 39
+tap1S = SoundID 40
 hit1S :: SoundID
-hit1S = SoundID 40
+hit1S = SoundID 41
 slideDoorS :: SoundID
-slideDoorS = SoundID 41
+slideDoorS = SoundID 42
 impact1S :: SoundID
-impact1S = SoundID 42
+impact1S = SoundID 43
 knifeS :: SoundID
-knifeS = SoundID 43
+knifeS = SoundID 44
 elecCrackleS :: SoundID
-elecCrackleS = SoundID 44
+elecCrackleS = SoundID 45
 smallGlass3S :: SoundID
-smallGlass3S = SoundID 45
+smallGlass3S = SoundID 46
 whiteNoiseFadeInS :: SoundID
-whiteNoiseFadeInS = SoundID 46
+whiteNoiseFadeInS = SoundID 47
 reload1S :: SoundID
-reload1S = SoundID 47
+reload1S = SoundID 48
 computerBeepingS :: SoundID
-computerBeepingS = SoundID 48
+computerBeepingS = SoundID 49
 seagullChatter1S :: SoundID
-seagullChatter1S = SoundID 49
+seagullChatter1S = SoundID 50
 miniS :: SoundID
-miniS = SoundID 50
+miniS = SoundID 51
 seagullCryS :: SoundID
-seagullCryS = SoundID 51
+seagullCryS = SoundID 52
 crankSlowS :: SoundID
-crankSlowS = SoundID 52
+crankSlowS = SoundID 53
 fireLoudS :: SoundID
-fireLoudS = SoundID 53
+fireLoudS = SoundID 54
 mini1S :: SoundID
-mini1S = SoundID 54
+mini1S = SoundID 55
 whiteNoiseFadeOutS :: SoundID
-whiteNoiseFadeOutS = SoundID 55
+whiteNoiseFadeOutS = SoundID 56
 sineRaisePitchTwoSecS :: SoundID
-sineRaisePitchTwoSecS = SoundID 56
+sineRaisePitchTwoSecS = SoundID 57
 tone440S :: SoundID
-tone440S = SoundID 57
+tone440S = SoundID 58
 foamSprayLoopS :: SoundID
-foamSprayLoopS = SoundID 58
+foamSprayLoopS = SoundID 59
 pickUpS :: SoundID
-pickUpS = SoundID 59
+pickUpS = SoundID 60
 hitS :: SoundID
-hitS = SoundID 60
+hitS = SoundID 61
 missileLaunchS :: SoundID
-missileLaunchS = SoundID 61
+missileLaunchS = SoundID 62
 fridgeHumS :: SoundID
-fridgeHumS = SoundID 62
+fridgeHumS = SoundID 63
 shotgunS :: SoundID
-shotgunS = SoundID 63
+shotgunS = SoundID 64
 foot1S :: SoundID
-foot1S = SoundID 64
+foot1S = SoundID 65
 bangEchoS :: SoundID
-bangEchoS = SoundID 65
+bangEchoS = SoundID 66
 teleS :: SoundID
-teleS = SoundID 66
+teleS = SoundID 67
 foot2S :: SoundID
-foot2S = SoundID 67
+foot2S = SoundID 68
 oldMachineBootS :: SoundID
-oldMachineBootS = SoundID 68
+oldMachineBootS = SoundID 69
 bangS :: SoundID
-bangS = SoundID 69
+bangS = SoundID 70
 seagullChatterS :: SoundID
-seagullChatterS = SoundID 70
+seagullChatterS = SoundID 71
 dedaS :: SoundID
-dedaS = SoundID 71
+dedaS = SoundID 72
 impact4S :: SoundID
-impact4S = SoundID 72
+impact4S = SoundID 73

src/Dodge/Tree/Compose/Data.hs

@@ -11,5 +11,5 @@ data ComposingNode a
     | UseNone   {_unCompose :: a}
     | UseLabel  {_composeIndex :: Int, _unCompose :: a} -- defaults to using no children
 type SubCompTree a = Tree (ComposingNode a)
-type CompTree a = Tree (Tree (ComposingNode a))
+type CompTree a = Tree (SubCompTree a)
 makeLenses ''ComposingNode