Defunction-ify item modules, requires more cleanup

2022-06-08 12:28:11 +01:00
parent d91a53f76c
commit bcbfd7d2fa
48 changed files with 762 additions and 740 deletions
@@ -0,0 +1,88 @@
+module Dodge.Default.Item
+    ( basicItemDisplay
+    , maybeWarmupStatus
+    , maybeRateStatus
+    , moduleStrings
+    , defaultItem
+    ) where
+import Dodge.Data
+import Padding
+import Dodge.Inventory.ItemSpace
+import Dodge.Module
+import Picture
+import ShapePicture
+import Shape
+
+import Data.Maybe
+import Data.Sequence
+import Control.Lens
+
+defaultItem :: Item
+defaultItem = Item
+    { _itCurseStatus = Uncursed
+    , _itType = defaultItemType
+    , _itEquipPict = \_ _ -> (,) emptySH blank
+    , _itEffect = NoItEffect
+    , _itID = Nothing
+    , _itIsHeld = False
+    , _itInvColor = yellow
+    , _itInvDisplay = basicItemDisplay
+    , _itInvSize = 1
+    , _itInvPos = Nothing
+    , _itDimension = ItemDimension 0 0 NoPortage (const mempty)
+    , _itConsumption = NoConsumption
+    , _itUse = NoUse
+    , _itAttachment = NoItAttachment
+    , _itParams = NoParams
+    , _itTweaks = NoTweaks
+    , _itScope = NoScope
+    , _itTargeting = NoTargeting
+    , _itValue = ItemValue 0 MundaneItem
+    }
+
+{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
+basicItemDisplay :: Item -> [String]
+basicItemDisplay it = Prelude.take (itSlotsTaken it) $
+    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+    : moduleStrings it ++ repeat "*"
+  where 
+    thename  = show . _iyBase $ _itType it
+    thenumber = case it ^? itConsumption of
+        Just am@LoadableAmmo{} -> case _laReloadState am of 
+            Nothing' -> show (_laLoaded am)
+            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
+        Just am@ChargeableAmmo{} -> show $ _wpCharge am
+        Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x)
+        Just NoConsumption -> ""
+        Nothing -> ""
+    theparam = fromMaybe []
+        . listToMaybe 
+        $ mapMaybe ($ it) 
+        [ maybeModeStatus
+--        , maybeWarmupStatus
+--        , maybeRateStatus
+        ]
+-- this can be moved to Dodge/Module and unified with moduleSizes
+
+maybeModeStatus :: Item -> Maybe String
+maybeModeStatus it = case it ^? itAttachment of
+    Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c]
+    Just ItMode {_itMode = i} -> Just $ show i
+    _   -> Nothing
+
+maybeRateStatus :: Item -> Maybe String
+maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
+    Nothing -> Nothing
+    _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it))
+
+maybeWarmupStatus :: Item -> Maybe String
+maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
+    Nothing -> Nothing
+    Just m  -> case m - (_warmTime . _useDelay $ _itUse it) of
+        x | x <= 1      -> Just "WARM"
+          | otherwise   -> let n = show x
+                in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n
+
+defaultItemType :: ItemType
+defaultItemType = ItemType NOTDEFINED mempty
+