justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Data-ify item drawing

Browse Source
This commit is contained in:
justin
2022-07-11 00:33:59 +01:00
parent 75cd15c240
commit ad84e69d05
15 changed files with 102 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Equipment.hs
+38 -30
View File
@@ -36,8 +36,7 @@ import LensHelp
magShield :: Item
magShield = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
{ _itID = Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ useMagShield
@@ -59,34 +58,35 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet
flameShield :: Item
flameShield = defaultEquipment
{ _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing
{ _itID = Nothing
} & itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ FLAMESHIELD
{- | Slows you down, blocks forward projectiles. -}
frontArmour :: Item
frontArmour = defaultEquipment
{ _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
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ FRONTARMOUR
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ const (emptySH , setDepth 20 $ pictures
[color thecol $ thickArc 0 (pi/2) 10 5
,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
])
where
thecol = yellow -- (greyN 0.1)
wristArmour :: Item
wristArmour = defaultEquipment
{ _itEquipPict = spicForWrist mempty
, _itID = Nothing
{_itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ onEquipWristShield
& itUse . eqEq . eqUse .~ setWristShieldPos
& itUse . eqEq . eqOnRemove .~ onRemoveWristShield
& itType . iyBase .~ WRISTARMOUR
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ const mempty
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = w
@@ -120,8 +120,7 @@ setWristShieldPos itm cr w = w
flatShield :: Item
flatShield = defaultEquipment
{ _itEquipPict = pictureWeaponAim flatShieldEquipSPic
, _itEffect = effectOnOffHeld createShieldWall removeShieldWall
{ _itEffect = effectOnOffHeld createShieldWall removeShieldWall
-- the above seems to work, but I am not sure why: it may break on edge
-- cases
, _itUse = RightUse
@@ -140,6 +139,7 @@ flatShield = defaultEquipment
, _itInvSize = 3
}
& itType . iyBase .~ FLATSHIELD
& itDimension . dimSPic .~ flatShieldEquipSPic
flatShieldEquipSPic :: Item -> SPic
flatShieldEquipSPic _ =
( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
@@ -209,44 +209,49 @@ effectOnOffHeld f f' = ItInvEffectID
{- | Increases speed, reduces friction, cannot only move forwards. -}
jetPack :: Item
jetPack = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
$ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
} & itUse . eqEq . eqSite .~ GoesOnBack
& itType . iyBase .~ JETPACK
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ ( \_ -> (,) emptySH $ setDepth 20
$ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
)
brainHat :: Item
brainHat = defaultEquipment
{ _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ BRAINHAT
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~
const (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
headLamp1 :: Item
headLamp1 = defaultEquipment
{ _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)
)
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ HEADLAMP1
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~
const (noPic $ colorSH yellow $
translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
<> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1))
headLamp :: Item
headLamp = defaultEquipment
{ _itEquipPict = pictureOnEquip (noPic headLampShape)
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ HEADLAMP
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ const (noPic headLampShape)
headLampShape :: Shape
headLampShape = colorSH yellow $
@@ -261,12 +266,14 @@ createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
powerLegs :: Item
powerLegs = defaultEquipment
{ _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnLegs
& itType . iyBase .~ POWERLEGS
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ const
(noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
speedLegs :: Item
speedLegs = powerLegs
& itType . iyBase .~ SPEEDLEGS
@@ -276,13 +283,14 @@ jumpLegs = powerLegs
wristInvisibility :: Item
wristInvisibility = defaultEquipment
{ _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
, _itID = Nothing
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ overCID (crCamouflage .~ Invisible)
& itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
& itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ const (noPic (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2))
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = creatures . ix (_crID cr) %~ f