Refactor, try to limit dependencies

This commit is contained in:
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
+7 -7
View File
@@ -1,16 +1,16 @@
module Dodge.Wall.Create
where
import Dodge.Data
import Dodge.Wall.Zone
module Dodge.Wall.Create where
import Control.Lens
import Dodge.Data.World
import Dodge.Wall.Zone
import qualified IntMapHelp as IM
createWall :: Wall -> World -> (Int,World)
createWall wl w = (wlid
createWall :: Wall -> World -> (Int, World)
createWall wl w =
( wlid
, w & cWorld . walls %~ IM.insert wlid newwl
& insertWallInZones newwl
)
where
newwl = wl {_wlID = wlid}
newwl = wl{_wlID = wlid}
wlid = IM.newKey $ _walls (_cWorld w)
+22 -17
View File
@@ -1,37 +1,42 @@
{- | Controls a walls response to external damage.
- Indestructible walls may still produce sparks, dust etc
-}
module Dodge.Wall.Damage
( damageBlocksBy
, damageWall
) where
import Dodge.Data
-}
module Dodge.Wall.Damage (
damageBlocksBy,
damageWall,
) where
import Dodge.Block
import LensHelp
import Dodge.Data.World
import Dodge.Wall.DamageEffect
import LensHelp
damageWall :: Damage -> Wall -> World -> World
damageWall dt wl w = case _wlStructure wl of
MachinePart mcid -> fst . defaultWallDamage dt wl $ w
& cWorld . machines . ix mcid . mcDamage .:~ dt
BlockPart blid -> let (w',x) = defaultWallDamage dt wl w
in w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
DoorPart drid -> let (w',x) = defaultWallDamage dt wl w
in w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid
_ -> fst $ defaultWallDamage dt wl w
MachinePart mcid ->
fst . defaultWallDamage dt wl $
w
& cWorld . machines . ix mcid . mcDamage .:~ dt
BlockPart blid ->
let (w', x) = defaultWallDamage dt wl w
in w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
DoorPart drid ->
let (w', x) = defaultWallDamage dt wl w
in w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid
_ -> fst $ defaultWallDamage dt wl w
-- block destruction is convoluted...
maybeDestroyBlock :: Int -> World -> World
maybeDestroyBlock blid w = case w ^? cWorld . blocks . ix blid of
Just bl | _blHP bl < 1 -> destroyBlock bl w
Just bl | _blHP bl < 1 -> destroyBlock bl w
_ -> w
maybeDestroyDoor :: Int -> World -> World
maybeDestroyDoor drid w = case w ^? cWorld . doors . ix drid of
Just dr | _drHP dr < 1 -> destroyDoor dr w
Just dr | _drHP dr < 1 -> destroyDoor dr w
_ -> w
damageBlocksBy :: Int -> Wall -> World -> World
damageBlocksBy x wl = case wl ^? wlStructure . wsBlock of
Just blid -> cWorld . blocks . ix blid . blHP -~ x
Nothing -> id
Nothing -> id
+79 -77
View File
@@ -1,42 +1,43 @@
module Dodge.Wall.DamageEffect where
import Dodge.Data
import Dodge.Spark
import Dodge.Base.Wall
import Dodge.Wall.Dust
import Dodge.Block
import Dodge.Data.World
import Dodge.Spark
import Dodge.Wall.Dust
import Geometry
import LensHelp
defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
defaultWallDamage :: Damage -> Wall -> World -> (World, Int)
defaultWallDamage dm wl = case _wlMaterial wl of
Stone -> stoneWallDamage dm wl
Glass -> windowWallDamage dm wl
Dirt -> dirtWallDamage dm wl
Stone -> stoneWallDamage dm wl
Glass -> windowWallDamage dm wl
Dirt -> dirtWallDamage dm wl
Crystal -> crystalWallDamage dm wl
Metal -> stoneWallDamage dm wl
Wood -> stoneWallDamage dm wl
Metal -> stoneWallDamage dm wl
Wood -> stoneWallDamage dm wl
Electronics -> stoneWallDamage dm wl
Flesh -> stoneWallDamage dm wl
stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
stoneWallDamage :: Damage -> Wall -> World -> (World, Int)
stoneWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d id
EXPLOSIVE -> a d id
CUTTING -> a d id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a d id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d id
EXPLOSIVE -> a d id
CUTTING -> a d id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a d id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
a x f w = (f w,x)
a x f w = (f w, x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
@@ -44,31 +45,32 @@ stoneWallDamage dm wl = case _dmType dm of
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
windowWallDamage :: Damage -> Wall -> World -> (World,Int)
windowWallDamage dm wl w = w & case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ dosplint . wlDustAt wl outTo
SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
CRUSHING -> a d dosplint
EXPLOSIVE -> a d dosplint
CUTTING -> a d dosplint
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 dosplint
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
windowWallDamage :: Damage -> Wall -> World -> (World, Int)
windowWallDamage dm wl w =
w & case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ dosplint . wlDustAt wl outTo
SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
CRUSHING -> a d dosplint
EXPLOSIVE -> a d dosplint
CUTTING -> a d dosplint
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 dosplint
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
mbl = do
mbl = do
blid <- wl ^? wlStructure . wsBlock
w ^? cWorld . blocks . ix blid
d :: Int
d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
a :: Int -> (World -> World) -> World -> (World,Int)
a x f w' = (f w',x)
a :: Int -> (World -> World) -> World -> (World, Int)
a x f w' = (f w', x)
dosplint = maybe id splinterBlock mbl
sp = _dmFrom dm
p = _dmAt dm
@@ -76,25 +78,25 @@ windowWallDamage dm wl w = w & case _dmType dm of
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
crystalWallDamage :: Damage -> Wall -> World -> (World,Int)
crystalWallDamage :: Damage -> Wall -> World -> (World, Int)
crystalWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a 0 $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a 0 id
EXPLOSIVE -> a 0 id
CUTTING -> a 0 id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a 0 $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a 0 id
EXPLOSIVE -> a 0 id
CUTTING -> a 0 id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
a x f w = (f w,x)
a x f w = (f w, x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
@@ -102,25 +104,25 @@ crystalWallDamage dm wl = case _dmType dm of
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
dirtWallDamage :: Damage -> Wall -> World -> (World,Int)
dirtWallDamage :: Damage -> Wall -> World -> (World, Int)
dirtWallDamage dm wl = case _dmType dm of
LASERING -> a d $ wlDustAt wl outTo
PIERCING -> a d $ wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d $ wlDustAt wl outTo
EXPLOSIVE -> a d $ muchWlDustAt wl outTo
CUTTING -> a d $ muchWlDustAt wl outTo
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a d id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
LASERING -> a d $ wlDustAt wl outTo
PIERCING -> a d $ wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d $ wlDustAt wl outTo
EXPLOSIVE -> a d $ muchWlDustAt wl outTo
CUTTING -> a d $ muchWlDustAt wl outTo
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a d id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
a x f w = (f w,x)
a x f w = (f w, x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
+13 -11
View File
@@ -1,23 +1,25 @@
module Dodge.Wall.Delete
( deleteWallIDs
, deleteWallID
) where
import Dodge.Data
import Dodge.Wall.Zone
module Dodge.Wall.Delete (
deleteWallIDs,
deleteWallID,
) where
import Control.Lens
import qualified IntMapHelp as IM
import qualified Data.IntSet as IS
import Dodge.Data.World
import Dodge.Wall.Zone
import qualified IntMapHelp as IM
deleteWallID :: Int -> World -> World
deleteWallID i w = w & cWorld . walls %~ IM.delete i
& deleteWallFromZones wl
deleteWallID i w =
w & cWorld . walls %~ IM.delete i
& deleteWallFromZones wl
where
wl = _walls (_cWorld w) IM.! i
deleteWall :: Wall -> World -> World
deleteWall wl = (cWorld . walls %~ IM.delete i)
. deleteWallFromZones wl
deleteWall wl =
(cWorld . walls %~ IM.delete i)
. deleteWallFromZones wl
where
i = _wlID wl
+6 -4
View File
@@ -1,18 +1,20 @@
module Dodge.Wall.Draw where
import Dodge.Data.Wall
import ShapePicture
import Picture.Base
import ShapePicture
drawWall :: WallDraw -> Wall -> SPic
drawWall wd = case wd of
DrawForceField -> drawForceField
drawForceField :: Wall -> SPic
drawForceField wl = (mempty
drawForceField wl =
( mempty
, setLayer BloomLayer
. setDepth 20
. color (_wlColor wl)
$ thickLine 5 [a,b]
$ thickLine 5 [a, b]
)
where
(a,b) = _wlLine wl
(a, b) = _wlLine wl
+9 -8
View File
@@ -1,8 +1,9 @@
module Dodge.Wall.Dust where
import Dodge.Data
import Control.Lens
import Dodge.Data.World
import Dodge.WorldEvent.Cloud
import Geometry
import Control.Lens
import RandomHelp
wlDustAt :: Wall -> Point2 -> World -> World
@@ -11,12 +12,12 @@ wlDustAt wl = smokeCloudAt dustcol 20 200 1 . addZ 20
dustcol = _wlColor wl & _4 .~ 1
muchWlDustAt :: Wall -> Point2 -> World -> World
muchWlDustAt wl p = flip (foldr f) [10,20..100]
muchWlDustAt wl p = flip (foldr f) [10, 20 .. 100]
where
f h w = w
& smokeCloudAt dustcol 20 200 1 (addZ h (p +.+ off))
& randGen .~ g
f h w =
w
& smokeCloudAt dustcol 20 200 1 (addZ h (p +.+ off))
& randGen .~ g
where
(off,g) = runState (randInCirc 1) (_randGen w)
(off, g) = runState (randInCirc 1) (_randGen w)
dustcol = _wlColor wl & _4 .~ 1
+15 -14
View File
@@ -1,18 +1,19 @@
module Dodge.Wall.ForceField where
import Dodge.Data
import Dodge.Default.Wall
import Color
import Dodge.Data.Wall
import Dodge.Default.Wall
forceField :: Wall
forceField = defaultWall
{_wlColor = orange
,_wlOpacity = DrawnWall DrawForceField
,_wlPathable = True
,_wlWalkable = True
,_wlFireThrough = True
,_wlReflect = True
,_wlUnshadowed = True
,_wlRotateTo = False
,_wlStructure = StandaloneWall
}
forceField =
defaultWall
{ _wlColor = orange
, _wlOpacity = DrawnWall DrawForceField
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = True
, _wlReflect = True
, _wlUnshadowed = True
, _wlRotateTo = False
, _wlStructure = StandaloneWall
}
+31 -27
View File
@@ -1,47 +1,51 @@
{-# LANGUAGE BangPatterns #-}
module Dodge.Wall.Move
( moveWallID
, moveWallIDUnsafe
, moveWall
, moveWallIDToward
, translateWallID
, mvPs
) where
import Dodge.Data
import Dodge.Base
import Geometry
import Dodge.Wall.Zone
import Data.Maybe
module Dodge.Wall.Move (
moveWallID,
moveWallIDUnsafe,
moveWall,
moveWallIDToward,
translateWallID,
mvPs,
) where
import Control.Lens
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.Wall.Zone
import Geometry
import qualified IntMapHelp as IM
moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World
moveWallIDUnsafe :: Int -> (Point2, Point2) -> World -> World
moveWallIDUnsafe wlid wlline w = case w ^? cWorld . walls . ix wlid of
Nothing -> error "tried moving nonexistant wall"
Just wl -> moveWall wlid wl wlline w
moveWallID :: Int -> (Point2,Point2) -> World -> World
moveWallID :: Int -> (Point2, Point2) -> World -> World
moveWallID wlid wlline w = case w ^? cWorld . walls . ix wlid of
Nothing -> w
Just wl -> moveWall wlid wl wlline w
moveWall :: Int -> Wall -> (Point2,Point2) -> World -> World
moveWall wlid wl wlline w = w & cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones wl
& insertWallInZones newwl
moveWall :: Int -> Wall -> (Point2, Point2) -> World -> World
moveWall wlid wl wlline w =
w & cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones wl
& insertWallInZones newwl
where
newwl = wl {_wlLine = wlline}
newwl = wl{_wlLine = wlline}
translateWallID :: Int -> Point2 -> World -> World
translateWallID wlid p w = fromMaybe w $ do
oldwl <- w ^? cWorld . walls . ix wlid
let newwl = oldwl & wlLine . each +~ p
return $ w
& cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones oldwl
& insertWallInZones newwl
return $
w
& cWorld . walls . ix wlid .~ newwl
& deleteWallFromZones oldwl
& insertWallInZones newwl
moveWallIDToward :: Int -> Float -> (Point2,Point2) -> World -> World
moveWallIDToward :: Int -> Float -> (Point2, Point2) -> World -> World
moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w
where
wl = _walls (_cWorld w) IM.! wlid
@@ -51,6 +55,6 @@ mvP :: Float -> Point2 -> Point2 -> Point2
{-# INLINE mvP #-}
mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p
mvPs :: Float -> (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2)
mvPs :: Float -> (Point2, Point2) -> (Point2, Point2) -> (Point2, Point2)
{-# INLINE mvPs #-}
mvPs !speed (!ex,!ey) (!sx,!sy) = (mvP speed ex sx,mvP speed ey sy)
mvPs !speed (!ex, !ey) (!sx, !sy) = (mvP speed ex sx, mvP speed ey sy)
+4 -5
View File
@@ -1,10 +1,8 @@
module Dodge.Wall.Zone
where
import Dodge.Zoning.Wall
import Dodge.Data
module Dodge.Wall.Zone where
--import qualified Data.IntSet as IS
import Control.Lens
import Dodge.Data.World
import Dodge.Zoning.Wall
-- need to verify that this not only inserts but also overwrites (updates) any
-- already existing walls
@@ -19,4 +17,5 @@ insertWallInZones wl = cWorld . wlZoning %~ zoneWall wl
deleteWallFromZones :: Wall -> World -> World
deleteWallFromZones wl = cWorld . wlZoning %~ deZoneWall wl
-- %~ flip (foldl' (flip $ \(a,b) updateeIMInZone a b (_wlID wl))) (zoneOfWall wl)