Refactor, try to limit dependencies
This commit is contained in:
+114
-97
@@ -1,68 +1,70 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Room.LasTurret where
|
||||
import Dodge.LevelGen.Data
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Dodge.Cleat
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Consumable
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Instance.Analyser
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.Data
|
||||
import Dodge.Tree
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Ngon
|
||||
import Dodge.Room.SensorDoor
|
||||
--import Dodge.Room.Foreground
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Tree
|
||||
import Dodge.Wire
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Instance.Analyser
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Consumable
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import RandomHelp
|
||||
|
||||
import qualified Data.Set as S
|
||||
--import Data.Maybe
|
||||
|
||||
cenLasTur :: Room
|
||||
cenLasTur = roomNgon 8 200 & rmPmnts .~
|
||||
[ putLasTurret 0.02
|
||||
, heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
|
||||
, mntLightLnkCond $ rprBool $ const . isInLnk
|
||||
]
|
||||
cenLasTur =
|
||||
roomNgon 8 200 & rmPmnts
|
||||
.~ [ putLasTurret 0.02
|
||||
, heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
|
||||
, mntLightLnkCond $ rprBool $ const . isInLnk
|
||||
]
|
||||
where
|
||||
covershape = rectNSWE 10 (-10) (-20) 20
|
||||
|
||||
lightSensInsideDoor :: Int -> Room -> Room
|
||||
lightSensInsideDoor outplid rm = rm
|
||||
& rmPmnts .++~
|
||||
[ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-100)))
|
||||
, psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
|
||||
, psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
|
||||
]
|
||||
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 10 (atFstLnkOutShiftInward 100)) outplid]
|
||||
lightSensInsideDoor outplid rm =
|
||||
rm
|
||||
& rmPmnts
|
||||
.++~ [ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-100)))
|
||||
, psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
|
||||
, psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
|
||||
]
|
||||
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 10 (atFstLnkOutShiftInward 100)) outplid]
|
||||
|
||||
lightSensByDoor :: Int -> Room -> Room
|
||||
lightSensByDoor outplid rm = rm
|
||||
& rmPmnts .++~
|
||||
[ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
|
||||
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
|
||||
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
|
||||
]
|
||||
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 20 (atFstLnkOutShiftBy sensorshift)) outplid]
|
||||
lightSensByDoor outplid rm =
|
||||
rm
|
||||
& rmPmnts
|
||||
.++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
|
||||
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
|
||||
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
|
||||
]
|
||||
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 20 (atFstLnkOutShiftBy sensorshift)) outplid]
|
||||
where
|
||||
covershape = rectNSWE 10 (-10) (-20) 20
|
||||
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
|
||||
sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)
|
||||
|
||||
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
|
||||
keyCardRoomRunPast keyid rmid = do
|
||||
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
|
||||
let doorroom = triggerDoorRoom rmid
|
||||
rToOnward "keyCardRoomRunPast" $
|
||||
treeFromTrunk [door] $ Node cenroom
|
||||
[ treeFromPost [doorroom] (cleatOnward door)
|
||||
, treeFromPost [door] (cleatLabel rmid corridor)
|
||||
]
|
||||
treeFromTrunk [door] $
|
||||
Node
|
||||
cenroom
|
||||
[ treeFromPost [doorroom] (cleatOnward door)
|
||||
, treeFromPost [door] (cleatLabel rmid corridor)
|
||||
]
|
||||
|
||||
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
|
||||
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (HELD (KEYCARD keyid)))
|
||||
@@ -71,78 +73,91 @@ healthAnalyserByDoor :: Int -> Room -> Room
|
||||
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
|
||||
|
||||
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
|
||||
analyserByDoor proxreq outplid rm = rm
|
||||
& rmPmnts .++~
|
||||
[ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
|
||||
]
|
||||
& rmOutPmnt .~
|
||||
[OutPlacement
|
||||
(analyser proxreq
|
||||
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
|
||||
(atFstLnkOutShiftBy sensorshift)
|
||||
)
|
||||
outplid]
|
||||
analyserByDoor proxreq outplid rm =
|
||||
rm
|
||||
& rmPmnts
|
||||
.++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
|
||||
]
|
||||
& rmOutPmnt
|
||||
.~ [ OutPlacement
|
||||
( analyser
|
||||
proxreq
|
||||
(atFstLnkOutShiftBy (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
|
||||
(atFstLnkOutShiftBy sensorshift)
|
||||
)
|
||||
outplid
|
||||
]
|
||||
where
|
||||
sensorshift (p,a) = (p +.+ rotateV a (V2 30 (-10)), a)
|
||||
sensorshift (p, a) = (p +.+ rotateV a (V2 30 (-10)), a)
|
||||
|
||||
healthTest :: RandomGen g => Int -> State g (Tree Room)
|
||||
healthTest n = do
|
||||
cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
|
||||
return $ treePost
|
||||
[ door
|
||||
, corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
|
||||
, cenroom
|
||||
, triggerDoorRoom n
|
||||
, cleatOnward door
|
||||
]
|
||||
return $
|
||||
treePost
|
||||
[ door
|
||||
, corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
|
||||
, cenroom
|
||||
, triggerDoorRoom n
|
||||
, cleatOnward door
|
||||
]
|
||||
|
||||
lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room String)
|
||||
lasSensorTurretTest n = do
|
||||
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
|
||||
rToOnward "lasSensorTurretTest" $ treePost
|
||||
[ door, cenroom, triggerDoorRoom n, cleatOnward door]
|
||||
rToOnward "lasSensorTurretTest" $
|
||||
treePost
|
||||
[door, cenroom, triggerDoorRoom n, cleatOnward door]
|
||||
|
||||
lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room String)
|
||||
lasCenSensEdge n = do
|
||||
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
|
||||
let doorroom = triggerDoorRoom n
|
||||
rToOnward "lasCenSensEdge"
|
||||
$ treeFromTrunk [ door] $ Node cenroom
|
||||
[ treePost [ doorroom, cleatOnward door ]
|
||||
, treePost [ door, cleatLabel 0 corridor]
|
||||
]
|
||||
rToOnward "lasCenSensEdge" $
|
||||
treeFromTrunk [door] $
|
||||
Node
|
||||
cenroom
|
||||
[ treePost [doorroom, cleatOnward door]
|
||||
, treePost [door, cleatLabel 0 corridor]
|
||||
]
|
||||
|
||||
lasTunnel :: RandomGen g => Float -> State g Room
|
||||
lasTunnel y = do
|
||||
extraPlmnts <- takeOne
|
||||
[ [ midWall ( rectNSWE 115 90 0 60)
|
||||
, midWall ( rectNSWE 65 40 (-40) 25)
|
||||
extraPlmnts <-
|
||||
takeOne
|
||||
[
|
||||
[ midWall (rectNSWE 115 90 0 60)
|
||||
, midWall (rectNSWE 65 40 (-40) 25)
|
||||
]
|
||||
,
|
||||
[ midWall (rectNSWE 125 100 0 25)
|
||||
, midWall (rectNSWE 80 40 (-40) 0)
|
||||
, midWall (rectNSWE 80 40 25 60)
|
||||
]
|
||||
]
|
||||
, [ midWall ( rectNSWE 125 100 0 25)
|
||||
, midWall ( rectNSWE 80 40 (-40) 0)
|
||||
, midWall ( rectNSWE 80 40 25 60)
|
||||
]
|
||||
]
|
||||
return defaultRoom
|
||||
{ _rmPolys = polys
|
||||
, _rmBound = polys
|
||||
, _rmLinks =
|
||||
[outLink (V2 20 (190 + y)) (1.5* pi)
|
||||
,outLink (V2 0 (190 + y)) (0.5* pi)
|
||||
, inLink (V2 (-40) 20) (0.5* pi)
|
||||
, inLink (V2 60 20) (1.5* pi)
|
||||
, inLink (V2 10 0) pi
|
||||
]
|
||||
, _rmPmnts = [putLasTurret 0.005 & plSpot .~ PS (V2 10 (240+y)) (1.5*pi)
|
||||
--, midWall (rectNSEW 65 40 0 25)
|
||||
, mntLS vShape (V2 60 145) (V3 40 125 90)
|
||||
, mntLS vShape (V2 (-40) 145) (V3 (-20) 125 90)
|
||||
]
|
||||
++ extraPlmnts
|
||||
, _rmName = "lasTunnel" ++ show y
|
||||
}
|
||||
return
|
||||
defaultRoom
|
||||
{ _rmPolys = polys
|
||||
, _rmBound = polys
|
||||
, _rmLinks =
|
||||
[ outLink (V2 20 (190 + y)) (1.5 * pi)
|
||||
, outLink (V2 0 (190 + y)) (0.5 * pi)
|
||||
, inLink (V2 (-40) 20) (0.5 * pi)
|
||||
, inLink (V2 60 20) (1.5 * pi)
|
||||
, inLink (V2 10 0) pi
|
||||
]
|
||||
, _rmPmnts =
|
||||
[ putLasTurret 0.005 & plSpot .~ PS (V2 10 (240 + y)) (1.5 * pi)
|
||||
, --, midWall (rectNSEW 65 40 0 25)
|
||||
mntLS vShape (V2 60 145) (V3 40 125 90)
|
||||
, mntLS vShape (V2 (-40) 145) (V3 (-20) 125 90)
|
||||
]
|
||||
++ extraPlmnts
|
||||
, _rmName = "lasTunnel" ++ show y
|
||||
}
|
||||
where
|
||||
polys = [rectNSWE (250+y) 0 0 20
|
||||
polys =
|
||||
[ rectNSWE (250 + y) 0 0 20
|
||||
, rectNSWE 145 0 (-40) 60
|
||||
]
|
||||
|
||||
@@ -150,9 +165,11 @@ lasTunnel y = do
|
||||
lasTunnelRunPast :: RandomGen g => Float -> State g (MetaTree Room String)
|
||||
lasTunnelRunPast y = do
|
||||
r <- lasTunnel y
|
||||
r1 <- takeOne [door,corridor]
|
||||
r2 <- takeOne [door,corridor]
|
||||
rToOnward "lasTunnelRunPast" $ Node r
|
||||
[ pure $ cleatOnward r1
|
||||
, return (cleatLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
|
||||
]
|
||||
r1 <- takeOne [door, corridor]
|
||||
r2 <- takeOne [door, corridor]
|
||||
rToOnward "lasTunnelRunPast" $
|
||||
Node
|
||||
r
|
||||
[ pure $ cleatOnward r1
|
||||
, return (cleatLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user