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

Simplify layout Annotations

Browse Source
This commit is contained in:
justin
2025-08-21 17:57:02 +01:00
parent befe24e038
commit e7b52f4487
10 changed files with 109 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Annotation.hs
+12 -10
View File
@@ -14,22 +14,24 @@ import Dodge.Tree
import LensHelp
import RandomHelp
annoToRoomTree :: Annotation -> State (StdGen, Int) MTRS
annoToRoomTree :: Annotation -> State LayoutVars MTRS
annoToRoomTree an = case an of
AnTree t -> zoom _1 t
AnTree t -> t
-- AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ()) <$> zoom _1 r <*> return []
OnwardList ans -> do
mts <- mapM annoToRoomTree ans
return $ foldr1 attachOnward' mts
IntAnno f -> do
(g, i) <- get
put (g, i + 1)
annoToRoomTree (f i)
PassthroughLockKeyLists ls ks i -> zoom _1 $ do
-- IntAnno f -> do
-- LayVars g i <- get
-- put $ LayVars g (i + 1)
-- annoToRoomTree (f i)
--PassthroughLockKeyLists ls ks i -> zoom lyGen $ do
PassthroughLockKeyLists ls ks -> do
i <- nextLayoutInt
(functionlockroom, randomitemidentity) <- takeOne ls
lr <- functionlockroom i
ii <- randomitemidentity
keyroom <- fromJust $ lookup ii ks
lr <- zoom lyGen $ functionlockroom i
ii <- zoom lyGen $ randomitemidentity
keyroom <- zoom lyGen . fromJust $ lookup ii ks
return $
MTree
("PassthroughLockKeyLists-" ++ show ii)
src/Dodge/Annotation/Data.hs
+22 -3
View File
@@ -11,14 +11,33 @@ import System.Random
type MTRS = MetaTree Room String
data LayoutVars = LayVars
{ _lyGen :: StdGen
, _lyCounter :: Int
}
data Annotation
= OnwardList [Annotation]
| IntAnno (Int -> Annotation)
-- | IntAnno (Int -> Annotation)
-- | AnRoom (State StdGen Room)
| AnTree (State StdGen (MetaTree Room String))
| AnTree (State LayoutVars (MetaTree Room String))
| PassthroughLockKeyLists
[(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
[(ItemType, State StdGen (MetaTree Room String))]
Int
-- Int
makeLenses ''Annotation
makeLenses ''LayoutVars
instance RandomGen LayoutVars where
genWord32 x = let (y,g) = genWord32 (x ^. lyGen)
in (y,x & lyGen .~ g)
genWord64 x = let (y,g) = genWord64 (x ^. lyGen)
in (y,x & lyGen .~ g)
split x = let (g,h) = split (x ^. lyGen) in (x & lyGen .~ g, x & lyGen .~ h)
nextLayoutInt :: State LayoutVars Int
nextLayoutInt = do
LayVars g i <- get
put $ LayVars g (i + 1)
return i
src/Dodge/Floor.hs
+22 -14
View File
@@ -4,6 +4,7 @@ module Dodge.Floor (
tutRoomTree,
) where
import Dodge.Annotation.Data
import Dodge.Room.Tutorial
import Data.List (intersperse)
import Dodge.Annotation
@@ -18,11 +19,11 @@ import LensHelp
import RandomHelp
-- | A test level tree.
initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
initialRoomTree :: State LayoutVars (MetaTree Room String)
initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree startWorldTreeTest
tutRoomTree :: State (StdGen, Int) (MetaTree Room String)
tutRoomTree :: State LayoutVars (MetaTree Room String)
tutRoomTree = annoToRoomTree tutAnoTree
--startWorldTreeTest :: Annotation
@@ -35,15 +36,15 @@ initialAnoTree :: Annotation
initialAnoTree =
OnwardList $
intersperse
(AnTree corDoor)
[ IntAnno $ AnTree . startRoom
, IntAnno $
(AnTree $ zoom lyGen corDoor)
[ AnTree $ intAnno startRoom
, --IntAnno $
PassthroughLockKeyLists
[(sensorRoomRunPast ElectricSensor, takeOne
[-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
HELD SPARKGUN])]
itemRooms
, IntAnno $ AnTree . lasSensorTurretTest
, AnTree $ intAnno lasSensorTurretTest
, -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
-- , AnRoom $ tanksRoom [] []
-- , AnRoom $ roomCCrits 0
@@ -62,8 +63,8 @@ initialAnoTree =
-- , AnTree $ tToBTree "spawners" <$> spawnerRoom
-- , AnRoom pistolerRoom
-- , AnRoom doubleCorridorBarrels
IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
, IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD"
PassthroughLockKeyLists keyCardRunPastRand itemRooms
, AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
, AnTree $
rToOnward "chaseCrit+armourChaseCrit rectRoom" $
return . cleatOnward $
@@ -71,11 +72,12 @@ initialAnoTree =
.++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
, psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
]
, IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
, AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
, IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms
, AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
, AnTree . zoom lyGen $
(tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
, PassthroughLockKeyLists lockRoomKeyItems itemRooms
, AnTree randomChallenges
, IntAnno $ AnTree . lasSensorTurretTest
, AnTree $ intAnno lasSensorTurretTest
, -- ,[AnTree $ fmap pure roomCCrits]
-- ,[AirlockAno]
-- ,[Corridor]
@@ -119,5 +121,11 @@ initialAnoTree =
AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward
]
anRoom :: StateT StdGen Identity Room -> Annotation
anRoom t = AnTree $ tToBTree "anRoom" . return . cleatOnward <$> t
intAnno :: (Int -> State StdGen MTRS) -> State LayoutVars MTRS
intAnno f = do
LayVars g i <- get
put $ LayVars g (i+1)
zoom lyGen (f i)
anRoom :: State StdGen Room -> Annotation
anRoom t = AnTree $ zoom lyGen $ (tToBTree "anRoom" . return . cleatOnward <$> t)
src/Dodge/LevelGen.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.LevelGen where
module Dodge.LevelGen (generateWorldFromSeed) where
import Dodge.Annotation.Data
import Dodge.Layout
import Data.Preload.Render
import Control.Lens
@@ -50,7 +51,7 @@ layoutLevelFromSeed i seed = do
putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
appendFile "log/attemptedSeeds" "\n"
let g = mkStdGen seed
let treecluster = evalState tutRoomTree (g, 0)
let treecluster = evalState initialRoomTree (LayVars g 0)
let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
appendFile "log/treeCluster" ("Seed: " ++ show seed ++ "\n")
putStrLn "MetaTree clusters:"
src/Dodge/LockAndKey.hs
+1 -1
View File
@@ -22,7 +22,7 @@ lockRoomMultiItems =
)
]
lockRoomKeyItems :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
lockRoomKeyItems :: [(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
lockRoomKeyItems =
[ (lasCenSensEdge, takeOne [HELD RLAUNCHER, LASER, HELD SPARKGUN, HELD FLATSHIELD])
, (sensorRoomRunPast LaserSensor, return LASER)
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -151,7 +151,7 @@ addButtonSlowDoor x h rm = do
Nothing
col = dim $ light red
slowDoorRoom :: RandomGen g => State g Room
slowDoorRoom :: State StdGen Room
slowDoorRoom = do
x <- state $ randomR (400, 800)
y <- state $ randomR (400, 800)
@@ -168,7 +168,7 @@ slowDoorRoom = do
proom <- southPillarsRoom x y h
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
slowDoorRoomRunPast :: State StdGen (MetaTree Room String)
slowDoorRoomRunPast = do
r <- slowDoorRoom
rToOnward "slowDoorRoomRunPast" $
src/Dodge/Room/Tutorial.hs
+6 -4
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Tutorial (tutAnoTree) where
import Dodge.Cleat
import Dodge.Room.Room
import Dodge.Annotation.Data
import Dodge.Room.Link
@@ -34,14 +35,15 @@ import Data.List (intersperse)
tutAnoTree :: Annotation
tutAnoTree = OnwardList $
intersperse
(AnTree corDoor)
[AnTree tutRooms]
(AnTree $ zoom lyGen corDoor)
[AnTree . zoom lyGen $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
,AnTree $ zoom lyGen tutRooms
]
tutRooms :: State StdGen (MetaTree Room String)
tutRooms = do
x <- tutRezBox
ys <- toggleDoorTest
return $ tToBTree "TutStartRez" $ treePost $ [x,door] <> ys
return $ tToBTree "DoorTest" $ treePost $ [] <> ys
tutRezBox :: State StdGen Room
tutRezBox = do
src/Dodge/Room/Warning.hs
+1 -1
View File
@@ -21,7 +21,7 @@ import Geometry
import LensHelp
import RandomHelp
warningRooms :: RandomGen g => String -> Int -> State g (MetaTree Room String)
warningRooms :: String -> Int -> State StdGen (MetaTree Room String)
warningRooms str n = do
rm <- do
tr <- tanksRoom [] []