From afeb9d2b649bc9bdd4216cbddeccc5f55b45f3df Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 21 Nov 2021 19:14:17 +0000 Subject: [PATCH] Add wire to central laser room --- src/Dodge/Layout.hs | 13 +++++-------- src/Dodge/LevelGen/Data.hs | 8 +++++--- src/Dodge/Placement/Instance/Button.hs | 2 +- src/Dodge/Placement/Instance/Sensor.hs | 8 ++++---- src/Dodge/Placement/PlaceSpot.hs | 3 +-- src/Dodge/PlacementSpot.hs | 24 ++++++++++++++++++++++-- src/Dodge/Room/Foreground.hs | 8 +++++--- src/Dodge/Room/Start.hs | 18 ++++++++++-------- src/Dodge/Wire.hs | 8 ++++---- 9 files changed, 57 insertions(+), 35 deletions(-) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 2dc5b8d39..3270beae5 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -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) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index e9e0a638d..a73707331 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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) diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 66cf6bae4..70ed8abb2 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -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) diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 7a75b1c41..dd3795f02 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 27cef78ba..b196fa1ec 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -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 diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 2270e2db6..c8993dd76 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -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 diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 9713744b0..7fc3bf7c5 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -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 diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index ff2601f54..7ffc32228 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -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) ] diff --git a/src/Dodge/Wire.hs b/src/Dodge/Wire.hs index 0dbd90a60..9ad8b2a89 100644 --- a/src/Dodge/Wire.hs +++ b/src/Dodge/Wire.hs @@ -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)