177 lines
6.0 KiB
Haskell
177 lines
6.0 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Room.LasTurret where
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.UseAll
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Data
|
|
import Dodge.Tree
|
|
import Dodge.RoomLink
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Ngon
|
|
--import Dodge.Room.Procedural
|
|
import Dodge.Room.Foreground
|
|
--import Dodge.Room.RoadBlock
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Placement.Instance.Analyser
|
|
import Dodge.Default.Room
|
|
import Dodge.Item.Consumable
|
|
--import Dodge.Machine
|
|
--import Dodge.Item.Weapon.Utility
|
|
--import Dodge.LevelGen.Data
|
|
--import Geometry.Data
|
|
import Geometry
|
|
--import Padding
|
|
import Color
|
|
import Shape
|
|
import LensHelp
|
|
import RandomHelp
|
|
--import Dodge.SoundLogic
|
|
|
|
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
|
|
]
|
|
where
|
|
covershape = rectNSEW 10 (-10) 20 (-20)
|
|
|
|
lightSensInsideDoor :: Int -> Room -> Room
|
|
lightSensInsideDoor outplid rm = rm
|
|
& rmPmnts .:~ psPt atFstLnkOut
|
|
(PutShape $ colorSH yellow $
|
|
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
|
|
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
|
|
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
|
|
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid]
|
|
|
|
lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
|
|
lasSensLightAboveDoor wth ps = extTrigLitPos
|
|
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
|
|
( \tp -> Just $ lightSensor wth (upf $ fromJust $ _plMID tp) ps )
|
|
where
|
|
upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
|
|
| otherwise = w
|
|
|
|
lightSensByDoor :: Int -> Room -> Room
|
|
lightSensByDoor outplid rm = rm
|
|
& rmPmnts .++~
|
|
[ psPt atFstLnkOut $ PutShape $ colorSH yellow
|
|
$ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
|
|
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
|
|
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
|
|
]
|
|
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
|
|
where
|
|
covershape = rectNSEW 10 (-10) 20 (-20)
|
|
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
|
|
|
|
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (LabTree Room)
|
|
keyCardRoomRunPast keyid rmid = do
|
|
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
|
|
let doorroom = triggerDoorRoom rmid
|
|
return (toOnward "keyCardRoomRunPast",
|
|
treeFromTrunk [door] $ Node cenroom
|
|
[ treeFromPost [doorroom] (useAll door)
|
|
, treeFromPost [door] (useLabel rmid corridor)
|
|
])
|
|
|
|
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
|
|
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
|
|
|
|
healthAnalyserByDoor :: Int -> Room -> Room
|
|
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
|
|
|
|
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
|
|
analyserByDoor proxreq outplid rm = rm
|
|
& rmPmnts .++~
|
|
[ psPt atFstLnkOut $ PutShape $ colorSH yellow
|
|
$ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 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)
|
|
|
|
healthTest :: RandomGen g => Int -> State g (Tree Room)
|
|
healthTest n = do
|
|
cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
|
|
let doorroom = triggerDoorRoom n
|
|
return $ treeFromPost [door
|
|
, corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
|
|
, cenroom, doorroom]
|
|
(useAll door)
|
|
|
|
lasSensorTurretTest :: RandomGen g => Int -> State g (LabTree Room)
|
|
lasSensorTurretTest n = do
|
|
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
|
|
let doorroom = triggerDoorRoom n
|
|
return ( toOnward "lasSensorTurretTest"
|
|
, treeFromPost [ door, cenroom, doorroom] (useAll door)
|
|
)
|
|
|
|
lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room)
|
|
lasCenSensEdge n = do
|
|
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
|
|
let doorroom = triggerDoorRoom n
|
|
rToOnward "lasCenSensEdge"
|
|
$ treeFromTrunk [ door] $ Node cenroom
|
|
[ treeFromPost [ doorroom] (useAll door)
|
|
, treeFromPost [ door] (useLabel 0 corridor)
|
|
]
|
|
|
|
lasTunnel :: RandomGen g => Float -> State g Room
|
|
lasTunnel y = do
|
|
extraPlmnts <- takeOne
|
|
[ [ midWall (rectNSEW 115 90 0 60)
|
|
, midWall (rectNSEW 65 40 (-40) 25)
|
|
]
|
|
, [ midWall (rectNSEW 125 100 0 25)
|
|
, midWall (rectNSEW 80 40 (-40) 0)
|
|
, midWall (rectNSEW 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
|
|
}
|
|
where
|
|
polys = [rectNSWE (250+y) 0 0 20
|
|
, rectNSWE 145 0 (-40) 60
|
|
]
|
|
|
|
-- a y value of 400 is probably "unrunnable"
|
|
lasTunnelRunPast :: RandomGen g => Float -> State g (LabTree Room)
|
|
lasTunnelRunPast y = do
|
|
r <- lasTunnel y
|
|
r1 <- takeOne [door,corridor]
|
|
r2 <- takeOne [door,corridor]
|
|
rToOnward "lasTunnelRunPast" $ Node r
|
|
[ pure $ useAll r1
|
|
, return (useLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
|
|
]
|