justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add seagull sounds, remove random generator paramatricity for level gen

Browse Source
This commit is contained in:
justin
2022-05-19 17:56:45 +01:00
parent 40fc6792ae
commit 887dd547d9
10 changed files with 147 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/sound/seagullChatter1.CHUGUGUG.10000.wav
BIN
View File
Binary file not shown.
data/sound/seagullCry1.CR-UH.5000.wav
BIN
View File
Binary file not shown.
src/Dodge/Annotation.hs
+7 -7
View File
@@ -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
+9 -8
View File
@@ -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]]
| SpecificRoom (State g (SubCompTree Room))
| OrAno [[Annotation]]
| SpecificRoom (State StdGen (SubCompTree Room))
| BossAno Creature
| TreasureAno [Creature] [Item]
| AnoApplyInt Int (Int -> State g (SubCompTree Room))
| AnoNewInt (Int -> State g (SubCompTree Room))
| AnoApplyInt Int (Int -> State StdGen (SubCompTree Room))
| AnoNewInt (Int -> State StdGen (SubCompTree Room))
| PassthroughLockKeyLists Int
[(Int -> State g (SubCompTree Room), State g CombineType)]
[(CombineType, State g (SubCompTree Room))]
[(Int -> State StdGen (SubCompTree Room), State StdGen CombineType)]
[(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
+1
View File
@@ -54,6 +54,7 @@ chaseCrit = defaultCreature
,seagullWhistle1S
,seagullCryS
,seagullCry1S
,seagullCry2S
] 50 0
, _crMvType = defaultChaseMvType
}
src/Dodge/Creature/Perception.hs
+3 -1
View File
@@ -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
+2 -2
View File
@@ -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
+2 -2
View File
@@ -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
+122 -117
View File
@@ -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
38 -> 10000
39 -> 8000
40 -> 4000
41 -> 3000
42 -> 8000
43 -> 2000
44 -> 10000
45 -> 5000
46 -> 2000
47 -> 3000
48 -> 5000
49 -> 10000
50 -> 12000
51 -> 5000
37 -> 8000
38 -> 5000
39 -> 10000
40 -> 8000
41 -> 4000
42 -> 3000
43 -> 8000
44 -> 2000
45 -> 10000
46 -> 5000
47 -> 2000
48 -> 3000
49 -> 5000
50 -> 10000
51 -> 12000
52 -> 5000
53 -> 10000
54 -> 12000
55 -> 2000
56 -> 3000
57 -> 8000
58 -> 5000
59 -> 2000
60 -> 3000
61 -> 10000
62 -> 500
63 -> 10000
64 -> 3000
65 -> 15000
66 -> 10000
67 -> 3000
68 -> 1000
69 -> 15000
70 -> 10000
71 -> 5000
72 -> 8000
53 -> 5000
54 -> 10000
55 -> 12000
56 -> 2000
57 -> 3000
58 -> 8000
59 -> 5000
60 -> 2000
61 -> 3000
62 -> 10000
63 -> 500
64 -> 10000
65 -> 3000
66 -> 15000
67 -> 10000
68 -> 3000
69 -> 1000
70 -> 15000
71 -> 10000
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"
36 -> "CRUMPLE"
37 -> "TRINKL"
38 -> "PEW"
39 -> "TAK"
40 -> "SMACK"
41 -> "DRR"
42 -> "CRASH"
43 -> "SWSH"
44 -> "CRAKLE"
45 -> "CRTINK"
46 -> "FHP"
47 -> "CHPCHPCHP"
48 -> "BIPBIPBIP"
49 -> "CHUGUGUG"
50 -> "BRPBRPBRP"
51 -> "CRUH"
52 -> "CHNKCHNKCHUNK"
53 -> "WRRR"
54 -> "BRDBRDBRD"
55 -> "PHF"
56 -> "BWAAH"
57 -> "BEP"
58 -> "HSSS"
59 -> "SHUHP"
60 -> "THUD"
61 -> "WHSSH"
62 -> "HMM"
63 -> "BRAHCHCH"
64 -> "TIP"
65 -> "BANGG"
66 -> "ZHM"
67 -> "TAP"
68 -> "BLPCHCH"
69 -> "BANG"
70 -> "CHUGUGUG"
71 -> "DEDA"
72 -> "CRISH"
35 -> "CRH"
36 -> "BRAP"
37 -> "CRUMPLE"
38 -> "TRINKL"
39 -> "PEW"
40 -> "TAK"
41 -> "SMACK"
42 -> "DRR"
43 -> "CRASH"
44 -> "SWSH"
45 -> "CRAKLE"
46 -> "CRTINK"
47 -> "FHP"
48 -> "CHPCHPCHP"
49 -> "BIPBIPBIP"
50 -> "CHUGUGUG"
51 -> "BRPBRPBRP"
52 -> "CRUH"
53 -> "CHNKCHNKCHUNK"
54 -> "WRRR"
55 -> "BRDBRDBRD"
56 -> "PHF"
57 -> "BWAAH"
58 -> "BEP"
59 -> "HSSS"
60 -> "SHUHP"
61 -> "THUD"
62 -> "WHSSH"
63 -> "HMM"
64 -> "BRAHCHCH"
65 -> "TIP"
66 -> "BANGG"
67 -> "ZHM"
68 -> "TAP"
69 -> "BLPCHCH"
70 -> "BANG"
71 -> "CHUGUGUG"
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
seagullCry1S = SoundID 9
seagullCry2S :: SoundID
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
+1 -1
View File
@@ -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