Make more sounds positional

2021-04-23 17:27:32 +02:00
parent ffe4a8083b
commit 4c611ba4aa
4 changed files with 75 additions and 63 deletions
@@ -31,7 +31,7 @@ import System.Random
 roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
    struct' <- aTreeStrut
-    let struct = Node [EndRoom] []
+    let struct = treePost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
    let t' = padCorridors struct
        t = treeTrunk 
                [[StartRoom]
@@ -70,34 +70,51 @@ withSound soundid f cid w = (soundOncePos soundid p . f cid) w
  where
    p = _crPos (_creatures w IM.! cid)

-withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
+withRecoil 
+    :: Float    -- ^ Recoil amount
+    -> (Int -> World -> World) 
+                -- ^ Underlying world effect, takes creature id as input
+    -> Int      -- ^ Creature id
+    -> World -> World
 withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
-    where pushback cr = over crPos 
-                             (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
-                             cr
-withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
+  where 
+    pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr
+withSidePush 
+    :: Float    -- ^ Maximal possible side push amount
+    -> (Int -> World -> World)  
+                -- ^ Underlying world effect, takes creature id as input
+    -> Int      -- ^ Creature id
+    -> World -> World
 withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
-    where push cr = over crPos 
-                             (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
-                             cr
-          (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
+  where 
+    push cr = over crPos (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr)) cr
+    (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w

-shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
+{- 
+Applies an effect and sound with an ammo check.
+-}
+shootWithSound 
+    :: Int  -- ^ Sound identifier
+    -> (Int -> World -> World) 
+            -- ^ Shoot effect, takes creature id as input
+    -> Int  -- ^ Creature id
+    -> World -> World
 shootWithSound soundid f cid w
-              | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                                    $ soundOnce soundid
-                                    $ set (pointerToItem . wpFireState) (_wpFireRate item)
-                                    $ f cid w
-              | reloadCondition = fromMaybe w $ reloadWeapon cid w
-              | otherwise = w
-    where cr  = (_creatures w IM.! cid)
-          itRef = _crInvSel cr
-          item = _crInv cr IM.! itRef
-          pointerToItem = creatures . ix cid . crInv . ix itRef
-          fireCondition = _wpReloadState item == 0
-                            && _wpFireState item == 0
-                            && _wpLoadedAmmo item > 0
-          reloadCondition = _wpLoadedAmmo item == 0
+    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+        $ soundOncePos soundid (_crPos cr)
+        $ set (pointerToItem . wpFireState) (_wpFireRate item)
+        $ f cid w
+    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | otherwise = w
+  where 
+    cr  = (_creatures w IM.! cid)
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fireCondition = _wpReloadState item == 0
+                      && _wpFireState item == 0
+                      && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0

 shoot :: (Int -> World -> World) -> Int -> World -> World
 shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
@@ -17,7 +17,7 @@ import Data.Tree
 import Control.Monad.State
 import System.Random

-data Annotation
+data Annotation g
    = Lock Int
    | Key  Int
    | Corridor
@@ -28,18 +28,19 @@ data Annotation
    | FirstWeapon
    | StartRoom
    | EndRoom
-    | OrAno [[Annotation]]
+    | OrAno [[Annotation g]]
+    | SpecificRoom (State g (Tree (Either Room Room)))

-addLock :: RandomGen g => Int -> Tree [Annotation] -> State g (Tree [Annotation])
+addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
 addLock i t = do
    (beforeLock, afterLock) <- splitTrunk t
    newBefore <- applyToRandomNode (Key i :) beforeLock
    return $ addToTrunk newBefore [Node [Lock i] afterLock]

-padCorridors :: Tree [Annotation] -> Tree [Annotation]
+padCorridors :: Tree [Annotation g] -> Tree [Annotation g]
 padCorridors (Node x xs) = Node [Corridor] [Node x (map padCorridors xs)]

-randomPadCorridors :: RandomGen g => Tree [Annotation] -> State g (Tree [Annotation])
+randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
 randomPadCorridors  (Node x xs) = do
    n <- state $ randomR (1, 3)
    xs' <- mapM randomPadCorridors xs
@@ -49,7 +50,7 @@ roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
 roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
                                (randomiseOutLinks corridor)

-annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room))
+annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
 annoToRoomTree [OrAno as] = do
    a <- takeOne as
    annoToRoomTree a
@@ -66,6 +67,7 @@ annoToRoomTree [StartRoom] = do
    w <- state $ randomR (100,400)
    h <- state $ randomR (200,400)
    fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
+annoToRoomTree (SpecificRoom rt:_) = rt
 annoToRoomTree _ = do
    w <- state $ randomR (100,400)
    h <- state $ randomR (200,400)
@@ -563,8 +563,8 @@ shootersRoom1 = do
    x4 <- state $ randomR (60,w-60)
    y4 <- state $ randomR (40,180)
    p <- takeOne [(x1,y1-10),(x2,y2-10),(x3,y3-10)]
-    let bln x y = putBlockN (x+25) (x-25) (y+10) (y)
-    let blv x y = putBlockV (x+25) (x-25) (y+10) (y)
+    let bln x y = putBlockN (x+25) (x-25) (y+10) y
+    let blv x y = putBlockV (x+25) (x-25) (y+10) y
    let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                  ++ [PS p (-pi/2) $ PutCrit autoCrit
                     ,PS (w/2,200) 0 putLamp
@@ -582,8 +582,8 @@ shootersRoom = do
    y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
    x4 <- state $ randomR (60,w-60)
    y4 <- state $ randomR (40,180)
-    let bln x y = putBlockN (x+25) (x-25) (y+10) (y)
-    let blv x y = putBlockV (x+25) (x-25) (y+10) (y)
+    let bln x y = putBlockN (x+25) (x-25) (y+10) y
+    let blv x y = putBlockV (x+25) (x-25) (y+10) y
    let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                  ++ [PS (x1,y1-10) (-pi/2) $ PutCrit autoCrit
                     ,PS (x2,y2-10) (-pi/2) $ PutCrit autoCrit
@@ -602,7 +602,7 @@ pistolerRoom = do
    f <- takeOne [f2]
    h <- state $ randomR (400,800)
    let w = h
-    i <- takeOne [4,6,8]
+    i <- takeOne [3,4,5]
    let j = fromIntegral (i+1)
    -- the 20+etc here is to correct for the pathfinding grid, which matches up to
    -- edges based on the size of doors (i.e. the line next to the wall is 20
@@ -617,22 +617,15 @@ pistolerRoom = do
    let plmnts = [PS (ps !! 0) aa $ PutCrit pistolCrit
                 ,PS (ps !! 1) ab $ PutCrit pistolCrit
                 ,PS (ps !! 2) ac $ PutCrit pistolCrit
-                -- ,PS (w-5,h/2) 0 $ putLamp
-                -- ,PS (5,h/2) 0 $ putLamp
-                -- ,PS (w/2,h-5) 0 $ putLamp
-                -- ,PS (w/2,5) 0 $ putLamp
-    --             ,PS (w-50,h/2) 0 $ putLamp
-    --             ,PS (50,h/2) 0 $ putLamp
-                 ,PS (w/2,h-50) 0 $ putLamp
-                 ,PS (w/2,50) 0 $ putLamp
-                 ,PS (w-5,h-5) 0 $ putLamp
-                 ,PS (5,h-5) 0 $ putLamp
-                 ,PS (w-5,5) 0 $ putLamp
-                 ,PS (5,5) 0 $ putLamp
-                 ,PS (w/2,h/2) 0 $ putLamp
+                 ,PS (w/2,h-50) 0 putLamp
+                 ,PS (w/2,50)   0 putLamp
+                 ,PS (w-5,h-5)  0 putLamp
+                 ,PS (5,h-5)    0 putLamp
+                 ,PS (w-5,5)    0 putLamp
+                 ,PS (5,5)      0 putLamp
+                 ,PS (w/2,h/2)  0 putLamp
                 ] 
                  ++ 
-              --   f (w*0.25) (h*0.5)
                 concat [f x y | x<-xs,y<-ys]
    return 
        $ set rmPS plmnts $ roomRect' w h (max i 2) (max i 2)
@@ -654,16 +647,16 @@ shootingRange = do

 spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
 spawnerRoom = do
-        x <- state $ randomR (250,300)
-        y <- state $ randomR (300,400)
-        wl <- takeOne [PS (0,0) 0 $ PutWindow (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) 
-                                  $ withAlpha 0.5 aquamarine
-                      ,windowLine (x/2,0) (x/2,y-60)
-                      ]
-        let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
-                     ,wl
-                     ,PS (x/2, y-10) 0 putLamp
-                     ]
-        let f ((lx,_),_) = lx < x/2-5 
-        roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2) 
-        return $ treeTrunk [Left (airlock 0)] roomWithSpawner
+    x <- state $ randomR (250,300)
+    y <- state $ randomR (300,400)
+    wl <- takeOne [PS (0,0) 0 $ PutWindow (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) 
+                              $ withAlpha 0.5 aquamarine
+                  ,windowLine (x/2,0) (x/2,y-60)
+                  ]
+    let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
+                 ,wl
+                 ,PS (x/2, y-10) 0 putLamp
+                 ]
+    let f ((lx,_),_) = lx < x/2-5 
+    roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect' x y 2 2) 
+    return $ treeTrunk [Left (airlock 0)] roomWithSpawner