Tweak starting rooms

2021-11-16 22:48:45 +00:00
parent 5d0b48829c
commit 559d7e3a23
6 changed files with 102 additions and 92 deletions
@@ -35,58 +35,58 @@ import qualified Data.IntMap.Strict as IM
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
    [[StartRoom]
-    ,[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 connectRoom slowDoorRoom ]
-    ,[Corridor]
-    ,[Corridor]
-    ,[SpecificRoom $ fmap connectRoom roomCCrits]
-    ,[AirlockAno]
-    ,[Corridor]
----    ,[SpecificRoom roomCCrits]
----    ,[Corridor]
----    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
----        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
----                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
----                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
----                    ]++)
----     ]
----    --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
----    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
----    -- ]
----    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
----        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
----     ]
----    ,[Corridor]
--    --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
---    ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
---    ,[DoorAno]
---    ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
---    ,[SpecificRoom blockedCorridor]
---    ,[OrAno [[DoorAno]
---            ,[Corridor]
---            ,[DoorNumAno 0,AirlockAno]] 
---            ]
---    ,[FirstWeapon]
---    ,[CorridorDebug]
---    ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
-    ,[OrAno 
-        [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
-        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
-            & crState . crDropsOnDeath .~ DropSpecific [0] ]
-        ]
-     ]
--    ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
-    ,[Corridor]
-    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
+--    ,[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 connectRoom slowDoorRoom ]
+--    ,[Corridor]
+--    ,[Corridor]
+--    ,[SpecificRoom $ fmap connectRoom roomCCrits]
+--    ,[AirlockAno]
+--    ,[Corridor]
+------    ,[SpecificRoom roomCCrits]
+------    ,[Corridor]
+------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
+------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
+------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
+------                    ]++)
+------     ]
+------    --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
+------    -- ]
+------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
+------     ]
+------    ,[Corridor]
+----    --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
+-----    ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
+-----    ,[DoorAno]
+-----    ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
+-----    ,[SpecificRoom blockedCorridor]
+-----    ,[OrAno [[DoorAno]
+-----            ,[Corridor]
+-----            ,[DoorNumAno 0,AirlockAno]] 
+-----            ]
+-----    ,[FirstWeapon]
+-----    ,[CorridorDebug]
+-----    ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
+--    ,[OrAno 
+--        [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
+--        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
+--            & crState . crDropsOnDeath .~ DropSpecific [0] ]
+--        ]
+--     ]
+----    ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
+--    ,[Corridor]
+--    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
    ] 
    $ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] 
                                [EndRoom]
@@ -44,7 +44,7 @@ generateLevelFromRoomList gr' w
    . flip (mapAccumR doRoomPlacements) rs'
    $ w { _walls        = wallsFromRooms rs
        , _floorTiles   = floorsFromRooms rs
-        , _gameRooms    = gameRoomsFromRooms rs
+        , _gameRooms    = gameRoomsFromRooms rs'
        , _pathGraph    = path
        , _pathGraphP   = pairPath
        }
@@ -155,10 +155,10 @@ gameRoomsFromRooms = map gameRoomFromRoom

 gameRoomFromRoom :: Room -> GameRoom
 gameRoomFromRoom rm = GameRoom
-    { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
+    { _grViewpoints = map doshift $ _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
 --       ++ map fst (_rmLinks rm)
-    , _grViewpointsEx = mapMaybe unpos (_rmPos rm)
-    , _grBound = expandPolyCorners 50 . convexHullSafe . nubBy closePoints 
+    , _grViewpointsEx = concatMap unpos (_rmPos rm)
+    , _grBound = map doshift $ expandPolyCorners 50 . convexHullSafe . nubBy closePoints 
        . concat $ _rmBound rm ++ _rmPolys rm
    , _grDir   = getDir $ _rmPos rm
    , _grLinkDirs = mapMaybe undir $ _rmPos rm
@@ -166,14 +166,18 @@ gameRoomFromRoom rm = GameRoom
    }
  where
    doshift = shiftPointBy (_rmShift rm)
-    unpos (OutLink _ p _) = Just $ doshift p
-    unpos (InLink    p _) = Just $ doshift p
-    unpos _ = Nothing
+    doubleShift p a = map doshift
+        [p +.+ 10 *.* unitVectorAtAngle a
+        ,p -.- 10 *.* unitVectorAtAngle a
+        ]
+    unpos (OutLink _ p a) = doubleShift p a
+    unpos (InLink    p a) = doubleShift p a
+    unpos _ = []
    undir (OutLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
    undir (InLink    _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
    undir _ = Nothing
    closePoints x y = roundPoint2 x == roundPoint2 y
-    getDir (InLink _ a:_) = a -- + snd (_rmShift rm)
+    getDir (InLink _ a:_) = a  + snd (_rmShift rm)
    getDir (_:xs) = getDir xs
    getDir _ = 0 -- fallback

@@ -7,12 +7,11 @@ import Dodge.Data
 import Dodge.Floor
 import Dodge.Layout
 import Dodge.Initialisation
--import qualified IntMapHelp as IM

--import Control.Lens
+import System.Random

 generateWorldFromSeed :: Int -> IO World
 generateWorldFromSeed i = do
    roomList <- layoutLevelFromSeed 0 i
    return $ generateLevelFromRoomList roomList 
-         initialWorld -- note this uses a random generator defined elsewhere
+         initialWorld{_randGen=mkStdGen i}
@@ -251,8 +251,10 @@ weaponEmptyRoom = do
            --,sPS (V2 (w/2) (h/2))      0 putLamp
            ,mntLightLnkCond unusedLnkToPS
            ]
-    (fmap connectRoom . randomiseOutLinks) =<< 
+    treeFromTrunk [Left corridor] 
+        <$> ((fmap connectRoom . randomiseOutLinks) =<< 
        changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
+        )
     
 weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
 weaponUnderCrits = do
@@ -275,18 +277,20 @@ weaponUnderCrits = do

 weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
 weaponBehindPillar  = do
-      cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,220]] ++ [V2 120 160,V2 120 200]
-      let d p = argV $ V2 120 80 -.- p
-      let plmnts1 = 
-            [sPS (V2 120 160)  0 $ RandPS randFirstWeapon
-            ,sPS cpos (d cpos) randC1
-            ]
-      rcp <- roomCenterPillar
-      return $ treeFromTrunk 
-        [Left door
-        ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
-        ]
-        (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
+    wpa  <- state $ randomR (0,pi)
+    wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
+    cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,40]] ++ [V2 120 160,V2 120 200]
+    let d p = argV $ V2 120 80 -.- p
+    let plmnts1 = 
+          [sPS wpos wpa $ RandPS randFirstWeapon
+          ,sPS cpos (d cpos) randC1
+          ]
+    rcp <- roomCenterPillar
+    return $ treeFromTrunk 
+      [Left corridor
+      ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
+      ]
+      (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)

 weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
 weaponBetweenPillars = do
@@ -48,11 +48,15 @@ rezBoxesThenWeaponRoom = do
    wroom  <- weaponRoom
    return $ rboxes `appendEitherTree` [wroom]

+rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxThenWeaponRoom = treeFromTrunk [Left rezBox,Left door] <$> weaponRoom
+
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = join $ takeOne 
-    [-- rezBoxesWp
-    rezBoxesThenWeaponRoom
-    --, rezBoxesWpCrit
+    [ rezBoxesWp
+    , rezBoxesThenWeaponRoom
+    , rezBoxThenWeaponRoom
+    , rezBoxesWpCrit
    ]

 rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
@@ -1,5 +1,4 @@
-{-
-Functions controlling the movement of the screen camera: 
+{- Functions controlling the movement of the screen camera: 
 '_cameraCenter', '_cameraZoom', _cameraRot';
 and the position that the character sees from: '_cameraViewFrom'.  -}
 module Dodge.Update.Camera 
@@ -165,23 +164,23 @@ farWallDist p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance)
    hw = halfWidth w
    hh = halfHeight w
    winFac = min hw hh
-    vps = concatMap _grViewpoints grs ++ linkvps
-    linkvps = map extend (concatMap _grViewpointsEx grs)
-    extend :: Point2 -> Point2
-    extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
+    vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
    wos = wallsOnScreen w

-farWallPoints :: Point2 -> World -> [Point2]
-farWallPoints p w = concatMap _grViewpoints grs ++ linkvps
+extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
+extendedViewPoints p grs = map extend 
+    (concatMap _grViewpointsEx grs
+    ++ map addDir (concatMap _grLinkDirs grs)
+    )
  where
-    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
-    linkvps = map extend (concatMap _grViewpointsEx grs
-        ++ map addDir (concatMap _grLinkDirs grs)
-        )
-    extend :: Point2 -> Point2
    extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
    addDir a = p +.+ unitVectorAtAngle a

+farWallPoints :: Point2 -> World -> [Point2]
+farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
+  where
+    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
+
 maxViewDistance :: Float
 maxViewDistance = 800