justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit before tweaking placementn/room generation

Browse Source
This commit is contained in:
justin
2025-09-23 09:52:52 +01:00
parent 4179115023
commit d1bb8a985b
18 changed files with 308 additions and 201 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+3 -2
View File
@@ -23,6 +23,7 @@ import System.Random
data GenWorld = GenWorld
{ _gwWorld :: World
, _genRooms :: IM.IntMap Room
, _genPmnt :: IM.IntMap [Placement]
}
---- ROOM DATATYPES
@@ -80,7 +81,7 @@ data Placement = Placement
{ _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
, _plIDCont :: GenWorld -> Placement -> Maybe Placement
}
{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
@@ -124,7 +125,7 @@ data Room = Room
}
data InPlacement = InPlacement
{ _ipPlacement :: World -> [Placement] -> Placement
{ _ipPlacement :: GenWorld -> [Placement] -> Placement
, _ipPlacementID :: Int
}
src/Dodge/DisplayInventory.hs
+4 -4
View File
@@ -176,10 +176,10 @@ filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
white
0
Nothing
f y
| null y =
IM.singleton 0 $ SelItem ["(NONE)"] 1 (length s) True (greyN 0.5) 0 Nothing
| otherwise = y
f y = y
-- | null y =
-- IM.singleton 0 $ SelItem ["(NONE)"] 1 (length s) True (greyN 0.5) 0 Nothing
-- | otherwise = y
itms' = f $ maybe id (IM.filter . filtfn) mfilt itms
numfiltitems = show (length itms - length itms') ++ " FILTERED"
src/Dodge/Layout.hs
+4 -2
View File
@@ -86,7 +86,7 @@ doInPlacements (im, w) =
doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
doRoomInPlacements im w rm = foldr f (w, rm) $ _rmInPmnt rm
where
f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w' ^. gwWorld) $ im IM.! i)
f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w') $ im IM.! i)
doOutPlacements :: GenWorld -> (IM.IntMap [Placement], GenWorld)
doOutPlacements w =
@@ -109,7 +109,9 @@ doIndividualPlacements gw =
in gw' & genRooms .~ rms
doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w, rm) $ _rmPmnts rm
--doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w, rm) $ _rmPmnts rm
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w, rm & rmPmnts .~ mempty)
$ _rmPmnts rm
setupWorldBounds :: World -> World
setupWorldBounds w =
src/Dodge/LevelGen/LevelStructure.hs
+1
View File
@@ -16,6 +16,7 @@ worldToGenWorld rms w =
GenWorld
{ _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w)
, _genRooms = rms
, _genPmnt = mempty
}
generateGenParams :: RandomGen g => State g GenParams
src/Dodge/LevelGen/PlacementHelper.hs
+2 -2
View File
@@ -54,7 +54,7 @@ ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing . const
contToIDCont :: (Int -> Maybe Placement) -> World -> Placement -> Maybe Placement
contToIDCont :: (Int -> Maybe Placement) -> GenWorld -> Placement -> Maybe Placement
contToIDCont f _ = f . fromJust . _plMID
jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
@@ -80,7 +80,7 @@ ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement
ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
ps0PushPSw :: PSType -> (World -> Placement -> Maybe Placement) -> Placement
ps0PushPSw :: PSType -> (GenWorld -> Placement -> Maybe Placement) -> Placement
ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl)
src/Dodge/Machine/Update.hs
+1 -1
View File
@@ -174,7 +174,7 @@ mcProximitySensorUpdate mc sens pr w
& mcsenslens . proxToggle ?~ True
& playsound dedaS
& mctermlens . tmFutureLines
<>~ [makeTermLine "SENSOR SUCCESS, DEACTIVATED"]
<>~ [makeTermLine "SENSOR SUCCESS: DEACTIVATED"]
<> tlSetStatus (TerminalPressTo "QUIT")
<> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
| notog =
src/Dodge/Placement/Instance/Analyser.hs
+12 -3
View File
@@ -1,4 +1,7 @@
module Dodge.Placement.Instance.Analyser (analyser) where
module Dodge.Placement.Instance.Analyser (
analyser,
analyserWithPrompt,
) where
import Color
import Dodge.Data.GenWorld
@@ -7,7 +10,11 @@ import Dodge.Placement.Instance
import LensHelp
analyser :: ProximitySensorType -> PlacementSpot -> PlacementSpot -> Placement
analyser pst pslight psmc = extTrigLitPos pslight $ \tp ->
analyser = analyserWithPrompt []
analyserWithPrompt ::
[TerminalLine] -> ProximitySensorType -> PlacementSpot -> PlacementSpot -> Placement
analyserWithPrompt l pst pslight psmc = extTrigLitPos pslight $ \tp ->
Just $
plSpot .~ psmc $
putTerminal
@@ -15,7 +22,9 @@ analyser pst pslight psmc = extTrigLitPos pslight $ \tp ->
(themachine & mcMounts . at OTTrigger .~ _plMID tp)
tparams
where
tparams = defaultTerminal & tmStatus .~ TerminalLineRead
tparams =
defaultTerminal & tmStatus .~ TerminalLineRead
& tmFutureLines .~ l
themachine =
defaultMachine & mcColor .~ aquamarine
& mcType .~ McTerminal
src/Dodge/Placement/Instance/Door.hs
+2 -2
View File
@@ -78,8 +78,8 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing $ \_ apl ->
Just $ Placement (PS 0 0) (PutCoord b) Nothing $ \w bpl ->
let x = w ^?! coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! coordinates . ix (bpl ^?! plMID . _Just)
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
in Just $ putDoubleDoor
AutoDoorObstacle
defaultAutoWall
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -41,7 +41,7 @@ placePlainPSSpot
placePlainPSSpot w rm plmnt shift =
let (i, w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
newplmnt = plmnt & plMID ?~ i
in maybe ((w', rm), [newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt (_gwWorld w') newplmnt)
in maybe ((w', rm & rmPmnts .:~ newplmnt), [newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt (w') newplmnt)
where
recrPlace newplmnt w' pl =
let (wr, newplmnts) = placeSpot (w', rm) pl
src/Dodge/Room/LasTurret.hs
+18
View File
@@ -90,9 +90,27 @@ analyserByNthLink n proxreq i rm =
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
analyserByNthLinkWithPrompt
:: Int -> [TerminalLine] -> ProximityRequirement -> Int -> Room -> Room
analyserByNthLinkWithPrompt n l proxreq i rm =
rm
& rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
]
& rmOutPmnt . at i ?~
analyserWithPrompt l
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor = analyserByNthLink 0
analyserByDoorWithPrompt :: [TerminalLine] -> ProximityRequirement -> Int -> Room -> Room
analyserByDoorWithPrompt = analyserByNthLinkWithPrompt 0
healthTest :: RandomGen g => Int -> State g (Tree Room)
healthTest n = do
cenroom <- shuffleLinks =<< healthAnalyserByDoor n <$> roomNgon 8 200
src/Dodge/Room/Room.hs
+1
View File
@@ -8,6 +8,7 @@ module Dodge.Room.Room (
pistolerRoom,
spawnerRoom,
corDoor,
weaponBehindPillar,
) where
import qualified Data.Set as S
src/Dodge/Room/Tutorial.hs
+61 -31
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Tutorial where
import Dodge.Room.Room
import Dodge.Annotation.Data
import Dodge.Cleat
--import Control.Monad
@@ -26,7 +27,6 @@ import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Room.RezBox
import Dodge.Room.RoadBlock
import Dodge.Room.Room
import Dodge.Room.Warning
--import Dodge.Room.RoadBlock
import Dodge.RoomLink
@@ -49,6 +49,9 @@ tutAnoTree =
[ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree corDoor
, AnTree $ tToBTree "critroom" <$> weaponBehindPillar
, AnTree corDoor
, AnTree $ tutDrop
, AnTree $ return $ tToBTree "cor" $ return $ cleatOnward corridor
---- , AnTree $ pickupTut
@@ -73,7 +76,18 @@ tutDrop = do
& plSpot .~ rprBoolShift isUnusedLnk
(\(p, a) -> (p + 10 *.* unitVectorAtAngle (a - pi/2), a))
ss =
[ makeTermLine "USE [F] OR CLICK AND DRAG TO DROP ITEMS"
[makeTermLine "--------------------------------------------"
,makeTermLine "YOU CAN ONLY CARRY A LIMITED AMOUNT OF ITEMS"
,makeTermLine "--------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE") <>
[ makeTermLine "USE [F] TO DROP SINGLE ITEMS"
,makeTermLine "--------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE") <>
[ makeTermLine "YOU CAN SELECT AND MOVE MULTIPLE ITEMS"
, makeTermLine " WITH THE MOUSE"
, makeTermLine "-------------------------------------------"
]
tutRooms :: State LayoutVars (MetaTree Room String)
@@ -81,7 +95,7 @@ tutRooms = do
i <- nextLayoutInt
j <- nextLayoutInt
x <-
shuffleLinks =<< analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
shuffleLinks =<< analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
<$> addDoorAtNthLinkToggleTerminal 1 ss j
<$> roomNgon 6 100
bcor <- blockedCorridor
@@ -97,13 +111,15 @@ tutRooms = do
]
where
ss =
[ makeTermLine "SOME TERMINALS CAN BE INTERACTED WITH DIRECTLY"
, makeTermLine " THESE WILL DISPLAY A PROMPT SYMBOL"
, makeTermLine " _____"
, makeTermLine " | | TYPE OR SCROLL TO ENTER COMMANDS"
, makeTermLine " | > |"
, makeTermLine " | | CLICK OR USE [RETURN] TO CONFIRM"
, makeTermLine " ^^^^^"
[ makeTermLine "---------------------------------------------"
, makeTermLine "YOU CAN INTERACT WITH SOME TERMINALS DIRECTLY"
, makeTermLine " THESE WILL DISPLAY A PROMPT SYMBOL"
, makeTermLine " *****"
, makeTermLine " * * TYPE OR SCROLL TO ENTER COMMANDS"
, makeTermLine " * > *"
, makeTermLine " * * CLICK OR USE [RETURN] TO CONFIRM"
, makeTermLine " ***** "
, makeTermLine "---------------------------------------------"
, makeTermLine ""
]
r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
@@ -114,27 +130,34 @@ tutRooms = do
& plSpot .~ rprBoolShift isUnusedLnk
(\(p, a) -> (p + 10 *.* unitVectorAtAngle (a - pi/2), a))
ss' =
[ makeTermLine "HOLD [CAPS] AND SCROLL"
, makeTermLine " OR CLICK AND DRAG TO REARRANGE INVENTORY ITEMS"
, makeTermLine ""
, makeTermLine "AMMO MAGS ARE TYPICALLY LOADED BENEATH WEAPONS"
[ makeTermLine "---------------------------------------------"
, makeTermLine "HOLD [CAPS] AND SCROLL"
, makeTermLine " OR CLICK AND DRAG"
, makeTermLine " TO REARRANGE INVENTORY ITEMS"
, makeTermLine "---------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE") <>
[ makeTermLine "AMMO MAGS ARE NORMALLY LOADED BENEATH WEAPONS"
, makeTermLine " .-------."
, makeTermLine " BURSTRIFLE |DRUMMAG|"
, makeTermLine " <------^-------^"
, makeTermLine ""
, makeTermLine "HOLD [RMB] TO AIM"
, makeTermLine "*AND* THEN TAP [LMB] TO FIRE LOADED WEAPONS"
, makeTermLine "---------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE") <>
[ makeTermLine "HOLD [RMB] TO AIM"
, makeTermLine " THEN CLICK [LMB] TO FIRE LOADED WEAPONS"
, makeTermLine "---------------------------------------------"
]
sensorTut :: [TerminalLine]
sensorTut =
[ makeTermLine "SOME TERMINALS DETECT EXTERNAL CONDITIONS"
, makeTermLine "WHILE WORKING THESE DISPLAY SPINNING SYMBOL"
, makeTermLine ""
, makeTermLine "**CAUTION**"
, makeTermLine "THE CONDITIONS AND ANY EFFECTS MAY BE HIDDEN"
, makeTermLine ""
[ makeTermLine "--------------------------------------------"
, makeTermLine "SOME TERMINALS DETECT EXTERNAL CONDITIONS"
, makeTermLine "WHILE ACTIVE THESE DISPLAY A SPINNING SYMBOL"
, makeTermLine " | / - \\"
, makeTermLine "--------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE")
tutRezBox :: RandomGen g => State g Room
tutRezBox = do
@@ -156,17 +179,24 @@ tutRezBox = do
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
& rmName .~ "tutRezBox"
where
s w = tutorialMessage1 (w ^. cWorld . cwGen . cwgSeed)
s w = tutorialMessage1 (w ^. gwWorld . cWorld . cwGen . cwgSeed)
tutorialMessage1 :: Int -> [TerminalLine]
tutorialMessage1 i =
[ makeTermLine $ "WELCOME TO ENVIRONMENT " ++ show i
[ makeTermLine "--------------------------------------------"
, makeTermLine $ "WELCOME TO ENVIRONMENT " ++ show i
, makeTermLine ""
, makeTermLine "USE [SPACE] TO INTERACT WITH NEARBY OBJECTS"
, makeTermLine "--------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "USE [SPACE] TO INTERACT WITH NEARBY OBJECTS")
<> [ makeTermLine "USE [SPACE] TO INTERACT WITH NEARBY OBJECTS"
, makeTermLine ""
, makeTermLine "USE [W]"
, makeTermLine " [A] [S]"
, makeTermLine " [D] TO MOVE"
<> tlSetStatus (TerminalPressTo "CONTINUE")
<> [ makeTermLine "USE [W]"
, makeTermLine " [A] [S]"
, makeTermLine " [D] TO MOVE"
, makeTermLine "--------------------------------------------"
]
<> tlSetStatus (TerminalPressTo "CONTINUE") <>
[ makeTermLine "AFTER EXITING THIS TERMINAL YOUR INVENTORY"
, makeTermLine " AND NEARBY OBJECTS WILL BE DISPLAYED"
, makeTermLine "--------------------------------------------"
]
src/Dodge/Tree/Shift.hs
+1 -1
View File
@@ -39,7 +39,7 @@ positionRoomsFromTree (Node (r, i) ts) =
(fmap (prRooms %~ map (first createUnusedLinkPos)))
(posRms (PosRooms (map pointsToPoly $ _rmBound r') []) (r', i) (zipCount ts) Empty)
where
r' = r & rmMID ?~ 0
r' = r & rmMID ?~ i
posRms ::
PosRooms ->