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

Start simplifying/removing Wall records

Browse Source
This commit is contained in:
justin
2025-10-23 18:11:01 +01:00
parent fc7c4d6468
commit 819f0d37ea
18 changed files with 230 additions and 243 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
-14
View File
@@ -30,7 +30,6 @@ module Dodge.Base.Collide (
hasButtonLOS,
canSee,
canSeeIndirect,
isWalkable,
anythingHitCirc,
collide3WallsFloor,
collide3,
@@ -41,7 +40,6 @@ import Control.Monad
import qualified Data.IntSet as IS
import Data.List (sortOn)
import Data.Maybe
import Data.Monoid
import Dodge.Base.Wall
import Dodge.Creature.Radius
import Dodge.Data.Object
@@ -325,18 +323,6 @@ hasLOSIndirect p1 p2 =
. collidePointTestFilter wlIsOpaque p1 p2
. wlsNearSeg p1 p2
isFlyable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isFlyable #-}
isFlyable p1 p2 =
not
. collidePointTestFilter (not . (^?! wlPathable)) p1 p2
. wlsNearSeg p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 w = isFlyable p1 p2 w && not (getAny $ foldMap f (w ^. cWorld . chasms))
where
f = foldMap (Any . isJust . uncurry (intersectSegSeg p1 p2)) . loopPairs
canSee :: Int -> Int -> World -> Bool
{-# INLINE canSee #-}
src/Dodge/Creature/Action.hs
+1
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.Action (
youDropItem,
) where
import Dodge.WorldEvent.ThingsHit
import Control.Applicative
import Control.Monad
import Data.Foldable
src/Dodge/Data/Door.hs
+6 -2
View File
@@ -29,19 +29,23 @@ data PushSource
data Door = Door
{ _drID :: Int
, _drTrigger :: WdBl
, _drMech :: DrWdWd
, _drUpdate :: DoorUpdate
, _drZeroPos :: (Point2,Float)
, _drOnePos :: (Point2,Float)
, _drLerp :: Float
, _drFootPrint :: IM.IntMap (Point2,Point2)
, _drHP :: Int
, _drSpeed :: Float
, _drPushedBy :: PushSource
, _drPushes :: Maybe Int
, _drMounts :: [MountedObject]
}
data DoorUpdate = DoorDoNothing | DoorLerp {_drLerpSpeed :: Float}
makeLenses ''Door
makeLenses ''DoorUpdate
--deriveJSON defaultOptions ''DoorStatus
deriveJSON defaultOptions ''DoorUpdate
deriveJSON defaultOptions ''PushSource
deriveJSON defaultOptions ''Door
src/Dodge/Data/Wall.hs
-2
View File
@@ -22,13 +22,11 @@ data Wall = Wall
, _wlColor :: Color
, _wlOpacity :: Opacity
, _wlPathFlag :: S.Set WallFlag
, _wlPathable :: Bool
, _wlPenetrable :: Bool
, _wlBouncy :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlUnshadowed :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
src/Dodge/Data/WorldEffect.hs
-3
View File
@@ -60,12 +60,9 @@ data WdP2f
= WdP2f0
| WdP2fDoorPosition Int
data DrWdWd = DrWdId | DoorLerp
deriveJSON defaultOptions ''ItCrWdWd
deriveJSON defaultOptions ''WdWd
deriveJSON defaultOptions ''WdP2
deriveJSON defaultOptions ''MdWdWd
deriveJSON defaultOptions ''WdBl
deriveJSON defaultOptions ''WdP2f
deriveJSON defaultOptions ''DrWdWd
src/Dodge/Default/Door.hs
+1 -4
View File
@@ -16,14 +16,12 @@ defaultAutoWall :: Wall
defaultAutoWall =
defaultDoorWall
& wlColor .~ dim yellow
& wlPathable .~ True
& wlOpacity .~ Opaque 9
defaultSwitchWall :: Wall
defaultSwitchWall =
defaultDoorWall
& wlColor .~ red
& wlPathable .~ False
& wlOpacity .~ Opaque 0
defaultDoor :: Door
@@ -33,7 +31,7 @@ defaultDoor =
-- , _drWallIDs = mempty
-- , _drStatus = DoorClosed
, _drTrigger = WdBlConst False
, _drMech = DrWdId
, _drUpdate = DoorDoNothing
-- , _drPos = (0, 0)
-- , _drOpenPos = (0, 0)
-- , _drClosePos = (0, 0)
@@ -42,7 +40,6 @@ defaultDoor =
, _drLerp = 0
, _drFootPrint = mempty
, _drHP = 10000
, _drSpeed = 1
, _drPushedBy = PushesItself
, _drPushes = Nothing
, _drMounts = mempty
src/Dodge/Default/Wall.hs
+1 -4
View File
@@ -23,13 +23,10 @@ defaultWall =
, _wlColor = greyN 0.6
, _wlPathFlag = S.fromList [WallBlockVisibility
, WallNotAutoOpen, WallNotDestrucable]
, --, _wlOpacity = Opaque 11
_wlOpacity = Opaque 11
, _wlPathable = False
, _wlOpacity = Opaque 11
, _wlPenetrable = False
, _wlFireThrough = False
, _wlTouchThrough = False
, _wlReflect = False
, _wlUnshadowed = True
, _wlRotateTo = True
, _wlStructure = StandaloneWall
src/Dodge/DrWdWd.hs
+4 -5
View File
@@ -20,11 +20,11 @@ import qualified Data.Set as S
updateDoor :: Door -> World -> (S.Set Int2, World)
updateDoor dr w
| dr ^. drHP < 1 = destroyDoor dr w
| DoorLerp <- dr ^. drMech = doorLerp dr w
| DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
| otherwise = (mempty,w)
doorLerp :: Door -> World -> (S.Set Int2,World)
doorLerp dr w = fromMaybe (mempty,w) $ do
doorLerp :: Float -> Door -> World -> (S.Set Int2,World)
doorLerp speed dr w = fromMaybe (mempty,w) $ do
x <- newlerp
let ps = wlposs x
is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
@@ -43,7 +43,6 @@ doorLerp dr w = fromMaybe (mempty,w) $ do
| clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
| otherwise = Nothing
toOpen = doWdBl (_drTrigger dr) w
speed = _drSpeed dr
drid = _drID dr
playSound x
| _drPushedBy dr == PushesItself =
@@ -81,5 +80,5 @@ stopPushing mdrid w = fromMaybe w $ do
drid <- mdrid
dr <- w ^? cWorld . lWorld . doors . ix drid
return $
w & cWorld . lWorld . doors . ix drid . drMech .~ DrWdId
w & cWorld . lWorld . doors . ix drid . drUpdate .~ DoorDoNothing
& stopPushing (_drPushes dr)
src/Dodge/Item/BackgroundEffect.hs
+1 -2
View File
@@ -80,10 +80,9 @@ shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = False
, _wlReflect = True
, _wlMaterial = Metal
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
}
src/Dodge/Item/Weapon/LaserPath.hs
+3 -2
View File
@@ -4,6 +4,7 @@ module Dodge.Item.Weapon.LaserPath (
reflectPulseLaserAlong,
) where
import Control.Lens
import Dodge.Data.Object
import Data.Bifunctor
import Data.Tuple
@@ -22,7 +23,7 @@ reflectLaserAlong ::
{-# INLINE reflectLaserAlong #-}
reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlUnshadowed sp ep w of
Just (p, Right wl)
| _wlReflect wl ->
| Metal <- wl ^. wlMaterial ->
second (p :) $
reflectLaserAlong
phasev
@@ -72,7 +73,7 @@ reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit
where
f = \case
((p, OWall wl) : _)
| _wlReflect wl ->
| Metal <- wl ^. wlMaterial ->
second (p :) $
reflectPulseLaserAlong
phasev
src/Dodge/Path.hs
+1 -1
View File
@@ -15,6 +15,7 @@ module Dodge.Path (
getEdgesCrossing,
) where
import Dodge.WorldEvent.ThingsHit
import qualified Data.Set as S
import qualified Algorithm.Search as AS
import Control.Lens
@@ -29,7 +30,6 @@ import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
import Dodge.Base.Collide
import Dodge.Data.World
import Dodge.Zoning.Base
import Dodge.Zoning.Common
src/Dodge/Placement/Instance/Door.hs
+3 -3
View File
@@ -56,7 +56,7 @@ doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
adoor =
defaultDoor
& drTrigger .~ cond
& drSpeed .~ speed
& drUpdate . drLerpSpeed .~ speed
divideDoorPane ::
Maybe Int ->
@@ -74,7 +74,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
where
adoor (x, y) = PutSlideDr thedoor wl mempty soff x y
thedoor =
defaultDoor & drSpeed .~ speed & drTrigger .~ cond
defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
& drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement
@@ -117,7 +117,7 @@ switchDoor btpos btrot dra drb col = pContID
thedoor =
defaultDoor
& drTrigger .~ WdBlBtOn btid
& drSpeed .~ 2
& drUpdate . drLerpSpeed .~ 2
drc = 0.5 *.* (dra +.+ drb)
--cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+2 -8
View File
@@ -36,18 +36,14 @@ plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cW
IM.insert drid $
defaultDoor
{ _drID = drid
-- , _drWallIDs = IS.fromList wlids
, _drTrigger = cond
, _drMech = DoorLerp
, _drUpdate = DoorLerp 0.01
, _drZeroPos = p1
, _drOnePos = p2
, _drLerp = 0
, _drFootPrint = IM.fromList . zip wlids $ wlps'
, _drSpeed = 0.01
}
-- nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
--wlps' = uncurry (rectanglePairs 9) $ head pss
wlps' = rectanglePairs 9 0 (V2 l 0)
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
@@ -96,13 +92,11 @@ plSlideDoor dr wl eo shiftOffset a b gw =
IM.insert drid $
dr
{ _drID = drid
-- , _drWallIDs = IS.fromList wlids
, _drMech = DoorLerp
, _drUpdate = DoorLerp $ 1 / distance a (shiftLeft a)
, _drZeroPos = (a, 0)
, _drOnePos = (shiftLeft a, 0)
, _drLerp = 0
, _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b-a)
, _drSpeed = 1 / distance a (shiftLeft a)
}
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -73,7 +73,7 @@ twinSlowDoorRoom w h x =
]
thedoor btid =
defaultDoor
& drSpeed .~ wlSpeed
& drUpdate . drLerpSpeed .~ wlSpeed
-- & drTrigger .~ WdBlBtNotOff btid
& drTrigger .~ WdBlBtOn btid
col = dim $ dim $ bright red
src/Dodge/Room/Procedural.hs
+1 -1
View File
@@ -334,4 +334,4 @@ centerVaultRoom w h d =
thedoor btid =
defaultDoor
& drTrigger .~ WdBlBtOn btid
& drSpeed .~ 2
& drUpdate . drLerpSpeed .~ 2
src/Dodge/Wall/ForceField.hs
-2
View File
@@ -9,10 +9,8 @@ forceField =
defaultWall
{ _wlColor = orange
, _wlOpacity = DrawnWall DrawForceField
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = False
, _wlReflect = True
, _wlUnshadowed = True
, _wlRotateTo = False
, _wlStructure = StandaloneWall
src/Dodge/WorldEvent/ThingsHit.hs
+16
View File
@@ -14,8 +14,11 @@ module Dodge.WorldEvent.ThingsHit (
crHit,
crWlPbHit,
wlsHitUnsorted,
isWalkable,
) where
import Data.Monoid
import qualified Data.Set as S
import Linear
import Dodge.Data.Object
import Dodge.Creature.Radius
@@ -155,3 +158,16 @@ crsHitRadial p r = mapMaybe f . crsNearCirc p r
let cp = cr ^. crPos . _xy
guard $ dist p cp < r + crRad (_crType cr)
return (cp + (1 + crRad (_crType cr)) *.* (cp - p), cr)
isFlyable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isFlyable #-}
isFlyable p1 p2 =
not . (WallNotAutoOpen `S.member`)
. foldMap (^. _2 . wlPathFlag)
. wlsHitUnsorted p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 w = isFlyable p1 p2 w && not (getAny $ foldMap f (w ^. cWorld . chasms))
where
f = foldMap (Any . isJust . uncurry (intersectSegSeg p1 p2)) . loopPairs