Work on room generation/laser run past
This commit is contained in:
+204
-167
@@ -1,42 +1,42 @@
|
||||
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
||||
|
||||
module Dodge.Room.Tutorial where
|
||||
|
||||
import Data.Maybe
|
||||
import Dodge.LockAndKey
|
||||
import Dodge.Room.SensorDoor
|
||||
import Dodge.Room.Room
|
||||
import Dodge.Data.AmmoType
|
||||
import Dodge.Room.Path
|
||||
import Dodge.Room.Pillar
|
||||
import Dodge.Room.Boss
|
||||
import Dodge.Room.Tanks
|
||||
import Dodge.Room.LongDoor
|
||||
import Dodge.Layout
|
||||
import Dodge.Item.Held.Utility
|
||||
import Control.Monad
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.Maybe
|
||||
import Data.Maybe (mapMaybe)
|
||||
import qualified Data.Set as S
|
||||
import Dodge.Cleat
|
||||
import Dodge.Data.AmmoType
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Data.MTRS
|
||||
import Dodge.Default.Terminal
|
||||
import Dodge.Item.Ammo
|
||||
import Dodge.Item.Held.Cane
|
||||
import Dodge.Item.Held.Utility
|
||||
import Dodge.Layout
|
||||
import Dodge.LevelGen.PlacementHelper
|
||||
import Dodge.LockAndKey
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.Room.Airlock
|
||||
import Dodge.Room.Boss
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.LasTurret
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.LongDoor
|
||||
import Dodge.Room.Ngon
|
||||
import Dodge.Room.Path
|
||||
import Dodge.Room.Pillar
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.RezBox
|
||||
import Dodge.Room.RoadBlock
|
||||
import Dodge.Room.Room
|
||||
import Dodge.Room.SensorDoor
|
||||
import Dodge.Room.Tanks
|
||||
import Dodge.Room.Warning
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Terminal
|
||||
@@ -52,45 +52,50 @@ tutAnoTree :: State LayoutVars MTRS
|
||||
tutAnoTree = do
|
||||
foldMTRS
|
||||
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
|
||||
-- , return . tToBTree "door" $ treePost [corridor, cleatOnward door]
|
||||
, corDoor
|
||||
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
, lasRunRand
|
||||
-- , passthroughLockKeyLists lockRoomKeyItems itemRooms
|
||||
, tToBTree "door" . return <$> return (cleatOnward door)
|
||||
, tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
-- , passthroughLockKeyLists
|
||||
-- [(sensorRoomRunPast ElectricSensor, takeOne
|
||||
-- [-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
|
||||
-- HELD SPARKGUN])]
|
||||
-- itemRooms
|
||||
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
-- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
, tToBTree "sdr" . return . cleatOnward <$>
|
||||
(shuffleLinks =<< distributerRoom BulletAmmo 100000)
|
||||
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa-- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
|
||||
--aaa---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
|
||||
--aaa-- , return $ tToBTree "door" $ return $ cleatOnward door
|
||||
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa-- , tToBTree "sdr" . return . cleatOnward <$>
|
||||
--aaa-- (shuffleLinks =<< tanksPipesRoom)
|
||||
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa , return $ tToBTree "door" $ return $ cleatOnward door
|
||||
--aaa , tutHub
|
||||
--aaa , chasmSpitTerminal
|
||||
--aaa , tutLight
|
||||
--aaa , tutDrop
|
||||
--aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--aaa ---- , AnTree $ pickupTut
|
||||
--aaa ---- , AnTree $ weaponTut
|
||||
, lasSensorTurretTest
|
||||
--ccc , passthroughLockKeyLists lockRoomKeyItems itemRooms
|
||||
--bbb , -- , return . tToBTree "door" $ treePost [corridor, cleatOnward door]
|
||||
--bbb corDoor
|
||||
--bbb , -- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb lasRunRand
|
||||
--bbb , corDoor
|
||||
--bbb , passthroughLockKeyLists lockRoomKeyItems itemRooms
|
||||
--bbb , -- , passthroughLockKeyLists lockRoomKeyItems itemRooms
|
||||
--bbb tToBTree "door" . return <$> return (cleatOnward door)
|
||||
--bbb , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb , -- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb -- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb -- , passthroughLockKeyLists
|
||||
--bbb -- [(sensorRoomRunPast ElectricSensor, takeOne
|
||||
--bbb -- [-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
|
||||
--bbb -- HELD SPARKGUN])]
|
||||
--bbb -- itemRooms
|
||||
--bbb -- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb -- , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
|
||||
--bbb tToBTree "sdr" . return . cleatOnward
|
||||
--bbb <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000)
|
||||
--bbb -- aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa-- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
|
||||
--bbb -- aaa---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
|
||||
--bbb -- aaa-- , return $ tToBTree "door" $ return $ cleatOnward door
|
||||
--bbb -- aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa-- , tToBTree "sdr" . return . cleatOnward <$>
|
||||
--bbb -- aaa-- (shuffleLinks =<< tanksPipesRoom)
|
||||
--bbb -- aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa , return $ tToBTree "door" $ return $ cleatOnward door
|
||||
--bbb -- aaa , tutHub
|
||||
--bbb -- aaa , chasmSpitTerminal
|
||||
--bbb -- aaa , tutLight
|
||||
--bbb -- aaa , tutDrop
|
||||
--bbb -- aaa , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||
--bbb -- aaa ---- , AnTree $ pickupTut
|
||||
--bbb -- aaa ---- , AnTree $ weaponTut
|
||||
]
|
||||
|
||||
foldMTRS ::
|
||||
@@ -100,13 +105,6 @@ foldMTRS xs = do
|
||||
ys <- sequence xs
|
||||
return $ foldr1 attachOnward' ys
|
||||
|
||||
setRoomInt :: Room -> State LayoutVars (Int, Room)
|
||||
setRoomInt x = do
|
||||
i <- nextLayoutInt
|
||||
return (i, x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
|
||||
where
|
||||
f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)
|
||||
|
||||
setTreeInts :: Tree Room -> State LayoutVars ([Int], Tree Room)
|
||||
setTreeInts x = do
|
||||
y <- traverse setRoomInt x
|
||||
@@ -116,7 +114,7 @@ tutDrop :: State LayoutVars (MetaTree Room String)
|
||||
tutDrop = do
|
||||
x <- shuffleLinks =<< roomNgon 6 100
|
||||
i <- nextLayoutInt
|
||||
--let y = decontamRoom i
|
||||
-- let y = decontamRoom i
|
||||
(j, y) <- setRoomInt (decontamRoom i)
|
||||
rm <- roomRectAutoLights 40 100
|
||||
return $
|
||||
@@ -129,9 +127,9 @@ tutDrop = do
|
||||
in putMessageTerminal
|
||||
(defaultTerminal & tmBootLines .~ ss <> tlSetStatus (TerminalPressTo $ show x <> "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
|
||||
& plSpot
|
||||
.~ rprBoolShift
|
||||
isUnusedLnk
|
||||
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
|
||||
.~ rprBoolShift
|
||||
isUnusedLnk
|
||||
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
|
||||
ss =
|
||||
[ makeTermLine "--------------------------------------------"
|
||||
, makeTermLine "YOU CAN ONLY CARRY A LIMITED AMOUNT OF ITEMS"
|
||||
@@ -152,18 +150,24 @@ cChasm = do
|
||||
x <- state $ randomR (150, 300)
|
||||
y <- state $ randomR (150, 300)
|
||||
roomRectAutoLights x y
|
||||
<&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks %~ setInLinks (isCornerLink SouthWest)
|
||||
<&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 50 0 (x -50))]
|
||||
<&> rmLinks
|
||||
%~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks
|
||||
%~ setInLinks (isCornerLink SouthWest)
|
||||
<&> rmPmnts
|
||||
<>~ [sps0 $ putConvexChasm (rectNSWE (y - 50) 50 0 (x - 50))]
|
||||
|
||||
lChasm :: State LayoutVars Room
|
||||
lChasm = do
|
||||
x <- state $ randomR (150, 300)
|
||||
y <- state $ randomR (150, 300)
|
||||
roomRectAutoLights x y
|
||||
<&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks %~ setInLinks (isCornerLink SouthEast)
|
||||
<&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 0 0 (x -50))]
|
||||
<&> rmLinks
|
||||
%~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks
|
||||
%~ setInLinks (isCornerLink SouthEast)
|
||||
<&> rmPmnts
|
||||
<>~ [sps0 $ putConvexChasm (rectNSWE (y - 50) 0 0 (x - 50))]
|
||||
|
||||
-- the Float is the width of the bridge
|
||||
zChasm :: Float -> State LayoutVars Room
|
||||
@@ -171,13 +175,16 @@ zChasm z = do
|
||||
x <- state $ randomR (150, 300)
|
||||
y <- state $ randomR (150, 300)
|
||||
roomRectAutoLights x y
|
||||
<&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks %~ setInLinks (isCornerLink SouthEast)
|
||||
<&> rmPath %~ addNodesCrossing (V2 0 (y/2),V2 x (y/2))
|
||||
<&> rmLinks
|
||||
%~ setOutLinks (isCornerLink NorthWest)
|
||||
<&> rmLinks
|
||||
%~ setInLinks (isCornerLink SouthEast)
|
||||
<&> rmPath
|
||||
%~ addNodesCrossing (V2 0 (y / 2), V2 x (y / 2))
|
||||
<&> rmPmnts
|
||||
<>~ [ sps0 $ putConvexChasm (rectNSWE (y / 2 - z) 0 0 (x -50))
|
||||
, sps0 $ putConvexChasm (rectNSWE y (y / 2 + z) 50 x)
|
||||
]
|
||||
<>~ [ sps0 $ putConvexChasm (rectNSWE (y / 2 - z) 0 0 (x - 50))
|
||||
, sps0 $ putConvexChasm (rectNSWE y (y / 2 + z) 50 x)
|
||||
]
|
||||
|
||||
midChasm :: State LayoutVars Room
|
||||
midChasm = do
|
||||
@@ -187,9 +194,12 @@ midChasm = do
|
||||
cs <- join $ takeOne [cenoct x y, censquare x y]
|
||||
shuffleLinks $
|
||||
r
|
||||
& rmLinks %~ setOutLinks (isMidEdgeLink r North)
|
||||
& rmLinks %~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts <>~ cs
|
||||
& rmLinks
|
||||
%~ setOutLinks (isMidEdgeLink r North)
|
||||
& rmLinks
|
||||
%~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts
|
||||
<>~ cs
|
||||
where
|
||||
censquare x y = do
|
||||
z <- state $ randomR (40, 60)
|
||||
@@ -206,26 +216,31 @@ midChasmPlatform = do
|
||||
cs <- join $ takeOne [censquare x y]
|
||||
shuffleLinks $
|
||||
r
|
||||
& rmLinks %~ setOutLinks (isMidEdgeLink r North)
|
||||
& rmLinks %~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts <>~ cs
|
||||
& rmLinks
|
||||
%~ setOutLinks (isMidEdgeLink r North)
|
||||
& rmLinks
|
||||
%~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts
|
||||
<>~ cs
|
||||
where
|
||||
censquare x y = do
|
||||
z <- state $ randomR (40, 60)
|
||||
let (chsms,clfs) = sqPlatformChasm 20 (min x y/2 - z)
|
||||
--return [sps0 $ putConvexChasm (rectNSWE (y - z) z z (x - z))]
|
||||
return [sps0 $ PutChasm
|
||||
(fmap (fmap (+ V2 (x/2) (y/2))) chsms)
|
||||
(fmap (fmap (+ V2 (x/2) (y/2))) clfs)
|
||||
]-- (rectNSWE (y - z) z z (x - z))]
|
||||
-- cenoct x y =
|
||||
-- return
|
||||
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
|
||||
let (chsms, clfs) = sqPlatformChasm 20 (min x y / 2 - z)
|
||||
-- return [sps0 $ putConvexChasm (rectNSWE (y - z) z z (x - z))]
|
||||
return
|
||||
[ sps0 $
|
||||
PutChasm
|
||||
(fmap (fmap (+ V2 (x / 2) (y / 2))) chsms)
|
||||
(fmap (fmap (+ V2 (x / 2) (y / 2))) clfs)
|
||||
] -- (rectNSWE (y - z) z z (x - z))]
|
||||
-- cenoct x y =
|
||||
-- return
|
||||
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
|
||||
|
||||
sqPlatformChasm :: Float -> Float -> ([[Point2]],[[Point2]])
|
||||
sqPlatformChasm b a =
|
||||
( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl],[ibl,obl,obr,ibr]]
|
||||
, [[obr,otr,otl,obl], [ibr,ibl, itl, itr]]
|
||||
sqPlatformChasm :: Float -> Float -> ([[Point2]], [[Point2]])
|
||||
sqPlatformChasm b a =
|
||||
( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl], [ibl, obl, obr, ibr]]
|
||||
, [[obr, otr, otl, obl], [ibr, ibl, itl, itr]]
|
||||
)
|
||||
where
|
||||
obr = V2 a (-a)
|
||||
@@ -237,10 +252,10 @@ sqPlatformChasm b a =
|
||||
itl = V2 (-b) b
|
||||
itr = V2 b b
|
||||
|
||||
sqSpitChasm :: Float -> Float -> ([[Point2]],[[Point2]])
|
||||
sqSpitChasm b a =
|
||||
( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl]]
|
||||
, [[ibr,obr,otr,otl,obl,ibl,itl,itr]]
|
||||
sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
|
||||
sqSpitChasm b a =
|
||||
( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
|
||||
, [[ibr, obr, otr, otl, obl, ibl, itl, itr]]
|
||||
)
|
||||
where
|
||||
obr = V2 a (-a)
|
||||
@@ -260,24 +275,30 @@ midChasmSpit = do
|
||||
cs <- join $ takeOne [censquare x y]
|
||||
shuffleLinks $
|
||||
r
|
||||
& rmLinks %~ setOutLinks
|
||||
(\rl -> isMidEdgeLink r North rl
|
||||
|| isMidEdgeLink r East rl
|
||||
|| isMidEdgeLink r West rl
|
||||
& rmLinks
|
||||
%~ setOutLinks
|
||||
( \rl ->
|
||||
isMidEdgeLink r North rl
|
||||
|| isMidEdgeLink r East rl
|
||||
|| isMidEdgeLink r West rl
|
||||
)
|
||||
& rmLinks %~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts .~ cs
|
||||
& rmLinks
|
||||
%~ setInLinks (isMidEdgeLink r South)
|
||||
& rmPmnts
|
||||
.~ cs
|
||||
where
|
||||
censquare x y = do
|
||||
z <- state $ randomR (40, 60)
|
||||
let (chsms,clfs) = sqSpitChasm 20 (min x y/2 - z)
|
||||
return [sps0 $ PutChasm
|
||||
(fmap (fmap (+ V2 (x/2) (y/2))) chsms)
|
||||
(fmap (fmap (+ V2 (x/2) (y/2))) clfs)
|
||||
]-- (rectNSWE (y - z) z z (x - z))]
|
||||
-- cenoct x y =
|
||||
-- return
|
||||
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
|
||||
let (chsms, clfs) = sqSpitChasm 20 (min x y / 2 - z)
|
||||
return
|
||||
[ sps0 $
|
||||
PutChasm
|
||||
(fmap (fmap (+ V2 (x / 2) (y / 2))) chsms)
|
||||
(fmap (fmap (+ V2 (x / 2) (y / 2))) clfs)
|
||||
] -- (rectNSWE (y - z) z z (x - z))]
|
||||
-- cenoct x y =
|
||||
-- return
|
||||
-- [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
|
||||
|
||||
chasmSpitTerminal :: State LayoutVars MTRS
|
||||
chasmSpitTerminal = do
|
||||
@@ -285,28 +306,37 @@ chasmSpitTerminal = do
|
||||
y <- midChasmSpit
|
||||
l3 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 0 rp
|
||||
l4 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 1 rp
|
||||
let y' = y & rmPmnts <>~ [l3,l4]
|
||||
return $ tToBTree "chasmTerm" $ Node (addDoorToggleTerminal' i1 (PS 150 0) y')
|
||||
[treePost [triggerDoorRoom i1, critDeadEnd]
|
||||
,treePost [triggerDoorRoom i1, critDeadEnd]
|
||||
,return $ cleatOnward $ triggerDoorRoom i1
|
||||
]
|
||||
let y' = y & rmPmnts <>~ [l3, l4]
|
||||
return $
|
||||
tToBTree "chasmTerm" $
|
||||
Node
|
||||
(addDoorToggleTerminal' i1 (PS 150 0) y')
|
||||
[ treePost [triggerDoorRoom i1, critDeadEnd]
|
||||
, treePost [triggerDoorRoom i1, critDeadEnd]
|
||||
, return $ cleatOnward $ triggerDoorRoom i1
|
||||
]
|
||||
|
||||
polyChasm :: Int -> Float -> State LayoutVars Room
|
||||
polyChasm n x =
|
||||
shuffleLinks
|
||||
=<< ( roomNgon n x
|
||||
<&> rmPmnts <>~ [sps0 $ putConvexChasm $ polyOrthDist n (x -30)]
|
||||
<&> rmLinks %~ setOutLinks (\rl -> rl ^. rlPos . _y > 0)
|
||||
<&> rmLinks %~ setInLinks (\rl -> rl ^. rlPos . _y < (5 - x))
|
||||
<&> rmPmnts
|
||||
<>~ [sps0 $ putConvexChasm $ polyOrthDist n (x - 30)]
|
||||
<&> rmLinks
|
||||
%~ setOutLinks (\rl -> rl ^. rlPos . _y > 0)
|
||||
<&> rmLinks
|
||||
%~ setInLinks (\rl -> rl ^. rlPos . _y < (5 - x))
|
||||
)
|
||||
|
||||
polyChasmC :: Int -> Float -> State LayoutVars Room
|
||||
polyChasmC n x =
|
||||
roomNgon n x
|
||||
<&> rmPmnts <>~ [sps0 $ putConvexChasm $ rectNSWE x (60 - x) (-40) 40]
|
||||
<&> rmLinks %~ setInLinks (\rl -> PolyEdge 1 `S.member` (rl ^. rlType))
|
||||
<&> rmLinks %~ setOutLinks (\rl -> PolyEdge (n -1) `S.member` (rl ^. rlType))
|
||||
<&> rmPmnts
|
||||
<>~ [sps0 $ putConvexChasm $ rectNSWE x (60 - x) (-40) 40]
|
||||
<&> rmLinks
|
||||
%~ setInLinks (\rl -> PolyEdge 1 `S.member` (rl ^. rlType))
|
||||
<&> rmLinks
|
||||
%~ setOutLinks (\rl -> PolyEdge (n - 1) `S.member` (rl ^. rlType))
|
||||
|
||||
chasmSimpleMaze :: State LayoutVars Room
|
||||
chasmSimpleMaze =
|
||||
@@ -338,10 +368,11 @@ tutLight = do
|
||||
return $
|
||||
tToBTree "TutLight" $
|
||||
treePost
|
||||
[ x & rmPmnts <>~
|
||||
[sps g (PutFlIt led)
|
||||
,sps g (PutFlIt battery)
|
||||
]
|
||||
[ x
|
||||
& rmPmnts
|
||||
<>~ [ sps g (PutFlIt led)
|
||||
, sps g (PutFlIt battery)
|
||||
]
|
||||
, corridor & rmPmnts .~ mempty
|
||||
, removeLights y
|
||||
, corridor & rmPmnts .~ mempty
|
||||
@@ -353,9 +384,12 @@ tutLight = do
|
||||
g = PSPos (\x _ -> f x) (const id) Nothing
|
||||
where
|
||||
f x = case _rpType x of
|
||||
NotLink{} | null (x ^. rpPlacementUse . at UsedPosFloor)
|
||||
-> Just (PS (_rpPos x) (_rpDir x)
|
||||
, x & rpPlacementUse . at UsedPosFloor ?~ ())
|
||||
NotLink{}
|
||||
| null (x ^. rpPlacementUse . at UsedPosFloor) ->
|
||||
Just
|
||||
( PS (_rpPos x) (_rpDir x)
|
||||
, x & rpPlacementUse . at UsedPosFloor ?~ ()
|
||||
)
|
||||
_ -> Nothing
|
||||
|
||||
removeLights :: Room -> Room
|
||||
@@ -374,7 +408,7 @@ tutHub = do
|
||||
k <- nextLayoutInt
|
||||
let a gw =
|
||||
analyserByNthLink
|
||||
3
|
||||
3
|
||||
(RequireDeadCreatures $ getCrsFromRooms is gw)
|
||||
k
|
||||
x <-
|
||||
@@ -382,13 +416,13 @@ tutHub = do
|
||||
. analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
|
||||
. (rmInPmnt .:~ (0, a))
|
||||
. addDoorAtNthLinkToggleTerminal 1 ss j
|
||||
-- . addDoorAtNthLinkToggleInterrupt 2 ds j
|
||||
-- . addDoorAtNthLinkToggleInterrupt 2 ds j
|
||||
. addDoorAtNthLinkToggleInterrupt 2 ds j1
|
||||
=<< roomNgon 6 100
|
||||
-- bcor <- treeAttachDeep (return door) <$> blockedCorridor
|
||||
-- bcor <- treeAttachDeep (return door) <$> blockedCorridor
|
||||
r1 <- r burstRifle <&> rmPmnts .:~ itemshiftterminal
|
||||
r2 <- ammoroom (drumMag & itConsumables ?~ 90) -- <&> rmPmnts .:~ tutorialterminal
|
||||
--r2 <- r (tinMag & itConsumables ?~ 500)
|
||||
-- r2 <- r (tinMag & itConsumables ?~ 500)
|
||||
return $
|
||||
tToBTree "DoorTest" $
|
||||
Node
|
||||
@@ -396,9 +430,9 @@ tutHub = do
|
||||
[ treeFromPost [triggerDoorRoom i] r1
|
||||
, treeFromPost [triggerDoorRoom j] r2
|
||||
, treeFromTrunk [triggerDoorRoom j1] wbp
|
||||
-- , (rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
|
||||
-- <$> treeAttachDeep wbp (return corridor)
|
||||
, treeFromPost [] (cleatOnward $ triggerDoorRoom k & rmInPmnt . ix 0 . _1 .~ 1)
|
||||
, -- , (rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
|
||||
-- <$> treeAttachDeep wbp (return corridor)
|
||||
treeFromPost [] (cleatOnward $ triggerDoorRoom k & rmInPmnt . ix 0 . _1 .~ 1)
|
||||
]
|
||||
where
|
||||
ds = ["DESTROY THIS TO OPEN THE DOOR"]
|
||||
@@ -420,9 +454,9 @@ tutHub = do
|
||||
putMessageTerminal
|
||||
(defaultTerminal & tmBootLines .~ ss' <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
|
||||
& plSpot
|
||||
.~ rprBoolShift
|
||||
isUnusedLnk
|
||||
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
|
||||
.~ rprBoolShift
|
||||
isUnusedLnk
|
||||
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
|
||||
ss' =
|
||||
[ makeTermLine "---------------------------------------------"
|
||||
, makeTermLine "HOLD [CAPS] AND SCROLL"
|
||||
@@ -455,8 +489,8 @@ getCrsFromRooms' is gw = fmap h $ show $ foldMap f (IM.restrictKeys (gw ^. genRo
|
||||
js = getRoomsFromInts is gw
|
||||
f rm = shortShow <$> rm ^.. rmPmnts . each . plType
|
||||
|
||||
--f rm = foldMap g $ rm ^. rmPmnts
|
||||
--g x = case x ^. plType of
|
||||
-- f rm = foldMap g $ rm ^. rmPmnts
|
||||
-- g x = case x ^. plType of
|
||||
-- PutCrit _ -> [x ^?! plMID . _Just]
|
||||
-- _ -> []
|
||||
|
||||
@@ -480,26 +514,28 @@ sensorTut =
|
||||
|
||||
-- <> tlSetStatus (TerminalPressTo "CONTINUE")
|
||||
|
||||
tutRezBox :: RandomGen g => State g Room
|
||||
tutRezBox :: (RandomGen g) => State g Room
|
||||
tutRezBox = do
|
||||
ls <- rezColor
|
||||
return $
|
||||
roomRect 40 60 1 1
|
||||
& rmPmnts
|
||||
.~ [ sPS (V2 20 1) 0 $ PutLS ls
|
||||
, Placement (PS 0 0) PutNothing Nothing Nothing $ \w _ ->
|
||||
Just $
|
||||
putImmediateMessageTerminal
|
||||
( defaultTerminal & tmBootLines .~ s w
|
||||
<> tlSetStatus (TerminalPressTo "QUIT")
|
||||
<> tlDoEffect TmWdWdPowerDownTerminal
|
||||
-- <> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
|
||||
)
|
||||
& plSpot .~ PS (V2 20 0) 0
|
||||
]
|
||||
.~ [ sPS (V2 20 1) 0 $ PutLS ls
|
||||
, Placement (PS 0 0) PutNothing Nothing Nothing $ \w _ ->
|
||||
Just $
|
||||
putImmediateMessageTerminal
|
||||
( defaultTerminal & tmBootLines .~ s w
|
||||
<> tlSetStatus (TerminalPressTo "QUIT")
|
||||
<> tlDoEffect TmWdWdPowerDownTerminal
|
||||
-- <> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
|
||||
)
|
||||
& plSpot
|
||||
.~ PS (V2 20 0) 0
|
||||
]
|
||||
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
||||
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
||||
& rmName .~ "tutRezBox"
|
||||
& rmName
|
||||
.~ "tutRezBox"
|
||||
where
|
||||
s w = tutorialMessage1 (w ^. gwWorld . cWorld . cwGen . cwgSeed)
|
||||
|
||||
@@ -517,23 +553,24 @@ tutorialMessage1 i =
|
||||
, makeTermLine " [D] TO MOVE"
|
||||
, makeTermLine "--------------------------------------------"
|
||||
]
|
||||
|
||||
-- <> tlSetStatus (TerminalPressTo "CONTINUE")
|
||||
-- <> [ makeTermLine "AFTER EXITING THIS TERMINAL YOUR INVENTORY"
|
||||
-- , makeTermLine " AND NEARBY OBJECTS WILL BE DISPLAYED"
|
||||
-- , makeTermLine "--------------------------------------------"
|
||||
-- ]
|
||||
passthroughLockKeyLists ::
|
||||
[(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
|
||||
-> [(ItemType, State LayoutVars (MetaTree Room String))]
|
||||
-> State LayoutVars (MetaTree Room String)
|
||||
[(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)] ->
|
||||
[(ItemType, State LayoutVars (MetaTree Room String))] ->
|
||||
State LayoutVars (MetaTree Room String)
|
||||
passthroughLockKeyLists ls ks = do
|
||||
i <- nextLayoutInt
|
||||
(functionlockroom, randomitemidentity) <- takeOne ls
|
||||
lr <- functionlockroom i
|
||||
ii <- randomitemidentity
|
||||
keyroom <- fromJust $ lookup ii ks
|
||||
return $
|
||||
MTree
|
||||
("PassthroughLockKeyLists-" ++ show ii)
|
||||
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
|
||||
[]
|
||||
i <- nextLayoutInt
|
||||
(functionlockroom, randomitemidentity) <- takeOne ls
|
||||
lr <- functionlockroom i
|
||||
ii <- randomitemidentity
|
||||
keyroom <- fromJust $ lookup ii ks
|
||||
return $
|
||||
MTree
|
||||
("PassthroughLockKeyLists-" ++ show ii)
|
||||
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
|
||||
[]
|
||||
|
||||
Reference in New Issue
Block a user