From bf1bfa54534d16f5242c144656d62f24bede056d Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 15 Jun 2022 08:21:53 +0100 Subject: [PATCH] Rename ItemAttachments --- src/Dodge/Default/Item.hs | 4 +- src/Dodge/Floor.hs | 3 +- src/Dodge/Item/Attachment.hs | 10 ++-- src/Dodge/Item/Attachment/Data.hs | 16 +++--- src/Dodge/Item/Equipment.hs | 4 +- src/Dodge/Item/Equipment/Booster.hs | 4 +- src/Dodge/Item/Weapon/BulletGuns.hs | 2 +- src/Dodge/Item/Weapon/Grenade.hs | 2 +- src/Dodge/Item/Weapon/Utility.hs | 6 +-- src/Dodge/Room.hs | 2 + src/Dodge/Room/Breather.hs | 11 +++- src/Dodge/Room/Containing.hs | 25 +++++---- src/Dodge/Room/Pillar.hs | 2 + src/Dodge/Room/Procedural.hs | 81 +++++++++++++---------------- src/Dodge/Room/Room.hs | 6 +++ 15 files changed, 98 insertions(+), 80 deletions(-) diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index 0db40d39a..5e56e4a75 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -67,8 +67,8 @@ basicItemDisplay it = Prelude.take (itSlotsTaken it) $ maybeModeStatus :: Item -> Maybe String maybeModeStatus it = case it ^? itAttachment of - Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c] - Just ItMode {_itMode = i} -> Just $ show i + Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c] + Just AttachMode {_atMode = i} -> Just $ show i _ -> Nothing maybeRateStatus :: Item -> Maybe String diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 54598e211..1fa0f4513 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -38,8 +38,9 @@ import Data.List (intersperse) initialAnoTree :: Annotation initialAnoTree = OnwardList - $ intersperse (AnTree $ tToBTree "door" . pure <$> shuffleLinks (cleatOnward door)) + $ intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom + , AnTree firstBreather -- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) , AnRoom $ roomCCrits 10 , AnTree $ tToBTree "spawners" <$> spawnerRoom diff --git a/src/Dodge/Item/Attachment.hs b/src/Dodge/Item/Attachment.hs index 7ca592979..214f0d12d 100644 --- a/src/Dodge/Item/Attachment.hs +++ b/src/Dodge/Item/Attachment.hs @@ -26,7 +26,7 @@ scrollCharMode x _ incCharMode :: Item -> Item -incCharMode = itAttachment . itCharMode %~ cycleL +incCharMode = itAttachment . atCharMode %~ cycleL where cycleL (x :<| xs) = xs |> x cycleL xs = xs @@ -34,7 +34,7 @@ incCharMode = itAttachment . itCharMode %~ cycleL decCharMode :: Item -> Item -decCharMode = itAttachment . itCharMode %~ cycleR +decCharMode = itAttachment . atCharMode %~ cycleR where cycleR (xs :|> x) = x <| xs cycleR xs = xs @@ -43,7 +43,7 @@ charFiringStratI :: [(Char, ChainEffect)] -- ^ Different firing effects for different characters -> ChainEffect charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv - . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . itCharMode of + . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . atCharMode of Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w _ -> w where @@ -55,10 +55,10 @@ changeFuse -> Item -> Item changeFuse scrollAmount _ it = it - & ( itAttachment .~ ItFuse newTime ) + & ( itAttachment .~ AttachFuse newTime ) & ( itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} ) where - oldTime = _itFuseTime $ _itAttachment it + oldTime = _atFuseTime $ _itAttachment it newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount) zm = 50 / fromIntegral newTime diff --git a/src/Dodge/Item/Attachment/Data.hs b/src/Dodge/Item/Attachment/Data.hs index 007311c77..162797aea 100644 --- a/src/Dodge/Item/Attachment/Data.hs +++ b/src/Dodge/Item/Attachment/Data.hs @@ -8,14 +8,14 @@ import Control.Lens import qualified Data.Sequence as Seq data ItAttachment - = ItFuse {_itFuseTime :: Int} - | ItMode {_itMode :: Int} - | ItCharMode {_itCharMode :: Seq.Seq Char } - | ItTargetPos { _itTargetPos :: Point2 } - | ItInt { _itInt :: Int } - | ItMInt { _itMInt :: Maybe Int } - | ItFloat { _itFloat :: Float } - | ItBool { _itBool :: Bool } + = AttachFuse {_atFuseTime :: Int} + | AttachMode {_atMode :: Int} + | AttachCharMode {_atCharMode :: Seq.Seq Char } + | AttachTargetPos { _atTargetPos :: Point2 } + | AttachInt { _atInt :: Int } + | AttachMInt { _atMInt :: Maybe Int } + | AttachFloat { _atFloat :: Float } + | AttachBool { _atBool :: Bool } | NoItAttachment data Scope = NoScope diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 748ac72cf..d6fbfffe5 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -39,7 +39,7 @@ magShield :: Item magShield = defaultEquipment { _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing - , _itAttachment = ItMInt Nothing + , _itAttachment = AttachMInt Nothing } & itUse . eqEq . eqUse .~ useMagShield & itUse . eqEq . eqSite .~ GoesOnWrist @@ -53,7 +53,7 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet ,_mgPos = _crPos cr ,_mgField = curveAroundField 50 200 } - mgid = case it ^? itAttachment . itMInt . _Just of + mgid = case it ^? itAttachment . atMInt . _Just of Just mgid' -> mgid' Nothing -> IM.newKey $ _magnets w -- it = _crInv cr IM.! invid diff --git a/src/Dodge/Item/Equipment/Booster.hs b/src/Dodge/Item/Equipment/Booster.hs index 8415f969f..e17cc96e8 100644 --- a/src/Dodge/Item/Equipment/Booster.hs +++ b/src/Dodge/Item/Equipment/Booster.hs @@ -43,14 +43,14 @@ boostSelfL x itm cr w = case boostPoint x cr w of cpos = _crPos cr r = _crRad cr pid = fromMaybe (IM.newKey $ _props w) - (cr ^? crInv . ix invid . itAttachment . itInt) + (cr ^? crInv . ix invid . itAttachment . atInt) crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w & creatures . ix cid %~ (crPos .~ p) . (crInv . ix invid %~ ammoEff . (itEffect . ieCounter .~ 1) - . (itAttachment .~ ItInt pid) + . (itAttachment .~ AttachInt pid) ) addBoostShockwave diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 88f7866a3..7c12354e5 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -73,7 +73,7 @@ autoGun = defaultAutoGun -- , _itFloorPict = autoGunPic -- , _itZoom = defaultItZoom , _itEquipPict = pictureWeaponOnAim - , _itAttachment = ItCharMode $ Seq.fromList "MS" + , _itAttachment = AttachCharMode $ Seq.fromList "MS" , _itParams = BulletShooter { _muzVel = 1 , _rifling = 0.9 diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 1ede1b9e2..d6c3e012b 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -111,7 +111,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w dir = argV v setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 - fuseTime = _itFuseTime $ _itAttachment $ _crInv cr IM.! j + fuseTime = _atFuseTime $ _itAttachment $ _crInv cr IM.! j throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x } diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 8423f67bb..4e1817564 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -68,7 +68,7 @@ shrinkGun = defaultGun , _itUse = defaultlUse {_lUse = hammerCheckL useShrinkGun} & useHammer .~ upHammer -- , _itFloorPict = shrinkGunPic - , _itAttachment = ItBool True + , _itAttachment = AttachBool True } & itType . iyBase .~ SHRINKER @@ -79,14 +79,14 @@ shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5 -- creature but using the old crInvSel value -- 22.05.23 this has been changed from using invids to items useShrinkGun :: Item -> Creature -> World -> World -useShrinkGun it cr w = if _itBool $ _itAttachment it +useShrinkGun it cr w = if _atBool $ _itAttachment it then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr where invid = fromJust $ _itInvPos it tryResize x g = maybe w g $ sizeSelf x cr w f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~ - ( (itAttachment . itBool .~ isInUse) . (itCurseStatus .~ cstatus) ) + ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) ) blinkGun :: Item blinkGun = defaultGun diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 52085796f..b88fe45d0 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -1,6 +1,7 @@ {- Specification of individual rooms. -} module Dodge.Room ( module Dodge.Room.Room + , module Dodge.Room.Breather , module Dodge.Room.RoadBlock , module Dodge.Room.LasTurret , module Dodge.Room.Foreground @@ -26,6 +27,7 @@ module Dodge.Room , module Dodge.Room.Pillar ) where import Dodge.Room.Room +import Dodge.Room.Breather import Dodge.Room.RoadBlock import Dodge.Room.LasTurret import Dodge.Room.Treasure diff --git a/src/Dodge/Room/Breather.hs b/src/Dodge/Room/Breather.hs index b05394233..578713393 100644 --- a/src/Dodge/Room/Breather.hs +++ b/src/Dodge/Room/Breather.hs @@ -30,5 +30,14 @@ import Dodge.Room.Containing firstBreather :: State StdGen (MetaTree Room String) firstBreather = do - itms <- takeOne [[],[itemFromBase $ CRAFT TUBE]] + itms <- takeOne + [[] + ,[itemFromBase $ CRAFT TUBE] + ,[itemFromBase $ CRAFT PIPE] + ,[itemFromBase $ CRAFT HARDWARE] + ,[itemFromBase $ CRAFT CAN] + ,[itemFromBase $ CRAFT TIN] + ,[itemFromBase $ CRAFT PLANK] + ,[itemFromBase $ CRAFT DRUM] + ] roomsContaining [] itms diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs index c98b4766f..38e3bb4cb 100644 --- a/src/Dodge/Room/Containing.hs +++ b/src/Dodge/Room/Containing.hs @@ -3,8 +3,10 @@ module Dodge.Room.Containing where import Dodge.Data import Dodge.Tree import Dodge.LevelGen.Data +import Dodge.PlacementSpot import RandomHelp import Dodge.Room.Procedural +import Dodge.Room.Pillar import Dodge.Room.Tanks import Dodge.Room.Link import Dodge.Room.Ngon @@ -13,25 +15,28 @@ import LensHelp import Geometry --import Dodge.Item.Equipment -import Data.List - roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String) -roomsContaining crs its = do - endroom <- join $ takeOne - [ randomFourCornerRoomCrsIts crs its - , tanksRoom crs its - ] - rToOnward ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs) - ++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its)) - $ pure $ cleatOnward endroom +roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs its + roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room) roomsContaining' crs its = do endroom <- join $ takeOne [ randomFourCornerRoomCrsIts crs its , tanksRoom crs its + , roomPillarsContaining crs its ] return (pure $ cleatOnward endroom) +roomPillarsContaining :: RandomGen g => [Creature] -> [Item] -> State g Room +roomPillarsContaining crs itms = do + (w,wn) <- takeOne [(240,2),(340,3)] + (h,hn) <- takeOne [(240,2),(340,3)] + let plmnts = + map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms + ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs + roomPillars 30 w h wn hn <&> rmPmnts .++~ plmnts + + pedestalRoom :: RandomGen g => Item -> State g Room pedestalRoom it = do let flit = PutFlIt it diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs index 7b640fb54..9d34ce19d 100644 --- a/src/Dodge/Room/Pillar.hs +++ b/src/Dodge/Room/Pillar.hs @@ -36,6 +36,8 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0)) h = h' - 9 aline = PutLineBlock baseBlockPane StoneBlock 9 9 +--longPillars :: Float -> Float + roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room roomPillars pillarsize w h wn hn = do let rm = roomRect w h wn hn diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index a0fe38bd2..6cd16b8d7 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -91,40 +91,34 @@ roomRect x y xn yn = defaultRoom zipCountDown :: [a] -> [(Int,a)] zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs -lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) - -> (Int -> RoomLinkType) +lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) -> (Int -> RoomLinkType) -> Int -> (Int,(Point2,Float)) -> RoomLink lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink - {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j] - ,_rlPos = p + { _rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j] + , _rlPos = p , _rlDir = a } {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} -- it is not clear to me that this works for very small rooms (but it does seem -- to do so) roomRectAutoLinks :: Float -> Float -> Room -roomRectAutoLinks x y = (roomRect x y (f x) (f y)) - {_rmPmnts = plmnts - ,_rmName = "autoRect" - } +roomRectAutoLinks x y = roomRect x y (f x) (f y) + & rmName .~ "autoRect" + & rmPmnts .~ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp] where f z = max 1 $ (ceiling z - 40) `div` 60 - plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp] {- Combines two rooms into one room. - will have to work out exactly what to do with combining links Mostly involves concatenation. -} combineRooms :: Room -> Room -> Room combineRooms r r' = defaultRoom - { _rmPolys = _rmPolys r ++ _rmPolys r' - , _rmLinks = _rmLinks r ++ _rmLinks r' - , _rmPath = map clampPath $ _rmPath r - ++ _rmPath r' - , _rmPmnts = _rmPmnts r ++ _rmPmnts r' - --, _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r) - -- ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r') - , _rmBound = _rmBound r ++ _rmBound r' - , _rmPos = _rmPos r ++ _rmPos r' - , _rmFloor = combineFloors (_rmFloor r) (_rmFloor r') + { _rmPolys = _rmPolys r ++ _rmPolys r' + , _rmLinks = _rmLinks r ++ _rmLinks r' + , _rmPath = map clampPath $ _rmPath r ++ _rmPath r' + , _rmPmnts = _rmPmnts r ++ _rmPmnts r' + , _rmBound = _rmBound r ++ _rmBound r' + , _rmPos = _rmPos r ++ _rmPos r' + , _rmFloor = combineFloors (_rmFloor r) (_rmFloor r') , _rmShift = (V2 0 0 , 0) } -- not that this assumes that any link paths are integral @@ -135,7 +129,7 @@ clampPath = bimap f f g = (fromIntegral :: Int -> Float) . floor combineFloors :: Floor -> Floor -> Floor -combineFloors f _ = f +combineFloors = const {- Randomly generate a top fourth of a room possibly with a wall. Add a light and a 'PutNothing' placement. -} quarterRoomTri :: RandomGen g => Float -> State g Room @@ -210,8 +204,8 @@ quarterRoomSquare w = do Tight corridors, random placements. -} randomFourCornerRoom :: RandomGen g => [Item] -> State g Room randomFourCornerRoom its = do - nCrits <- state $ randomR (1,3) - crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit] + nCrits <- state $ randomR (1,3) + crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit] ++ replicate 20 chaseCrit randomFourCornerRoomCrsIts crits its {- | A randomly generate room based on four randomly generated corners. @@ -231,28 +225,27 @@ centerVaultRoom -> Float -- ^ Height -> Float -- ^ Vault dimensions -> State g Room -centerVaultRoom w h d = do - return $ defaultRoom - { _rmPolys = [rectNSWE h (-h) (-w) w] - , _rmLinks = - [outLink (V2 0 h) 0 - ,outLink (V2 w 0) (-pi/2) - ,outLink (V2 (-w) 0) (pi/2) - , inLink (V2 0 (-h)) pi ] - , _rmPath = [] - , _rmPmnts = - [sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall - ,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall - ,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall - ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall - ] - ++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70)) - [0,0.5*pi,pi,1.5*pi] - ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) - [0,pi/2,pi,3*pi/2] - , _rmBound = [rectNSWE h (-h) (-w) w] - , _rmName = "cenVault" - } +centerVaultRoom w h d = return $ defaultRoom + { _rmPolys = [rectNSWE h (-h) (-w) w] + , _rmLinks = + [outLink (V2 0 h) 0 + ,outLink (V2 w 0) (-pi/2) + ,outLink (V2 (-w) 0) (pi/2) + , inLink (V2 0 (-h)) pi ] + , _rmPath = [] + , _rmPmnts = + [sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall + ,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall + ,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall + ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall + ] + ++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70)) + [0,0.5*pi,pi,1.5*pi] + ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) + [0,pi/2,pi,3*pi/2] + , _rmBound = [rectNSWE h (-h) (-w) w] + , _rmName = "cenVault" + } where col = dim $ dim $ bright red theDoor = diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 4af55cefe..096d91a67 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -7,6 +7,7 @@ module Dodge.Room.Room , doubleCorridorBarrels , pistolerRoom , spawnerRoom + , corDoor ) where import Dodge.Cleat import Dodge.Data @@ -332,3 +333,8 @@ spawnerRoom = do (PutCrit spawnerCrit) aRoom <- airlock return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner + +corDoor :: State StdGen (MetaTree Room String) +corDoor = do + cor <- shuffleLinks $ cleatOnward corridor + return $ tToBTree "corDoor" $ treePost [door,cor]