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

Work on room generation/laser run past

Browse Source
This commit is contained in:
justin
2026-03-17 21:50:28 +00:00
parent 13b12f01a8
commit 3b4cf68a15
18 changed files with 656 additions and 528 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+36 -26
View File
@@ -1,20 +1,20 @@
module Dodge.Block.Debris (
cubeShape,
-- dirtColor,
-- dirtColor,
makeDoorDebris,
makeBlockDebris,
makeDebris,
makeDebrisDirected,
) where
import Dodge.Material.Color
import qualified Data.IntMap.Strict as IM
import Dodge.ShiftPoint
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Data.World
import Dodge.Material.Color
import Dodge.Material.Sound
import Dodge.ShiftPoint
import Dodge.WorldEvent.Sound
import Geometry
import Grid
@@ -30,7 +30,7 @@ makeDoorDebris dr w = w & makeDebris mt p
p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
((wlid,_),_) <- IM.minViewWithKey wlids
((wlid, _), _) <- IM.minViewWithKey wlids
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
makeBlockDebris :: Block -> World -> World
@@ -44,33 +44,39 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
wl <- w ^? cWorld . lWorld . walls . ix wlid
return $ _wlMaterial wl
--makeDebris :: Material -> Color -> Point2 -> World -> World
-- makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris :: Material -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2 * pi) 0
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
--makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
--makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
-- makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
-- makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected arcrad dir bm p w =
w
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld . lWorld . debris <>~ thedebris
& randGen .~ newg
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld
. lWorld
. debris
<>~ thedebris
& randGen
.~ newg
& soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
where
(thedebris, newg) = mapM f [35, 55, 75, 95] & runState $ _randGen w
f h = do
v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
spinspeed <- randomR (-0.2, -0.1) & state
-- basedebris <- baseDebris bm
return $ DebrisChunk
{ _dbPos = p `v2z` h
-- , _dbType = BlockDebris col
, _dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
}
-- basedebris <- baseDebris bm
return $
DebrisChunk
{ _dbPos = p `v2z` h
, -- , _dbType = BlockDebris col
_dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
}
-- basedebris
-- & prColor .~ col
-- & prPos .~ p
@@ -91,9 +97,13 @@ debrisSize mt = case mt of
Electronics -> 10
Flesh -> 10
ForceField -> 10
Photovoltaic -> 10
LightningRod -> 10
Pyroelectric -> 10
Piezoelectric -> 10
--shardShape :: Float -> Shape
--shardShape size =
-- shardShape :: Float -> Shape
-- shardShape size =
-- translateSHz (- size) $
-- upperPrismPolySU
-- size
@@ -102,10 +112,10 @@ debrisSize mt = case mt of
-- , V2 (- size) (-1)
-- ]
--
--jaggedShape :: State StdGen Shape
--jaggedShape = do
-- jaggedShape :: State StdGen Shape
-- jaggedShape = do
-- s <- randomR (4, 10) & state
-- return $ shardShape s
cubeShape :: Float -> Shape
cubeShape size = translateSHz (- size) $ upperPrismPolySU (2 * size) $ square size
cubeShape size = translateSHz (-size) $ upperPrismPolySU (2 * size) $ square size
src/Dodge/Data/GenWorld.hs
+3 -2
View File
@@ -24,7 +24,7 @@ import System.Random
data GenWorld = GenWorld
{ _gwWorld :: World
, _genRooms :: IM.IntMap Room
, _genPmnt :: IM.IntMap Placement
, _genPmnt :: IM.IntMap Placement -- stored generated placements
, _genInts :: IM.IntMap Int
}
@@ -138,7 +138,8 @@ data Room = Room
, _rmPos :: [RoomPos]
, _rmPath :: S.Set (Point2, Point2)
, _rmPmnts :: [Placement]
, _rmInPmnt :: [(Int,GenWorld -> Placement)]
, _rmInPmnt :: [(Int,GenWorld -> Placement)] -- so far as I can tell,
-- the first Int only determines the order in which these are applied
, _rmBound :: [[Point2]]
, _rmFloor :: Floor
, _rmName :: String
src/Dodge/Data/Material.hs
+4
View File
@@ -17,6 +17,10 @@ data Material
| Flesh
| Electronics
| ForceField
| Photovoltaic
| LightningRod
| Pyroelectric
| Piezoelectric
deriving (Eq, Ord, Show, Bounded, Enum, Read) --Generic, Flat)
deriveJSON defaultOptions ''Material
src/Dodge/Floor.hs
+2 -2
View File
@@ -31,7 +31,7 @@ initialRoomTree =
[-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
HELD SPARKGUN])]
itemRooms
, intAnno lasSensorTurretTest
, lasSensorTurretTest
, -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
-- , AnRoom $ tanksRoom [] []
-- , AnRoom $ roomCCrits 0
@@ -63,7 +63,7 @@ initialRoomTree =
$ tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward
, passthroughLockKeyLists lockRoomKeyItems itemRooms
, randomChallenges
, intAnno lasSensorTurretTest
, lasSensorTurretTest
, -- ,[AnTree $ fmap pure roomCCrits]
-- ,[AirlockAno]
-- ,[Corridor]
src/Dodge/LevelGen.hs
+1
View File
@@ -31,6 +31,7 @@ generateWorldFromSeed rdata i = do
postGenerationProcessing :: RenderData -> GenWorld -> IO World
postGenerationProcessing _ gw = do
let w = _gwWorld gw & cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
putStrLn $ show $ gw ^. genInts
return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
assignPushDoors :: World -> Door -> World
src/Dodge/LockAndKey.hs
+8 -7
View File
@@ -24,13 +24,14 @@ lockRoomMultiItems =
lockRoomKeyItems :: [(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
lockRoomKeyItems =
[ (lasCenSensEdge, takeOne [HELD RLAUNCHER, LASER, HELD SPARKGUN, HELD FLATSHIELD])
, (sensorRoomRunPast LaserSensor, return LASER)
, (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
, (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
, (const glassLessonRunPast, takeOne [LASER])
, (const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD])
, (keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
[ (lasCenSensEdge, takeOne [ HELD FLATSHIELD])
-- [ (lasCenSensEdge, takeOne [HELD RLAUNCHER, LASER, HELD SPARKGUN, HELD FLATSHIELD])
-- , (sensorRoomRunPast LaserSensor, return LASER)
-- , (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
-- , (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
-- , (const glassLessonRunPast, takeOne [LASER])
-- , (const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD])
-- , (keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
]
keyCardRunPastRand :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
src/Dodge/Material/Color.hs
+4
View File
@@ -16,3 +16,7 @@ materialColor = \case
Flesh -> red
Electronics -> greyN 0.2
ForceField -> magenta
Photovoltaic -> yellow
LightningRod -> yellow
Pyroelectric -> yellow
Piezoelectric -> yellow
src/Dodge/Material/Damage.hs
+54
View File
@@ -25,6 +25,10 @@ damMatSideEffect dm = \case
Dirt -> damageDirt dm
Glass -> damageGlass dm
Crystal -> damageCrystal dm
Photovoltaic -> damagePhotovoltaic dm
LightningRod -> damageLightningRod dm
Pyroelectric -> damagePyroelectric dm
Piezoelectric -> damagePiezoelectric dm
_ -> defDamageMaterial dm
defDamageMaterial :: Damage -> ECW -> World -> (Int,World)
@@ -66,6 +70,56 @@ damageStone dm ecw w = case dm of
so = DamageHitSound (w ^. cWorld . lWorld . lClock)
outTo x t = x -.- squashNormalizeV t
damageLightningRod :: Damage -> ECW -> World -> (Int,World)
damageLightningRod dm ecw w = case dm of
Electrical{} -> (dm ^. dmAmount, w)
_ -> damageStone dm ecw w
damagePyroelectric :: Damage -> ECW -> World -> (Int,World)
damagePyroelectric dm ecw w = case dm of
Flaming{} -> (dm ^. dmAmount, w)
Explosive{} -> (dm ^. dmAmount, w)
Sparking{} -> (dm ^. dmAmount, w)
_ -> damageStone dm ecw w
-- this should be correct
-- to be honest, we shouldn't just pass an int forward here...
damagePiezoelectric :: Damage -> ECW -> World -> (Int,World)
damagePiezoelectric = damageStone
damagePhotovoltaic :: Damage -> ECW -> World -> (Int,World)
damagePhotovoltaic dm ecw w = case dm of
Lasering _ p t -> f dmam $ laserSpark (outTo p t) (rdir p t)
Piercing _ p t ->
f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
. makeDustAt Stone 200 (addZ 20 (outTo p t))
-- . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
. randsound p [slapS, slap1S, slap2S]
Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
Crushing{} -> f dmam id
Explosive{} -> f dmam id
Sparking{} -> f 0 id
Flaming{} -> f 0 id
Electrical{} -> f 0 id
Poison{} -> f 0 id
Enterrement{} -> f 0 id
Flashing{} -> f 0 id
where
f x g = (x, g w)
dmam = dm ^. dmAmount
rdir p t = argV $ reflectIn v t
where
v = case ecw of
Right wl -> uncurry (-) $ _wlLine wl
Left cr -> vNormal (p - cr ^. crPos . _xy)
randsound p xs =
let (x, g) = runState (takeOne xs) $ _randGen w
in soundStart so p x Nothing . set randGen g
so = DamageHitSound (w ^. cWorld . lWorld . lClock)
outTo x t = x -.- squashNormalizeV t
damageMetal :: Damage -> ECW -> World -> (Int,World)
damageMetal dm ecw w = case dm of
Lasering _ p t -> f 0 $ laserSpark (outTo p t) (rdir p t)
src/Dodge/Material/Sound.hs
+4
View File
@@ -15,6 +15,10 @@ destroyMatS mat = case mat of
Electronics -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S,metal7S]
Flesh -> [gut1S, gut2S, gut3S, gut4S, gut5S, gut6S]
ForceField -> []
Photovoltaic -> [glassShat1S, glassShat2S, glassShat3S, glassShat4S]
LightningRod -> [glassShat1S, glassShat2S, glassShat3S, glassShat4S]
Pyroelectric -> [glassShat1S, glassShat2S, glassShat3S, glassShat4S]
Piezoelectric -> [glassShat1S, glassShat2S, glassShat3S, glassShat4S]
--weakenMatS :: Material -> [SoundID]
--weakenMatS mat = case mat of
src/Dodge/Placement/Instance/LightSource.hs
+3
View File
@@ -1,8 +1,11 @@
module Dodge.Placement.Instance.LightSource (
mntLSOn,
mntLSCond,
aShape,
aBar,
lShape,
jShape,
liShape,
mntLightLnkCond,
mntLS,
vShape,
src/Dodge/Placement/Instance/Sensor.hs
+7
View File
@@ -17,11 +17,18 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
PutMachine
(reverse $ square wdth)
( defaultMachine
& mcMaterial .~ mattype
& mcMounts . at OTTrigger .~ mtrid
& mcMounts . at OTLightSource ?~ lsid
& mcType .~ McDamSensor (DamSensor 0 dt)
)
Nothing
where
mattype = case dt of
LaserSensor -> Photovoltaic
ElectricSensor -> LightningRod
ThermalSensor -> Pyroelectric
PhysicalSensor -> Piezoelectric
lightSensor :: Float -> Maybe Int -> PlacementSpot -> Placement
lightSensor = damageSensor LaserSensor
src/Dodge/Placement/PlaceSpot.hs
+4 -5
View File
@@ -27,8 +27,6 @@ import LensHelp
import Linear
import NewInt
--import System.Random
-- when placing a placement, we update the world and the room and assign an id
-- to the placement. This id should be associated with the type of placement and
-- match up with the created id for the object (creature id, flitid id, etc)
@@ -199,7 +197,7 @@ plMachine ::
plMachine wallpoly mc mitm p rot gw =
( mcid
, gw & tolw . machines . at mcid ?~ themc
& gwWorld %~ placeMachineWalls wallpoly mcid wlid
& gwWorld %~ placeMachineWalls (_mcMaterial mc) wallpoly mcid wlid
& tolw %~ maybe id placeturretitm mitm
)
where
@@ -215,10 +213,11 @@ plMachine wallpoly mc mitm p rot gw =
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
placeMachineWalls :: [Point2] -> Int -> Int -> World -> World
placeMachineWalls poly mcid = insertStructureWalls MachinePart baseWall poly mcid
placeMachineWalls :: Material -> [Point2] -> Int -> Int -> World -> World
placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly mcid
where
baseWall = defaultMachineWall & wlStructure . wsMachine .~ mcid
& wlMaterial .~ mat
mvLS :: Point3 -> Float -> LightSource -> LightSource
mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z + startPos
src/Dodge/Room/LasTurret.hs
+56 -10
View File
@@ -14,11 +14,17 @@ module Dodge.Room.LasTurret (
lasCenRunClose1,
lasCenRunCloseLongCor,
lasRunRand,
setRoomInt,
) where
import Control.Monad
import Data.Foldable (fold)
import Data.Foldable
import Data.Maybe
import Color
import Shape
import Dodge.Placement.Instance.LightSource
import Dodge.Room.Path
import Control.Monad
--import Data.Foldable (fold)
import Dodge.Room.Procedural
import qualified Data.Set as S
import Dodge.Cleat
@@ -40,9 +46,13 @@ import Geometry
import LensHelp
import RandomHelp
-- no lights!
cenLasTur :: (RandomGen g) => State g Room
cenLasTur = do
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
-- lshape <- takeOne [vShape, lShape, jShape, liShape]
-- let lightn i = mntLSCond (fmap (fmap $ colorSH black) lshape)
-- $ rprBool $ const . (\rp -> PolyEdge i `S.member` (fold (rp ^? rpType . rplsType)))
-- thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
roomNgon 8 200
<&> rmPmnts
.~ [ putLasTurret 0.02
@@ -50,8 +60,11 @@ cenLasTur = do
(resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100 <&> (,S.singleton UsedPosLow)))
30
covershape
, thelight
-- , lightn 0
-- , lightn 3
-- , lightn 6
]
<&> rmPath %~ addNodesCrossingCirc 0 30
where
covershape = rectNSWE 10 (-10) (-20) 20
@@ -131,24 +144,57 @@ healthTest n = do
, cleatOnward door
]
lasSensorTurretTest :: (RandomGen g) => Int -> State g (MetaTree Room String)
lasSensorTurretTest n = do
cenroom <- shuffleLinks . lightSensInsideDoor n =<< cenLasTur
lasSensorTurretTest :: State LayoutVars (MetaTree Room String)
lasSensorTurretTest = do
n <- nextLayoutInt
cenroom' <- shuffleLinks . lightSensInsideDoor n =<< cenLasTur
(i,cenroom'') <- setRoomInt cenroom'
lshape <- takeOne [vShape, lShape, jShape, liShape]
let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a +_rpDir rp))
let cenroom = cenroom''
& rmInPmnt <>~
[(0, alight pi . f i)
,(0, alight (0.5*pi) . f i)
,(0, alight (1.5*pi) . f i)]
rToOnward "lasSensorTurretTest" $
treePost
[door, cenroom, triggerDoorRoom n, cleatOnward door]
where
f i gw = fromJust $ find (isused ._rpType) (gw ^?! genRooms . ix (gw ^?! genInts . ix i) . rmPos)
isused UsedOutLink{_rplsChildNum = 0} = True
isused _ = False
lasCenSensEdge :: (RandomGen g) => Int -> State g (MetaTree Room String)
-- note the double usage of the int, shouldn't cause a problem
lasCenSensEdge :: Int -> State LayoutVars (MetaTree Room String)
lasCenSensEdge n = do
cenroom <- shuffleLinks . lightSensByDoor n =<< cenLasTur
cenroom' <- (shuffleLinks . lightSensByDoor n =<< cenLasTur)
(i,cenroom'') <- setRoomInt cenroom'
lshape <- takeOne [vShape, lShape, jShape, liShape]
let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a +_rpDir rp))
let cenroom = cenroom''
& rmInPmnt <>~
[(0, alight pi . f i)
,(0, alight (0.5*pi) . f i)
,(0, alight (1.5*pi) . f i)]
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" $
treeFromTrunk [door] $
Node
cenroom
[ treePost [doorroom, cleatOnward door]
, treePost [door, cleatLabel 0 corridor]
, treePost [door, cleatLabel n corridor]
]
where
f i gw = fromJust $ find (isused ._rpType) (gw ^?! genRooms . ix (gw ^?! genInts . ix i) . rmPos)
isused UsedOutLink{_rplsChildNum = 0} = True
isused _ = False
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)
lasRunYinYang :: (RandomGen g) => State g (MetaTree Room String)
lasRunYinYang = do
src/Dodge/Room/Tutorial.hs
+204 -167
View File
@@ -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])
[]
src/Dodge/TestString.hs
+3 -1
View File
@@ -32,7 +32,9 @@ import Data.Foldable
import Data.Monoid
testStringInit :: Universe -> [String]
testStringInit u = fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcHP
testStringInit u =
(fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcType . _McDamSensor . sensAmount)
<> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
--testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
--testStringInit u = map show
-- (u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer)
src/Dodge/Tree/Compose.hs
+1 -1
View File
@@ -3,7 +3,6 @@
-- | Combining and composing trees of trees.
module Dodge.Tree.Compose (
tToBTree,
overwriteLabel,
composeTree,
decomposeTree,
numMetaTree,
@@ -16,6 +15,7 @@ module Dodge.Tree.Compose (
attachOnward,
attachOnward',
showIntsString,
overwriteLabel,
module Dodge.Data.MetaTree
) where
src/Dodge/Wall/Damage.hs
+1
View File
@@ -43,6 +43,7 @@ damageWall wlid dt w = fromMaybe (mempty,w) $ do
& maybeDestroyDoor drid
_ -> (mempty, w')
-- the way that sensor damage is registered is not yet ideal
damageMachine :: Damage -> Int -> Int -> World -> (S.Set Int2, World)
damageMachine dam x mcid w = case w ^? cWorld . lWorld . machines . ix mcid of
Just mc | Just se <- mc ^? mcType . _McDamSensor
tags
+261 -307
View File
File diff suppressed because it is too large Load Diff