Cleanup
This commit is contained in:
@@ -1,5 +1,3 @@
|
|||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
|
|
||||||
module Dodge.Block (destroyBlock) where
|
module Dodge.Block (destroyBlock) where
|
||||||
|
|
||||||
import ListHelp
|
import ListHelp
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ doWdCrBl wcb = case wcb of
|
|||||||
False
|
False
|
||||||
(\cid -> canSee (_crID cr) cid w)
|
(\cid -> canSee (_crID cr) cid w)
|
||||||
(_targetCr (_crIntention cr))
|
(_targetCr (_crIntention cr))
|
||||||
WdCrSafeDistFromTarget x -> \w -> crSafeDistFromTarg w x -- currently ignores walls etc
|
WdCrSafeDistFromTarget x -> (`crSafeDistFromTarg` x) -- currently ignores walls etc
|
||||||
|
|
||||||
doCrBl :: CrBl -> Creature -> Bool
|
doCrBl :: CrBl -> Creature -> Bool
|
||||||
doCrBl cb = case cb of
|
doCrBl cb = case cb of
|
||||||
|
|||||||
+2
-2
@@ -28,9 +28,9 @@ doorLerp speed dr w = fromMaybe (mempty,w) $ do
|
|||||||
x <- newlerp
|
x <- newlerp
|
||||||
let ps = wlposs x
|
let ps = wlposs x
|
||||||
is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
|
is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
|
||||||
-- it seems possible that this will miss some paths: we add zones for the
|
-- it seems possible that this will miss some paths: we don't add zones for the
|
||||||
-- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
|
-- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
|
||||||
return $ (is,
|
return (is,
|
||||||
f x
|
f x
|
||||||
& playSound x
|
& playSound x
|
||||||
& cWorld . lWorld . doors . ix drid . drLerp .~ x)
|
& cWorld . lWorld . doors . ix drid . drLerp .~ x)
|
||||||
|
|||||||
@@ -38,14 +38,14 @@ damageStone dm ecw w = case dm of
|
|||||||
. randsound p [slapS, slap1S]
|
. randsound p [slapS, slap1S]
|
||||||
Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
|
Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
|
||||||
Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
|
Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
|
||||||
Crushing{} -> f dmam $ id
|
Crushing{} -> f dmam id
|
||||||
Explosive{} -> f dmam $ id
|
Explosive{} -> f dmam id
|
||||||
Sparking{} -> f 0 $ id
|
Sparking{} -> f 0 id
|
||||||
Flaming{} -> f 0 $ id
|
Flaming{} -> f 0 id
|
||||||
Electrical{} -> f 0 $ id
|
Electrical{} -> f 0 id
|
||||||
Poison{} -> f 0 $ id
|
Poison{} -> f 0 id
|
||||||
Enterrement{} -> f 0 $ id
|
Enterrement{} -> f 0 id
|
||||||
Flashing{} -> f 0 $ id
|
Flashing{} -> f 0 id
|
||||||
where
|
where
|
||||||
f x g = (x, g w)
|
f x g = (x, g w)
|
||||||
dmam = dm ^. dmAmount
|
dmam = dm ^. dmAmount
|
||||||
@@ -69,15 +69,15 @@ damageMetal dm ecw w = case dm of
|
|||||||
Blunt _ p t -> f dmam $
|
Blunt _ p t -> f dmam $
|
||||||
makeSpark NormalSpark (outTo p t) (rdir p t)
|
makeSpark NormalSpark (outTo p t) (rdir p t)
|
||||||
. randsound p [clangS,clang1S,clang2S]
|
. randsound p [clangS,clang1S,clang2S]
|
||||||
Shattering {} -> f dmam $ id
|
Shattering {} -> f dmam id
|
||||||
Crushing{} -> f dmam $ id
|
Crushing{} -> f dmam id
|
||||||
Explosive{} -> f dmam $ id
|
Explosive{} -> f dmam id
|
||||||
Sparking{} -> f 0 $ id
|
Sparking{} -> f 0 id
|
||||||
Flaming{} -> f 0 $ id
|
Flaming{} -> f 0 id
|
||||||
Electrical{} -> f 0 $ id
|
Electrical{} -> f 0 id
|
||||||
Poison{} -> f 0 $ id
|
Poison{} -> f 0 id
|
||||||
Enterrement{} -> f 0 $ id
|
Enterrement{} -> f 0 id
|
||||||
Flashing{} -> f 0 $ id
|
Flashing{} -> f 0 id
|
||||||
where
|
where
|
||||||
f x g = (x, g w)
|
f x g = (x, g w)
|
||||||
dmam = dm ^. dmAmount
|
dmam = dm ^. dmAmount
|
||||||
|
|||||||
+2
-2
@@ -101,11 +101,11 @@ smallSnailInt2 =
|
|||||||
[V2 x y | x <- [-2 .. 2], y <- [-2 .. 2]]
|
[V2 x y | x <- [-2 .. 2], y <- [-2 .. 2]]
|
||||||
|
|
||||||
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
|
||||||
makePathBetweenPs a b w = traverse (flip getNodePos w) =<< makePathBetween a b w
|
makePathBetweenPs a b w = traverse (`getNodePos` w) =<< makePathBetween a b w
|
||||||
|
|
||||||
-- assumes that pathfinding is symmetric
|
-- assumes that pathfinding is symmetric
|
||||||
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
|
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
|
||||||
pointTowardsImpulse a b w = (find $ flip (isWalkable a) w) =<< makePathBetweenPs b a w
|
pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs b a w
|
||||||
|
|
||||||
pairsToIncGraph ::
|
pairsToIncGraph ::
|
||||||
Set.Set (Point2, Point2) ->
|
Set.Set (Point2, Point2) ->
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE LambdaCase #-}
|
--{-# LANGUAGE LambdaCase #-}
|
||||||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||||
|
|
||||||
{- | deals with placement of objects within the world
|
{- | deals with placement of objects within the world
|
||||||
|
|||||||
@@ -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)) ..]
|
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
|
||||||
wlps' = rectanglePairs 9 0 (V2 l 0)
|
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
|
addWalls w' = foldl' (addDoorWall eo drid defaultSwitchWall) w' $ zip wlids
|
||||||
$ wlps' & each . each %~ shiftPointBy p1
|
$ wlps' & each . each %~ shiftPointBy p1
|
||||||
|
|
||||||
addDoorWall :: S.Set EdgeObstacle
|
addDoorWall :: S.Set EdgeObstacle
|
||||||
|
|||||||
+1
-4
@@ -3,8 +3,6 @@
|
|||||||
|
|
||||||
module Dodge.Update (updateUniverse) where
|
module Dodge.Update (updateUniverse) where
|
||||||
|
|
||||||
import Dodge.Zoning.Base
|
|
||||||
--import Dodge.Path
|
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Color
|
import Color
|
||||||
@@ -322,8 +320,7 @@ updateAimPos u =
|
|||||||
-- f x _ = S.map WallObstacle x
|
-- f x _ = S.map WallObstacle x
|
||||||
|
|
||||||
updateDoors :: World -> World
|
updateDoors :: World -> World
|
||||||
updateDoors w = let (is,w') = foldrM updateDoor w (w ^. cWorld . lWorld . doors)
|
updateDoors w = uncurry updateEdgesWall $ foldrM updateDoor w (w ^. cWorld . lWorld . doors)
|
||||||
in updateEdgesWall (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w'
|
|
||||||
|
|
||||||
updateMagnets :: LWorld -> LWorld
|
updateMagnets :: LWorld -> LWorld
|
||||||
updateMagnets lw =
|
updateMagnets lw =
|
||||||
|
|||||||
@@ -1,35 +1,41 @@
|
|||||||
module Dodge.Update.WallDamage (updateWallDamages,updateEdgesWall) where
|
module Dodge.Update.WallDamage (updateWallDamages, updateEdgesWall) where
|
||||||
|
|
||||||
import Dodge.WorldEvent.ThingsHit
|
import Geometry.Data
|
||||||
import Dodge.Path
|
|
||||||
import Dodge.Zoning.Base
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Maybe
|
|
||||||
import Dodge.Data.World
|
|
||||||
import Dodge.Wall.Damage
|
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
|
import Data.Maybe
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
import Dodge.Data.World
|
||||||
|
import Dodge.Path
|
||||||
|
import Dodge.Wall.Damage
|
||||||
|
import Dodge.WorldEvent.ThingsHit
|
||||||
|
import Dodge.Zoning.Base
|
||||||
|
import qualified IntMapHelp as IM
|
||||||
|
|
||||||
updateWallDamages :: World -> World
|
updateWallDamages :: World -> World
|
||||||
updateWallDamages w =
|
updateWallDamages w =
|
||||||
let (is,w')
|
let (is, w') =
|
||||||
= IM.foldlWithKey' f (mempty,w) (w ^. cWorld . lWorld . wallDamages)
|
IM.foldlWithKey' f (mempty, w) (w ^. cWorld . lWorld . wallDamages)
|
||||||
in updateEdgesWall (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w'
|
in updateEdgesWall is
|
||||||
|
w'
|
||||||
& cWorld . lWorld . wallDamages .~ IM.empty
|
& cWorld . lWorld . wallDamages .~ IM.empty
|
||||||
where
|
where
|
||||||
f isw k dams = fromMaybe isw $ do
|
f isw k dams = fromMaybe isw $ do
|
||||||
wl <- isw ^? _2 . cWorld . lWorld . walls . ix k
|
wl <- isw ^? _2 . cWorld . lWorld . walls . ix k
|
||||||
return $ foldl' (flip (`damageWall` wl)) isw dams
|
return $ foldl' (flip (`damageWall` wl)) isw dams
|
||||||
|
|
||||||
updateEdgesWall :: S.Set (Int,Int) -> World -> World
|
updateEdgesWall :: S.Set Int2 -> World -> World
|
||||||
updateEdgesWall = flip $ foldl' updateEdgeWallObs
|
updateEdgesWall is w = updateEdgesWall'
|
||||||
|
(zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w
|
||||||
|
|
||||||
updateEdgeWallObs :: World -> (Int,Int) -> World
|
updateEdgesWall' :: S.Set (Int, Int) -> World -> World
|
||||||
updateEdgeWallObs w (i,j) = fromMaybe w $ do
|
updateEdgesWall' = flip $ foldl' updateEdgeWallObs
|
||||||
|
|
||||||
|
updateEdgeWallObs :: World -> (Int, Int) -> World
|
||||||
|
updateEdgeWallObs w (i, j) = fromMaybe w $ do
|
||||||
s <- getNodePos i w
|
s <- getNodePos i w
|
||||||
e <- getNodePos j w
|
e <- getNodePos j w
|
||||||
let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w
|
let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w
|
||||||
return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j)
|
return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i, j)
|
||||||
where
|
where
|
||||||
f x _ = S.map WallObstacle x
|
f x _ = S.map WallObstacle x
|
||||||
|
|||||||
@@ -20,7 +20,7 @@ damageWall dt wl (is,w) = case _wlStructure wl of
|
|||||||
DoorPart drid ->
|
DoorPart drid ->
|
||||||
f $ w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
|
f $ w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
|
||||||
-- & maybeDestroyDoor drid
|
-- & maybeDestroyDoor drid
|
||||||
_ -> f $ w'
|
_ -> f w'
|
||||||
where
|
where
|
||||||
f = (,) is
|
f = (,) is
|
||||||
-- x = case dt of
|
-- x = case dt of
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
--{-# LANGUAGE BangPatterns #-}
|
||||||
|
|
||||||
module Dodge.Wall.Move (
|
module Dodge.Wall.Move (
|
||||||
moveWallID,
|
moveWallID,
|
||||||
|
|||||||
Reference in New Issue
Block a user