Add missing file, workaround for placement positions bug
This commit is contained in:
+20
-22
@@ -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)
|
||||
]
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user