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
@@ -22,14 +22,13 @@ import LensHelp
 import Data.Maybe
 magShield :: Item
 magShield = defaultEquipment
-    { _itType = MAGSHIELD
-    , _itName = "MAGSHIELD"
-    , _itEquipPict = \_ _ -> (,) emptySH blank
+    { _itEquipPict = \_ _ -> (,) emptySH blank
    , _itID = Nothing
    , _itAttachment = ItMInt Nothing
    }
    & itUse . eqEq . eqUse .~ useMagShield 
    & itUse . eqEq . eqSite .~ GoesOnWrist
+    & itType . iyBase .~ MAGSHIELD
 useMagShield :: Item -> Creature -> World -> World
 useMagShield it cr w = w & magnets . at mgid ?~ themagnet
  where
@@ -46,37 +45,34 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet

 flameShield :: Item 
 flameShield = defaultEquipment
-    { _itType = FLAMESHIELD
-    , _itName = "FLAMESHIELD"
-    , _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
+    { _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
    , _itID = Nothing
    } & itUse . eqEq . eqSite .~ GoesOnChest
+    & itType . iyBase .~ FLAMESHIELD
 {- | Slows you down, blocks forward projectiles. -}
 frontArmour :: Item
 frontArmour = defaultEquipment
-    { _itType = FRONTARMOUR
-    , _itName = "FARMOUR"
-    , _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures
+    { _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures
        [color thecol $ thickArc 0        (pi/2) 10 5
        ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
        ])
    , _itID = Nothing
    }
    & itUse . eqEq . eqSite .~ GoesOnChest
+    & itType . iyBase .~ FRONTARMOUR
  where
    thecol = yellow -- (greyN 0.1)

 wristArmour :: Item
 wristArmour = defaultEquipment
-    { _itType = WRISTARMOUR
-    , _itName = "WRISTARMOUR"
-    , _itEquipPict = spicForWrist mempty
+    { _itEquipPict = spicForWrist mempty
    , _itID = Nothing
    }
    & itUse . eqEq . eqSite .~ GoesOnWrist
    & itUse . eqEq . eqOnEquip .~ onEquipWristShield
    & itUse . eqEq . eqUse .~ setWristShieldPos
    & itUse . eqEq . eqOnRemove .~ onRemoveWristShield
+    & itType . iyBase .~ WRISTARMOUR

 onEquipWristShield :: Item -> Creature -> World -> World
 onEquipWristShield itm cr w = w
@@ -114,8 +110,6 @@ flatShield = defaultEquipment
    , _itEffect = effectOnOffHeld createShieldWall removeShieldWall
        -- the above seems to work, but I am not sure why: it may break on edge
        -- cases
-    , _itName   = "FLATSHIELD"
-    , _itType = FLATSHIELD
    , _itUse  = RightUse
        { _rUse = \_ _ -> id
        , _useDelay = NoDelay
@@ -135,6 +129,7 @@ flatShield = defaultEquipment
        ,"*" ++ replicate 13 ' ' ++ "*"
        ]
    }
+    & itType . iyBase .~ FLATSHIELD
 flatShieldEquipSPic :: Item -> SPic
 flatShieldEquipSPic _ = 
    ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
@@ -215,29 +210,25 @@ effectOnOffHeld f f' = ItInvEffectID
 {- | Increases speed, reduces friction, cannot only move forwards. -}
 jetPack :: Item
 jetPack = defaultEquipment
-    { _itType = JETPACK
-    , _itName = "JETPACK"
-    , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
+    { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
        $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
    , _itEffect = NoItEffect
    , _itID = Nothing
    }   & itUse . eqEq . eqSite .~ GoesOnBack
+    & itType . iyBase .~ JETPACK

 brainHat :: Item
 brainHat = defaultEquipment
-    { _itType = BRAINHAT
-    , _itName = "BRAINHAT"
-    , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
+    { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
    , _itEffect = NoItEffect
    , _itID = Nothing
    }
    & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ BRAINHAT

 headLamp1 :: Item
 headLamp1 = defaultEquipment
-    { _itType = HEADLAMP
-    , _itName = "HEADLAMP1"
-    , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
+    { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
            translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
            <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1)
            -- <> (upperPrismPoly 3 $ rectWH 4 4)
@@ -247,16 +238,16 @@ headLamp1 = defaultEquipment
    }
    & itUse . eqEq . eqUse .~ createHeadLamp
    & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ HEADLAMP1
 headLamp :: Item
 headLamp = defaultEquipment
-    { _itType = HEADLAMP
-    , _itName = "HEADLAMP"
-    , _itEquipPict = pictureOnEquip (noPic headLampShape)
+    { _itEquipPict = pictureOnEquip (noPic headLampShape)
    , _itEffect = NoItEffect
    , _itID = Nothing
    }
    & itUse . eqEq . eqUse .~ createHeadLamp
    & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ HEADLAMP

 headLampShape :: Shape
 headLampShape = colorSH yellow $ 
@@ -271,34 +262,28 @@ createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7

 powerLegs :: Item
 powerLegs = defaultEquipment
-    { _itType = POWERLEGS
-    , _itName = "POWERLEGS"
-    , _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
+    { _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
    , _itEffect = NoItEffect
    , _itID = Nothing
    }
    & itUse . eqEq . eqSite .~ GoesOnLegs
+    & itType . iyBase .~ POWERLEGS
 speedLegs :: Item
 speedLegs = powerLegs
-    { _itType = SPEEDLEGS
-    , _itName = "SPEEDLEGS"
-    }
+    & itType . iyBase .~ SPEEDLEGS
 jumpLegs :: Item
 jumpLegs = powerLegs
-    { _itType = JUMPLEGS
-    , _itName = "JUMPLEGS"
-    }
+    & itType . iyBase .~ JUMPLEGS

 wristInvisibility :: Item
 wristInvisibility = defaultEquipment
-    { _itType = INVISIBILITYEQUIPMENT GoesOnWrist
-    , _itName = "WRISTINVISIBILITY"
-    , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
+    { _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
    , _itID = Nothing
    }
    & itUse . eqEq . eqSite .~ GoesOnWrist
    & itUse . eqEq . eqOnEquip  .~ overCID (crCamouflage .~ Invisible)
    & itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
+    & itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist

 overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
 overCID f _ cr = creatures . ix (_crID cr) %~ f