From f5309526123f44a7e72d6d53b443d1b85a2c32dd Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 16 Nov 2021 12:57:13 +0000 Subject: [PATCH] Add indicator light to switch doors --- src/Dodge/Default.hs | 2 +- src/Dodge/Floor.hs | 8 +++--- src/Dodge/Layout.hs | 9 ++++++- src/Dodge/LevelGen/Data.hs | 15 +---------- src/Dodge/LevelGen/Switch.hs | 46 ++++++++++++++++++++++++++++++++++ src/Dodge/PlacementSpot.hs | 23 +++++++++++++++++ src/Dodge/Placements/Button.hs | 25 ++++++++++++++++++ src/Dodge/Room/Foreground.hs | 7 ++++++ src/Dodge/Wire.hs | 2 +- 9 files changed, 117 insertions(+), 20 deletions(-) create mode 100644 src/Dodge/PlacementSpot.hs diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 248972f5f..b2a869a48 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -272,7 +272,7 @@ defaultPP = PressPlate defaultLS :: LightSource defaultLS = LS { _lsID = 0 - , _lsPos = 0 + , _lsPos = V3 0 0 50 , _lsDir = 0 , _lsRad = 700 , _lsIntensity = 0.6 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 11d59a6d1..c2c4983b8 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -14,7 +14,9 @@ import Dodge.Layout.Tree.Annotate import Dodge.Layout.Tree.Shift import Dodge.Creature import Dodge.LevelGen.Data +import Dodge.LevelGen.Switch import Dodge.Item.Weapon.Launcher +import Dodge.PlacementSpot import MonadHelp import Data.Tree import Color @@ -34,9 +36,9 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] ,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 - & rmExtPmnt ?~ triggerSwitch red - (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) ) - & rmLinkEff .~ [putWireEnd 0] + & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red) + (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) ) + & rmLinkEff .~ [putWireEnd 0] ] ,[UseLabel 0 $ return switchDoorRoom] ] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index b221729ab..dba46c60b 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -14,6 +14,7 @@ import Dodge.Bounds import Dodge.Default.Wall import Dodge.Room.Link import Geometry +import Geometry.Vector3D import Geometry.ConvexPoly import qualified IntMapHelp as IM import Tile @@ -66,6 +67,12 @@ 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) <>) where @@ -73,7 +80,7 @@ placeWire rm (RoomWire p _) (RoomWire q _) = foregroundShape --rmWalls = foldr cutWalls [] (_rmPolys rm) doOrdering = orderPolygonAround rmcen (p:q:ps) col | clockwise = colorSH red - | otherwise = colorSH orange + | otherwise = colorSH red rmps = concat $ _rmPolys rm rmcen = centroid rmps clockwise = isLHS rmcen p q diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 729e55526..1df1db7e4 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -83,6 +83,7 @@ data Room = Room } data RoomWire = RoomWire Point2 Float + | WallWire Point2 Float Float data RoomPos = OutLink Int Point2 Float | InLink Point2 Float @@ -104,20 +105,6 @@ makeLenses ''PSType makeLenses ''PlacementSpot makeLenses ''Placement --- TODO rename to any unused link facing out -anyLnkOutPS :: PlacementSpot -anyLnkOutPS = PSLnk f (const id) Nothing - where - f (UnusedLink p a) = Just $ PS p a - f _ = Nothing - - -anyLnkInPS :: Float -- ^ amount to shift inward - -> PlacementSpot -anyLnkInPS x = PSLnk f (const id) Nothing - where - f (UnusedLink v a) = Just $ PS (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)) (a+ pi) - f _ = Nothing spNoID :: PlacementSpot -> PSType -> Placement spNoID ps pst = Placement ps pst Nothing (const Nothing) diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index f7ef4f726..aa63a8ea9 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -1,6 +1,8 @@ module Dodge.LevelGen.Switch ( makeSwitch , makeButton + , makeSwitchSPic + , drawSwitchWire ) where import Dodge.Data import Dodge.Default @@ -44,6 +46,50 @@ drawSwitch col1 col2 bt ] , mempty) +drawSwitchWire :: Color -> Color -> Button -> SPic +drawSwitchWire col1 col2 bt + | _btState bt == BtOff = flick $ pi/4 + | otherwise = flick (negate (pi/4)) + where + flick a = ( mconcat + [ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10) + , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2) + ] + , mempty) + +makeSwitchSPic + :: (Button -> SPic) + -> (World -> World) -- ^ Switch on effect + -> (World -> World) -- ^ Switch off effect + -> Button +makeSwitchSPic dswitch effOn effOff = Button + { _btPict = dswitch + , _btPos = V2 0 0 + , _btRot = 0 + , _btEvent = flipSwitch + , _btID = 0 + , _btText = "SWITCH/" + , _btState = BtOff + } + where + flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w + bpos b w = _btPos $ _buttons w IM.! _btID b + switchEffect b = case _btState b of + BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b)) + BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b)) + _ -> error "Trying to switch a button with no label" + turnOn :: Button -> Button + turnOn bt = bt + { _btState = BtOn + , _btText = "SWITCH\\" + } + turnOff :: Button -> Button + turnOff bt = bt + { _btState = BtOff + , _btText = "SWITCH/" + } + + makeSwitch :: Color -> Color diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs new file mode 100644 index 000000000..51b428e13 --- /dev/null +++ b/src/Dodge/PlacementSpot.hs @@ -0,0 +1,23 @@ +module Dodge.PlacementSpot where +import Dodge.LevelGen.Data +import Geometry + +-- TODO rename to any unused link facing out +anyLnkOutPS :: PlacementSpot +anyLnkOutPS = PSLnk f (const id) Nothing + where + f (UnusedLink p a) = Just $ PS p a + f _ = Nothing + +fstLnkOut :: PlacementSpot +fstLnkOut = PSLnk f (const id) Nothing + where + f (OutLink 0 p a) = Just $ PS p a + f _ = Nothing + +anyLnkInPS :: Float -- ^ amount to shift inward + -> PlacementSpot +anyLnkInPS x = PSLnk f (const id) Nothing + where + f (UnusedLink v a) = Just $ PS (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)) (a+ pi) + f _ = Nothing diff --git a/src/Dodge/Placements/Button.hs b/src/Dodge/Placements/Button.hs index f12d31221..98de0300d 100644 --- a/src/Dodge/Placements/Button.hs +++ b/src/Dodge/Placements/Button.hs @@ -7,10 +7,35 @@ import Dodge.LevelGen.Data import Dodge.Default import Dodge.LevelGen.Switch import Dodge.Placements.LightSource +import Dodge.PlacementSpot +import ShapePicture import Data.Maybe import Control.Lens +triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement +triggerSwitchSPic sdraw ps = plCont ps (PutTrigger (const False)) + $ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff $ trigid tp) (offeff $ trigid tp))) + (const Nothing) + where + trigid tp = fromJust $ _plMID tp + oneff tid = triggers . ix tid .~ const True + offeff tid = triggers . ix tid .~ const False + +triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement +triggerSwitchSPicLight sdraw ps = plCont ps (PutTrigger (const False)) + $ \tp -> Just $ pContID fstLnkOut (PutLS thels) + $ \lsid -> Just + $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp))) + (const Nothing) + where + thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75} + trigid tp = fromJust $ _plMID tp + eff lsid tid b c = (triggers . ix tid .~ const b) + . (lightSources . ix lsid . lsIntensity .~ c) + oneff lsid tid = eff lsid tid True (V3 0 0.5 0) + offeff lsid tid = eff lsid tid False (V3 0.5 0 0) + triggerSwitch :: Color -> PlacementSpot -> Placement triggerSwitch col ps = plCont ps (PutTrigger (const False)) $ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp))) diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index b6310a9f3..9713744b0 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -142,6 +142,13 @@ girder = girderCol orange 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) + where + z1 = b -.-.- a + pipePP :: Float -> Point3 -> Point3 -> Shape pipePP w a b = prismPoly (map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 4 w) diff --git a/src/Dodge/Wire.hs b/src/Dodge/Wire.hs index 593901cdf..0dbd90a60 100644 --- a/src/Dodge/Wire.hs +++ b/src/Dodge/Wire.hs @@ -9,4 +9,4 @@ putWireEnd :: Int -> (Point2,Float) -> Room -> Room putWireEnd i pos = rmEndWires %~ IM.insert i (uncurry RoomWire pos) putWireStart :: Int -> (Point2,Float) -> Room -> Room -putWireStart i pos = rmStartWires %~ IM.insert i (uncurry RoomWire pos) +putWireStart i pos = rmStartWires %~ IM.insert i (uncurry WallWire pos 10)