Commit before moving to external weapon magazines

src/Dodge/Data/Item/Combine.hs

@@ -1,38 +1,38 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Item.Combine where
 
-import Dodge.Data.Item.Targeting
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.Map.Strict as M
 import Dodge.Data.Equipment.Misc
+import Dodge.Data.Item.Targeting
 import Dodge.Data.Item.Use.Consumption
 
 data ItemType = ItemType
     { _iyBase :: ItemBaseType
     , _iyModules :: M.Map ModuleSlot ItemModuleType
     }
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Stack = NoStack | Stack ItAmount
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CraftType
     = PIPE
     | TUBE
     | HARDWARE
     | SPRING
-
     | HOSE
     | TAPE
-
     | CAN
     | TIN
     | STEELDRUM
@@ -78,26 +78,29 @@ data CraftType
     | TIMEMODULE
     | SIZEMODULE
     | GRAVITYMODULE
-
     | TARGETMODULE TargetType
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
 
 data ItemBaseType
     = NoItemType
     | HELD {_ibtHeld :: HeldItemType}
     | LEFT {_ibtLeft :: LeftItemType}
     | EQUIP {_ibtEquip :: EquipItemType}
+    | AMMO {_ibtAmmo :: AmmoItemType}
     | Consumable {_ibtConsumable :: ConsumableItemType}
     | CRAFT CraftType
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ConsumableItemType
     = MEDKIT Int
     | EXPLOSIVES
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data EquipItemType
     = MAGSHIELD
@@ -112,16 +115,15 @@ data EquipItemType
     | POWERLEGS
     | SPEEDLEGS
     | JUMPLEGS
-
     | JETPACK
     | FUELPACK
     | BULLETBELTPACK
     | BULLETBELTBRACER
     | BATTERYPACK
-
     | AUTODETECTOR Detector
-    deriving (Eq,Ord,Show,Read)
+    deriving (Eq, Ord, Show, Read)
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data LeftItemType
     = BOOSTER
@@ -183,6 +185,11 @@ data HeldItemType
     | KEYCARD Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data AmmoItemType
+    = TINMAGAZINE
+    | DRUMMAGAZINE
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 data ItemModuleType
     = EMPTYMODULE
     | DRUMMAG
@@ -232,11 +239,12 @@ deriveJSON defaultOptions ''Detector
 deriveJSON defaultOptions ''EquipItemType
 deriveJSON defaultOptions ''LeftItemType
 deriveJSON defaultOptions ''HeldItemType
+deriveJSON defaultOptions ''AmmoItemType
 deriveJSON defaultOptions ''ItemModuleType
 deriveJSON defaultOptions ''ModuleSlot
 deriveJSON defaultOptions ''ItemBaseType
 deriveJSON defaultOptions ''ItemType
+
 instance ToJSONKey ModuleSlot
 
 instance FromJSONKey ModuleSlot
-

src/Dodge/Data/Item/Use/Consumption.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -32,12 +32,12 @@ data AmmoSource
     deriving (Eq, Show, Read) --Generic, Flat)
 
 data InternalAmmo = InternalAmmo
-        { _iaMax :: Int
+    { _iaMax :: Int
-        , _iaLoaded :: Int
+    , _iaLoaded :: Int
-        , _iaPrimed :: Bool
+    , _iaPrimed :: Bool
-        , _iaCycle :: [LoadAction]
+    , _iaCycle :: [LoadAction]
-        , _iaProgress :: Maybe [LoadAction]
+    , _iaProgress :: Maybe [LoadAction]
-        }
+    }
     deriving (Eq, Show, Read) --Generic, Flat)
 
 data LeftConsumption
@@ -54,8 +54,9 @@ data LeftConsumption
     deriving (Eq, Show, Read) --Generic, Flat)
 
 newtype ItAmount = ItAmount {_getItAmount :: Int}
---    deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
+    --    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)
 

src/Dodge/Item.hs

@@ -7,6 +7,7 @@ module Dodge.Item (
     itemFromBase,
 ) where
 
+import Dodge.Item.Ammo
 import Dodge.Data.Item
 import Dodge.Item.Consumable
 import Dodge.Item.Craftable
@@ -20,9 +21,15 @@ itemFromBase ibt = case ibt of
     HELD ht -> itemFromHeldType ht
     LEFT lt -> itemFromLeftType lt
     EQUIP et -> itemFromEquipType et
+    AMMO at -> itemFromAmmoType at
     Consumable et -> itemFromConsumableType et
     CRAFT cr -> makeTypeCraft cr
 
+itemFromAmmoType :: AmmoItemType -> Item
+itemFromAmmoType at = case at of
+    TINMAGAZINE -> tinMagazine
+    DRUMMAGAZINE -> drumMagazine
+
 itemFromConsumableType :: ConsumableItemType -> Item
 itemFromConsumableType ct = case ct of
     MEDKIT i -> medkit i

src/Dodge/Item/Display.hs

@@ -2,7 +2,7 @@ module Dodge.Item.Display (
     --itemDisplay,
     itemDisplayOffset,
     canAttachTargetingBelow,
---    selectedItemDisplay,
+    --    selectedItemDisplay,
     itemString,
     itemBaseName,
     basicItemDisplay,
@@ -10,21 +10,24 @@ module Dodge.Item.Display (
 
 import Control.Applicative
 import Control.Monad
-import Dodge.Item.Info
 import Data.Maybe
 import Dodge.Data.Creature
+import Dodge.Item.Info
 import Dodge.Item.SlotsTaken
 import Dodge.Module
 import LensHelp
 import Padding
 
-itemDisplayOffset :: Creature -> Item -> (Int,[String])
+itemDisplayOffset :: Creature -> Item -> (Int, [String])
 itemDisplayOffset cr itm = case itm ^. itType . iyBase of
-    EQUIP (TARGETINGHAT tt) | targetItemCanAttachAbove cr itm 
-        -> (-1, leftPad 15 ' ' (targetingTypeString tt) : 
-            (itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^') )))
     EQUIP (TARGETINGHAT tt)
-        -> (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
+        | targetItemCanAttachAbove cr itm ->
+            ( -1
+            , leftPad 15 ' ' (targetingTypeString tt) :
+              (itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^')))
+            )
+    EQUIP (TARGETINGHAT tt) ->
+        (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
     _ -> (0, itemDisplay cr itm)
 
 targetItemCanAttachAbove :: Creature -> Item -> Bool
@@ -46,10 +49,9 @@ targetingTypeString tt = case tt of
     TargetRBCreature -> "LIFEFORM"
     TargetCursor -> "CURSOR"
 
-    
-
 itemDisplay :: Creature -> Item -> [String]
-itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it
+itemDisplay cr itm =
+    --itemDisplayWithNumber (showConsumption cr it) it
     zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
 
 zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
@@ -57,18 +59,17 @@ zipWithDefaults f g h = go
   where
     go [] bs = map g bs
     go as [] = map f as
-    go (a:as) (b:bs) = h a b : go as bs
+    go (a : as) (b : bs) = h a b : go as bs
-
 
 itemDisplayPad :: [Char] -> String -> [Char]
 itemDisplayPad ls rs
     | rs == "" = ls
-    | otherwise = midPadL 15 ' ' ls (' ':rs)
+    | otherwise = midPadL 15 ' ' ls (' ' : rs)
 
 basicItemDisplay :: Item -> [String]
 basicItemDisplay itm =
     Prelude.take (itSlotsTaken itm) $
-        itemBaseName itm  :
+        itemBaseName itm :
         catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
             ++ moduleStrings itm
             ++ repeat "*"
@@ -85,6 +86,7 @@ itemBaseName it = case _iyBase $ _itType it of
         Nothing -> show hit
     LEFT lit -> show lit
     EQUIP eit -> showEquipItem eit
+    AMMO ait -> show ait
     Consumable cit -> show cit
 
 showEquipItem :: EquipItemType -> String
@@ -125,8 +127,8 @@ itemNumberDisplay cr itm = case iu of
 showEquipmentNumber :: Creature -> Item -> [String]
 showEquipmentNumber cr itm = case _eeUse ee of
     EFuelSource x _ -> [show x]
-    EAmmoSource {} -> showAmmoSource cr itm
+    EAmmoSource{} -> showAmmoSource cr itm
-    EBatterySource {_euseBatteryAmount = x} -> [show x]
+    EBatterySource{_euseBatteryAmount = x} -> [show x]
     _ -> [""]
   where
     ee = itm ^?! itUse . equipEffect
@@ -137,11 +139,13 @@ showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
     atype <- eu ^? euseAmmoSourceType
     x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
     i <- itm ^? itLocation . ipInvID
-    (do 
+    ( do
-        at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
+            at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
-        as <-  cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
+            as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
-        guard (at' == atype && as == AboveSource)
+            guard (at' == atype && as == AboveSource)
-        return ["vvvv",x] ) <|> Just [x]
+            return ["vvvv", x]
+        )
+        <|> Just [x]
 
 showReloadProgress :: Creature -> Item -> String
 showReloadProgress cr itm = case ic ^? laSource of

src/Dodge/Item/Draw/SPic.hs

@@ -23,6 +23,7 @@ itemSPic it =
         HELD ht -> heldItemSPic ht it
         LEFT lt -> leftItemSPic lt it
         EQUIP et -> equipItemSPic et it
+        AMMO {} -> defSPic
         Consumable{} -> defSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic