Use strict tuples for SPics
This commit is contained in:
+30
-143
@@ -5,6 +5,7 @@ module Dodge.Item.Draw.SPic (
|
||||
itemTreeSPic,
|
||||
) where
|
||||
|
||||
import Data.Strict.Tuple
|
||||
import Data.Maybe
|
||||
import qualified Linear.Quaternion as Q
|
||||
import Dodge.Data.ComposedItem
|
||||
@@ -58,35 +59,33 @@ ammoMagSPic :: Item -> AmmoMagType -> SPic
|
||||
ammoMagSPic it = \case
|
||||
TINMAG -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
|
||||
DRUMMAG -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
|
||||
CHEMFUELPOUCH -> (colorSH yellow (upperPrismPolyST 3 $ polyCirc 3 5)
|
||||
, mempty
|
||||
CHEMFUELPOUCH -> noPic $ colorSH yellow (upperPrismPolyST 3 $ polyCirc 3 5)
|
||||
-- , setLayer MidLayer . color black $ translate3 (V3 0 0 4) $ circleSolid (5 * am)
|
||||
)
|
||||
_ -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
|
||||
where
|
||||
y = fromIntegral y' * 0.3
|
||||
y' = fromMaybe 0 $ it ^? itUse . amagLoadStatus . iaLoaded
|
||||
am = fractionLoadedAmmo (it ^?! itUse . amagLoadStatus)
|
||||
-- am = fractionLoadedAmmo (it ^?! itUse . amagLoadStatus)
|
||||
|
||||
fractionLoadedAmmo :: ReloadStatus -> Float
|
||||
fractionLoadedAmmo rs = fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)
|
||||
|
||||
fractionLoadedAmmo2 :: ReloadStatus -> Float
|
||||
fractionLoadedAmmo2 rs =
|
||||
1 - (1 - fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)) ** 2
|
||||
--fractionLoadedAmmo :: ReloadStatus -> Float
|
||||
--fractionLoadedAmmo rs = fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)
|
||||
--
|
||||
--fractionLoadedAmmo2 :: ReloadStatus -> Float
|
||||
--fractionLoadedAmmo2 rs =
|
||||
-- 1 - (1 - fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)) ** 2
|
||||
|
||||
equipItemSPic :: EquipItemType -> Item -> SPic
|
||||
equipItemSPic et _ = case et of
|
||||
MAGSHIELD -> defSPic
|
||||
FLAMESHIELD -> defSPic
|
||||
FRONTARMOUR ->
|
||||
( mempty
|
||||
, setDepth 20 $
|
||||
fold
|
||||
[ color yellow $ thickArc 0 (pi / 2) 10 5
|
||||
, color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5
|
||||
]
|
||||
)
|
||||
FRONTARMOUR -> defSPic
|
||||
-- ( mempty
|
||||
-- , setDepth 20 $
|
||||
-- fold
|
||||
-- [ color yellow $ thickArc 0 (pi / 2) 10 5
|
||||
-- , color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5
|
||||
-- ]
|
||||
-- )
|
||||
WRISTARMOUR -> defSPic
|
||||
INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPolySI 3 $ rectWH 2 2)
|
||||
BRAINHAT -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
|
||||
@@ -198,10 +197,10 @@ heldItemSPic ht it = case ht of
|
||||
FORCEFIELDGUN -> defSPic
|
||||
TORCH -> noPic torchShape
|
||||
BANGSTICK i -> noPic $ baseStickShapeX it i -- <> addBullets it
|
||||
PISTOL -> noPic $ baseStickShape <> addTinClip it
|
||||
MACHINEPISTOL -> noPic $ baseStickShape <> addTinClip it
|
||||
AUTOPISTOL -> noPic $ baseStickShape <> addTinClip it
|
||||
SMG -> noPic $ baseSMGShape <> addTinClip it
|
||||
PISTOL -> noPic $ baseStickShape
|
||||
MACHINEPISTOL -> noPic $ baseStickShape
|
||||
AUTOPISTOL -> noPic $ baseStickShape
|
||||
SMG -> noPic $ baseSMGShape
|
||||
BANGCONE -> noPic $ bangConeShape 5
|
||||
BLUNDERBUSS -> noPic $ bangConeShape 20
|
||||
GRAPECANNON _ -> noPic $ bangConeShape 20
|
||||
@@ -209,12 +208,12 @@ heldItemSPic ht it = case ht of
|
||||
VOLLEYGUN i -> noPic $ volleyGunShape i -- <> addBullets it
|
||||
RIFLE -> noPic baseRifleShape -- <> addBullets it
|
||||
-- REPEATER -> noPic $ baseRifleShape <> addTinClip it
|
||||
AUTORIFLE -> noPic $ baseRifleShape <> addTinClip it
|
||||
BURSTRIFLE -> noPic $ baseRifleShape <> addTinClip it
|
||||
AUTORIFLE -> noPic $ baseRifleShape
|
||||
BURSTRIFLE -> noPic $ baseRifleShape
|
||||
BANGROD -> noPic baseRodShape -- <> addBullets it
|
||||
ELEPHANTGUN -> noPic baseAMRShape -- <> addBullets it
|
||||
AMR -> noPic $ baseAMRShape <> addTinClip it
|
||||
AUTOAMR -> noPic $ baseAMRShape <> addTinClip it
|
||||
AMR -> noPic $ baseAMRShape
|
||||
AUTOAMR -> noPic $ baseAMRShape
|
||||
SNIPERRIFLE -> noPic baseAMRShape -- <> addBullets it
|
||||
-- MACHINEGUN -> noPic $ baseAMRShape <> addTinClip it
|
||||
FLAMESPITTER -> flamerPic it
|
||||
@@ -290,97 +289,8 @@ baseCaneShape :: Shape
|
||||
baseCaneShape = colorSH red $ xCylinderST 3 15
|
||||
|
||||
baseRifleShape :: Shape
|
||||
--baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
|
||||
--baseRifleShape = colorSH red . rotateSHq (V3 0 1 0) (pi/2) . upperCylinder 25 $ polyCirc 3 2
|
||||
--baseRifleShape = colorSH red $ xCylinder 4 2 25
|
||||
baseRifleShape = colorSH red $ xCylinderST 3 25
|
||||
|
||||
--addBullets :: Item -> Shape
|
||||
--addBullets itm = fromMaybe mempty $ do
|
||||
-- x <- itm ^? itUse . heldConsumption . laSource . _InternalSource . iaLoaded
|
||||
-- hit <- itm ^? itType . iyBase . ibtHeld
|
||||
-- ps <- fmap (take x) $ ammoPosition itm hit ^? amPosDirs
|
||||
-- return $ foldMap (uncurry (drawBullet itm)) ps
|
||||
|
||||
---- why is this duplicated?
|
||||
--drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape
|
||||
--drawBullet itm p q =
|
||||
-- translateSH p $
|
||||
-- overPosSH (Q.rotate q) $
|
||||
-- colorSH
|
||||
-- midcol
|
||||
-- ( upperPrismPolyTS 0.2 $
|
||||
-- reverse
|
||||
-- (rectNSWE 0.2 (- 0.2) (-1) 1)
|
||||
-- )
|
||||
-- <> tip
|
||||
-- <> foot
|
||||
-- where
|
||||
-- midcol =
|
||||
-- maybe
|
||||
-- black
|
||||
-- bulletEffectColor
|
||||
-- (itm ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
|
||||
-- tip = fromMaybe mempty $ do
|
||||
-- ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
|
||||
-- return $
|
||||
-- colorSH (bulletPayloadColor ebt) $
|
||||
-- upperPrismPolyTS 0.2 $
|
||||
-- reverse $
|
||||
-- rectNSWE 0.2 (- 0.2) 1 2
|
||||
-- foot = fromMaybe mempty $ do
|
||||
-- ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
|
||||
-- return $
|
||||
-- colorSH (bulletTrajColor ebt) $
|
||||
-- upperPrismPolyTS 0.2 $
|
||||
-- reverse $
|
||||
-- rectNSWE 0.2 (- 0.2) (-2) (-1)
|
||||
|
||||
addTinClip :: Item -> Shape
|
||||
addTinClip _ = mempty
|
||||
--addTinClip :: Item -> Shape
|
||||
--addTinClip itm = fromMaybe mempty $ do
|
||||
-- hit <- itm ^? itType . iyBase . ibtHeld
|
||||
-- let ap = ammoPosition itm hit
|
||||
-- p <- ap ^? amposPos
|
||||
-- d <- ap ^? amposDir
|
||||
-- return $ translateSH p $ overPosSH (Q.rotate d) $ makeTinClip itm
|
||||
--
|
||||
--makeTinClip :: Item -> Shape
|
||||
--makeTinClip it =
|
||||
-- colorSH
|
||||
-- midcol
|
||||
-- ( upperPrismPolyTS
|
||||
-- 1
|
||||
-- ( reverse $
|
||||
-- rectNSWE 0 (- y) (-1) 1
|
||||
-- )
|
||||
-- )
|
||||
-- <> tips
|
||||
-- <> tails
|
||||
-- where
|
||||
-- midcol =
|
||||
-- maybe
|
||||
-- black
|
||||
-- bulletEffectColor
|
||||
-- (it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
|
||||
-- y = fromIntegral y' * 0.3
|
||||
-- y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laSource . _InternalSource . iaLoaded
|
||||
-- tips = fromMaybe mempty $ do
|
||||
-- ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
|
||||
-- return $
|
||||
-- colorSH (bulletPayloadColor ebt) $
|
||||
-- upperPrismPolyTS 1.1 $
|
||||
-- reverse $
|
||||
-- rectNSWE 0 (- y) 1 2
|
||||
-- tails = fromMaybe mempty $ do
|
||||
-- ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
|
||||
-- return $
|
||||
-- colorSH (bulletTrajColor ebt) $
|
||||
-- upperPrismPolyTS 1.1 $
|
||||
-- reverse $
|
||||
-- rectNSWE 0 (- y) (-2) (-1)
|
||||
|
||||
--bulletEffectColor :: BulletEffect -> Color
|
||||
--bulletEffectColor x = case x of
|
||||
-- DestroyBullet -> black
|
||||
@@ -428,12 +338,9 @@ miniGunXPictItem i it = miniGunXPict i spin
|
||||
+ _warmTime (_heldDelay $ _itUse it)
|
||||
|
||||
miniGunXPict :: Int -> Int -> SPic
|
||||
miniGunXPict i spin =
|
||||
miniGunXPict i spin = noPic
|
||||
( colorSH red (rotateSHx a barrels)
|
||||
<> baseRifleShape
|
||||
, -- <> clip (-1) 0
|
||||
-- <> clip (-7) 0
|
||||
mempty
|
||||
)
|
||||
where
|
||||
aBarrel = translateSH (V3 15 2 2) baseCaneShape
|
||||
@@ -452,22 +359,7 @@ baseSMGShape :: Shape
|
||||
baseSMGShape = colorSH green $ xCylinderST 3 20
|
||||
|
||||
flamerPic :: Item -> SPic
|
||||
--flamerPic it =
|
||||
flamerPic _ =
|
||||
( colorSH yellow $
|
||||
-- translateSHxy tx ty (upperPrismPolyST tz $ polyCirc 3 r)
|
||||
-- <>
|
||||
xCylinderST 5 18
|
||||
, mempty
|
||||
--, color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * am)
|
||||
-- , color black $ translate3 (V3 tx ty (tz + 0.01)) $ circleSolid (r * 0.5)
|
||||
)
|
||||
-- where
|
||||
-- tx = 4
|
||||
-- ty = - 6
|
||||
-- tz = 3
|
||||
-- r = 5
|
||||
-- am = fractionLoadedAmmo2 it
|
||||
flamerPic _ = noPic . colorSH yellow $ xCylinderST 5 18
|
||||
|
||||
launcherPic :: Item -> SPic
|
||||
launcherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
|
||||
@@ -496,14 +388,12 @@ teslaGunPic =
|
||||
xb = 9
|
||||
|
||||
lasGunPic :: Item -> SPic
|
||||
--lasGunPic it =
|
||||
lasGunPic _ =
|
||||
( colorSH blue $
|
||||
upperBoxST 4 (rectNESW 3 30 1 0)
|
||||
<> upperBoxSU 4 (rectNESW (-1) 30 (-3) 0)
|
||||
<> upperBoxSU 1 (rectNESW 3 30 (-3) 0)
|
||||
, setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
|
||||
)
|
||||
<> upperBoxSU 1 (rectNESW 3 30 (-3) 0))
|
||||
:!: (setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0)
|
||||
where
|
||||
--amFrac = fractionLoadedAmmo it
|
||||
amFrac = 0.5
|
||||
@@ -527,10 +417,7 @@ tractorGunPic :: Item -> SPic
|
||||
tractorGunPic = lasGunPic
|
||||
|
||||
flatShieldEquipSPic :: SPic
|
||||
flatShieldEquipSPic =
|
||||
( colorSH yellow $ upperBoxMT 10 (rectWH 2 10)
|
||||
, mempty
|
||||
)
|
||||
flatShieldEquipSPic = noPic . colorSH yellow $ upperBoxMT 10 (rectWH 2 10)
|
||||
|
||||
headLampShape :: Shape
|
||||
headLampShape =
|
||||
|
||||
Reference in New Issue
Block a user