diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 8982d37ac..09c12415f 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -35,7 +35,6 @@ makeDoorDebris dr w = w & makeDebris mt p return $ wl ^. wlMaterial makeBlockDebris :: Block -> World -> World ---makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps where dsize = debrisSize mt diff --git a/src/Dodge/Default/Door.hs b/src/Dodge/Default/Door.hs index e912da3b6..3384b6aec 100644 --- a/src/Dodge/Default/Door.hs +++ b/src/Dodge/Default/Door.hs @@ -16,12 +16,7 @@ defaultAutoWall = defaultDoorWall -- & wlColor .~ dim yellow & wlOpacity .~ Opaque 9 - -defaultSwitchWall :: Wall -defaultSwitchWall = - defaultDoorWall --- & wlColor .~ red - & wlOpacity .~ Opaque 0 + & wlPathFlag . at WallNotAutoOpen .~ Nothing defaultDoor :: Door defaultDoor = diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index ed955cdf5..7e034831a 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -1,6 +1,5 @@ module Dodge.Default.Wall ( defaultWall, - defaultSensorWall, defaultMachineWall, defaultWindow, defaultCrystalWall, @@ -35,17 +34,14 @@ defaultWall = } defaultDoorWall :: Wall -defaultDoorWall = - defaultWall{_wlMaterial = Metal} +defaultDoorWall = defaultWall & wlPathFlag . at WallNotDestrucable .~ Nothing + & wlMaterial .~ Metal + & wlOpacity .~ Opaque 0 {- Indestructible see-through wall. -} defaultCrystalWall :: Wall defaultCrystalWall = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Crystal --- { _wlColor = withAlpha 0.5 aquamarine --- , _wlOpacity = SeeThrough --- , _wlMaterial = Crystal --- } defaultMachineWall :: Wall defaultMachineWall = @@ -57,9 +53,6 @@ defaultMachineWall = , _wlTouchThrough = True } -defaultSensorWall :: Wall -defaultSensorWall = defaultMachineWall - defaultDirtWall :: Wall defaultDirtWall = defaultWall diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index d8ea5cf08..e2b32e26d 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -3,12 +3,9 @@ module Dodge.Path ( pointTowardsImpulse, makePathBetween, makePathBetweenPs, - -- , removePathsCrossing obstructPathsCrossing, --- pairsToGraph, getNodePos, walkableNodeNear, --- bfsNodePoints, snapToGrid, pairsToIncGraph, updateEdge, diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index f7bb6e1f3..23f23feaa 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -112,7 +112,7 @@ switchDoor btpos btrot dra drb col = pContID sps0 (doorbetween btid drb drc) where --doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) - doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall + doorbetween btid a b = PutSlideDr thedoor defaultDoorWall (S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b where thedoor = diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index a99c4d5b8..d24699bbd 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -29,7 +29,6 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $ (damageTypeThreshold dt) ) ) --- defaultMachineWall Nothing damageTypeThreshold :: SensorType -> Int diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 4e1567538..83480a18d 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -36,7 +36,6 @@ putTerminalFull f col mc tm = ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl) & mcMounts . at OTTerminal .~ _plMID tmpl ) --- defaultMachineWall Nothing ) $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl) diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index 031851460..76f656def 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -1,10 +1,19 @@ -module Dodge.Placement.Instance.Wall where +module Dodge.Placement.Instance.Wall + (invisibleWall, crystalLine, blockLine, putBlockRect + ,baseBlockPane + ,midWall + ,windowLine + ,putBlockN + ,putBlockV + ,heightWallPS + ,replacePutID + ) where +import qualified Data.Set as S import Dodge.Material.Color import Control.Lens import Data.List import Dodge.Data.GenWorld -import Dodge.Default.Block import Dodge.Default.Wall import Dodge.LevelGen.PlacementHelper import Dodge.Placement.Instance.Block @@ -27,13 +36,13 @@ invisibleWall ps = midWall :: [Point2] -> Placement midWall = heightWallPS (PS 0 0) 50 -singleBlock :: Point2 -> [Placement] -singleBlock a = - [ sPS a 0 $ - PutBlock defaultBlock baseBlockPane $ - reverse $ - square 10 - ] +--singleBlock :: Point2 -> [Placement] +--singleBlock a = +-- [ sPS a 0 $ +-- PutBlock defaultBlock baseBlockPane $ +-- reverse $ +-- square 10 +-- ] {- Places a line of blocks between two points. @@ -65,35 +74,28 @@ crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b -- ] -- left = 7 *.* normalizeV (a-.-b) -- up = vNormal left -{- Places an unbreakable wall between two points. -Depth 15, does not extend wider than points. - -} -wallLine :: Point2 -> Point2 -> Placement -wallLine a b = sps0 $ PutWall ps defaultWall - where - ps = - [ a +.+ up - , a -.- up - , b -.- up - , b +.+ up - ] - left = 15 *.* normalizeV (a -.- b) - up = vNormal left +-- +--{- Places an unbreakable wall between two points. +--Depth 15, does not extend wider than points. +-- -} +--wallLine :: Point2 -> Point2 -> Placement +--wallLine a b = sps0 $ PutWall ps defaultWall +-- where +-- ps = +-- [ a +.+ up +-- , a -.- up +-- , b -.- up +-- , b +.+ up +-- ] +-- left = 15 *.* normalizeV (a -.- b) +-- up = vNormal left -windowLineType :: Point2 -> Point2 -> PSType -windowLineType = PutLineBlock defaultWindow 8 +--windowLineType :: Point2 -> Point2 -> PSType +--windowLineType = PutLineBlock defaultWindow 8 baseBlockPane :: Wall -baseBlockPane = - defaultWall - { _wlLine = (V2 0 0, V2 50 0) - , _wlID = 0 - --, _wlColor = greyN 0.5 --- , _wlColor = dark $ dark orange - --, _wlOpacity = Opaque 10 - , _wlOpacity = Opaque 17 - , _wlUnshadowed = True - } +baseBlockPane = defaultWall & wlOpacity .~ Opaque 17 + & wlPathFlag .~ S.fromList [WallBlockVisibility, WallNotAutoOpen] -- TODO find home for this {- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -} @@ -127,18 +129,18 @@ subZipWith f g xs ys = isPutID :: Int -> Placement -> Bool isPutID i ps = Just i == ps ^? plType . putID -putBlockRect' :: Float -> Float -> Placement -putBlockRect' w h = - ps0jPushPS (aline tl tr) $ - ps0jPushPS (aline tr br) $ - ps0jPushPS (aline br bl) $ - sps0 (aline bl tl) - where - tl = V2 (- w) h - tr = V2 w h - br = V2 w (- h) - bl = V2 (- w) (- h) - aline = PutLineBlock baseBlockPane 9 +--putBlockRect' :: Float -> Float -> Placement +--putBlockRect' w h = +-- ps0jPushPS (aline tl tr) $ +-- ps0jPushPS (aline tr br) $ +-- ps0jPushPS (aline br bl) $ +-- sps0 (aline bl tl) +-- where +-- tl = V2 (- w) h +-- tr = V2 w h +-- br = V2 w (- h) +-- bl = V2 (- w) (- h) +-- aline = PutLineBlock baseBlockPane 9 putBlockRect :: Float -> Float -> Float -> Float -> [Placement] putBlockRect a x b y = @@ -154,12 +156,12 @@ putBlockV a x b y = , blockLine (V2 x b) (V2 a b) ] -putBlockC :: Float -> Float -> Float -> Float -> [Placement] -putBlockC a x b y = - [ blockLine (V2 a b) (V2 a y) - , blockLine (V2 x b) (V2 a b) - , blockLine (V2 a y) (V2 x y) - ] +--putBlockC :: Float -> Float -> Float -> Float -> [Placement] +--putBlockC a x b y = +-- [ blockLine (V2 a b) (V2 a y) +-- , blockLine (V2 x b) (V2 a b) +-- , blockLine (V2 a y) (V2 x y) +-- ] putBlockN :: Float -> Float -> Float -> Float -> [Placement] putBlockN a x b y = diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index c45b9409c..af96627f2 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -44,7 +44,7 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..] wlps' = rectanglePairs 9 0 (V2 l 0) --addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids - addWalls w' = foldl' (addDoorWall eo drid defaultSwitchWall) w' $ zip wlids + addWalls w' = foldl' (addDoorWall eo drid defaultDoorWall) w' $ zip wlids $ wlps' & each . each %~ shiftPointBy p1 addDoorWall :: S.Set EdgeObstacle diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 1220234d7..ec092991d 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -51,8 +51,7 @@ decontamRoom i = return $ putDoubleDoor switchWallObs - --(switchWallCol red) - defaultSwitchWall + defaultDoorWall (cond pmnt) (V2 (-10) 35) (V2 (-10) 65) @@ -62,7 +61,7 @@ decontamRoom i = cutps = [rectNSWE 100 0 0 40, switchcut] ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps) --thewall = switchWallCol col - thewall = defaultSwitchWall + thewall = defaultDoorWall switchcut = rectNSWE 65 35 (-40) 80 lnks = [ (V2 20 95, 0) @@ -89,8 +88,7 @@ airlock0 = , _rmBound = [rectNSWE 75 15 0 40, switchcut] } where - --thewall = switchWallCol col - thewall = defaultSwitchWall + thewall = defaultDoorWall switchcut = rectNSWE 65 35 (-40) 20 lnks = [ (V2 20 95, 0) diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 09feabb43..7570c1a37 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -42,6 +42,5 @@ triggerDoorRoom i = f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do pmnt <- gw ^? genPmnt . ix i return $ putDoubleDoor - --switchWallObs (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2 - switchWallObs defaultSwitchWall (cond pmnt) (V2 0 20) (V2 40 20) 2 + switchWallObs defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2 cond pmnt = WdTrig $ fromJust (_plMID pmnt) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 3faf86a24..d3a586510 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -58,7 +58,7 @@ twinSlowDoorRoom w h x = } where --thewall = switchWallCol red - thewall = defaultSwitchWall + thewall = defaultDoorWall wlSpeed = 0.5 addColorChange lsid drid = over prUpdate $ @@ -131,7 +131,7 @@ addButtonSlowDoor x h rm = do -- TODO make the height of this light source and of other mounted lights -- be taken from a single consistent source --thewall = switchWallCol red - thewall = defaultSwitchWall + thewall = defaultDoorWall butDoor = putLitButOnPos col (rprBool (isUnusedLnkType InLink)) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 45202bc04..6f41798eb 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -331,7 +331,7 @@ centerVaultRoom w h d = sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0)) ] --thewall = switchWallCol col - thewall = defaultSwitchWall + thewall = defaultDoorWall thedoor btid = defaultDoor & drTrigger .~ WdBlBtOn btid