Cleanup

2024-10-01 01:50:15 +01:00
parent 5091709f70
commit dc44d20baf
8 changed files with 268 additions and 344 deletions
@@ -1 +1 @@
-All good (605 modules, at 01:43:48)
+All good (605 modules, at 01:50:02)
@@ -38,7 +38,7 @@ itemUseEffect cr it w = case it ^. ldtValue . itUse of
            & pointerToItem itm . itUse . heldHammer .~ HammerDown
    UseHotkey{} -> doequipmentchange
    EquipUse{} -> doequipmentchange
-    (ConsumeUse eff) -> useC eff (_ldtValue it) cr w
+    (UseConsume eff) -> useC eff (_ldtValue it) cr w
    CraftUse{} -> w
    AttachUse{} -> selectUse it cr  w
    TargetingUse {} -> w
@@ -104,7 +104,7 @@ useItemLeftClick cr w = fromMaybe w $ do
    ituse <- cr ^? crInv . ix invid . itUse
    case ituse of
        UseHeld{} -> return w
-        ConsumeUse{} -> return $ useItemLeftClick' cr w
+        UseConsume{} -> return $ useItemLeftClick' cr w
        EquipUse{} -> return $ useItemLeftClick' cr w
        UseHotkey{} -> return $ useItemLeftClick' cr w
        UseAmmoMag{} -> return w
@@ -49,28 +49,20 @@ data ItemUse
        , _equipEffect :: EquipEffect
        , _leftConsumption :: LeftConsumption
        }
-    | ConsumeUse
-        { _cUse :: Cuse
-        --        , _useAmount :: ItAmount
-        }
+    | UseConsume { _cUse :: Cuse }
    | EquipUse
        { _equipEffect :: EquipEffect
        , _equipTargeting :: Maybe TargetingType
        }
    | CraftUse
-    | --        {_useAmount :: ItAmount}
-      AttachUse
+    | AttachUse
        {_atLinkedProjectile :: Maybe Int}
-    | --        {_attachParams :: AttachParams}
-      UseAmmoMag
+    | UseAmmoMag
        { _amagLoadStatus :: ReloadStatus
        , _amagParams :: AmmoParams
        , _amagType :: AmmoType
        }
-    | ScopeUse
-        { -- | a camera offset
-          _scopeScope :: Scope
-        }
+    | ScopeUse { _scopeScope :: Scope }
    | TargetingUse
        { _tgPos :: Maybe Point2
        , _tgID :: Maybe Int
@@ -79,12 +71,10 @@ data ItemUse
    | BulletModUse
        { _buMod :: BulletMod
        }
-    deriving (Eq, Show, Read) --Generic, Flat)
+    deriving (Eq, Show, Read)

-data TriggerType
-    = AutoTrigger
-    | HammerTrigger
-    deriving (Eq, Show, Read) --Generic, Flat)
+data TriggerType = AutoTrigger | HammerTrigger
+    deriving (Eq, Show, Read)

 data HeldParams
    = DefaultHeldParams
@@ -121,18 +111,10 @@ data HeldParams

 data AmmoParams
    = BulletParams {_ampBullet :: Bullet}
-    | ProjectileParams
-        { _ampPayload :: Payload
--        , _ampPjDraw :: ProjectileDraw
-        }
+    | ProjectileParams { _ampPayload :: Payload }
    | GasParams {_ampCreateGas :: GasFuel}
    deriving (Eq, Show, Read) --Generic, Flat)

--data ScrollAttachParams
--    = CharScrollParams
--        { _scrollChar :: Seq.Seq Char}
--    deriving (Eq, Show, Read) --Generic, Flat)
-
 data AimParams = AimParams
    { _aimWeight :: Int
    , _aimTurnSpeed :: Float
@@ -194,9 +176,7 @@ data AimStance
    | TwoHandOver
    | TwoHandFlat
    | OneHand
-    --    | LeaveHolstered
    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-    --deriving (Eq, Show, Ord, Enum, Read) --Generic, Flat)

 data ItZoom = ItZoom
    { _izMax :: Float
@@ -6,7 +6,6 @@ module Dodge.Default.Item (

 import qualified Data.IntMap.Strict as IM
 import Control.Lens
--import qualified Data.Map.Strict as M
 import Dodge.Data.Item
 import Dodge.Default.Item.Effect
 import Dodge.Default.Item.Use
@@ -42,26 +41,10 @@ singleAmmo :: a -> IM.IntMap a
 singleAmmo x = IM.insert 0 x mempty

 defaultBulletWeapon :: Item
-defaultBulletWeapon =
-    defaultHeldItem
--        & itUse . heldMods .~ PistolMod
+defaultBulletWeapon = defaultHeldItem
        & itUse . heldAmmoTypes .~ singleAmmo BulletAmmo
--        & itUse . heldUse .~ HeldUseAmmoParams -- useAmmoParams
--        & itType . iyModules . at ModBulletCollision ?~ EMPTYMODULE
        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0 PistolFlare MuzzleShootBullet]
--        & itType . iyModules . at ModBulletPayload ?~ EMPTYMODULE
--        & itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
-
--defaultWeapon :: Item
--defaultWeapon =
--    defaultHeldItem
--        & itUse .~ defaultHeldUse
--        & itType . iyModules
--            .~ M.fromList
--                [ (ModTarget, EMPTYMODULE)
--                , (ModTeleport, EMPTYMODULE)
--                ]

 defaultConsumable :: Item
-defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing
+defaultConsumable = defaultHeldItem & itUse .~ UseConsume CDoNothing

@@ -463,7 +463,6 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
  where
    -- the sound should be moved to the projectile firing
    startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing 
--    failsound = soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing
    failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
        Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
        _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
@@ -113,7 +113,7 @@ itemNumberDisplay cr itm = case iu of
    UseHotkey{} -> [showAutoRechargeProgress (_leftConsumption iu)]
    EquipUse{} -> showEquipmentNumber cr itm
    CraftUse -> []
-    ConsumeUse {} -> []
+    UseConsume {} -> []
    AttachUse {} -> []
    UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
    ScopeUse OpticScope {_opticZoom = x} -> [shortShow x]
@@ -5,35 +5,23 @@ module Dodge.Item.Draw.SPic (
    itemTreeSPic,
 ) where

-import Data.Strict.Tuple
+import Color
 import Data.Maybe
-import qualified Linear.Quaternion as Q
+import Data.Strict.Tuple
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
-import Color
--import qualified Data.Map.Strict as M
--import Data.Maybe
 import Dodge.Data.Item
--import Dodge.Item.AmmoPosition
--import Dodge.Item.Weapon.FractionLoaded
 import Geometry
 import LensHelp
+import qualified Linear.Quaternion as Q
 --import qualified Linear.Quaternion as Q
 import Picture
 import Shape
 import ShapePicture
--import Data.Maybe
-
--itemHeldAmmoPic :: Item -> Item -> SPic
--itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
-
--addAmmoClip :: Item -> Item -> SPic
--addAmmoClip itm amit = fromMaybe mempty $ do
--    hit <- itm ^? itType . iyBase . ibtHeld
--    return mempty

 itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
-itemTreeSPic (LDT (itm,_) l r) = itemSPic itm
+itemTreeSPic (LDT (itm, _) l r) =
+    itemSPic itm
        <> foldMap (itemRotTreeSPic itm) (l <> r)

 itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink ComposedItem) -> SPic
@@ -65,6 +53,7 @@ ammoMagSPic it = \case
  where
    y = fromIntegral y' * 0.3
    y' = fromMaybe 0 $ it ^? itUse . amagLoadStatus . iaLoaded
+
 --    am = fractionLoadedAmmo (it ^?! itUse . amagLoadStatus)

 --fractionLoadedAmmo :: ReloadStatus -> Float
@@ -100,8 +89,8 @@ equipItemSPic et _ = case et of
        noPic $ colorSH yellow $ upperPrismPolyMT 10 $ polyCirc 3 5
    BULLETBELTPACK ->
        noPic $ colorSH green backpackShape
-    BULLETBELTBRACER
-        -> noPic (colorSH green $ upperPrismPolySU 3 $ rectWH 2 2)
+    BULLETBELTBRACER ->
+        noPic (colorSH green $ upperPrismPolySU 3 $ rectWH 2 2)
    AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)

 backpackShape :: Shape
@@ -183,14 +172,6 @@ leftItemSPic lt _ = case lt of
 --  where
 --    f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)

--revolverAmmoPos :: AmmoPosition
--revolverAmmoPos =
--    Bullets
--        [(V3 5 0 1 + Q.rotate q (V3 0 0 2), q) | q <- qs]
--  where
--    qs = [Q.axisAngle (V3 1 0 0) (f i) | i <- [1 .. 6 :: Int]]
--    f i = fromIntegral i * pi / 3 + pi / 6
-
 heldItemSPic :: HeldItemType -> Item -> SPic
 heldItemSPic ht it = case ht of
    FLATSHIELD -> flatShieldEquipSPic
@@ -207,7 +188,6 @@ heldItemSPic ht it = case ht of
    MINIGUNX i -> miniGunXPictItem i it
    VOLLEYGUN i -> noPic $ volleyGunShape i -- <> addBullets it
    RIFLE -> noPic baseRifleShape -- <> addBullets it
--    REPEATER -> noPic $ baseRifleShape <> addTinClip it
    AUTORIFLE -> noPic $ baseRifleShape
    BURSTRIFLE -> noPic $ baseRifleShape
    BANGROD -> noPic baseRodShape -- <> addBullets it
@@ -224,14 +204,9 @@ heldItemSPic ht it = case ht of
    SPARKGUN -> teslaGunPic
    TESLAGUN -> teslaGunPic
    LASGUN -> lasGunPic it
--    LASCIRCLE -> lasGunPic it
--    DUALBEAM -> dualBeamPic it
--    LASWIDE _ -> lasGunPic it
-    --SONICGUN        -> noPic baseSonicShape
    TRACTORGUN -> tractorGunPic it
    LAUNCHER -> launcherPic it
    LAUNCHERX _ -> launcherPic it
--    REMOTELAUNCHER -> launcherPic it
    POISONSPRAYER -> flamerPic it
    DRONELAUNCHER -> defSPic
    SHATTERGUN -> shatterGunSPic
@@ -252,11 +227,6 @@ torchShape =
    bot = upperPrismPolySE 0.5 $ rectXH 9 2
    back = upperPrismPolySE 3 $ rectXH 1 2

--modulesSPic :: Item -> ModuleSlot -> ItemModuleType -> SPic
--modulesSPic it _ imt = case imt of
--    ATTACHTORCH -> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape)
--    _ -> mempty
-
 baseStickShapeX :: Item -> Int -> Shape
 baseStickShapeX it _ = foldMap f (it ^?! itUse . heldAim . aimMuzzles)
  where
@@ -334,11 +304,11 @@ volleyGunShape i =
 miniGunXPictItem :: Int -> Item -> SPic
 miniGunXPictItem i it = miniGunXPict i spin
  where
-    spin = (-10) -- * _iaLoaded (_laSource (_heldConsumption (_itUse it))) 
-                + _warmTime (_heldDelay $ _itUse it)
+    spin = (-10) + _warmTime (_heldDelay $ _itUse it)

 miniGunXPict :: Int -> Int -> SPic
-miniGunXPict i spin = noPic
+miniGunXPict i spin =
+    noPic
        ( colorSH red (rotateSHx a barrels)
            <> baseRifleShape
        )
@@ -363,6 +333,7 @@ flamerPic _ = noPic . colorSH yellow $ xCylinderST 5 18

 launcherPic :: Item -> SPic
 launcherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
+
 --launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20
 --    ( colorSH cyan $
 --        prismPoly
@@ -392,7 +363,8 @@ lasGunPic _ =
    ( colorSH blue $
        upperBoxST 4 (rectNESW 3 30 1 0)
            <> upperBoxSU 4 (rectNESW (-1) 30 (-3) 0)
-            <> upperBoxSU 1 (rectNESW 3 30 (-3) 0))
+            <> upperBoxSU 1 (rectNESW 3 30 (-3) 0)
+    )
        :!: (setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0)
  where
    --amFrac = fractionLoadedAmmo it
@@ -455,5 +427,3 @@ keyPic =

 legsSPic :: Color -> SPic
 legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPolyST 3 $ rectWH 2 2
-
-