583 lines
21 KiB
Haskell
583 lines
21 KiB
Haskell
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
|
|
module Dodge.Room.Tutorial where
|
|
|
|
import Dodge.Room.Foreground
|
|
import Data.Foldable
|
|
import Control.Monad
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
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.Modify
|
|
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
|
|
import Dodge.Tree.Compose
|
|
import Geometry
|
|
import LensHelp
|
|
import Linear
|
|
import RandomHelp
|
|
import ShortShow
|
|
import TreeHelp
|
|
|
|
tutAnoTree :: State LayoutVars MTRS
|
|
tutAnoTree = do
|
|
foldMTRS
|
|
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
|
|
, corDoor
|
|
, chasmSpitTerminal
|
|
--a , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a , corDoor
|
|
--a , tToBTree "sdr" . return . cleatOnward
|
|
--a <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000)
|
|
--a , -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a -- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
|
|
--a ---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
|
|
--a -- , return $ tToBTree "door" $ return $ cleatOnward door
|
|
--a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a -- , tToBTree "sdr" . return . cleatOnward <$>
|
|
--a -- (shuffleLinks =<< tanksPipesRoom)
|
|
--a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a return $ tToBTree "door" $ return $ cleatOnward door
|
|
--a , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a , tutHub
|
|
--a , chasmSpitTerminal
|
|
--a , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a , tutLight
|
|
--a , tutDrop
|
|
--a , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
|
--a ---- , AnTree $ pickupTut
|
|
--a ---- , AnTree $ weaponTut
|
|
]
|
|
|
|
foldMTRS ::
|
|
[State LayoutVars (MetaTree Room String)] ->
|
|
State LayoutVars (MetaTree Room String)
|
|
foldMTRS xs = do
|
|
ys <- sequence xs
|
|
return $ foldr1 attachOnward' ys
|
|
|
|
setTreeInts :: Tree Room -> State LayoutVars ([Int], Tree Room)
|
|
setTreeInts x = do
|
|
y <- traverse storeRoomID x
|
|
return (foldMap ((: []) . fst) y, fmap snd y)
|
|
|
|
tutDrop :: State LayoutVars (MetaTree Room String)
|
|
tutDrop = do
|
|
x <- shuffleLinks =<< roomNgon 6 100
|
|
i <- nextLayoutInt
|
|
-- let y = decontamRoom i
|
|
(j, y) <- storeRoomID (decontamRoom i)
|
|
rm <- roomRectAutoLights 40 100
|
|
return $
|
|
tToBTree "TutDrop" $
|
|
treePost
|
|
[x & rmInPmnt .:~ (0, return . t j), y, cleatOnward rm]
|
|
where
|
|
t j gw =
|
|
let x = gw ^? genInts . ix j
|
|
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))
|
|
ss =
|
|
[ 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 "-------------------------------------------"
|
|
]
|
|
|
|
cChasm :: State LayoutVars Room
|
|
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))]
|
|
|
|
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))]
|
|
|
|
-- the Float is the width of the bridge
|
|
zChasm :: Float -> State LayoutVars Room
|
|
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))
|
|
<&> rmPmnts
|
|
<>~ [ 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
|
|
x <- state $ randomR (200, 300)
|
|
y <- state $ randomR (200, 300)
|
|
r <- roomRectAutoLights x y
|
|
cs <- join $ takeOne [cenoct x y, censquare x y]
|
|
shuffleLinks $
|
|
r
|
|
& rmLinks
|
|
%~ setOutLinks (isMidEdgeLink r North)
|
|
& rmLinks
|
|
%~ setInLinks (isMidEdgeLink r South)
|
|
& rmPmnts
|
|
<>~ cs
|
|
where
|
|
censquare x y = do
|
|
z <- state $ randomR (40, 60)
|
|
return [sps0 $ putConvexChasm (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)]
|
|
|
|
midChasmPlatform :: State LayoutVars Room
|
|
midChasmPlatform = do
|
|
x <- state $ randomR (250, 300)
|
|
y <- state $ randomR (250, 300)
|
|
r <- roomRectAutoLights x y
|
|
cs <- join $ takeOne [censquare x y]
|
|
shuffleLinks $
|
|
r
|
|
& 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)]
|
|
|
|
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)
|
|
obl = V2 (-a) (-a)
|
|
otl = V2 (-a) a
|
|
otr = V2 a a
|
|
ibr = V2 b (-b)
|
|
ibl = V2 (-b) (-b)
|
|
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]]
|
|
-- ( earClip clfs
|
|
, [clfs]
|
|
)
|
|
where
|
|
clfs = [ibr, obr, otr, otl, obl, ibl, itl, itr]
|
|
obr = V2 a (-a)
|
|
obl = V2 (-a) (-a)
|
|
otl = V2 (-a) a
|
|
otr = V2 a a
|
|
ibr = V2 b (-a)
|
|
ibl = V2 (-b) (-a)
|
|
itl = V2 (-b) b
|
|
itr = V2 b b
|
|
-- otl---------otr
|
|
-- | itl-itr |
|
|
-- obr-ibl ibr-obl
|
|
|
|
nonConvexChasm :: [Point2] -> PSType
|
|
nonConvexChasm ps = PutChasm [] [ps]
|
|
|
|
midChasmSpit :: State LayoutVars Room
|
|
midChasmSpit = do
|
|
let x = 300
|
|
y = 300
|
|
r <- roomRectAutoLights x y
|
|
cs <- join $ takeOne [censquare x y]
|
|
foutlnks <-
|
|
takeOne
|
|
[ \rl ->
|
|
isMidEdgeLink r North rl
|
|
|| isMidEdgeLink r East rl
|
|
|| isMidEdgeLink r West rl
|
|
, \rl -> OnEdge North `S.member` (rl ^. rlType)
|
|
&& not (FromEdge East 0 `S.member` (rl ^. rlType))
|
|
&& not (FromEdge West 0 `S.member` (rl ^. rlType))
|
|
]
|
|
shuffleLinks $
|
|
r
|
|
& rmLinks %~ setOutLinks foutlnks
|
|
& 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)]
|
|
|
|
chasmSpitTerminal :: State LayoutVars MTRS
|
|
chasmSpitTerminal = do
|
|
i1 <- nextLayoutInt
|
|
y <- midChasmSpit
|
|
shp <- takeOne [vShape, lShape, jShape, liShape]
|
|
let l1 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp North East
|
|
l2 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp North West
|
|
l3 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East North
|
|
l4 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East South
|
|
ls <- takeOne [[l1,l2],[l3,l4]
|
|
-- ,[spanLightI (V2 120 0) (V2 120 300)]
|
|
-- , [spanLightI (V2 0 128) (V2 300 128)]
|
|
-- , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
|
|
]
|
|
gh <- takeOne [55,75,97]
|
|
gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
|
|
dec <- takeOne $ replicate 3 [] <>
|
|
[[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)]
|
|
,[sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
|
|
,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300),sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
|
|
,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
|
|
,[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
|
|
,[sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
|
|
,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20),sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
|
|
]
|
|
let y' = y & rmPmnts <>~ ls <> dec
|
|
return $
|
|
tToBTree "chasmTerm" $
|
|
Node
|
|
(addDoorToggleTerminal' i1 (PS 150 0) y')
|
|
[ treePost [triggerDoorRoom i1, critDeadEnd]
|
|
, treePost [triggerDoorRoom i1, critDeadEnd]
|
|
, return $ cleatOnward $ triggerDoorRoom i1
|
|
]
|
|
where
|
|
f rp a b = FromEdge a 2 `S.member` fold (rp ^? rpType . rplsType)
|
|
&& OnEdge b `S.member` fold (rp ^? rpType . rplsType)
|
|
|
|
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))
|
|
)
|
|
|
|
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))
|
|
|
|
chasmSimpleMaze :: State LayoutVars Room
|
|
chasmSimpleMaze =
|
|
join $
|
|
takeOne
|
|
[ midChasm
|
|
, zChasm 25
|
|
, lChasm
|
|
, cChasm
|
|
, pc1
|
|
, pc2
|
|
, midChasmSpit
|
|
]
|
|
where
|
|
pc1 = do
|
|
i <- takeOne [6, 8]
|
|
x <- state $ randomR (100, 150)
|
|
polyChasm i x
|
|
pc2 = do
|
|
i <- takeOne [6, 8]
|
|
x <- state $ randomR (100, 150)
|
|
polyChasmC i x
|
|
|
|
tutLight :: State LayoutVars (MetaTree Room String)
|
|
tutLight = do
|
|
x <- rmPos shuffle =<< chasmSimpleMaze
|
|
y <- rmPos shuffle =<< chasmSimpleMaze
|
|
z <- chasmSimpleMaze
|
|
return $
|
|
tToBTree "TutLight" $
|
|
treePost
|
|
[ x
|
|
& rmPmnts
|
|
<>~ [ sps g (PutFlIt led)
|
|
, sps g (PutFlIt battery)
|
|
]
|
|
, corridor & rmPmnts .~ mempty
|
|
, removeLights y
|
|
, corridor & rmPmnts .~ mempty
|
|
, removeLights z
|
|
, door
|
|
, cleatOnward corridor & rmPmnts .~ mempty
|
|
]
|
|
where
|
|
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 ?~ ()
|
|
)
|
|
_ -> Nothing
|
|
|
|
tutHub :: State LayoutVars (MetaTree Room String)
|
|
tutHub = do
|
|
(is, wbp) <- setTreeInts =<< critsRoom 1
|
|
i <- nextLayoutInt
|
|
j <- nextLayoutInt
|
|
j1 <- nextLayoutInt
|
|
k <- nextLayoutInt
|
|
let a gw =
|
|
analyserByNthLink
|
|
3
|
|
(RequireDeadCreatures $ getCrsFromRooms is gw)
|
|
k
|
|
x <-
|
|
shuffleLinks
|
|
. analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
|
|
. (rmInPmnt .:~ (0, return . a))
|
|
. addDoorAtNthLinkToggleTerminal 1 ss j
|
|
-- . addDoorAtNthLinkToggleInterrupt 2 ds j
|
|
. addDoorAtNthLinkToggleInterrupt 2 ds j1
|
|
=<< roomNgon 6 100
|
|
-- bcor <- treeAttachDeep (return door) <$> blockedCorridor
|
|
r1 <- r burstRifle <&> rmPmnts .:~ itemshiftterminal
|
|
r2 <- ammoroom (drumMag & itConsumables ?~ 90) -- <&> rmPmnts .:~ tutorialterminal
|
|
-- r2 <- r (tinMag & itConsumables ?~ 500)
|
|
return $
|
|
tToBTree "DoorTest" $
|
|
Node
|
|
x
|
|
[ 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)
|
|
]
|
|
where
|
|
ds = ["DESTROY THIS TO OPEN THE DOOR"]
|
|
ss =
|
|
[ makeTermLine "SOME TERMINALS HAVE A PROMPT"
|
|
, makeTermLine " *****"
|
|
, makeTermLine " * * TYPE OR SCROLL TO ENTER COMMANDS"
|
|
, makeTermLine " * > *"
|
|
, makeTermLine " * * CLICK OR USE [RETURN] TO CONFIRM"
|
|
, makeTermLine " ***** "
|
|
, makeTermLine "---------------------------------------------"
|
|
, makeTermLine ""
|
|
]
|
|
r x = roomRectAutoLights 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
|
|
ammoroom x = roomRectAutoLights 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
|
|
itemshiftterminal =
|
|
putMessageTerminal
|
|
(defaultTerminal & tmBootLines .~ ss' <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
|
|
& plSpot
|
|
.~ rprBoolShift
|
|
isUnusedLnk
|
|
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
|
|
ss' =
|
|
[ 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 "---------------------------------------------"
|
|
]
|
|
<> tlSetStatus (TerminalPressTo "CONTINUE")
|
|
<> [ makeTermLine "HOLD [RMB] TO AIM"
|
|
, makeTermLine " THEN CLICK [LMB] TO FIRE LOADED WEAPONS"
|
|
, makeTermLine "---------------------------------------------"
|
|
]
|
|
|
|
getRoomsFromInts :: [Int] -> GenWorld -> IS.IntSet
|
|
getRoomsFromInts is gw =
|
|
foldMap IS.singleton $ IM.restrictKeys (gw ^. genInts) (IS.fromList is)
|
|
|
|
getCrsFromRooms' :: [Int] -> GenWorld -> String
|
|
getCrsFromRooms' is gw = fmap h $ show $ foldMap f (IM.restrictKeys (gw ^. genRooms) js)
|
|
where
|
|
h ',' = ' '
|
|
h x = x
|
|
js = getRoomsFromInts is gw
|
|
f rm = shortShow <$> rm ^.. rmPmnts . each . plType
|
|
|
|
-- f rm = foldMap g $ rm ^. rmPmnts
|
|
-- g x = case x ^. plType of
|
|
-- PutCrit _ -> [x ^?! plMID . _Just]
|
|
-- _ -> []
|
|
|
|
getCrsFromRooms :: [Int] -> GenWorld -> [Int]
|
|
getCrsFromRooms is gw = foldMap f (IM.restrictKeys (gw ^. genRooms) js)
|
|
where
|
|
js = getRoomsFromInts is gw
|
|
f rm = foldMap g $ rm ^. rmPmnts
|
|
g x = case x ^. plType of
|
|
PutCrit _ -> [x ^?! plMID . _Just]
|
|
_ -> []
|
|
|
|
sensorTut :: [TerminalLine]
|
|
sensorTut =
|
|
[ 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
|
|
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
|
|
]
|
|
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
|
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
|
& rmName
|
|
.~ "tutRezBox"
|
|
where
|
|
s w = tutorialMessage1 (w ^. gwWorld . cWorld . cwGen . cwgSeed)
|
|
|
|
tutorialMessage1 :: Int -> [TerminalLine]
|
|
tutorialMessage1 i =
|
|
[ makeTermLine "--------------------------------------------"
|
|
, makeTermLine $ "WELCOME TO ENVIRONMENT " ++ show i
|
|
, makeTermLine ""
|
|
, makeTermLine "USE [SPACE] TO INTERACT WITH NEARBY OBJECTS"
|
|
, makeTermLine "--------------------------------------------"
|
|
]
|
|
<> 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 "--------------------------------------------"
|
|
-- ]
|
|
passthroughLockKeyLists ::
|
|
[(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])
|
|
[]
|