Rename ItemAttachments

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 AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
-    Just ItMode {_itMode = i} -> Just $ show i
+    Just AttachMode {_atMode = i} -> Just $ show i
     _   -> Nothing
 
 maybeRateStatus :: Item -> Maybe String

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

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
 

src/Dodge/Item/Attachment/Data.hs

@@ -8,14 +8,14 @@ import Control.Lens
 import qualified Data.Sequence as Seq
 
 data ItAttachment 
-    = ItFuse {_itFuseTime :: Int}
+    = AttachFuse {_atFuseTime :: Int}
-    | ItMode {_itMode :: Int}
+    | AttachMode {_atMode :: Int}
-    | ItCharMode {_itCharMode :: Seq.Seq Char }
+    | AttachCharMode {_atCharMode :: Seq.Seq Char }
-    | ItTargetPos { _itTargetPos :: Point2 }
+    | AttachTargetPos { _atTargetPos :: Point2 }
-    | ItInt { _itInt :: Int }
+    | AttachInt { _atInt :: Int }
-    | ItMInt { _itMInt :: Maybe Int }
+    | AttachMInt { _atMInt :: Maybe Int }
-    | ItFloat { _itFloat :: Float }
+    | AttachFloat { _atFloat :: Float }
-    | ItBool  { _itBool  :: Bool  }
+    | AttachBool  { _atBool  :: Bool  }
     | NoItAttachment
 
 data Scope = NoScope

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

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

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

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 }

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 

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

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

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
+roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs its
-    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' :: 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

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

src/Dodge/Room/Procedural.hs

@@ -91,25 +91,22 @@ roomRect x y xn yn = defaultRoom
 zipCountDown :: [a] -> [(Int,a)]
 zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
 
-lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) 
+lnkBothAnd :: RoomLinkType -> (Int -> 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]
+    { _rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
-    ,_rlPos = p 
+    , _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)) 
+roomRectAutoLinks x y = roomRect x y (f x) (f y) 
-    {_rmPmnts = plmnts
+    & rmName .~ "autoRect"
-    ,_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.  -}
@@ -117,11 +114,8 @@ combineRooms :: Room -> Room -> Room
 combineRooms r r' = defaultRoom
     { _rmPolys  = _rmPolys r ++ _rmPolys r'
     , _rmLinks  = _rmLinks r ++ _rmLinks r'
-    , _rmPath  = map clampPath $ _rmPath  r 
+    , _rmPath   = map clampPath $ _rmPath  r ++ _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')
@@ -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
@@ -231,8 +225,7 @@ centerVaultRoom
     -> Float    -- ^ Height
     -> Float    -- ^ Vault dimensions
     -> State g Room
-centerVaultRoom w h d = do
+centerVaultRoom w h d = return $ defaultRoom
-    return $ defaultRoom
     { _rmPolys  = [rectNSWE h (-h) (-w) w]
     , _rmLinks  = 
         [outLink (V2 0    h) 0   

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]