Data-ify item drawing

This commit is contained in:
2022-07-11 00:33:59 +01:00
parent 75cd15c240
commit ad84e69d05
15 changed files with 102 additions and 81 deletions
+12 -10
View File
@@ -47,13 +47,14 @@ translateToRightHand cr = translateToRightHand' cr . mirrorSPxz
translateToRightHand' :: Creature -> SPic -> SPic
translateToRightHand' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
| twoFlat cr = waistSP . translateSPf 4 (-8)
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) . offTrans-- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10) . offTrans
| twoFlat cr = waistSP . translateSPf 4 (-8) . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (-f sa) (-off)
_ -> waistSP . translateSPf 0 (-off)
Just (Walking sa LeftForward) -> waistSP . translateSPf (-f sa) (-off) . offTrans
_ -> waistSP . translateSPf 0 (-off) . offTrans
where
offTrans = translateSP (V3 0 (-4) (-4))
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -73,13 +74,14 @@ translatePointToLeftHand cr
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4
| twoFlat cr = waistSP . translateSPf 4 8
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off . offTrans
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4 . offTrans
| twoFlat cr = waistSP . translateSPf 4 8 . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (-f sa) off
_ -> waistSP . translateSPf 0 off
Just (Walking sa RightForward) -> waistSP . translateSPf (-f sa) off . offTrans
_ -> waistSP . translateSPf 0 off . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+5 -3
View File
@@ -15,6 +15,7 @@ import Dodge.Data
import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Item.Draw
import Picture
import Geometry
import Shape
@@ -213,9 +214,10 @@ shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap f (_crInv cr)
where
f itm = _itEquipPict itm cr itm
drawEquipment cr = foldMap (itemEquipPict cr) (_crInv cr)
--drawEquipment cr = foldMap f (_crInv cr)
-- where
-- f itm = _itEquipPict itm cr itm
circLine :: Float -> Picture
circLine x = line [V2 0 0,V2 x 0]
+1 -1
View File
@@ -535,7 +535,7 @@ data ItemConsumption
data Item = Item
{ _itConsumption :: ItemConsumption
, _itUse :: ItemUse
, _itEquipPict :: Creature -> Item -> SPic
-- , _itEquipPict :: Creature -> Item -> SPic
, _itType :: ItemType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
+2 -2
View File
@@ -3,13 +3,13 @@ module Dodge.Default.Item
) where
import Dodge.Data
import Picture
import Shape
--import Shape
defaultItem :: Item
defaultItem = Item
{ _itCurseStatus = Uncursed
, _itType = defaultItemType
, _itEquipPict = \_ _ -> (,) emptySH blank
-- , _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = NoItEffect
, _itID = Nothing
, _itIsHeld = False
+2 -4
View File
@@ -5,7 +5,7 @@ import Dodge.Item.Weapon.AmmoParams
import Dodge.Reloading.Action
import Dodge.Item.Weapon.Bullet
import Dodge.Default.Item
import Dodge.Item.Draw
--import Dodge.Item.Draw
import Picture
import ShapePicture
import Shape
@@ -110,7 +110,6 @@ defaultWeapon = defaultItem
& itConsumption .~ defaultLoadable
& itUse .~ defaultrUse
& itDimension .~ defItDimCol white
& itEquipPict .~ pictureWeaponOnAim
& itInvColor .~ white
& itType . iyModules .~ M.fromList
[(ModBullet, EMPTYMODULE)
@@ -128,8 +127,7 @@ defaultItemValue :: ItemValue
defaultItemValue = ItemValue 10 MundaneItem
defaultCraftable :: Item
defaultCraftable = defaultItem
{ _itEquipPict = pictureWeaponOnAim
, _itInvColor = green
{ _itInvColor = green
, _itDimension = defItDimCol green
}
defItDim :: ItemDimension
+3 -4
View File
@@ -3,10 +3,10 @@ import Dodge.Data
--import Dodge.Picture.Layer
import Dodge.Default
import Dodge.SoundLogic
import Shape
--import Shape
--import ShapePicture
import Dodge.Item.Draw
import Picture
--import Dodge.Item.Draw
--import Picture
--import Data.Maybe
import Control.Lens
@@ -17,7 +17,6 @@ medkit i = defaultConsumable
{ _itUse = ConsumeUse
{_cUse = \_ cr w -> w & creatures . ix (_crID cr) . crHP +~ i
}
, _itEquipPict = pictureWeaponAim $ const $ (,) emptySH $ color blue $ circleSolid 3
, _itID = Nothing
}
& itType . iyBase .~ MEDKIT i
+8
View File
@@ -3,6 +3,7 @@ module Dodge.Item.Draw
, pictureWeaponAim
, twoFlatHRot
, itSPic
, itemEquipPict
) where
import Dodge.Data
--import Dodge.Picture.Layer
@@ -10,11 +11,18 @@ import Dodge.Data
--import Shape
import ShapePicture
import Dodge.Creature.HandPos
import Dodge.Item.Equipment.Shape
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Data.Maybe
itemEquipPict :: Creature -> Item -> SPic
itemEquipPict cr it = case _dimPortage (_itDimension it) of
HeldItem {} -> pictureWeaponOnAim cr it
WornItem -> pictureOnEquip (itSPic it) cr it
NoPortage -> mempty
pictureWeaponOnAim
:: Creature
-> Item
+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
+5 -5
View File
@@ -8,11 +8,11 @@ import LensHelp
import Data.Maybe
shapeForWrist :: Shape -> Creature -> Item -> SPic
shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
spicForWrist :: SPic -> Creature -> Item -> SPic
spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
--shapeForWrist :: Shape -> SPic
--shapeForWrist = noPic . translateSH (V3 0 4 (-4))
--
--spicForWrist :: SPic -> SPic
--spicForWrist = translateSP (V3 0 4 (-4))
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- itm ^? itPos . ipInvID
+9 -5
View File
@@ -4,17 +4,19 @@ import Dodge.Default
import Picture
import Geometry.Data
import LensHelp
--import ShapePicture
import ShapePicture
import Shape
keyCard :: Int -> Item
keyCard n = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = aquamarine
}
& itType . iyBase .~ KEYCARD n
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ (const . noShape)
(setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
keyPic :: Picture
keyPic = color green $
@@ -25,12 +27,14 @@ keyPic = color green $
latchkey :: Int -> Item
latchkey _ = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
, _itEffect = NoItEffect
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = yellow
}
& itDimension . dimPortage .~ WornItem
& itDimension . dimSPic .~ ( \_ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
)
latchkeyPic :: Picture
latchkeyPic = color yellow $
pictures [translate (-4) 0 $ thickCircle 4 2
+1 -2
View File
@@ -20,7 +20,7 @@ import Dodge.Default
--import Dodge.Item.Weapon.ExtraEffect
--import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.AmmoParams
import Dodge.Item.Draw
--import Dodge.Item.Draw
import Dodge.Item.Weapon.TriggerType
import Dodge.SoundLogic.LoadSound
import Picture
@@ -283,7 +283,6 @@ miniGunX i = defaultAutoGun
, _torqueAfter = 0
, _randomOffset = 10
}
, _itEquipPict = pictureWeaponAim (miniGunXPictItem i)
, _itInvSize = 4
, _itDimension = ItemDimension
{ _dimRad = 20
+1 -2
View File
@@ -20,7 +20,7 @@ import Dodge.Data
import Dodge.Default.Weapon
import Dodge.Default
import Dodge.Item.Attachment
import Dodge.Item.Draw
--import Dodge.Item.Draw
import Dodge.Item.Weapon.TriggerType
import Dodge.SoundLogic.LoadSound
import Picture
@@ -44,7 +44,6 @@ autoGun = defaultAutoGun
& laCycle .~ [loadEject 30, loadInsert 30 , loadPrime 10]
-- , _itFloorPict = autoGunPic
-- , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim
, _itAttachment = AttachCharMode $ Seq.fromList "MS"
, _itParams = BulletShooter
{ _muzVel = 1
+1 -1
View File
@@ -200,7 +200,7 @@ targetLaserUpdate _ cr w t
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
addLaserPic = instantParticles .:~ PtTargetLaser
{ _ptUpdate = ptSimpleTime 1
, _ptPoints = (sp:ps)
, _ptPoints = sp:ps
, _ptColor = col
}
--wpammo = _itConsumption it
+6 -6
View File
@@ -6,7 +6,7 @@ import Dodge.Item.Weapon.Remote
import Dodge.Base
import Dodge.Zone
import Dodge.SoundLogic
import Dodge.Item.Draw
--import Dodge.Item.Draw
--import Dodge.Item.Weapon.InventoryDisplay
--import Dodge.Item.Attachment
import Picture
@@ -103,7 +103,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
, _pjTimer = fuseTime
}
j = crSel cr
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank
removePict = id -- set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> (,) emptySH blank
i = IM.newKey $ _props w
v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
@@ -125,7 +125,7 @@ throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x }
counterDown it
| _ieCounter (_itEffect it) == 0 = it
& itUse . useHammer .~ HammerUp
& itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50)
-- & itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50)
| otherwise = it & itEffect . ieCounter -~ 1
--flameGrenade :: Item
@@ -239,7 +239,7 @@ throwRemoteBomb cr w = setLocation
| otherwise = v'
j = crSel cr
-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> mempty
removePict = id -- set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> mempty
resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse)
$ \_ -> explodeRemoteBomb itid i
p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
@@ -267,8 +267,8 @@ explodeRemoteBomb itid pjid cr w
where
cid = _crID cr
-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
resetPict = id --set (creatures . ix cid . crInv . ix j . itEquipPict )
-- (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = crSel $ _creatures w IM.! cid
remoteBombPic
+8 -6
View File
@@ -2,7 +2,7 @@ module Dodge.Item.Weapon.Radar where
import Dodge.Data
--import Dodge.Picture.Layer
import Dodge.Default
import Dodge.Item.Draw
--import Dodge.Item.Draw
--import Dodge.Item.Equipment
import Dodge.Item.Equipment.Shape
import Dodge.Item.Weapon.TriggerType
@@ -15,7 +15,7 @@ import Dodge.SoundLogic
import Geometry
import Picture
import Shape
--import ShapePicture
import ShapePicture
import Control.Lens
@@ -30,20 +30,22 @@ clickDetector dt = defaultWeapon
]
& itUse . useAim . aimRange .~ 1
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
& itEquipPict .~ pictureWeaponAim (\_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5))
& itType . iyBase .~ CLICKDETECTOR dt
autoDetector :: Detector -> Item
autoDetector dt = defaultEquipment
{_itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
-- , _itEffect = autoRadarEffect
, _itID = Nothing
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqUse .~ autoEffect (detectorEffect dt) 100 click1S
& itUse . eqEq . eqParams .~ EquipCounter 0
& itUse . eqEq . eqViewDist ?~ 350
& itType . iyBase .~ AUTODETECTOR dt
& itDimension . dimPortage
.~ WornItem
& itDimension . dimSPic .~ const
(noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2))
-- , _itEffect = autoRadarEffect
detectorColor :: Detector -> Color
detectorColor dt = case dt of