Implement magazine drawing using ammo positioning function

src/Dodge/Item/AmmoPosition.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Dodge.Item.AmmoPosition where
+
+import Linear.Quaternion (Quaternion (..))
+import Control.Lens
+import Geometry.Data
+
+data AmmoPosition
+    = Magazine {_amposPos :: Point3, _amposDir :: Quaternion Float}
+    | Bullets {_amPosDirs :: [(Point3,Point3)]}
+    | NoAmmoPosition
+makeLenses ''AmmoPosition

src/Dodge/Item/Draw/SPic.hs

@@ -1,5 +1,7 @@
 module Dodge.Item.Draw.SPic where
 
+import qualified Linear.Quaternion as Q
+import Dodge.Item.AmmoPosition
 import Color
 import Data.Maybe
 import Dodge.Data.Item
@@ -56,55 +58,58 @@ leftItemSPic lt _ = case lt of
     BLINKER -> defSPic
     _ -> defSPic
 
-magazinePosition :: HeldItemType -> Maybe (Point3, Point3)
+ammoPosition :: HeldItemType -> AmmoPosition
-magazinePosition hit = case hit of
+ammoPosition hit = case hit of
-    FLATSHIELD -> Nothing
+    FLATSHIELD -> NoAmmoPosition
-    FORCEFIELDGUN -> Nothing
+    FORCEFIELDGUN -> NoAmmoPosition
-    TORCH -> Nothing
+    TORCH -> NoAmmoPosition
-    BANGSTICK _ -> Nothing
+    BANGSTICK _ -> NoAmmoPosition
-    PISTOL -> Just (V3 5 2 0, V3 0 1 0)
+    PISTOL -> Magazine (V3 5 2 0) lhs
-    REVOLVER -> Nothing
+    REVOLVER -> NoAmmoPosition
-    REVOLVERX _ -> Nothing
+    REVOLVERX _ -> NoAmmoPosition
-    MACHINEPISTOL -> Just (V3 5 2 0, V3 0 1 0)
+    MACHINEPISTOL -> Magazine (V3 5 2 0) lhs
-    AUTOPISTOL -> Just (V3 5 2 0, V3 0 1 0)
+    AUTOPISTOL -> Magazine (V3 5 2 0) lhs
-    SMG -> Just (V3 7 (-2) 0 , V3 0 0 0)
+    SMG -> Magazine (V3 7 (-2) 0 ) rhs
-    BANGCONE -> Nothing
+    BANGCONE -> NoAmmoPosition
-    BLUNDERBUSS -> Nothing
+    BLUNDERBUSS -> NoAmmoPosition
-    GRAPECANNON _ -> Nothing
+    GRAPECANNON _ -> NoAmmoPosition
-    MINIGUNX _ -> Nothing
+    MINIGUNX _ -> NoAmmoPosition
-    VOLLEYGUN _ -> Nothing
+    VOLLEYGUN _ -> NoAmmoPosition
-    RIFLE -> Nothing
+    RIFLE -> NoAmmoPosition
-    REPEATER -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    REPEATER -> Magazine (V3 10 (-2) 0 ) rhs
-    AUTORIFLE -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    AUTORIFLE -> Magazine (V3 10 (-2) 0 ) rhs
-    BURSTRIFLE -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    BURSTRIFLE -> Magazine (V3 10 (-2) 0 ) rhs
-    BANGROD -> Nothing
+    BANGROD -> NoAmmoPosition
-    ELEPHANTGUN -> Nothing
+    ELEPHANTGUN -> NoAmmoPosition
-    AMR -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    AMR -> Magazine (V3 10 (-2) 0 ) rhs
-    AUTOAMR -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    AUTOAMR -> Magazine (V3 10 (-2) 0 ) rhs
-    SNIPERRIFLE -> Nothing
+    SNIPERRIFLE -> NoAmmoPosition
-    MACHINEGUN -> Just (V3 10 (-2) 0 , V3 0 0 0)
+    MACHINEGUN -> Magazine (V3 10 (-2) 0 ) rhs
-    FLAMESPITTER -> Nothing
+    FLAMESPITTER -> NoAmmoPosition
-    FLAMETHROWER -> Nothing
+    FLAMETHROWER -> NoAmmoPosition
-    FLAMETORRENT -> Nothing
+    FLAMETORRENT -> NoAmmoPosition
-    FLAMEWALL -> Nothing
+    FLAMEWALL -> NoAmmoPosition
-    BLOWTORCH -> Nothing
+    BLOWTORCH -> NoAmmoPosition
-    SPARKGUN -> Nothing
+    SPARKGUN -> NoAmmoPosition
-    TESLAGUN -> Nothing
+    TESLAGUN -> NoAmmoPosition
-    LASGUN -> Nothing
+    LASGUN -> NoAmmoPosition
-    LASCIRCLE -> Nothing
+    LASCIRCLE -> NoAmmoPosition
-    DUALBEAM -> Nothing
+    DUALBEAM -> NoAmmoPosition
-    LASWIDE _ -> Nothing
+    LASWIDE _ -> NoAmmoPosition
     --SONICGUN        -> noPic baseSonicShape
-    TRACTORGUN -> Nothing
+    TRACTORGUN -> NoAmmoPosition
-    LAUNCHER -> Nothing
+    LAUNCHER -> NoAmmoPosition
-    LAUNCHERX _ -> Nothing
+    LAUNCHERX _ -> NoAmmoPosition
-    REMOTELAUNCHER -> Nothing
+    REMOTELAUNCHER -> NoAmmoPosition
-    POISONSPRAYER -> Nothing
+    POISONSPRAYER -> NoAmmoPosition
-    DRONELAUNCHER -> Nothing
+    DRONELAUNCHER -> NoAmmoPosition
-    SHATTERGUN -> Nothing
+    SHATTERGUN -> NoAmmoPosition
-    HELDDETECTOR _ -> Nothing
+    HELDDETECTOR _ -> NoAmmoPosition
-    KEYCARD _ -> Nothing
+    KEYCARD _ -> NoAmmoPosition
-    BINOCULARS -> Nothing
+    BINOCULARS -> NoAmmoPosition
+  where
+    lhs = Q.axisAngle (V3 0 0 1) pi
+    rhs = Q.axisAngle (V3 0 1 0) pi
 
 heldItemSPic :: HeldItemType -> Item -> SPic
 heldItemSPic ht it = case ht of
@@ -112,12 +117,14 @@ heldItemSPic ht it = case ht of
     FORCEFIELDGUN -> defSPic
     TORCH -> noPic torchShape
     BANGSTICK i -> noPic $ baseStickShapeX it i <> stickClip it
-    PISTOL -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) 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
-    SMG -> noPic (baseSMGShape <> makeTinClipAt 0 (V3 7 (-2) 0) it)
+    --SMG -> noPic (baseSMGShape <> makeTinClipAt 0 (V3 7 (-2) 0) it)
+    SMG -> noPic $ baseSMGShape <> addTinClip it
     BANGCONE ->
         noPic $
             colorSH cyan $
@@ -237,6 +244,35 @@ makeSingleClipAt p it = case it ^? itUse . heldConsumption . laLoaded of
     Just 0 -> mempty
     _ -> translateSH p $ upperPrismPoly 1 $ square 1.5
 
+addTinClip :: Item -> Shape
+addTinClip itm = fromMaybe mempty $ do
+    hit <- itm ^? itType . iyBase . ibtHeld
+    let ap = ammoPosition hit
+    p <- ap ^? amposPos
+    d <- ap ^? amposDir
+    return $ translateSH p $ overPosSH (Q.rotate d) $ makeTinClip itm
+
+makeTinClip :: Item -> Shape
+makeTinClip it =
+        colorSH midcol (upperPrismPoly 1 (
+            reverse $
+                rectNSWE 0 (- y) (-2) 2)) <> translateSHz (-0.05) (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
+
 makeTinClipAt :: Float -> Point3 -> Item -> Shape
 makeTinClipAt r p it =
     translateSH p . overPosSH (rotate3z r) $