88 lines
2.9 KiB
Haskell
88 lines
2.9 KiB
Haskell
module Dodge.Room.SensorDoor where
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Placement.Instance.Terminal
|
|
import Dodge.Data
|
|
import Dodge.Tree
|
|
--import Dodge.RoomLink
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Ngon
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Link
|
|
--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 Lorem
|
|
import LensHelp
|
|
import Dodge.RandomHelp
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Maybe
|
|
import Data.Char
|
|
--import Data.Tree
|
|
import Control.Monad.State
|
|
import System.Random
|
|
|
|
sensorRoom :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
|
|
sensorRoom senseType n = do
|
|
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
|
|
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
|
|
let doorroom = triggerDoorRoom n
|
|
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
|
|
|
|
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
|
|
sensorRoomRunPast dt n = do
|
|
t <- sensorRoom dt n
|
|
return $ applyToSubforest [0] (++
|
|
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
|
|
& rmName .~ "test"
|
|
] (UseLabel 0 corridor)]
|
|
) t
|
|
--[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
|
|
|
|
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
|
|
sensAboveDoor sensetype wth ps = extTrigLitPos
|
|
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
|
|
( \tp -> Just $ damageSensor sensetype wth (upf $ fromJust $ _plMID tp) ps )
|
|
where
|
|
upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
|
|
| otherwise = w
|
|
|
|
sensInsideDoor :: DamageType -> Int -> Room -> Room
|
|
sensInsideDoor senseType outplid rm = rm
|
|
& rmName .++~ take 4 (show senseType)
|
|
& 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))
|
|
, putTerminal (genTermMessage messagef)
|
|
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
|
|
]
|
|
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
|
|
where
|
|
mtoup = map toUpper
|
|
horline = "-----------------"
|
|
messagef gp =
|
|
let Just (pc,ds) = gp ^? sensorCoding . ix senseType
|
|
in [horline
|
|
,"SENSOR ATTRIBUTES"
|
|
,horline
|
|
,mtoup $ show senseType
|
|
,"COLOR:"++ mtoup (show pc)
|
|
,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
|
|
,horline
|
|
]
|