diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index cccf7a507..ba98e9654 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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] diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index b6257936b..134c053b2 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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) diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index 3477de4b9..e50d96f00 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -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) diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 06a0ca974..8b8c12b96 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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