Add missing file, workaround for placement positions bug

This commit is contained in:
2022-03-08 07:59:36 +00:00
parent 79b5241c32
commit 59e6f433ff
16 changed files with 67 additions and 86 deletions
+20 -22
View File
@@ -20,11 +20,11 @@ import Geometry
--import Padding
import Color
import Shape
import LensHelp
import Data.Maybe
import Data.Tree
import Control.Monad.State
import Control.Lens
import System.Random
cenLasTur :: Room
@@ -36,46 +36,44 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
lightSensInsideDoor :: Room -> Room
lightSensInsideDoor rm = rm
& rmPmnts %~ ( (psPt atFstLnkOut $ PutShape $ colorSH yellow $
& 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)) : )
& rmExtPmnt ?~
extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ lightSensor 10 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftInward 100)
)
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
& rmExtPmnt ?~ lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)
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 | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
| otherwise = w
lightSensByDoor :: Room -> Room
lightSensByDoor rm = rm
& rmPmnts %~ (
& rmPmnts .++~
[ psPt atFstLnkOut $ PutShape $ colorSH yellow
$ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20))
, heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20))
] ++ )
& rmExtPmnt ?~
extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ lightSensor 20 (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftBy sensorshift)
)
, heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20))
]
& rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)
where
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
| otherwise = w
lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
lasSensorTurretTest n = do
cenroom <- randomiseOutLinks $ (lightSensInsideDoor cenLasTur) {_rmLabel = Just n}
let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel .~ Just n
let doorroom = switchDoorRoom & rmTakeFrom .~ Just n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
lasCenSensEdge n = do
cenroom <- randomiseOutLinks $ (lightSensByDoor cenLasTur) {_rmLabel = Just n}
cenroom <- shuffleLinks $ (lightSensByDoor cenLasTur) {_rmLabel = Just n}
let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
return $ treeFromTrunk [PassDown door] (Node (PassDown cenroom)
[treeFromPost [PassDown doorroom] (UseAll door), treeFromPost [PassDown door] (UseLabel 0 corridor)
return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
]
)