Add laser tunnel lock-key combination

2022-03-09 15:27:35 +00:00
parent a4ec4e4889
commit 3bfebc266b
11 changed files with 104 additions and 75 deletions
@@ -57,10 +57,9 @@ itemCombinations =

    , p [p 2 TUBE,o HARDWARE] launcher
    , p [p 2 TUBE,o LAUNCHER] (launcherX 2)
-    , p [p 2 TUBE,o $ LAUNCHERX 2] (launcherX 3)
-    , po [TRANSMITTER,MINIDISPLAY,LAUNCHER] remoteLauncher
-
-    , po [LIGHTER,PIPE,CAN]  flameStick
+    ] ++ [ p [p 2 TUBE,o $ LAUNCHERX i] (launcherX (i+1)) | i <- [2..9]]
+    ++
+    [ po [LIGHTER,PIPE,CAN]  flameStick
    , po [FLAMESTICK,CAN,PUMP] blowTorch
    , po [FLAMESTICK,DRUM] flameThrower
    , po [FLAMETHROWER,DRUM] flameWall
@@ -163,7 +162,7 @@ moduleCombinations =
    amod cts str func = (cts,ItemModule [str] 1 func)

 homingLaunchers :: [Item]
-homingLaunchers = launcher : [launcherX i | i <- [2..3]]
+homingLaunchers = launcher : [launcherX i | i <- [2..10]]

 bulletWeapons :: [Item]
 bulletWeapons = [bangStick i | i <- [1..9] ]
@@ -178,6 +178,7 @@ testInventory = IM.fromList $ zip [0..]
 --    , makeTypeCraftNum 3 DRUM
 --    , makeTypeCraftNum 3 PUMP
 --    , makeTypeCraftNum 1 MAGNET
+    , makeTypeCraftNum 1 TRANSMITTER
    , makeTypeCraftNum 5 HARDWARE
    , makeTypeCraftNum 3 SPRING
    , makeTypeCraftNum 10 CAN
@@ -185,7 +186,6 @@ testInventory = IM.fromList $ zip [0..]
    , makeTypeCraftNum 3 PLANK
    , makeTypeCraftNum 1 MOTOR
    , makeTypeCraftNum 5 MICROCHIP
--    , makeTypeCraftNum 1 TRANSMITTER
 --    , makeTypeCraftNum 5 AIUNIT
    ]
 stackedInventory :: IM.IntMap Item
@@ -34,9 +34,7 @@ import System.Random
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
    [[AnoApplyInt 0 startRoom]
--    [[SpecificRoom startRoom']
--    , [SpecificRoom $ rezThenLasTurret]
--    , [SpecificRoom $ fmap (return . PassDown) longRoom]
+--    , [SpecificRoom $ fmap (return . UseAll) lasTunnelRunnable]
    , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
    , [SpecificRoom randomChallenges]
    , [AnoApplyInt 1 lasSensorTurretTest]
@@ -18,6 +18,7 @@ lockRoomKeyItems =
    ,(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))]
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.PlacementSpot where
 import Dodge.LevelGen.Data
 import Geometry
@@ -39,7 +40,7 @@ unusedSpotAwayFromLink x = PSPos f (const id) Nothing

 setFallback :: Placement -> Placement -> Placement
 setFallback fallback plmnt = plmnt
-    & plSpot . psFallback .~ Just fallback
+    & plSpot . psFallback %~ maybe (Just fallback) Just
    & plIDCont %~ fmap (fmap $ setFallback fallback)

 unusedOffPathAwayFromLink :: Float -> PlacementSpot
@@ -88,7 +89,7 @@ useRoomPosCond t rp _
    a = _rpDir rp

 unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
-unusedLnkToPS = useRoomPosCond $ \rp -> case rp of
+unusedLnkToPS = useRoomPosCond $ \case
    UnusedLink {} -> True
    _ -> False

@@ -3,6 +3,7 @@ import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
 import Dodge.Data
 import Dodge.Tree
+import Dodge.RoomLink
 import Dodge.Room.Door
 import Dodge.Room.Room
 import Dodge.Room.Corridor
@@ -11,7 +12,7 @@ import Dodge.Room.Link
 import Dodge.Room.Foreground
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
--import Dodge.Item.Random
+import Dodge.Default.Room
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.Utility
 --import Dodge.LevelGen.Data
@@ -21,7 +22,9 @@ import Geometry
 import Color
 import Shape
 import LensHelp
+import Dodge.RandomHelp

+import qualified Data.Set as S
 import Data.Maybe
 import Data.Tree
 import Control.Monad.State
@@ -51,7 +54,6 @@ lasSensLightAboveDoor wth ps = extTrigLitPos
    upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
        | otherwise = w

-
 lightSensByDoor :: Room -> Room
 lightSensByDoor rm = rm 
    & rmPmnts .++~ 
@@ -78,3 +80,48 @@ lasCenSensEdge n = do
        [ treeFromPost [PassDown doorroom] (UseAll door)
        , treeFromPost [PassDown door]     (UseLabel 0 corridor)
        ]
+
+lasTunnel :: RandomGen g => Float -> State g Room
+lasTunnel y = do
+    extraPlmnts <- takeOne
+        [   [ midWall (rectNSEW 115 90 0 60)
+            , midWall (rectNSEW 65  40 (-40) 25)
+            ]
+        ,   [ midWall (rectNSEW 125 100 0 25)
+            , midWall (rectNSEW 80   40 (-40) 0)
+            , midWall (rectNSEW 80   40 25 60)
+            ]
+        ]
+    return  defaultRoom
+        { _rmPolys  = polys
+        , _rmBound  = polys
+        , _rmLinks  = 
+            [outLink (V2 20 (190 + y)) (1.5* pi)
+            ,outLink (V2 0 (190 + y)) (0.5* pi)
+            , inLink (V2 (-40) 20) (0.5* pi)
+            , inLink (V2 60 20) (1.5* pi)
+            , inLink (V2 10 0) pi
+            ]
+        , _rmPmnts  = [putLasTurret 0.005 & plSpot .~ PS (V2 10 (240+y)) (1.5*pi)
+            --, midWall (rectNSEW 65 40 0 25)
+            , mntLS vShape (V2 60 145) (V3 40 125 90)
+            , mntLS vShape (V2 (-40) 145) (V3 (-20) 125 90)
+            ]
+            ++ extraPlmnts
+        , _rmName = "lasTunnel" ++ show y
+        }
+  where
+    polys = [rectNSWE (250+y) 0 0 20
+        , rectNSWE 145 0 (-40) 60
+        ]
+
+-- a y value of 400 is probably "unrunnable"
+lasTunnelRunPast :: RandomGen g => Float -> State g (SubCompTree Room)
+lasTunnelRunPast y = do
+    r <- lasTunnel y
+    r1 <- takeOne [door,corridor]
+    r2 <- takeOne [door,corridor]
+    return $ Node (PassDown r)
+        [ singleUseAll r1
+        , return (UseLabel 0 $ r2 & rmConnectsTo .~ S.singleton InLink)
+        ]
@@ -5,7 +5,6 @@ The last link in the list is considered the incoming link, the other links are
 the outgoing links.  -}
 module Dodge.Room.Link
    ( shiftRoomShiftToLink
-    , shiftRoomBy
    , moveRoomBy
    , shiftLinkBy
    , doRoomShift
@@ -105,6 +104,7 @@ moveRoomBy shift r = r
        . (tileX    %~ shiftPointBy shift      )
        )
    & rmViewpoints %~ map (shiftPointBy shift)
+    & rmPos %~ map ( ( rpPos %~ shiftPointBy shift ) . (rpDir +~ snd shift) )

 shiftRoomShiftToLink :: (Point2,Float) -> (Point2,Float) -> Room -> Room
 shiftRoomShiftToLink l inlink r 
@@ -32,10 +32,11 @@ import Dodge.Creature
 import Geometry
 import Picture
 import Data.Tile
+import LensHelp

 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
-import Control.Lens
+--import Control.Lens
 import Control.Monad
 import Control.Monad.State
 import System.Random
@@ -104,6 +105,7 @@ combineRooms r r' = defaultRoom
    --, _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')
    , _rmShift  = (V2 0 0 , 0)
    }
@@ -120,20 +122,14 @@ combineFloors f _ = f
 Add a light and a 'PutNothing' placement.  -}
 quarterRoomTri :: RandomGen g => Float -> State g Room
 quarterRoomTri w = do
-    let commonPlacements = 
-            [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
-            , sPS (V2 (w-20) (w-20)) pi PutNothing 
-            , sPS (V2 (w-15) (w-25)) pi PutNothing 
-            ]
    b <- takeOne 
        [   [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70)
            , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
-            ] ++ commonPlacements
-        ,   blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
-            : commonPlacements
+            ]
+        ,   [blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))]
        ,   [ blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
            , blockLine (V2 (-29) w) (V2 0 (w/2))
-            ] ++ commonPlacements
+            ]
        ]
    pure $ defaultRoom
        { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
@@ -146,26 +142,28 @@ quarterRoomTri w = do
            ,(V2 0 (w-20),V2 0 0)
            ,(V2 (55-w) (w-20),V2 0 0)
            ]
-        , _rmPmnts     = b
+        , _rmPmnts  = b ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
+            , sPS (V2 (w-20) (w-20)) pi PutNothing 
+            , sPS (V2 (w-15) (w-25)) pi PutNothing 
+            ]
+        , _rmPos = 
+            [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty 
+            , UnusedSpot (V2 (w-15) (w-25)) pi S.empty 
+            ]
        , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
        }
 quarterRoomSquare :: RandomGen g => Float -> State g Room
 quarterRoomSquare w = do
-    let commonPlacements =
-            [ blockLine (V2 (w/2) (w/2)) (V2 0 w)
-            , sPS (V2 20 (2*w-40)) pi PutNothing
-            , sPS (V2 25 (2*w-45)) pi PutNothing
-            ]
    b <- takeOne 
        [   [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
-            ] ++ commonPlacements
+            ]
        ,   [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (negate w)  w   ) (V2 0 w)
-            ] ++ commonPlacements
+            ]
        ,   [ mntLS iShape (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20)  (1.3*w-20) 70)
            , blockLine (V2 0 w) (V2 0 (w*2))
-            ] ++ commonPlacements
+            ]
        ]
    pure $ defaultRoom
        { _rmPolys  = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
@@ -185,21 +183,16 @@ quarterRoomSquare w = do
            ,(V2 0 0,V2 0 (w-40))
 --            ,(V2 (20-w) (w-20),V2 (40-w) (w))
            ]
-        , _rmPmnts     = b
-        , _rmBound  = [map toV2 [(w,w),(0,2*w),(-w,w)]]
+        , _rmPmnts = b ++
+            [ blockLine (V2 (w/2) (w/2)) (V2 0 w)
+            , sPS (V2 20 (2*w-40)) pi PutNothing
+            , sPS (V2 25 (2*w-45)) pi PutNothing
+            ]
+        , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty
+                , UnusedSpot (V2 25 (2*w-45)) pi S.empty
+                ]
+        , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
        }
-{- | Replace the first 'PutNothing' with a given 'PSType'. -}
-fillNothingPlacement :: PSType -> Room -> Room
-fillNothingPlacement pst r =
-    r & rmPmnts %~ replaceNothingWith pst
-  where
-    replaceNothingWith x (Placement (PS p rot) PutNothing _ _: pss) = sPS p rot x : pss
-    replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
-    replaceNothingWith _ [] = []
-{- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
-}
-fillNothingPlacements :: [PSType] -> Room -> Room
-fillNothingPlacements pst r = foldr fillNothingPlacement r pst
 {- | Randomise the ordering of placements in a room.
 Useful for randomising the position of generic placements such as 'PutNothing'. -}
 shufflePlacements :: RandomGen g => Room -> State g Room
@@ -211,24 +204,19 @@ shufflePlacements = rmPmnts shuffle
 Tight corridors, random placements. -}
 randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
 randomFourCornerRoom its = do
-    corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
-    itms <- shuffle its
    nCrits <- state $ randomR (1,3)
-    crits <- takeN nCrits <=< shuffle $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
+    crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
        ++ replicate 20 chaseCrit
-    randomiseAllLinks . fillNothingPlacements (crits ++ map PutFlIt itms) =<< 
-        ( shufflePlacements
-        . over rmPmnts ( sps0 putLamp :)
-        . foldr1 combineRooms
-        $ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
-        )
+    randomFourCornerRoomCrsIts crits its
 {- | A randomly generate room based on four randomly generated corners. 
 Tight corridors. -}
 randomFourCornerRoomCrsIts :: RandomGen g => [Creature] -> [Item] -> State g Room
 randomFourCornerRoomCrsIts crits its = do
    corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
    itms <- shuffle its
-    randomiseAllLinks . fillNothingPlacements (map PutCrit crits ++ map PutFlIt itms) =<< 
+    let putitms = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
+        putcrits = map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crits
+    randomiseAllLinks . (rmPmnts .++~ (putitms ++ putcrits)) =<< 
        ( shufflePlacements
        . over rmPmnts ( sps0 putLamp :)
        . foldr1 combineRooms
@@ -1,6 +1,5 @@
 {- Connecting rooms designed with a pass-through technique in mind.  -}
-module Dodge.Room.RoadBlock
-    where
+module Dodge.Room.RoadBlock where
 import Dodge.Data
 import Dodge.RoomLink
 import Geometry
@@ -87,18 +86,3 @@ blockedCorridorCloseBlocks = do
            ]
        ]
    return $ corridor & rmPmnts .~ theblocks
-
-lasTunnel :: Room
-lasTunnel = defaultRoom
-    { _rmPolys  = polys
-    , _rmBound  = polys
-    , _rmLinks  = [outLink (V2 20 190) (1.5* pi), inLink (V2 0 20) (0.5* pi)]
-    , _rmPmnts  = [putLasTurret 0.005 & plSpot .~ PS (V2 10 240) (1.5*pi)
-        , midWall (rectNSEW 65 40 0 25)
-        , mntLS vShape (V2 50 10) (V3 40 20 50)
-        ]
-    }
-  where
-    polys = [rectNSWE 250 0 0 20
-        , rectNSWE 80 0 0 60
-        ]
@@ -92,7 +92,7 @@ rezBoxThenWeaponRoom = do
 rezBoxThenRoom :: RandomGen g => Room -> State g (SubCompTree Room)
 rezBoxThenRoom r = do
    rcol <- rezColor
-    treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> (return $ singleUseAll r)
+    return $ treeFromTrunk [PassDown $ rezBox rcol,PassDown door] $ singleUseAll r

 rezBoxThenRooms :: RandomGen g => SubCompTree Room -> State g (SubCompTree Room)
 rezBoxThenRooms r = do
@@ -21,6 +21,17 @@ rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
 rectWH :: Float -> Float -> [Point2]
 rectWH w h = rectNSWE h (-h) (-w) w

+isotriBWH :: Point2 -> Float -> Float -> [Point2]
+isotriBWH (V2 x y) w h = [V2 (x-w) y, V2 (x+w) y, V2 x (y+h)]
+
+-- trapezion
+trapezionBWHW :: Point2 -> Float -> Float -> Float -> [Point2]
+trapezionBWHW (V2 x y) w1 h w2 = 
+    [ V2 (x-w1) y
+    , V2 (x+w1) y
+    , V2 (x+w2) (y+h)
+    , V2 (x-w2) (y+h)]
+
 rectXH :: Float -> Float -> [Point2]
 rectXH x h = rectNSWE h (-h) 0 x