diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index 155caa539..d8ef8d348 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/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) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--deriving (Eq, Ord, Show, Read) --Generic, Flat) data Stack = NoStack | Stack ItAmount - deriving (Eq,Ord,Show,Read) - --deriving (Eq, Ord, Show, Read) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--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, Enum, Read) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--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) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--deriving (Eq, Ord, Show, Read) --Generic, Flat) data ConsumableItemType = MEDKIT Int | EXPLOSIVES - deriving (Eq,Ord,Show,Read) - --deriving (Eq, Ord, Show, Read) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--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) --Generic, Flat) + deriving (Eq, Ord, Show, Read) + +--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 - diff --git a/src/Dodge/Data/Item/Use/Consumption.hs b/src/Dodge/Data/Item/Use/Consumption.hs index 4b82bc818..4c740817f 100644 --- a/src/Dodge/Data/Item/Use/Consumption.hs +++ b/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 #-} @@ -26,18 +26,18 @@ data HeldConsumption | NoConsumption deriving (Eq, Show, Read) --Generic, Flat) -data AmmoSource +data AmmoSource = InternalSource InternalAmmo | AboveSource deriving (Eq, Show, Read) --Generic, Flat) data InternalAmmo = InternalAmmo - { _iaMax :: Int - , _iaLoaded :: Int - , _iaPrimed :: Bool - , _iaCycle :: [LoadAction] - , _iaProgress :: Maybe [LoadAction] - } + { _iaMax :: Int + , _iaLoaded :: Int + , _iaPrimed :: Bool + , _iaCycle :: [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) diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 170c41c5d..4091fafb9 100644 --- a/src/Dodge/Item.hs +++ b/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 diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index ca4d5dca8..5d91cdec8 100644 --- a/src/Dodge/Item/Display.hs +++ b/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))) + 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))) _ -> (0, itemDisplay cr itm) targetItemCanAttachAbove :: Creature -> Item -> Bool @@ -34,7 +37,7 @@ targetItemCanAttachAbove cr itm = fromMaybe False $ do return $ canAttachTargetingBelow itm' canAttachTargetingBelow :: Item -> Bool -canAttachTargetingBelow itm = +canAttachTargetingBelow itm = isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType) || Just LAUNCHHOME == (itm ^? itType . iyModules . ix ModLauncherHoming) @@ -45,11 +48,10 @@ targetingTypeString tt = case tt of TargetRBLine -> "" 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 - EBatterySource {_euseBatteryAmount = x} -> [show x] + EAmmoSource{} -> showAmmoSource cr itm + 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 - at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType - as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource - guard (at' == atype && as == AboveSource) - return ["vvvv",x] ) <|> Just [x] + ( do + at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType + as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource + guard (at' == atype && as == AboveSource) + return ["vvvv", x] + ) + <|> Just [x] showReloadProgress :: Creature -> Item -> String showReloadProgress cr itm = case ic ^? laSource of diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index a7f3d0b0e..f6736723b 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/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