From 58a24c58e317af80cc13c4f82e354ddb5a67ad68 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 16 Mar 2022 18:02:17 +0000 Subject: [PATCH] Add more procedural girders --- src/Dodge/Combine/Combinations.hs | 2 +- src/Dodge/Data.hs | 8 ++++ src/Dodge/Default.hs | 2 + src/Dodge/Default/Weapon.hs | 4 ++ src/Dodge/Floor.hs | 15 +------- src/Dodge/LockAndKey.hs | 21 ++++++----- src/Dodge/Placement/Instance/Terminal.hs | 35 +++++++++++++++++- src/Dodge/PlacementSpot.hs | 14 ++----- src/Dodge/Room.hs | 2 + src/Dodge/Room/Containing.hs | 17 ++++++++- src/Dodge/Room/Foreground.hs | 2 +- src/Dodge/Room/LasTurret.hs | 2 +- src/Dodge/Room/LongDoor.hs | 11 ++++-- src/Dodge/Room/Procedural.hs | 3 +- src/Dodge/Room/Room.hs | 22 ----------- src/Dodge/Room/SensorDoor.hs | 34 +++++------------ src/Dodge/Room/Start.hs | 32 ++++++---------- src/Dodge/Room/Tanks.hs | 47 ++++++++++++++++++------ 18 files changed, 150 insertions(+), 123 deletions(-) diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index a9bd0e191..90fb8a7e9 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -27,7 +27,7 @@ itemCombinations = , po [BANGSTICK 1,CAN] revolver , po [REVOLVER, SPRING, HARDWARE] $ revolverX 1 - , po [PIPE,TUBE,HARDWARE] bangCone + , po [TUBE,HARDWARE] bangCone , po [BANGCONE,PLANK] blunderbuss , po [BLUNDERBUSS,TUBE] bigBlunderbuss , po [BIGBLUNDERBUSS,TUBE] biggerBlunderbuss diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8a44bf614..fb7c0a5b6 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -405,7 +405,14 @@ data Item = Item , _itTweaks :: ItemTweaks , _itModules :: M.Map ModuleSlot ItemModule , _itScope :: Scope + , _itValue :: ItemValue } +data ItemValue = ItemValue + { _ivInt :: Int + , _ivType :: ItemValueType + } +data ItemValueType = MundaneItem | ArtefactItem + data Targeting = NoTargeting | TargetingOnHeld @@ -1019,3 +1026,4 @@ makeLenses ''HUDElement makeLenses ''SubInventory makeLenses ''TerminalParams makeLenses ''TerminalLine +makeLenses ''ItemValue diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 6a07e0974..a76c7ac22 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -157,6 +157,7 @@ defaultEquipment = Item , _itModules = M.empty , _itScope = NoScope , _itTargeting = NoTargeting + , _itValue = defaultItemValue } defaultItZoom :: ItZoom defaultItZoom = ItZoom 20 0.2 1 @@ -182,6 +183,7 @@ defaultConsumable = Item , _itModules = M.empty , _itScope = NoScope , _itTargeting = NoTargeting + , _itValue = defaultItemValue } defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature) defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds') diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index d92de4297..f2fee82ae 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -106,7 +106,10 @@ defaultGun = Item ] , _itScope = NoScope , _itTargeting = NoTargeting + , _itValue = defaultItemValue } +defaultItemValue :: ItemValue +defaultItemValue = ItemValue 10 MundaneItem defaultCraftable :: Item defaultCraftable = Item { _itName = "default" @@ -128,6 +131,7 @@ defaultCraftable = Item , _itModules = M.empty , _itScope = NoScope , _itTargeting = NoTargeting + , _itValue = defaultItemValue } defItDim :: ItemDimension defItDim = ItemDimension diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index b2ccea0e7..8c426e925 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -36,23 +36,10 @@ import System.Random initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[AnoApplyInt 0 startRoom] --- , [SpecificRoom $ sensorRoom Flaming 50] + , [SpecificRoom $ fmap (return . UseAll) $ tanksRoom [] []] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] --- ,[ChainAnos --- [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 --- & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red) --- (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) ) --- & rmLinkEff .~ [putWireEnd 0] --- ] --- ,[UseLabel 0 $ return switchDoorRoom] --- ] --- ] --- ,[SpecificRoom $ return $ connectRoom lasTunnel ] --- ,[SpecificRoom $ fmap singleUseAll slowDoorRoom ] --- ,[Corridor] --- ,[Corridor] -- ,[SpecificRoom $ fmap singleUseAll roomCCrits] -- ,[AirlockAno] -- ,[Corridor] diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index e3d3e8fa6..a2a6d8b78 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -14,14 +14,14 @@ import Control.Monad.State lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = - --[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) - [(sensorRoomRunPast Electrical, return SPARKGUN ) - --,(sensorRoomRunPast Flaming, return FLAMESPITTER ) - --,(sensorRoomRunPast Lasering, return LASGUN ) - --,(const slowDoorRoomRunPast, return MINIGUN) - --,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) - --,(const glassLessonRunPast, takeOne [LASGUN]) - --,(const $ lasTunnelRunPast 400, return FLATSHIELD) + [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) + ,(sensorRoomRunPast Electrical, return SPARKGUN ) + ,(sensorRoomRunPast Flaming, return FLAMESPITTER ) + ,(sensorRoomRunPast Lasering, return LASGUN ) + ,(const slowDoorRoomRunPast, return MINIGUN) + ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) + ,(const glassLessonRunPast, takeOne [LASGUN]) + ,(const $ lasTunnelRunPast 400, return FLATSHIELD) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] @@ -31,7 +31,10 @@ itemRooms = , rc $ map makeTypeCraft [TUBE,TUBE,HARDWARE] ] ) - , (MINIGUN , join $ takeOne [roomMiniIntro, minigunFakeout] ) + , (MINIGUN , join $ takeOne + [roomMiniIntro + , rc $ map makeTypeCraft ([MOTOR,HARDWARE] ++ replicate 6 PIPE) + ] ) , (LASGUN , join $ takeOne [rc $ map makeTypeCraft [PRISM,TRANSFORMER,PIPE] ] diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 3b2e497c6..fdf7223d8 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -1,6 +1,8 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Placement.Instance.Terminal ( putTerminal + , simpleTermMessage + , genTermMessage ) where import Dodge.Data import Dodge.LevelGen.Data @@ -27,8 +29,9 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) }) $ const Nothing where - g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp - & plGenUpdate .~ Nothing + g gp pl = (gp, + pl & plType . pstPutButton . btTerminalParams .~ f gp + & plGenUpdate .~ Nothing ) thebutton = Button { _btPict = const mempty @@ -52,3 +55,31 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display { _termID = btid , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams } + +simpleTermMessage :: [String] -> (GenParams -> TerminalParams) +simpleTermMessage ss = const $ TerminalParams + {_termDisplayedLines = [] + ,_termFutureLines = TerminalLineEffect 0 termsound + : map totermline (topflush ++ ss) + ,_termMaxLines = 7 + } + where + topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] + totermline s = TerminalLineDisplay 0 s white + termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' + where + tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos + +genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams) +genTermMessage f = \gp -> TerminalParams + {_termDisplayedLines = [] + ,_termFutureLines = TerminalLineEffect 0 termsound + : map totermline (topflush (f gp) ++ f gp) + ,_termMaxLines = 7 + } + where + topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] + totermline s = TerminalLineDisplay 0 s white + termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' + where + tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index cb099e730..2a637236b 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -25,6 +25,7 @@ module Dodge.PlacementSpot , shiftInBy , resetPLUse , psposAddLabel + , shiftByV2 ) where import Dodge.LevelGen.Data import Geometry @@ -192,17 +193,8 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n shiftInBy :: Float -> (Point2,Float) -> (Point2,Float) shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a) ---anyLnkInPS :: Float -- ^ amount to shift inward --- -> PlacementSpot ---anyLnkInPS x = PSPos f (const id) Nothing --- where --- f rp _ = case _rpLinkStatus rp of --- UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1) --- _ -> Nothing --- where --- a = _rpDir rp --- v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi) --- a' = a + pi +shiftByV2 :: Point2 -> (Point2,Float) -> (Point2,Float) +shiftByV2 x (p,a) = (p +.+ rotateV a x,a) -- this should probably check the placement use, but so should others: should -- unify these diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 6e0a35c7c..26e18e9f3 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -21,6 +21,7 @@ module Dodge.Room , module Dodge.Room.Tanks , module Dodge.Room.Containing , module Dodge.Room.SensorDoor + , module Dodge.Room.Ngon ) where import Dodge.Room.Room import Dodge.Room.RoadBlock @@ -43,3 +44,4 @@ import Dodge.Room.GlassLesson import Dodge.Room.Tanks import Dodge.Room.Containing import Dodge.Room.SensorDoor +import Dodge.Room.Ngon diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs index a599457e1..e941d70d7 100644 --- a/src/Dodge/Room/Containing.hs +++ b/src/Dodge/Room/Containing.hs @@ -5,12 +5,15 @@ import Dodge.LevelGen.Data import Dodge.RandomHelp import Dodge.Room.Procedural import Dodge.Room.Tanks +import Dodge.Room.Link +import Dodge.Room.Ngon +import LensHelp +import Geometry --import Dodge.Item.Equipment import System.Random import Control.Monad.State - roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (SubCompTree Room) roomsContaining crs its = do endroom <- join $ takeOne @@ -18,3 +21,15 @@ roomsContaining crs its = do , tanksRoom crs its ] return $ treeFromPost [] $ UseAll endroom + +pedestalRoom :: RandomGen g => Item -> State g Room +pedestalRoom it = do + let flit = PutFlIt it + x <- state $ randomR (150,250) + ngon <- state $ randomR (5,9) + r <- takeOne + [ shuffleLinks =<< (centerVaultRoom x x 50 <&> rmPmnts .:~ sps0 flit) + , shuffleLinks $ roomRectAutoLinks (2*x) (2*x) & rmPmnts .:~ sPS (V2 x x) 0 flit + , shuffleLinks $ roomNgon ngon x & rmPmnts .:~ sps0 flit + ] + r <&> rmName .++~ "ped-" diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index b93641776..2edd333fe 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -93,7 +93,7 @@ girderV -> Float -- ^ distance between cross bars -> Float -- ^ width -> Point2 -> Point2 -> Shape -girderV h d w x y = colorSH red $ mconcat $ +girderV h d w x y = mconcat $ [ thinHighBar h xt yt , thinHighBar h xb yb ] diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index efaae82b2..f7979747c 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -5,9 +5,9 @@ import Dodge.Data import Dodge.Tree import Dodge.RoomLink import Dodge.Room.Door -import Dodge.Room.Room import Dodge.Room.Corridor import Dodge.Room.Link +import Dodge.Room.Ngon --import Dodge.Room.Procedural import Dodge.Room.Foreground --import Dodge.Room.RoadBlock diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f0c70a889..37156cb9f 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -96,8 +96,12 @@ addButtonSlowDoor x h rm = do & rmPmnts .++~ [butDoor , theterminal] & rmBound .:~ openDoorBound where - theterminal = putTerminal (const NoTerminalParams) - & plSpot .~ rprBoolShift (\rp _ -> RoomPosLab 0 `S.member` _rpType rp) (shiftInBy 20) + theterminal = putTerminal (simpleTermMessage themessage) + & plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10))) + themessage = + ["WARNING:" + ,"LARGE BIOMASS DETECTED" + ] ++ replicate 5 "" openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) belowH y = (sndV2 . fst) y < h - 40 aboveH y = (sndV2 . fst) y > h + 40 @@ -105,7 +109,8 @@ addButtonSlowDoor x h rm = do (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const -- TODO make the height of this light source and of other mounted lights -- be taken from a single consistent source - butDoor = putLitButOnPos col (psposAddLabel (RoomPosLab 0) $ rprBool $ isUnusedLnkType InLink) + butDoor = putLitButOnPos col + (rprBool (isUnusedLnkType InLink)) $ \btplmnt -> Just $ putDoubleDoorThen False col (cond' $ fromJust $ _plMID btplmnt) 30 (V2 0 h) (V2 x h) 2 $ \dr1 dr2 -> amountedlight dr1 50 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index a7e93f072..bdb22510d 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -22,7 +22,6 @@ import Dodge.Room.Path import Dodge.Default.Room --import Dodge.Item.Consumable --import Dodge.Item.Equipment -import Dodge.Room.Foreground --import Dodge.Item.Weapon import Dodge.RandomHelp import Dodge.LevelGen.Data @@ -248,13 +247,13 @@ centerVaultRoom w h d = do ,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 - ,sps0 $ PutShape $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h)) ] ++ 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 diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 4e9cb3e6b..4007fb132 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -28,10 +28,8 @@ import LensHelp import Control.Monad.State --import Control.Monad.Loops import System.Random -import Data.Maybe import Data.Tree import Data.Bifunctor -import Data.List roomC :: RandomGen g => Float -> Float -> State g Room roomC w h = do @@ -182,26 +180,6 @@ roomOctogon = defaultRoom ,( (0,40),pi) ] -roomNgon :: Int -> Float -> Room -roomNgon n x = defaultRoom - { _rmPolys = [poly] - , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks] - , _rmPath = [] -- TODO - , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk] - , _rmBound = [poly] - , _rmFloor = Tiled [makeTileFromPoly poly 9] - , _rmName = show n ++ "gon" - } - where - rot = 2*pi / fromIntegral n - rots = map ((rot *) . fromIntegral) [0..n-1] - poly = mapMaybe - (\(ra,rb) -> intersectLineLine' (rotateV ra bl) (rotateV ra br) (rotateV rb bl) (rotateV rb br)) - $ loopPairs rots - bl = V2 x x - br = V2 (-x) x - lnks = sortOn ((\(V2 a b) -> (negate b,a)) . fst) $ map (\r -> (rotateV r (V2 0 x),r)) rots - allPairs :: Eq a => [a] -> [(a,a)] allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y] diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index db4d9ef5e..cadde5dbd 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -6,15 +6,14 @@ import Dodge.Data import Dodge.Tree --import Dodge.RoomLink import Dodge.Room.Door +import Dodge.Room.Ngon import Dodge.Room.Procedural -import Dodge.Room.Room import Dodge.Room.Corridor import Dodge.Room.Link --import Dodge.Room.Procedural import Dodge.Room.Foreground --import Dodge.Room.RoadBlock import Dodge.Placement.Instance -import Dodge.SoundLogic --import Dodge.Default.Room --import Dodge.Item.Weapon.BulletGuns --import Dodge.Item.Weapon.Utility @@ -69,33 +68,20 @@ sensInsideDoor senseType outplid rm = rm thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) - , putTerminal messagef + , putTerminal (genTermMessage messagef) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) ] & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] where mtoup = map toUpper horline = "-----------------" - topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]] messagef gp = let Just (pc,ds) = gp ^? sensorCoding . ix senseType - themessage = - topflush ++ - [horline - ,"SENSOR ATTRIBUTES" - ,horline - ,mtoup $ show senseType - ,"COLOR:"++ mtoup (show pc) - ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds) - ,horline - ] - in TerminalParams - {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white) - ,_termFutureLines = TerminalLineEffect 0 termsound - : map totermline themessage - ,_termMaxLines = 7 - } - totermline s = TerminalLineDisplay 0 s white - termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' - where - tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos + in [horline + ,"SENSOR ATTRIBUTES" + ,horline + ,mtoup $ show senseType + ,"COLOR:"++ mtoup (show pc) + ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds) + ,horline + ] diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 370f01012..991d45d05 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -3,7 +3,6 @@ import Dodge.Data import Dodge.LevelGen.Data --import Dodge.PlacementSpot import Dodge.Room.RunPast -import Dodge.Room.Tanks import Dodge.Room.Containing import Dodge.Room.LongDoor --import Dodge.RoomLink @@ -17,9 +16,7 @@ import Dodge.Room.RezBox import Dodge.Room.Corridor import Dodge.Room.Room import Dodge.Room.Link -import Dodge.Room.Procedural -import Dodge.Item.Weapon.BulletGuns -import Dodge.Item.Weapon.Utility +import Dodge.Item.Weapon import Dodge.Item.Craftable --import Dodge.LevelGen.Data --import Geometry.Data @@ -33,15 +30,16 @@ import Control.Monad.State import System.Random --import qualified Data.IntMap.Strict as IM -minigunFakeout :: RandomGen g => State g (SubCompTree Room) -minigunFakeout = do - rcol <- rezColor +powerFakeout :: RandomGen g => State g (SubCompTree Room) +powerFakeout = do ncor <- state $ randomR (0,2) - roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150 - & rmPmnts .:~ plRRpt 0 (PutFlIt $ miniGunX 6) + it <- takeOne + [miniGunX 6 + ,launcherX 7 + ] + roomwithmini <- pedestalRoom it randcors <- replicateM ncor $ (fmap PassDown . shuffleLinks) corridor - return $ ([PassDown $ rezBox rcol - ,PassDown door + return $ ([PassDown door ,PassDown roomwithmini ,PassDown door ] @@ -52,8 +50,8 @@ minigunFakeout = do startRoom :: RandomGen g => Int -> State g (SubCompTree Room) startRoom i = join $ uncurry takeOneWeighted $ unzip --- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom] - [ (,) one rezBoxesWp + [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom] + , (,) one rezBoxesWp , (,) one rezBoxesThenWeaponRoom , (,) 1 rezBoxThenWeaponRoom , (,) one rezBoxesWpCrit @@ -106,11 +104,3 @@ startCrafts = takeOne $ map (map makeTypeCraft) [ [PIPE,PIPE,HARDWARE] , [TUBE,PIPE,HARDWARE] ] - -startRoom' :: RandomGen g => State g (SubCompTree Room) -startRoom' = do - scrafts <- startCrafts - troom <- tanksRoom [] scrafts - thecol <- rezColor - treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll - <$> shuffleLinks troom diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index 250bdf57b..b8ad327ea 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/src/Dodge/Room/Tanks.hs @@ -10,9 +10,9 @@ import Dodge.Placement.TopDecoration import Dodge.PlacementSpot --import Padding import Color ---import Shape +import Shape import LensHelp ---import Geometry +import Geometry --import Data.Maybe --import Data.Tree @@ -29,6 +29,29 @@ randomTank = takeOne $ map (\f -> f (dim orange) orange) , roundTankCross , tankSquareDec plusDecoration ] +addGirderNS :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room +addGirderNS shapef col room = do + let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room + girderPosOrder <- shuffle [1 .. nwestlnks - 2] + return $ room & rmPmnts .:~ foldr1 setFallback + (sps0 PutNothing : [ twoRoomPoss + (isUnusedLnkType (FromWest i)) + (isUnusedLnkType (FromWest i)) + $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) + | i <- girderPosOrder] + ) +addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room +addGirderEW shapef col room = do + let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room + girderPosOrder <- shuffle [1 .. nwestlnks - 2] + return $ room & rmPmnts .:~ foldr1 setFallback + (sps0 PutNothing : + [ twoRoomPoss + (isUnusedLnkType (FromSouth i)) + (isUnusedLnkType (FromSouth i)) + $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) + | i <- girderPosOrder] + ) tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room tanksRoom crs its = do @@ -37,17 +60,19 @@ tanksRoom crs its = do ntanks <- state $ randomR (3,6) thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50 let room = roomRectAutoLinks w h - nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room - girderPosOrder <- shuffle [1 .. nwestlnks - 2] let plmnts = - --ok, this has become complicated - foldr1 setFallback [ twoRoomPoss (isUnusedLnkType (FromSouth i)) - (isUnusedLnkType (FromSouth i)) $ \ps1 ps2 -> - sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2) - | i <- girderPosOrder] - : map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its + map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs ++ replicate ntanks thetank -- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25) - return $ room & rmPmnts .++~ plmnts + hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10] + addhighgirds <- takeOne $ + [ addGirderEW hgshape black >=> addGirderEW hgshape black + , addGirderEW hgshape black + , addGirderNS hgshape black >=> addGirderNS hgshape black + , addGirderNS hgshape black + ] ++ replicate 4 return + lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10] + addlowgirds <- takeOne $ addGirderNS lgshape red : replicate 4 return + (addlowgirds >=> addhighgirds) $ room & rmPmnts .++~ plmnts & rmName .~ "tanksRoom"