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

Remove separate wall color, should be handled by material type

Browse Source
This commit is contained in:
justin
2025-10-23 21:27:14 +01:00
parent 819f0d37ea
commit 3c6d269d00
24 changed files with 136 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+22 -11
View File
@@ -7,9 +7,9 @@ module Dodge.Block.Debris (
makeDebrisDirected,
) where
import Dodge.Material.Color
import qualified Data.IntMap.Strict as IM
import Dodge.ShiftPoint
import Color
import Data.Foldable
import qualified Data.IntSet as IS
import Data.Maybe
@@ -24,32 +24,41 @@ import RandomHelp
import Shape
makeDoorDebris :: Door -> World -> World
makeDoorDebris dr w = w & makeDebris mt col p
--makeDoorDebris dr w = w & makeDebris mt col p
makeDoorDebris dr w = w & makeDebris mt p
where
p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
--(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
((wlid,_),_) <- IM.minViewWithKey wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
return (_wlMaterial wl, _wlColor wl)
--return (_wlMaterial wl, _wlColor wl)
return $ wl ^. wlMaterial
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
--makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps
makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
where
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
--(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
return (_wlMaterial wl, _wlColor wl)
--return (_wlMaterial wl, _wlColor wl)
return $ _wlMaterial wl
makeDebris :: Material -> Color -> Point2 -> World -> World
--makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris :: Material -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2 * pi) 0
makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
--makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
--makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected arcrad dir bm p w =
w
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld . lWorld . debris <>~ thedebris
@@ -63,7 +72,8 @@ makeDebrisDirected arcrad dir bm col p w =
-- basedebris <- baseDebris bm
return $ DebrisChunk
{ _dbPos = p `v2z` h
, _dbType = BlockDebris col
-- , _dbType = BlockDebris col
, _dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
@@ -87,6 +97,7 @@ debrisSize mt = case mt of
Metal -> 10
Electronics -> 10
Flesh -> 10
ForceField -> 10
--shardShape :: Float -> Shape
--shardShape size =
src/Dodge/Bullet.hs
+7 -2
View File
@@ -107,8 +107,9 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
-- tpos <- cr ^? crTargeting . ctPos . _Just
-- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
-- might want to restrict what/how bounces by material type
bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
bounceDir _ (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
bounceDir _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
bounceDir m (p, Left cr) | crIsArmouredFrom m p cr
= Just $ vNormal $ p - (cr ^. crPos . _xy)
bounceDir _ _ = Nothing
@@ -207,6 +208,10 @@ movePenBullet bu hitstream w = case hitstream of
first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w
_ -> expireAndDamage bu hitstream w
materialPenetrable :: Material -> Bool
materialPenetrable _ = error "Haven't decided which materials are peneterable"
penThing :: Either Creature Wall -> Bool
penThing (Left _) = True
penThing (Right wl) = _wlPenetrable wl
penThing (Right wl) = _wlStructure wl /= StandaloneWall
&& materialPenetrable (wl ^. wlMaterial)
src/Dodge/Data/GenWorld.hs
+1 -2
View File
@@ -9,7 +9,6 @@ module Dodge.Data.GenWorld (
) where
import ShortShow
import Color
import Control.Lens
import Control.Monad.State
import qualified Data.Set as S
@@ -55,7 +54,7 @@ data PSType
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
| PutSlideDr Door Wall (S.Set EdgeObstacle) Float Point2 Point2
-- | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
| PutDoor Color (S.Set EdgeObstacle) WdBl Float Point2A Point2A -- [(Point2, Point2)]
| PutDoor (S.Set EdgeObstacle) WdBl Float Point2A Point2A -- [(Point2, Point2)]
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
src/Dodge/Data/Material.hs
+10 -1
View File
@@ -6,7 +6,16 @@ module Dodge.Data.Material where
import Data.Aeson
import Data.Aeson.TH
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics
data Material
= Wood
| Dirt
| Stone
| Glass
| Metal
| Crystal
| Flesh
| Electronics
| ForceField
deriving (Eq, Ord, Show, Bounded, Enum, Read) --Generic, Flat)
deriveJSON defaultOptions ''Material
src/Dodge/Data/Wall.hs
+1 -6
View File
@@ -7,7 +7,6 @@ module Dodge.Data.Wall (
module Dodge.Data.Material,
) where
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -19,14 +18,10 @@ import qualified Data.Set as S
data Wall = Wall
{ _wlLine :: (Point2, Point2)
, _wlID :: Int
, _wlColor :: Color
-- , _wlColor :: Color
, _wlOpacity :: Opacity
, _wlPathFlag :: S.Set WallFlag
, _wlPenetrable :: Bool
, _wlBouncy :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlUnshadowed :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
src/Dodge/Default/Door.hs
+4 -5
View File
@@ -3,25 +3,24 @@ module Dodge.Default.Door (
module Dodge.Default.Wall,
) where
import Color
import Control.Lens
import Dodge.Data.Door
import Dodge.Data.Wall
import Dodge.Default.Wall
switchWallCol :: Color -> Wall
switchWallCol col = defaultSwitchWall & wlColor .~ col
--switchWallCol :: Color -> Wall
--switchWallCol col = defaultSwitchWall
defaultAutoWall :: Wall
defaultAutoWall =
defaultDoorWall
& wlColor .~ dim yellow
-- & wlColor .~ dim yellow
& wlOpacity .~ Opaque 9
defaultSwitchWall :: Wall
defaultSwitchWall =
defaultDoorWall
& wlColor .~ red
-- & wlColor .~ red
& wlOpacity .~ Opaque 0
defaultDoor :: Door
src/Dodge/Default/Wall.hs
+20 -30
View File
@@ -8,11 +8,10 @@ module Dodge.Default.Wall (
defaultDirtWall,
) where
import qualified Data.Set as S
import Control.Lens
import qualified Data.Set as S
import Dodge.Data.Wall
import Geometry.Data
import Picture
{- Indestructible wall. -}
defaultWall :: Wall
@@ -20,34 +19,34 @@ defaultWall =
Wall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.6
, _wlPathFlag = S.fromList [WallBlockVisibility
, WallNotAutoOpen, WallNotDestrucable]
-- , _wlColor = greyN 0.6
, _wlPathFlag =
S.fromList
[ WallBlockVisibility
, WallNotAutoOpen
, WallNotDestrucable
]
, _wlOpacity = Opaque 11
, _wlPenetrable = False
, _wlFireThrough = False
, _wlTouchThrough = False
, _wlUnshadowed = True
, _wlRotateTo = True
, _wlStructure = StandaloneWall
, _wlWalkable = False
, _wlHeight = 100
, _wlMaterial = Stone
, _wlBouncy = True
, _wlTouchThrough = False
}
defaultDoorWall :: Wall
defaultDoorWall = defaultWall { _wlMaterial = Metal }
& wlPathFlag . at WallNotDestrucable .~ Nothing
defaultDoorWall =
defaultWall{_wlMaterial = Metal}
& wlPathFlag . at WallNotDestrucable .~ Nothing
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
defaultCrystalWall =
defaultWall
{ _wlColor = withAlpha 0.5 aquamarine
, _wlOpacity = SeeThrough
, _wlMaterial = Crystal
}
defaultCrystalWall = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Crystal
-- { _wlColor = withAlpha 0.5 aquamarine
-- , _wlOpacity = SeeThrough
-- , _wlMaterial = Crystal
-- }
defaultMachineWall :: Wall
defaultMachineWall =
@@ -56,37 +55,28 @@ defaultMachineWall =
, _wlRotateTo = False
, _wlStructure = MachinePart 0
, _wlMaterial = Metal
, _wlPenetrable = True
}
defaultSensorWall :: Wall
defaultSensorWall = defaultMachineWall & wlBouncy .~ False
defaultSensorWall = defaultMachineWall
defaultDirtWall :: Wall
defaultDirtWall =
defaultWall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlColor = dirtColor
-- , _wlColor = dirtColor
, _wlOpacity = Opaque 6
, _wlRotateTo = False
, _wlFireThrough = False
, _wlPenetrable = True
, _wlMaterial = Dirt
}
dirtColor :: Color
dirtColor = dark $ dark orange
--dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
defaultWindow :: Wall
defaultWindow =
defaultWall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlColor = withAlpha 0.5 cyan
-- , _wlColor = withAlpha 0.5 cyan
, _wlOpacity = SeeThrough
, _wlFireThrough = False
, _wlMaterial = Glass
, _wlPenetrable = True
}
src/Dodge/Item/BackgroundEffect.hs
+4 -5
View File
@@ -7,7 +7,6 @@ module Dodge.Item.BackgroundEffect (
) where
import Linear
import Color
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Test
@@ -78,11 +77,11 @@ itEffectOnDrop itm cr w = case itm ^. itType of
shieldWall :: Int -> Wall
shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlWalkable = True
, _wlFireThrough = False
{ --_wlColor = yellow
_wlOpacity = SeeAbove
, _wlMaterial = Metal
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
, _wlPathFlag = mempty
}
& wlPathFlag .~ mempty
src/Dodge/Item/Weapon/Shatter.hs
+3 -2
View File
@@ -27,11 +27,12 @@ shootShatter _ cr w =
shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
shatterWall w sp ep p wl =
w
& makeDebris (_wlMaterial wl) (_wlColor wl) p
-- & makeDebris (_wlMaterial wl) (_wlColor wl) p
& makeDebris (_wlMaterial wl) p
& makeDebrisDirected
(pi / 2)
(argV $ vNormal $ uncurry (-) $ _wlLine wl)
(_wlMaterial wl)
(_wlColor wl)
-- (_wlColor wl)
p
& damageWall (Shattering 1000 p (ep - sp)) wl
src/Dodge/Material/Color.hs
+1
View File
@@ -16,3 +16,4 @@ materialColor =
Crystal -> green
Flesh -> red
Electronics -> greyN 0.2
ForceField -> magenta
src/Dodge/Material/Sound.hs
+2
View File
@@ -14,6 +14,7 @@ destroyMatS mat = case mat of
Metal -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S,metal7S]
Electronics -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S,metal7S]
Flesh -> [gut1S, gut2S, gut3S, gut4S, gut5S, gut6S]
ForceField -> []
weakenMatS :: Material -> [SoundID]
weakenMatS mat = case mat of
@@ -25,3 +26,4 @@ weakenMatS mat = case mat of
Metal -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
Electronics -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
Flesh -> [blood1S, blood2S, blood3S, blood4S, blood5S, blood6S, blood7S, blood8S]
ForceField -> []
src/Dodge/Placement/Instance/Block.hs
+1 -1
View File
@@ -18,7 +18,7 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
& blMaterial .~ mat
wl =
defaultWall
& wlColor .~ col
-- & wlColor .~ col
& wlRotateTo .~ False
& wlOpacity .~ SeeAbove
& wlMaterial .~ mat
src/Dodge/Placement/Instance/Door.hs
+2 -1
View File
@@ -111,7 +111,8 @@ switchDoor btpos btrot dra drb col = pContID
jsps0J (doorbetween btid dra drc) $
sps0 (doorbetween btid drb drc)
where
doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
--doorbetween btid a b = PutSlideDr thedoor (switchWallCol col)
doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall
(S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
where
thedoor =
src/Dodge/Placement/Instance/Wall.hs
+3 -5
View File
@@ -1,6 +1,6 @@
module Dodge.Placement.Instance.Wall where
import Color
import Dodge.Material.Color
import Control.Lens
import Data.List
import Dodge.Data.GenWorld
@@ -11,7 +11,7 @@ import Dodge.Placement.Instance.Block
import Geometry
heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (_wlColor defaultWall) h ps
heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (materialColor Stone) h ps
invisibleWall :: [Point2] -> Placement
invisibleWall ps =
@@ -89,12 +89,10 @@ baseBlockPane =
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
--, _wlColor = greyN 0.5
, _wlColor = dark $ dark orange
-- , _wlColor = dark $ dark orange
--, _wlOpacity = Opaque 10
, _wlOpacity = Opaque 17
, _wlUnshadowed = True
, _wlFireThrough = False
, _wlPenetrable = True
}
-- TODO find home for this
src/Dodge/Placement/PlaceSpot.hs
+6 -9
View File
@@ -7,7 +7,6 @@
module Dodge.Placement.PlaceSpot (placeSpot) where
import qualified Data.Set as S
import Color
import Control.Monad.State
import Data.Bifunctor
import Data.Foldable
@@ -135,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
--PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutDoor col eo f l p1 p2 -> plDoor col eo f l (pashift p1) (pashift p2) w
PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b ->
plSlideDoor wl dr eo off (doShift a) (doShift b) w
@@ -229,7 +228,7 @@ plTurret ::
plTurret wallpoly mc wl itm p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
& gwWorld . cWorld . lWorld . items . at itid ?~ itm'
)
where
@@ -237,7 +236,6 @@ plTurret wallpoly mc wl itm p rot gw =
itm & itID .~ NInt itid
& itLocation .~ OnTurret mcid
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
col = _mcColor mc
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -252,10 +250,9 @@ plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> GenWorld -> (Int
plMachine' wallpoly mc wl p rot gw =
( mcid
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
)
where
col = _mcColor mc
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -263,13 +260,13 @@ plMachine' wallpoly mc wl p rot gw =
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls ::
Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
Wall -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
where
f (wid, l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall =
wl
& wlColor .~ col
-- & wlColor .~ col
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+3 -4
View File
@@ -15,10 +15,8 @@ import Dodge.Path
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
plDoor ::
Color ->
S.Set EdgeObstacle ->
-- | Opening condition
WdBl ->
@@ -29,7 +27,7 @@ plDoor ::
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
@@ -45,7 +43,8 @@ plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cW
}
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 $ switchWallCol col) w' $ zip wlids
addWalls w' = foldl' (addDoorWall eo drid $ defaultSwitchWall) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
addDoorWall :: S.Set EdgeObstacle
src/Dodge/Render/Walls.hs
+15 -13
View File
@@ -1,11 +1,10 @@
module Dodge.Render.Walls (
wallsToDraw,
) where
module Dodge.Render.Walls (wallsToDraw) where
import qualified Control.Foldl as L
import Control.Lens
import Dodge.Base.Wall
import Dodge.Data.World
import Dodge.Material.Color
import Dodge.Wall.Draw
--import Dodge.Zoning.Base
--import Dodge.Zoning.Wall
@@ -14,17 +13,20 @@ import Geometry
import ShapePicture
-- not necessary: should just poke all walls to their wanted places
wallsToDraw :: World -> ( [((Point2, Point2), Point4)], SPic, [Wall])
wallsToDraw w = L.fold
( (,,)
<$>L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat
<*> L.prefilter wlOpaqueDraw L.list
)
(w ^. cWorld . lWorld . walls)
-- (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight wlZoneSize cam)
wallsToDraw :: World -> ([((Point2, Point2), Point4)], SPic, [Wall])
wallsToDraw w =
L.fold
( (,,)
<$> L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat
<*> L.prefilter wlOpaqueDraw L.list
)
(w ^. cWorld . lWorld . walls)
where
f wl = (_wlLine wl, _wlColor wl)
-- (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight wlZoneSize cam)
f wl = (_wlLine wl, materialColor $ _wlMaterial wl)
-- cam = w ^. cWorld . camPos
--wallsToDraw
src/Dodge/Room/Airlock.hs
+13 -13
View File
@@ -51,7 +51,8 @@ decontamRoom i =
return $
putDoubleDoor
switchWallObs
(switchWallCol red)
--(switchWallCol red)
defaultSwitchWall
(cond pmnt)
(V2 (-10) 35)
(V2 (-10) 65)
@@ -60,7 +61,8 @@ decontamRoom i =
mcpos = V2 70 50
cutps = [rectNSWE 100 0 0 40, switchcut]
ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
thewall = switchWallCol col
--thewall = switchWallCol col
thewall = defaultSwitchWall
switchcut = rectNSWE 65 35 (-40) 80
lnks =
[ (V2 20 95, 0)
@@ -87,7 +89,8 @@ airlock0 =
, _rmBound = [rectNSWE 75 15 0 40, switchcut]
}
where
thewall = switchWallCol col
--thewall = switchWallCol col
thewall = defaultSwitchWall
switchcut = rectNSWE 65 35 (-40) 20
lnks =
[ (V2 20 95, 0)
@@ -96,13 +99,12 @@ airlock0 =
col = dim $ dim $ bright red
--airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
airlockDoor :: Color -> WdBl -> Float -> Point2A -> Point2A -> PSType
airlockDoor col = PutDoor col switchWallObs
airlockDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType
airlockDoor = PutDoor switchWallObs
airlockDoubleDoor ::
Point2 ->
Point2 ->
Color ->
WdBl ->
Float ->
Point2A ->
@@ -111,9 +113,9 @@ airlockDoubleDoor ::
Point2A ->
Point2A ->
Maybe Placement
airlockDoubleDoor p1 p2 col cond l1 x1 y1 l2 x2 y2 =
jspsJ p1 0 (airlockDoor col cond l1 x1 y1) $
sPS p2 0 (airlockDoor col cond l2 x2 y2)
airlockDoubleDoor p1 p2 cond l1 x1 y1 l2 x2 y2 =
jspsJ p1 0 (airlockDoor cond l1 x1 y1) $
sPS p2 0 (airlockDoor cond l2 x2 y2)
airlockSimple :: Room
airlockSimple =
@@ -128,7 +130,6 @@ airlockSimple =
airlockDoubleDoor
0
(V2 180 0)
col
(WdBlBtOn btid)
l1
x1
@@ -173,7 +174,6 @@ airlockZ = do
airlockDoubleDoor
(V2 0 60)
(V2 180 60)
col
(WdBlBtOn btid)
l1
x1
@@ -222,7 +222,7 @@ airlock90 =
[ pContID
(PS (V2 120 120) (3 * pi / 4))
(PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
$ \btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
$ \btid -> jsps (V2 5 5) 0 $ airlockDoor (WdBlBtOn btid) l1 x1 y1
, mntLS vShape (V2 35 35) (V3 70 70 50)
]
, _rmBound =
@@ -256,7 +256,7 @@ airlockCrystal =
[ pContID
(PS (V2 145 70) (pi / 2))
(PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect)
$ \btid -> jsps (V2 40 70) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
$ \btid -> jsps (V2 40 70) 0 $ airlockDoor (WdBlBtOn btid) l1 x1 y1
, crystalLine (V2 0 70) (V2 40 70)
, mntLS vShape (V2 150 70) (V3 110 70 70)
]
src/Dodge/Room/Door.hs
+2 -2
View File
@@ -1,7 +1,6 @@
{- Rooms that connect other rooms, blocking sight. -}
module Dodge.Room.Door where
import Color
import Data.Maybe
import Dodge.Data.GenWorld
import Dodge.Default.Door
@@ -43,5 +42,6 @@ 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 (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
switchWallObs defaultSwitchWall (cond pmnt) (V2 0 20) (V2 40 20) 2
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LongDoor.hs
+4 -2
View File
@@ -57,7 +57,8 @@ twinSlowDoorRoom w h x =
, _rmViewpoints = [V2 0 h]
}
where
thewall = switchWallCol red
--thewall = switchWallCol red
thewall = defaultSwitchWall
wlSpeed = 0.5
addColorChange lsid drid =
over prUpdate $
@@ -129,7 +130,8 @@ addButtonSlowDoor x h rm = do
.++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
-- TODO make the height of this light source and of other mounted lights
-- be taken from a single consistent source
thewall = switchWallCol red
--thewall = switchWallCol red
thewall = defaultSwitchWall
butDoor = putLitButOnPos
col
(rprBool (isUnusedLnkType InLink))
src/Dodge/Room/Procedural.hs
+2 -1
View File
@@ -330,7 +330,8 @@ centerVaultRoom w h d =
jspsJ (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (PutSlideDr (thedoor btid) thewall switchWallObs 1 (V2 21 0) (V2 0 0))
]
thewall = switchWallCol col
--thewall = switchWallCol col
thewall = defaultSwitchWall
thedoor btid =
defaultDoor
& drTrigger .~ WdBlBtOn btid
src/Dodge/Wall/Draw.hs
+4 -1
View File
@@ -1,8 +1,10 @@
module Dodge.Wall.Draw (drawWall) where
import Dodge.Material.Color
import Dodge.Data.Wall
import Picture.Base
import ShapePicture
import Control.Lens
drawWall :: WallDraw -> Wall -> SPic
drawWall wd = case wd of
@@ -11,7 +13,8 @@ drawWall wd = case wd of
drawForceField :: Wall -> SPic
drawForceField wl = noShape . setLayer BloomLayer
. setDepth 20
. color (_wlColor wl)
. color (materialColor (wl ^. wlMaterial))
-- . color (_wlColor wl)
$ thickLine 5 [a, b]
where
(a, b) = _wlLine wl
src/Dodge/Wall/ForceField.hs
+2 -5
View File
@@ -1,17 +1,14 @@
module Dodge.Wall.ForceField where
import Color
import Dodge.Data.Wall
import Dodge.Default.Wall
forceField :: Wall
forceField =
defaultWall
{ _wlColor = orange
, _wlOpacity = DrawnWall DrawForceField
, _wlWalkable = True
, _wlFireThrough = False
{ _wlOpacity = DrawnWall DrawForceField
, _wlUnshadowed = True
, _wlRotateTo = False
, _wlStructure = StandaloneWall
, _wlMaterial = ForceField
}
src/Dodge/WallCreatureCollisions.hs
+4 -2
View File
@@ -47,7 +47,8 @@ colCrWall w c
p2 = c ^. crPos . _xy
ls = _wlLine <$> wls
ls' = filter (uncurry $ isLHS p1) ls
wls = filter (not . _wlWalkable) $ wlsNearRect (p2 +.+ V2 r r) (p2 -.- V2 r r) w
wls = filter notff $ wlsNearRect (p2 +.+ V2 r r) (p2 -.- V2 r r) w
notff x = x ^. wlMaterial /= ForceField
-- the amount to push creatures out from walls, extra to their radius
wallBuffer :: Float
@@ -88,9 +89,10 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (crRad (cr ^. crType)) cpos)
crOnWall :: Creature -> World -> Bool
crOnWall cr =
any (uncurry (circOnSeg p r) . _wlLine)
. filter (not . _wlWalkable)
. filter notff
. wlsNearPoint p
where
notff x = x ^. wlMaterial /= ForceField
p = cr ^. crPos . _xy
r = crRad (cr ^. crType)