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

Commit mid big tree composing change

Browse Source
This commit is contained in:
justin
2022-06-09 21:25:22 +01:00
parent 8fb80f9691
commit 3edc7a0a58
20 changed files with 263 additions and 248 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Room.hs
+62 -60
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.Room where
import Data.Tile
import Dodge.UseAll
import Dodge.Data
import Dodge.PlacementSpot
import Dodge.RoomLink
@@ -54,12 +55,12 @@ roomPadCut ps p = defaultRoom
, _rmPath = [(V2 0 0,p)]
}
branchWith :: Room -> [Tree Room] -> SubCompTree Room
branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts
branchWith :: Room -> [Tree Room] -> Tree Room
branchWith r ts = Node r $ return (useAll door) : ts
manyDoors :: Int -> SubCompTree Room
manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door
manyDoors :: Int -> Tree Room
manyDoors i = treeFromPost (replicate i ( door)) $ useAll door
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
@@ -96,12 +97,12 @@ glassSwitchBackCrits = glassSwitchBack
, spNoID (PSRoomRand 1 (uncurry PS)) randC1
] ++)
miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 :: RandomGen g => State g (Tree Room)
miniTree2 = (glassSwitchBackCrits
>>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70))
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
miniRoom3 :: RandomGen g => State g (Tree Room)
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
@@ -120,19 +121,19 @@ miniRoom3 = do
] ++
[ sPS cp 0 $ PutCrit miniGunCrit
, sPS (V2 (w/2) (h/2)) 0 putLamp ]
fmap singleUseAll $ shuffleLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
fmap (pure . useAll) $ shuffleLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
roomMiniIntro :: RandomGen g => State g (LabSubCompTree Room)
-- no idea what was going on here...
roomMiniIntro :: RandomGen g => State g (LabTree Room)
roomMiniIntro = do
midroom <- join $ takeOne [miniTree2] --,glassLesson]
return (chainUses
[return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor]
,TreeSubLabelling "roomMiniIntro" Nothing)
return ( toOnward "roomMiniIntro"
, midroom )
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
@@ -181,7 +182,7 @@ randFirstWeapon = do
++ replicate 5 (bangStick 4)
++ replicate 5 (bangCaneX 3)
weaponEmptyRoom :: RandomGen g => State g (SubCompTree Room)
weaponEmptyRoom :: RandomGen g => State g (Tree Room)
weaponEmptyRoom = do
w <- state $ randomR (220,300)
h <- state $ randomR (220,300)
@@ -195,9 +196,9 @@ weaponEmptyRoom = do
f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
rm <- addHighGirder >=> shuffleLinks
$ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
return $ treeFromTrunk [PassDown corridor] (singleUseAll rm )
return $ treeFromTrunk [ corridor] (pure $ useAll rm )
weaponUnderCrits :: RandomGen g => Int -> State g (LabSubCompTree Room)
weaponUnderCrits :: RandomGen g => Int -> State g (LabTree Room)
weaponUnderCrits i = do
let plmnts =
[--sPS (V2 20 0) 0 $ RandPS randFirstWeapon
@@ -206,37 +207,37 @@ weaponUnderCrits i = do
]
addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
let continuationRoom = treeFromTrunk
[PassDown $ addwpat (V2 20 0) corridorN,PassDown $ addwpat (V2 20 0) corridorN]
(singleUseAll (set rmPmnts plmnts corridorN))
[ addwpat (V2 20 0) corridorN, addwpat (V2 20 0) corridorN]
(pure $ useAll (set rmPmnts plmnts corridorN))
rcp <- roomCenterPillar
rmpils <- roomPillars 30 240 240 2 2
deadEndRoom' <- takeOne
[ addwpat (V2 120 20) rmpils
, addwpat (V2 120 20) rcp]
junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
junctionRoom <- takeOne [ tEast, tWest]
let thetree = treeFromTrunk
--[PassDown $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[PassDown corridorN
,PassDown corridorN]
--[ $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[ corridorN
, corridorN]
$ Node junctionRoom
[continuationRoom
,singleUseNone deadEndRoom'
,pure deadEndRoom'
]
return thetree
<&> (, TreeSubLabelling ("weaponUnderCrits "++show i) (Just $ fmap composingNodeName thetree))
return (toOnward "weaponUnderCrits" , thetree )
-- TODO addSubmessages
composingNodeName :: ComposingNode Room -> TreeSubLabelling
composingNodeName cn = case cn of
PassDown rm -> f $ _rmName rm ++ "-PassDown"
SplitDown rm -> f $ _rmName rm ++ "-SplitDown"
UseAll rm -> f $ _rmName rm ++ "-UseAll"
UseSome is rm -> f $ _rmName rm ++ "-" ++ show is ++ "-UseSome"
UseNone rm -> f $ _rmName rm ++ "-UseNone"
UseLabel i rm -> f $ _rmName rm ++ "-" ++ show i ++ "-UseLabel"
where
f str = TreeSubLabelling str Nothing
--composingNodeName :: ComposingNode Room -> TreeSubLabelling
--composingNodeName cn = case cn of
-- rm -> f $ _rmName rm ++ "-"
-- SplitDown rm -> f $ _rmName rm ++ "-SplitDown"
-- useAll rm -> f $ _rmName rm ++ "-useAll"
-- UseSome is rm -> f $ _rmName rm ++ "-" ++ show is ++ "-UseSome"
-- UseNone rm -> f $ _rmName rm ++ "-UseNone"
-- useLabel i rm -> f $ _rmName rm ++ "-" ++ show i ++ "-useLabel"
-- where
-- f str = TreeSubLabelling str Nothing
weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
weaponBehindPillar :: RandomGen g => State g (Tree Room)
weaponBehindPillar = do
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]
@@ -248,13 +249,13 @@ weaponBehindPillar = do
]
rcp <- roomCenterPillar
return $ treeFromTrunk
[PassDown corridor
--,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
,PassDown $ over rmPmnts (++ plmnts1) rcp
[ corridor
--, $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
, over rmPmnts (++ plmnts1) rcp
]
(singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
(pure . useAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
weaponBetweenPillars :: RandomGen g => State g (Tree Room)
weaponBetweenPillars = do
(w,wn) <- takeOne [(240,2),(340,3)]
(h,hn) <- takeOne [(240,2),(340,3)]
@@ -271,9 +272,9 @@ weaponBetweenPillars = do
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~
sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
return $ singleUseAll theRoom
return $ pure $ useAll theRoom
weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
weaponLongCorridor :: RandomGen g => State g (Tree Room)
weaponLongCorridor = do
rt <- takeOne [tEast, tWest]
connectingRoom <- takeOne
@@ -281,9 +282,9 @@ weaponLongCorridor = do
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (singleUseAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (singleUseNone $ putWp corridor)
return $ Node (PassDown rt) [branch1,branch2]
let branch1 = treeFromTrunk (replicate i1 $ corridorN) (pure . useAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ corridorN) (pure . useSide $ putWp corridor)
return $ Node ( rt) [branch1,branch2]
where
putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
@@ -304,16 +305,16 @@ deadEndRoom = defaultRoom
where
lnks = [(V2 0 30 ,0) ]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
weaponRoom :: RandomGen g => Int -> State g (LabTree Room)
weaponRoom i = join $ takeOne
[ weaponEmptyRoom <&> (,f "weaponEmptyRoom")
[ weaponEmptyRoom <&> (f "weaponEmptyRoom")
, weaponUnderCrits i
, weaponBehindPillar<&> (,f "weaponBehindPillar")
, weaponBetweenPillars<&> (,f "weaponBetweenPillars")
, weaponLongCorridor<&> (,f "weaponLongCorridor")
, weaponBehindPillar<&> (f "weaponBehindPillar")
, weaponBetweenPillars<&> (f "weaponBetweenPillars")
, weaponLongCorridor<&> (f "weaponLongCorridor")
]
where
f str = TreeSubLabelling str Nothing
f str = ( toOnward str ,)
roomCCrits :: RandomGen g => State g Room
roomCCrits = roomC 200 200
@@ -409,7 +410,7 @@ pistolerRoom = pillarGrid
]
++)
shootingRange :: RandomGen g => State g (LabSubCompTree Room)
shootingRange :: RandomGen g => State g (LabTree Room)
shootingRange = do
rm1 <- shootersRoom1 >>= randomiseAllLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
@@ -419,22 +420,23 @@ shootingRange = do
rm3 <- shootersRoom >>= randomiseAllLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0)
return (treeFromPost
[PassDown rm1
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
return ( toOnward "shootingRange"
,treeFromPost
[ rm1
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
,PassDown rm2
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
, rm2
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(UseAll rm3)
,TreeSubLabelling "shootingRange" Nothing)
(useAll rm3)
)
spawnerRoom :: RandomGen g => State g (SubCompTree Room)
spawnerRoom :: RandomGen g => State g (Tree Room)
spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&>
rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
aRoom <- airlock
return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner
return $ treeFromTrunk [ aRoom, corridor] $ pure $ useAll roomWithSpawner