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

Cleanup, remove records, stop unecessary Aeson compile

Browse Source
This commit is contained in:
justin
2025-06-06 20:43:49 +01:00
parent d3de40d432
commit d2d4642380
22 changed files with 311 additions and 340 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
+16 -6
View File
@@ -24,6 +24,14 @@ updateBullet w bu
-- have to be slightly carefull not to accelerate bullets using magnets
| otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w
buDamages :: Bullet -> [Damage]
buDamages bu = case _buPayload bu of
BulBall {} -> []
BulPlain x -> [Damage PIERCING x 0 0 0 $ PushBackDamage 2]
BulFlak -> []
BulFrag -> []
BulGas -> []
-- do we want this to drain energy from the deflection source?
applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld
@@ -110,7 +118,7 @@ bounceDir _ = Nothing
useBulletPayload :: Bullet -> Point2 -> World -> World
useBulletPayload bu = case _buPayload bu of
BulSpark -> const id
BulPlain _ -> const id
BulFlak -> makeFlak bu
BulFrag -> makeFragBullets
BulGas -> (`makeGasCloud` V2 0 0)
@@ -126,12 +134,14 @@ makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
as = randomRs (0, 2 * pi) $ _randGen w
ss = randomRs (5, 15) $ _randGen w
f a s =
defaultBullet & buVel .~ s *.* unitVectorAtAngle a
defaultBullet
& buPayload .~ BulPlain 5
& buVel .~ s *.* unitVectorAtAngle a
& buDrag .~ 0.8
& buPos .~ p
& buOldPos .~ p
& buWidth .~ 1
& buDamages .~ [Damage PIERCING 5 0 0 0 $ PushBackDamage 2]
-- & buDamages .~ [Damage PIERCING 5 0 0 0 $ PushBackDamage 2]
makeFlak :: Bullet -> Point2 -> World -> World
makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
@@ -139,9 +149,9 @@ makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
s = min 10 (0.5 * magV (_buVel bu))
xs = take 5 $ randomRs (- s, s) $ _randGen w
f x = bu & buVel %~ g x
& buPayload .~ BulSpark
& buPayload .~ BulPlain 25
& buWidth .~ 0.5
& buDamages .~ [Damage PIERCING 25 0 0 0 $ PushBackDamage 2]
-- & buDamages .~ [Damage PIERCING 25 0 0 0 $ PushBackDamage 2]
g x v = v +.+ x *.* normalizeV (vNormal v)
hitEffFromBul :: World -> Bullet -> (World, Bullet)
@@ -162,7 +172,7 @@ hitEffFromBul w bu = case _buEffect bu of
hitstream = thingsHit sp (sp + _buVel bu) w
setFromToDams :: Bullet -> Point2 -> [Damage]
setFromToDams bu p = map f (_buDamages bu)
setFromToDams bu p = map f (buDamages bu)
where
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
src/Dodge/Combine.hs
+3 -2
View File
@@ -3,6 +3,7 @@ module Dodge.Combine (
combineList,
) where
import Dodge.Data.CombAmount
import Dodge.Item.InvSize
import Dodge.Item.Grammar
import Data.Bifunctor
@@ -40,7 +41,7 @@ flatLookupItems =
flip multiLookupTrieI combinationsTrie . sortOn fst . groupSplitItemAmounts
. invertInventoryToMap
combinationsTrie :: Trie (ItAmount, ItemType) Item
combinationsTrie :: Trie (CombAmount, ItemType) Item
{-# INLINE combinationsTrie #-}
combinationsTrie =
foldl'
@@ -48,7 +49,7 @@ combinationsTrie =
emptyTrie
itemCombinations
groupSplitItemAmounts :: M.Map ItemType [Int] -> [((ItAmount, ItemType), [Int])]
groupSplitItemAmounts :: M.Map ItemType [Int] -> [((CombAmount, ItemType), [Int])]
groupSplitItemAmounts = M.foldMapWithKey f
where
f ibt is = [((fromIntegral i, ibt), take i is) | i <- [1 .. length is]]
src/Dodge/Combine/Combinations.hs
+6 -5
View File
@@ -6,13 +6,14 @@ module Dodge.Combine.Combinations
, bulletWeapons
) where
import Dodge.Data.CombAmount
import Dodge.Data.Magnet
import Dodge.Item.Ammo
import Dodge.Data.Item
import Dodge.Item
import LensHelp
watchCombinations :: [([(ItAmount, ItemType)], Item)]
watchCombinations :: [([(CombAmount, ItemType)], Item)]
watchCombinations =
[]
-- [ po [HELD TIMESTOPPER, HELD REWINDER] timeScroller
@@ -23,7 +24,7 @@ watchCombinations =
-- po xs it = (map o xs, it)
-- o = (1,)
backpackCombinations :: [([(ItAmount,ItemType)],Item)]
backpackCombinations :: [([(CombAmount,ItemType)],Item)]
backpackCombinations =
[ po [CRAFT HOSE, CRAFT STEELDRUM] fuelPack
]
@@ -39,7 +40,7 @@ backpackCombinations =
-- po xs it = (map o xs, it)
-- o = (1,)
magazineCombinations :: [([(ItAmount,ItemType)],Item)]
magazineCombinations :: [([(CombAmount,ItemType)],Item)]
magazineCombinations =
[ po [CRAFT TIN, CRAFT SPRING] tinMag
]
@@ -50,9 +51,9 @@ magazineCombinations =
flatItemCombinations :: [([ItemType], Item)]
flatItemCombinations = map (over _1 (concatMap f)) itemCombinations
where
f (x,it) = replicate (_getItAmount x) it
f (x,it) = replicate (_getCombAmount x) it
itemCombinations :: [([(ItAmount, ItemType)], Item)]
itemCombinations :: [([(CombAmount, ItemType)], Item)]
itemCombinations =
watchCombinations ++
backpackCombinations ++
src/Dodge/Combine/Graph.hs
+3 -2
View File
@@ -4,6 +4,7 @@ module Dodge.Combine.Graph
( combinationsDotGraph
) where
import Dodge.Data.CombAmount
import Data.Bifunctor
import qualified Data.Graph.Inductive as FGL
import Data.GraphViz.Attributes.Complete
@@ -21,7 +22,7 @@ data CombClust
| JoinClust
deriving (Eq, Ord, Show, Enum, Bounded)
newtype CombNode = CombNode {_unCombNode :: Either ItemType [(ItAmount, ItemType)]}
newtype CombNode = CombNode {_unCombNode :: Either ItemType [(CombAmount, ItemType)]}
deriving (Eq, Ord, Show)
instance Labellable CombNode where
@@ -68,7 +69,7 @@ itemCombinationsEdges = concatMap (f . over _2 _itType) itemCombinations
| otherwise = (CombNode $ Right abts, CombNode $ Left bt, 0) : map g abts
where
bts = map snd abts
g (am, bt') = (CombNode $ Left bt', CombNode $ Right abts, _getItAmount am)
g (am, bt') = (CombNode $ Left bt', CombNode $ Right abts, _getCombAmount am)
combinationsGraph :: FGL.Gr CombNode CombEdge
combinationsGraph =
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -101,7 +101,7 @@ checkDeath cr w
removecr
| _crID cr == 0 =
-- (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
(cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0)
cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
src/Dodge/Data/AmmoType.hs
+1 -1
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.AmmoType where
src/Dodge/Data/Bullet.hs
+2 -2
View File
@@ -23,7 +23,7 @@ data Bullet = Bullet
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buDamages :: [Damage]
-- , _buDamages :: [Damage]
}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
@@ -42,7 +42,7 @@ data BulletEffect
data BulletPayload
= BulBall {_spawnEBT :: EnergyBallType}
| BulSpark
| BulPlain {_sparkDam :: Int}
| BulFlak
| BulFrag
| BulGas
src/Dodge/Data/CombAmount.hs
+16
View File
@@ -0,0 +1,16 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CombAmount where
import Control.Lens
newtype CombAmount = CombAmount {_getCombAmount :: Int}
deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
makeLenses ''CombAmount
src/Dodge/Data/Creature.hs
+2
View File
@@ -14,8 +14,10 @@ module Dodge.Data.Creature (
module Dodge.Data.ActionPlan,
module Dodge.Data.Item,
module Dodge.Data.Material,
module Dodge.Data.Item.Use.Consumption.LoadAction,
) where
import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Aeson
src/Dodge/Data/Creature/State.hs
-8
View File
@@ -16,16 +16,9 @@ import Geometry.Data
data CreatureState = CrSt
{ _csDamage :: [Damage]
, _csSpState :: CrSpState
-- , _csDropsOnDeath :: CreatureDropType
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CreatureDropType
= DropAll
| DropAmount Int
| DropSpecific [Int]
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrSpState
= Barrel {_piercedPoints :: [Point2]}
| GenCr
@@ -55,7 +48,6 @@ data CrGroup
makeLenses ''CreatureState
makeLenses ''CrSpState
makeLenses ''CrGroup
deriveJSON defaultOptions ''CreatureDropType
deriveJSON defaultOptions ''CrSpState
deriveJSON defaultOptions ''Faction
deriveJSON defaultOptions ''CrGroup
src/Dodge/Data/Item.hs
+8 -8
View File
@@ -29,12 +29,12 @@ import NewInt
data ItID = ItID
deriving (Eq, Ord, Show, Read)
data Consumables
= NoConsumables
| AmmoMag
{ _magLoadStatus :: ReloadStatus
}
deriving (Eq, Show, Read)
--data Consumables
-- = NoConsumables
-- | AmmoMag
-- { _magLoadStatus :: ReloadStatus
-- }
-- deriving (Eq, Show, Read)
data Item = Item
{ _itUse :: ItemUse
@@ -61,11 +61,11 @@ data ItemTargeting = NoItTargeting
}
makeLenses ''ItemTargeting
makeLenses ''Consumables
--makeLenses ''Consumables
makeLenses ''Item
makeLenses ''ItemScroll
deriveJSON defaultOptions ''ItemScroll
deriveJSON defaultOptions ''Consumables
--deriveJSON defaultOptions ''Consumables
deriveJSON defaultOptions ''ItemTargeting
deriveJSON defaultOptions ''ItID
deriveJSON defaultOptions ''Item
src/Dodge/Data/Item/Use.hs
+7 -4
View File
@@ -5,24 +5,27 @@
module Dodge.Data.Item.Use (
module Dodge.Data.Item.Use,
module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Item.Targeting,
module Dodge.Data.GenFloat,
module Dodge.Data.Item.Scope,
module Dodge.Data.Item.BulletMod,
module Dodge.Data.Payload
module Dodge.Data.Payload,
module Dodge.Data.Bullet,
module Dodge.Data.Item.Use.Consumption.Ammo,
) where
import Dodge.Data.Payload
import Dodge.Data.Item.Use.Consumption.Ammo
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Set as S
import Dodge.Data.Bullet
import Dodge.Data.GenFloat
import Dodge.Data.Item.BulletMod
import Dodge.Data.Item.Scope
import Dodge.Data.Item.Targeting
import Dodge.Data.Item.Use.Consumption
import Dodge.Data.Payload
--import Dodge.Data.Item.Use.Consumption
import Geometry.Data
data ItemUse
src/Dodge/Data/Item/Use/Consumption.hs
-50
View File
@@ -1,50 +0,0 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Consumption (
module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Item.Use.Consumption.Ammo,
module Dodge.Data.Item.Use.Consumption.LoadAction,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.Item.Use.Consumption.LoadAction
data ReloadStatus = ReloadStatus
{ _iaLoaded :: Int
}
deriving (Eq, Show, Read) --Generic, Flat)
data LeftConsumption
= AutoRecharging
{ _arLoaded :: Int
, _arMax :: Int
, _arTime :: Int
, _arProgress :: Int
}
| ChargeableAmmo
{ _wpMaxCharge :: Int
, _wpCharge :: Int
}
deriving (Eq, Show, Read) --Generic, Flat)
newtype ItAmount = ItAmount {_getItAmount :: Int}
-- deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
-- deriving stock (Generic)
-- deriving anyclass (Flat)
makeLenses ''LeftConsumption
makeLenses ''ItAmount
makeLenses ''ReloadStatus
deriveJSON defaultOptions ''ReloadStatus
deriveJSON defaultOptions ''LeftConsumption
deriveJSON defaultOptions ''ItAmount
src/Dodge/Data/LWorld.hs
+2 -4
View File
@@ -104,8 +104,7 @@ data LWorld = LWorld
, _gusts :: IM.IntMap Gust
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Projectile
, -- , _instantBullets :: [Bullet]
_bullets :: [Bullet]
, _bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
@@ -117,8 +116,7 @@ data LWorld = LWorld
, _arcNode :: M.Map ArcNodeType Int
, _shockwaves :: [Shockwave]
, _lasers :: [Laser]
, -- , _lasersToDraw :: [Laser]
_linearShockwaves :: IM.IntMap LinearShockwave
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _walls :: IM.IntMap Wall
, _wallDamages :: IM.IntMap [Damage]
src/Dodge/Data/LightSource.hs
+3 -3
View File
@@ -14,9 +14,9 @@ data LightSourceDraw = DefaultLightSourceDraw
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LSParam = LSParam -- LSPosRadCol
{ _lsPos :: !Point3
, _lsRad :: !Float
, _lsCol :: !Point3
{ _lsPos :: Point3
, _lsRad :: Float
, _lsCol :: Point3
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Equipment.hs
+2 -2
View File
@@ -19,7 +19,7 @@ import qualified IntMapHelp as IM
effectOnRemove :: Item -> Creature -> World -> World
effectOnRemove itm = case itm ^. itType of
EQUIP WRISTARMOUR -> onRemoveWristShield itm
_ -> \_ -> id
_ -> const id
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
@@ -32,7 +32,7 @@ onRemoveWristShield itm _ =
effectOnEquip :: Item -> Creature -> World -> World
effectOnEquip itm = case itm ^. itType of
EQUIP WRISTARMOUR -> onEquipWristShield itm
_ -> \_ -> id
_ -> const id
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
src/Dodge/HeldUse.hs
+1 -1
View File
@@ -891,7 +891,7 @@ getBulletType magtree =
-- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
-- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
-- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
bpayload = fromMaybe BulSpark $ do
bpayload = fromMaybe (BulPlain 100) $ do
attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft)
attree ^? ldtValue . itUse . ubMod . bmPayload
beffect = fromMaybe DestroyBullet $ do
src/Dodge/Humanoid.hs
+1 -1
View File
@@ -171,7 +171,7 @@ updateHumanoid cr = case cr ^?! crType of
-- ]
-- cr
-- InanimateAI -> id
where
-- where
-- drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
-- reloadActions =
-- [ holsterWeapon
src/Dodge/Item/Weapon/Bullet.hs
+6 -6
View File
@@ -11,19 +11,19 @@ defaultBullet :: Bullet
defaultBullet =
Bullet
{ _buEffect = DestroyBullet
, _buPayload = BulSpark
, _buPayload = BulPlain 100
, _buVel = V2 50 0
, _buDrag = 1
, _buPos = 0
, _buOldPos = 0
, _buWidth = 2
, _buDamages = basicBulDams
-- , _buDamages = basicBulDams
}
basicBulDams :: [Damage]
basicBulDams =
[ Damage PIERCING 100 0 0 0 $ PushBackDamage 2
]
--basicBulDams :: [Damage]
--basicBulDams =
-- [ Damage PIERCING 100 0 0 0 $ PushBackDamage 2
-- ]
--hvBulletAmmo :: Bullet
--hvBulletAmmo =
src/Dodge/Payload.hs
+2 -1
View File
@@ -35,10 +35,11 @@ makeShrapnelAt p v w =
drags = replicateM 75 (state $ randomR (0.85,0.9)) & evalState $ _randGen w
buls = zipWith f vs drags
f v' drag = defaultBullet
& buPayload .~ BulPlain 10
& buEffect .~ BounceBullet
& buVel .~ v + v'
& buDrag .~ drag
& buPos .~ (p - v)
& buOldPos .~ (p - v)
& buDamages .~ [Damage PIERCING 10 0 0 0 $ PushBackDamage 2]
-- & buDamages .~ [Damage PIERCING 10 0 0 0 $ PushBackDamage 2]
& buWidth .~ 1
src/Dodge/Spark.hs
+4 -3
View File
@@ -22,21 +22,22 @@ updateSpark w sk
| otherwise = case thingHit sp ep w of
Nothing -> (w, Just $ sk & skPos .~ ep & skVel .*.*~ 0.9 & skOldPos .~ sp)
Just (hp, hthing) ->
( sparkDam sk sp ep (hp, hthing) w
--( sparkDam sk sp ep (hp, hthing) w
( sparkDam' sk sp ep (hp, hthing) w
, Just $ sk & skPos .~ hp & skOldPos .~ sp & skVel .~ 0
)
where
sp = _skPos sk
ep = sp +.+ _skVel sk
sparkDam ::
sparkDam' ::
Spark ->
Point2 ->
Point2 ->
(Point2, Either Creature Wall) ->
World ->
World
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
sparkDam' sk sp ep mayEiCrWl = case mayEiCrWl of
(hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl
where
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
tags
+225 -230
View File
File diff suppressed because it is too large Load Diff