justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add wire to central laser room

Browse Source
This commit is contained in:
justin
2021-11-21 19:14:17 +00:00
parent 2f3896345d
commit afeb9d2b64
9 changed files with 57 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+5 -8
View File
@@ -68,14 +68,11 @@ placeRoomWires rm w = IM.foldr ($) w
$ IM.intersectionWith (placeWire rm) (_rmStartWires rm) (_rmEndWires rm)
placeWire :: Room -> RoomWire -> RoomWire -> World -> World
placeWire rm (WallWire p a h) wr = placeWire rm wr (RoomWire p a) .
(foregroundShape %~ (colorSH red (barPP 1.5 (addZ h p') (addZ 80 p')) <>)
)
where
p' = shiftPointBy (_rmShift rm) p
placeWire rm rw1 rw2@WallWire{} = placeWire rm rw2 rw1
placeWire rm (RoomWire p _) (RoomWire q _) = foregroundShape
%~ ((col $ thinHighBarChain 80 $ map (shiftPointBy rs) doOrdering) <>)
placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape
%~ (col ( (thinHighBarChain h2 $ map (shiftPointBy rs) doOrdering) <>
(barPP 1.5 (addZ h1 p) (addZ h2 p))
) <>
)
where
--TODO use rmWalls for non convex rooms
--rmWalls = foldr cutWalls [] (_rmPolys rm)
src/Dodge/LevelGen/Data.hs
+5 -3
View File
@@ -83,8 +83,8 @@ data Room = Room
, _rmEndWires :: IM.IntMap RoomWire
}
data RoomWire
= RoomWire Point2 Float
| WallWire Point2 Float Float
= --RoomWire Point2 Float
WallWire Point2 Float Float
data RoomPos
= OutLink Int Point2 Float
| InLink Point2 Float
@@ -98,7 +98,6 @@ makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing)
@@ -108,6 +107,9 @@ pContID ps pt = Placement ps pt Nothing . intPlPlPl
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing
psPt :: PlacementSpot -> PSType -> Placement
psPt ps pt = Placement ps pt Nothing (const Nothing)
sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
src/Dodge/Placement/Instance/Button.hs
+1 -1
View File
@@ -25,7 +25,7 @@ triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False))
triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement
triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False))
$ \tp -> Just $ pContID fstLnkOut (PutLS thels)
$ \tp -> Just $ pContID atFstLnkOut (PutLS thels)
$ \lsid -> Just
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
(const Nothing)
src/Dodge/Placement/Instance/Sensor.hs
+4 -4
View File
@@ -15,9 +15,9 @@ import Data.Either
damageSensor
:: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
-> (Machine -> World -> World)
-> Point2 -> Float -> Placement
damageSensor damF upf p r = pContID (PS p r) ( PutLS theLS)
$ \lsid -> jsps p r $ PutMachine yellow (reverse $ square wdth) defaultMachine
-> PlacementSpot -> Placement
damageSensor damF upf ps = pContID ps ( PutLS theLS)
$ \lsid -> Just $ spNoID ps $ PutMachine yellow (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic
, _mcUpdate = \mc w -> upf mc $ sensorUpdate damF mc w
, _mcLSs = [lsid]
@@ -25,7 +25,7 @@ damageSensor damF upf p r = pContID (PS p r) ( PutLS theLS)
where
theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
lightSensor :: (Machine -> World -> World) -> Point2 -> Float -> Placement
lightSensor :: (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor senseLasering
senseLasering :: DamageType -> Either Int Int
src/Dodge/Placement/PlaceSpot.hs
+1 -2
View File
@@ -85,8 +85,7 @@ shiftPSBy (pos,rot) ps = ps
& psPos %~ shiftPointBy (pos,rot)
& psRot %~ (+ rot)
-- the Int here allows for passing parameters down to other placements:
-- button ids, etc
-- the Int here is some id that is assigned when the placement is placed
placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID ps pt w = case pt of
PutTrigger cond -> placeNewInto triggers cond w
src/Dodge/PlacementSpot.hs
+22 -2
View File
@@ -12,8 +12,28 @@ anyLnkOutPS = PSPos f (const id) Nothing
f (UnusedLink p a) = Just (PS p a, PosPl p a)
f _ = Nothing
fstLnkOut :: PlacementSpot
fstLnkOut = PSPos f (const id) Nothing
atFstLnkOut :: PlacementSpot
atFstLnkOut = PSPos f (const id) Nothing
where
f (OutLink 0 p a) = Just (PS p a, OutLink 0 p a)
f _ = Nothing
atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float))
-> PlacementSpot
atFstLnkOutShiftBy theshift = PSPos f (const id) Nothing
where
f (OutLink 0 p a) = Just (PS p' a', OutLink 0 p a)
where
(p',a') = theshift (p,a)
f _ = Nothing
atFstLnkOutShiftInward :: Float -> PlacementSpot
atFstLnkOutShiftInward x = atFstLnkOutShiftBy f
where
f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
overFstLnkOut :: PlacementSpot
overFstLnkOut = PSPos f (const id) Nothing
where
f (OutLink 0 p a) = Just (PS p a, PosPl p a)
f _ = Nothing
src/Dodge/Room/Foreground.hs
+5 -3
View File
@@ -143,9 +143,11 @@ robotArm :: Shape
robotArm = undefined
barPP :: Float -> Point3 -> Point3 -> Shape
barPP w a b = prismPoly
(map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
(map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
barPP w a b
| a == b = mempty
| otherwise = prismPoly
(map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
(map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
where
z1 = b -.-.- a
src/Dodge/Room/Start.hs
+10 -8
View File
@@ -54,13 +54,15 @@ centralLasTurret :: Room
centralLasTurret = roomNgon 8 200 & rmPmnts .~
[ putLasTurret
, heightWall 30 (rectNSEW (-90) (-110) 10 (-10))
, spanColLightI 0.5 100 (V2 0 (-5)) (V2 0 5)
, spanColLightI 0.5 98 (V2 0 (-5)) (V2 0 5)
, psPt atFstLnkOut $ PutForeground $ 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 (PS (V2 200 0) 0)
--extTrigLitPos (anyLnkInPS 5)
extTrigLitPos fstLnkOut
( \tp -> Just $ lightSensor (upf $ fromJust $ _plMID tp) (V2 100 0) 0
extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18 (-2)), a)))
( \tp -> Just $ lightSensor (upf $ fromJust $ _plMID tp) (atFstLnkOutShiftInward 100)
)
where
upf trid mc w | _mcSensor mc > 90 = w & triggers . ix trid .~ const True
@@ -68,8 +70,8 @@ centralLasTurret = roomNgon 8 200 & rmPmnts .~
rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
rezThenLasTurret = do
rbox <- rezBoxStart
let cenroom = centralLasTurret {_rmLabel = Just 0}
doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just 0}
let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
contTree = treeFromPost [Left cenroom] (Right doorroom)
return $ rbox `appendEitherTree` [contTree]
@@ -211,7 +213,7 @@ startRoom' = do
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquare (dim orange) 50 50
, tankSquare (dim orange) 50 120
, lightSensor (const id) (V2 (0.8*w) (0.25*h)) 0
, lightSensor (const id) (PS (V2 (0.8*w) (0.25*h)) 0)
, putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
]
src/Dodge/Wire.hs
+4 -4
View File
@@ -5,8 +5,8 @@ import Geometry
import qualified Data.IntMap.Strict as IM
import Control.Lens
putWireEnd :: Int -> (Point2,Float) -> Room -> Room
putWireEnd i pos = rmEndWires %~ IM.insert i (uncurry RoomWire pos)
putWireEnd :: Int -> (Point2,Float) -> Float -> Room -> Room
putWireEnd i (p,a) h = rmEndWires %~ IM.insert i (WallWire p a h)
putWireStart :: Int -> (Point2,Float) -> Room -> Room
putWireStart i pos = rmStartWires %~ IM.insert i (uncurry WallWire pos 10)
putWireStart :: Int -> (Point2,Float) -> Float -> Room -> Room
putWireStart i (p,a) h = rmStartWires %~ IM.insert i (WallWire p a h)