Use ammo positions to draw magazines and bullets

This commit is contained in:
2023-01-13 15:44:12 +00:00
parent 4f00041680
commit 60943953a6
2 changed files with 94 additions and 51 deletions
+1 -1
View File
@@ -7,6 +7,6 @@ import Geometry.Data
data AmmoPosition
= Magazine {_amposPos :: Point3, _amposDir :: Quaternion Float}
| Bullets {_amPosDirs :: [(Point3,Point3)]}
| Bullets {_amPosDirs :: [(Point3,Quaternion Float)]}
| NoAmmoPosition
makeLenses ''AmmoPosition
+93 -50
View File
@@ -58,15 +58,16 @@ leftItemSPic lt _ = case lt of
BLINKER -> defSPic
_ -> defSPic
ammoPosition :: HeldItemType -> AmmoPosition
ammoPosition hit = case hit of
ammoPosition :: Item -> HeldItemType -> AmmoPosition
ammoPosition itm hit = case hit of
FLATSHIELD -> NoAmmoPosition
FORCEFIELDGUN -> NoAmmoPosition
TORCH -> NoAmmoPosition
BANGSTICK _ -> NoAmmoPosition
-- note that this uses a hard coded value from brlSpread
BANGSTICK i -> bangStickAmmoPos i itm
PISTOL -> Magazine (V3 5 2 0) lhs
REVOLVER -> NoAmmoPosition
REVOLVERX _ -> NoAmmoPosition
REVOLVER -> revolverAmmoPos
REVOLVERX _ -> revolverAmmoPos
MACHINEPISTOL -> Magazine (V3 5 2 0) lhs
AUTOPISTOL -> Magazine (V3 5 2 0) lhs
SMG -> Magazine (V3 7 (-2) 0 ) rhs
@@ -74,8 +75,8 @@ ammoPosition hit = case hit of
BLUNDERBUSS -> NoAmmoPosition
GRAPECANNON _ -> NoAmmoPosition
MINIGUNX _ -> NoAmmoPosition
VOLLEYGUN _ -> NoAmmoPosition
RIFLE -> NoAmmoPosition
VOLLEYGUN i -> volleygunAmmoPos i
RIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
REPEATER -> Magazine (V3 10 (-2) 0 ) rhs
AUTORIFLE -> Magazine (V3 10 (-2) 0 ) rhs
BURSTRIFLE -> Magazine (V3 10 (-2) 0 ) rhs
@@ -83,7 +84,7 @@ ammoPosition hit = case hit of
ELEPHANTGUN -> NoAmmoPosition
AMR -> Magazine (V3 10 (-2) 0 ) rhs
AUTOAMR -> Magazine (V3 10 (-2) 0 ) rhs
SNIPERRIFLE -> NoAmmoPosition
SNIPERRIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
MACHINEGUN -> Magazine (V3 10 (-2) 0 ) rhs
FLAMESPITTER -> NoAmmoPosition
FLAMETHROWER -> NoAmmoPosition
@@ -108,21 +109,45 @@ ammoPosition hit = case hit of
KEYCARD _ -> NoAmmoPosition
BINOCULARS -> NoAmmoPosition
where
lhs = Q.axisAngle (V3 0 0 1) pi
rhs = Q.axisAngle (V3 0 1 0) pi
lhs = Q.axisAngle (V3 1 0 0) pi
rhs = Q.axisAngle (V3 1 0 0) 0
bangStickAmmoPos :: Int -> Item -> AmmoPosition
bangStickAmmoPos i itm = Bullets
[ (rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a) | a <- map f [0..i - 1]]
where
f n = barrelspread * fromIntegral n
- 0.5 * barrelspread * fromIntegral (_brlNum (_gunBarrels (_itParams itm)) -1)
barrelspread = itm ^?! itParams . gunBarrels . brlSpread . spreadAngle
volleygunAmmoPos :: Int -> AmmoPosition
volleygunAmmoPos i = Bullets
[(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0..i-1] ]
where
f n = fromIntegral n * 5 - ((fromIntegral i - 1)*2.5)
revolverAmmoPos :: AmmoPosition
revolverAmmoPos = Bullets
[( V3 5 0 1 + Q.rotate q (V3 0 0 2), q) | q <- qs]
where
qs = [Q.axisAngle (V3 1 0 0) (f i) | i <- [1 .. 6::Int]]
f i = fromIntegral i * pi/3 + pi/6
heldItemSPic :: HeldItemType -> Item -> SPic
heldItemSPic ht it = case ht of
FLATSHIELD -> flatShieldEquipSPic
FORCEFIELDGUN -> defSPic
TORCH -> noPic torchShape
BANGSTICK i -> noPic $ baseStickShapeX it i <> stickClip it
BANGSTICK i -> noPic $ baseStickShapeX it i <> addBullets it
--BANGSTICK i -> noPic $ baseStickShapeX it i <> stickClip it
--PISTOL -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it
PISTOL -> noPic $ baseStickShape <> addTinClip it
REVOLVER -> noPic $ baseStickShape <> revolverClip it
REVOLVERX _ -> noPic $ baseStickShape <> revolverClip it
MACHINEPISTOL -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it
AUTOPISTOL -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it
--REVOLVER -> noPic $ baseStickShape <> revolverClip it
--REVOLVERX _ -> noPic $ baseStickShape <> revolverClip it
REVOLVER -> noPic $ baseStickShape <> addBullets it
REVOLVERX _ -> noPic $ baseStickShape <> addBullets it
MACHINEPISTOL -> noPic $ baseStickShape <> addTinClip it
AUTOPISTOL -> noPic $ baseStickShape <> addTinClip it
--SMG -> noPic (baseSMGShape <> makeTinClipAt 0 (V3 7 (-2) 0) it)
SMG -> noPic $ baseSMGShape <> addTinClip it
BANGCONE ->
@@ -141,17 +166,17 @@ heldItemSPic ht it = case ht of
upperPrismPoly 3 (rectXH 20 2)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 20 30)
MINIGUNX i -> miniGunXPictItem i it
VOLLEYGUN i -> volleyGunSPic i it
RIFLE -> noPic $ baseRifleShape <> makeSingleClipAt (V3 5 0 3) it
REPEATER -> noPic $ baseRifleShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
AUTORIFLE -> noPic $ baseRifleShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
BURSTRIFLE -> noPic $ baseRifleShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
VOLLEYGUN i -> volleyGunSPic i it <> noPic (addBullets it)
RIFLE -> noPic $ baseRifleShape <> addBullets it -- makeSingleClipAt (V3 5 0 3) it
REPEATER -> noPic $ baseRifleShape <> addTinClip it
AUTORIFLE -> noPic $ baseRifleShape <> addTinClip it
BURSTRIFLE -> noPic $ baseRifleShape <> addTinClip it
BANGROD -> noPic $ baseRodShape <> makeSingleClipAt (V3 5 0 3) it
ELEPHANTGUN -> noPic $ baseAMRShape <> makeSingleClipAt (V3 5 0 3) it
AMR -> noPic $ baseAMRShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
AUTOAMR -> noPic $ baseAMRShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
AMR -> noPic $ baseAMRShape <> addTinClip it
AUTOAMR -> noPic $ baseAMRShape <> addTinClip it
SNIPERRIFLE -> noPic $ baseAMRShape <> makeSingleClipAt (V3 5 0 3) it
MACHINEGUN -> noPic $ baseAMRShape <> makeTinClipAt 0 (V3 10 (-2) 0) it
MACHINEGUN -> noPic $ baseAMRShape <> addTinClip it
FLAMESPITTER -> flamerPic it
FLAMETHROWER -> flamerPic it
FLAMETORRENT -> flamerPic it
@@ -242,12 +267,52 @@ baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
makeSingleClipAt :: Point3 -> Item -> Shape
makeSingleClipAt p it = case it ^? itUse . heldConsumption . laLoaded of
Just 0 -> mempty
_ -> translateSH p $ upperPrismPoly 1 $ square 1.5
_ -> translateSH p $ colorSH midcol (upperPrismPoly 1 $ reverse
(rectNSWE 0.2 (- 2) (-1) 1)) <> tip <> foot
where
midcol = maybe black bulletEffectColor
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
tip = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0.2 (- 0.2) 1 2
foot = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0.2 (- 0.2) (-2) (-1)
addBullets :: Item -> Shape
addBullets itm = fromMaybe mempty $ do
x <- itm ^? itUse . heldConsumption . laLoaded
hit <- itm ^? itType . iyBase . ibtHeld
ps <- fmap (take x) $ (ammoPosition itm hit) ^? amPosDirs
return $ foldMap (uncurry (drawBullet itm)) ps
drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape
drawBullet itm p q = translateSH p $ overPosSH (Q.rotate q) $ colorSH midcol (upperPrismPoly 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) $ upperPrismPoly 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) $ upperPrismPoly 0.2 $
reverse $
rectNSWE 0.2 (- 0.2) (-2) (-1)
addTinClip :: Item -> Shape
addTinClip itm = fromMaybe mempty $ do
hit <- itm ^? itType . iyBase . ibtHeld
let ap = ammoPosition hit
let ap = ammoPosition itm hit
p <- ap ^? amposPos
d <- ap ^? amposDir
return $ translateSH p $ overPosSH (Q.rotate d) $ makeTinClip itm
@@ -256,7 +321,7 @@ makeTinClip :: Item -> Shape
makeTinClip it =
colorSH midcol (upperPrismPoly 1 (
reverse $
rectNSWE 0 (- y) (-2) 2)) <> translateSHz (-0.05) (tips <> tails)
rectNSWE 0 (- y) (-1) 1)) <> tips <> tails
where
midcol = maybe black bulletEffectColor
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
@@ -266,34 +331,12 @@ makeTinClip it =
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) (-2) (-1)
rectNSWE 0 (- y) 1 2
tails = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) 1 2
makeTinClipAt :: Float -> Point3 -> Item -> Shape
makeTinClipAt r p it =
translateSH p . overPosSH (rotate3z r) $
colorSH midcol (upperPrismPoly 1 (
reverse $
rectNSWE 0 (- y) (-2) 2)) <> tips <> tails
where
midcol = maybe black bulletEffectColor
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
y = fromIntegral y' * 0.3
y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laLoaded
tips = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) (-2) (-1)
tails = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) 1 2
bulletEffectColor :: BulletEffect -> Color
bulletEffectColor x = case x of
@@ -334,7 +377,7 @@ volleyGunSPic i it =
)
[0 .. i -1]
)
<> caneClipX i it
-- <> caneClipX i it
caneClipX :: Int -> Item -> Shape
caneClipX i it = case it ^? itUse . heldConsumption . laLoaded of