131 lines
4.4 KiB
Haskell
131 lines
4.4 KiB
Haskell
module Dodge.Room.LasTurret where
|
|
import Dodge.LevelGen.Data
|
|
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.Default.Room
|
|
--import Dodge.Item.Weapon.BulletGuns
|
|
--import Dodge.Item.Weapon.Utility
|
|
--import Dodge.LevelGen.Data
|
|
--import Geometry.Data
|
|
import Geometry
|
|
--import Padding
|
|
import Color
|
|
import Shape
|
|
import LensHelp
|
|
import Dodge.RandomHelp
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Maybe
|
|
import Data.Tree
|
|
import Control.Monad.State
|
|
import System.Random
|
|
|
|
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 | _mcSensorAmount 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)
|
|
|
|
lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
|
|
lasSensorTurretTest n = do
|
|
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
|
|
let doorroom = triggerDoorRoom n
|
|
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
|
|
|
|
lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
|
|
lasCenSensEdge n = do
|
|
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
|
|
let doorroom = triggerDoorRoom n
|
|
return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
|
|
[ treeFromPost [PassDown doorroom] (UseAll door)
|
|
, treeFromPost [PassDown 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 (SubCompTree Room)
|
|
lasTunnelRunPast y = do
|
|
r <- lasTunnel y
|
|
r1 <- takeOne [door,corridor]
|
|
r2 <- takeOne [door,corridor]
|
|
return $ Node (PassDown r)
|
|
[ singleUseAll r1
|
|
, return (UseLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
|
|
]
|