Defunction-ify item modules, requires more cleanup

src/Dodge/Default/Item.hs

@@ -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
+

src/Dodge/Default/LightSource.hs

@@ -0,0 +1,36 @@
+module Dodge.Default.LightSource where
+import Dodge.Data
+import Picture
+import Geometry
+import LensHelp
+
+defaultLS :: LightSource
+defaultLS = LS
+    { _lsID = 0
+    , _lsParam = LSParam
+        { _lsPos = V3 0 0 50
+        , _lsRad = 700
+        , _lsCol = 0.6
+        }
+    , _lsDir = 0
+    , _lsPict = defLSPic 
+    }
+defLSPic :: LightSource -> Picture
+defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
+  where
+    col = V4 r g b 2
+    V3 r g b = _lsCol $ _lsParam ls
+defaultTLS :: TempLightSource
+defaultTLS = TLS
+    { _tlsParam = LSParam
+        { _lsPos = 0
+        , _lsRad = 0
+        , _lsCol = 0.5
+        }
+    , _tlsUpdate = f
+    , _tlsTime = 1
+    }
+  where
+    f _ t 
+        | _tlsTime t <= 0 = Nothing
+        | otherwise       = Just $ t & tlsTime -~ 1

src/Dodge/Default/Weapon.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.Weapon
     where
 import Dodge.Data
+import Dodge.Default.Item
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Draw
 import Picture
@@ -94,11 +95,10 @@ defaultAimParams = AimParams
     , _aimStance = OneHand
     }
 
+
 defaultGun :: Item
-defaultGun = Item 
-    { _itName = "default"
-    , _itType = NoCombineType
-    , _itCurseStatus = Uncursed
+defaultGun = defaultItem 
+    { _itCurseStatus = Uncursed
     , _itConsumption = defaultAmmo
     , _itUse = defaultrUse
     , _itDimension = defItDimCol white
@@ -113,41 +113,23 @@ defaultGun = Item
     , _itInvSize  = 1
     , _itParams = NoParams
     , _itTweaks = NoTweaks
-    , _itModules = M.fromList 
-        [(ModBullet, DefaultModule)
-        ,(ModTarget, DefaultModule)
-        ,(ModBulletTrajectory, DefaultModule)
-        ,(ModTeleport, DefaultModule)
-        ]
     , _itScope = NoScope
     , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
-    }
+    } 
+    & itType . iyModules .~ M.fromList 
+        [(ModBullet, EMPTYMODULE)
+        ,(ModTarget, EMPTYMODULE)
+        ,(ModBulletTrajectory, EMPTYMODULE)
+        ,(ModTeleport, EMPTYMODULE)
+        ]
+
 defaultItemValue :: ItemValue
 defaultItemValue = ItemValue 10 MundaneItem
 defaultCraftable :: Item
-defaultCraftable = Item 
-    { _itName = "default"
-    , _itType = NoCombineType
-    , _itCurseStatus = Uncursed
-    , _itConsumption = NoConsumption
-    , _itUse = NoUse
-    , _itEquipPict = pictureWeaponOnAim
-    , _itAttachment = NoItAttachment
-    , _itID = Nothing
-    , _itInvPos = Nothing
-    , _itIsHeld = False
-    , _itEffect = NoItEffect
-    , _itInvDisplay = basicItemDisplay
+defaultCraftable = defaultItem 
+    { _itEquipPict = pictureWeaponOnAim
     , _itInvColor = green
-    , _itInvSize  = 1
-    , _itParams = NoParams
     , _itDimension = defItDimCol green
-    , _itTweaks = NoTweaks
-    , _itModules = M.empty
-    , _itScope = NoScope
-    , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
     }
 defItDim :: ItemDimension
 defItDim = ItemDimension