Add muzzle flare

src/Color.hs

@@ -72,3 +72,19 @@ bright (V4 r g b a) = V4 (r*1.2) (g*1.2) (b*1.2) a
 greyN :: Float -> Color
 {-# INLINE greyN #-}
 greyN x = toV4 (x,x,x,1)
+
+numColor :: Int -> Color
+numColor 0  = toV4 (1,0,0,1) 
+numColor 1  = toV4 (0,1,0,1) 
+numColor 2  = toV4 (0,0,1,1) 
+numColor 3  = toV4 (1,1,0,1)  
+numColor 4  = toV4 (0,1,1,1) 
+numColor 5  = toV4 (1,0,1,1)  
+numColor 6  = toV4 (1,0,0.5,1) 
+numColor 7  = toV4 (0.5,0,1,1)  
+numColor 8  = toV4 (0,0.5,1,1) 
+numColor 9  = toV4 (0,1,0.5,1) 
+numColor 10 = toV4 (0.5,1,0,1)
+numColor 11 = toV4 (1,0.5,0,1)  
+numColor 12 = toV4 (1,1,1,1) 
+numColor _  = toV4 (1,1,1,1) 

src/Dodge/Data.hs

@@ -303,6 +303,7 @@ data Item
         , _itWorldTrigger :: Maybe (Int -> World -> Bool)
         , _itAimStance :: AimStance
         , _wpNumBarrels :: Int
+        , _itDimension  :: ItemDimension
         }
     | Consumable
         { _itName :: String
@@ -377,6 +378,13 @@ data Item
         }
      | NoItem
 
+data ItemDimension = ItemDimension
+    { _itDim    :: Point3 -- length width height
+    , _itHandle :: Point3
+    , _itCenter :: Point3
+    , _muzzleLength :: Float
+    }
+
 data ReloadType = ActiveReload | PassiveReload SoundID
 
 data ItEffect = NoItEffect
@@ -762,18 +770,4 @@ makeLenses ''Intention
 makeLenses ''Door
 makeLenses ''Block
 makeLenses ''Zone
-numColor :: Int -> Color
+makeLenses ''ItemDimension
-numColor 0  = toV4 (1,0,0,1) 
-numColor 1  = toV4 (0,1,0,1) 
-numColor 2  = toV4 (0,0,1,1) 
-numColor 3  = toV4 (1,1,0,1)  
-numColor 4  = toV4 (0,1,1,1) 
-numColor 5  = toV4 (1,0,1,1)  
-numColor 6  = toV4 (1,0,0.5,1) 
-numColor 7  = toV4 (0.5,0,1,1)  
-numColor 8  = toV4 (0,0.5,1,1) 
-numColor 9  = toV4 (0,1,0.5,1) 
-numColor 10 = toV4 (0.5,1,0,1)
-numColor 11 = toV4 (1,0.5,0,1)  
-numColor 12 = toV4 (1,1,1,1) 
-numColor _  = toV4 (1,1,1,1) 

src/Dodge/Default/Weapon.hs

@@ -7,6 +7,8 @@ import Dodge.Item.Attachment.Data
 import Dodge.Item.Data
 import Picture
 import ShapePicture
+
+import Linear.V3
 defaultGun :: Item
 defaultGun = Weapon 
     { _itName = "default"
@@ -47,7 +49,16 @@ defaultGun = Weapon
     , _itWorldTrigger = Nothing
     , _itAimStance = OneHand
     , _wpNumBarrels = 1
+    , _itDimension = defaultItemDimension
     }
+defaultItemDimension :: ItemDimension
+defaultItemDimension = ItemDimension
+    { _itDim = V3 4 4 4
+    , _itHandle = V3 2 2 2
+    , _itCenter = V3 2 2 2
+    , _muzzleLength = 5 -- how much the item projects out from the cr radius when aiming
+    }
+
 defaultAutoGun :: Item
 defaultAutoGun = defaultGun 
     { _itInvDisplay = basicWeaponDisplay

src/Dodge/Item/Weapon.hs

@@ -703,8 +703,8 @@ boosterGun = defaultGun
 
 aTeslaArc :: Creature -> World -> World
 aTeslaArc cr w 
-    = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
+    = -- teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-    $ set randGen g w
+    set randGen g w
     & particles %~ (makeTeslaArcAt col pos dir :)
   where 
     pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir

src/Dodge/Item/Weapon/Laser.hs

@@ -11,7 +11,7 @@ import Dodge.Item.Attachment.Data
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
-import Dodge.WorldEvent.Flash
+--import Dodge.WorldEvent.Flash
 import Dodge.Creature.State.Data
 import Geometry
 import Picture
@@ -25,9 +25,7 @@ import qualified Data.Sequence as Seq
 --import qualified Data.IntMap.Strict as IM
 
 aLaser :: Creature -> World -> World
-aLaser cr w = over particles (makeLaserAt phaseV pos dir : )
+aLaser cr w = over particles (makeLaserAt phaseV pos dir : ) w
-    $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-    w
   where 
     pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
     dir = _crDir cr
@@ -56,7 +54,7 @@ moveLaser
     -> (World, Maybe Particle)
 moveLaser phaseV pos dir w pt
     = ( set randGen g $ hitEffect w
-      , Just pt {_ptDraw = const pic ,_ptUpdate = ptTimer' 0 }
+      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
       )
   where 
     xp = pos +.+ 800 *.* unitVectorAtAngle dir

src/Dodge/Item/Weapon/TriggerType.hs

@@ -42,6 +42,7 @@ import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Creature.Action (startReloadingWeapon)
 import Dodge.WorldEvent
+--import Dodge.WorldEvent.Flash
 --import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
 import Dodge.Item.Attachment.Data
@@ -50,6 +51,7 @@ import Dodge.Default
 import Sound.Data
 import Geometry
 import Geometry.Vector3D
+--import Color
 
 import System.Random
 import Control.Lens
@@ -313,11 +315,16 @@ modClock n chainEff eff it cr w
 
 withMuzFlareI :: ChainEffect
 withMuzFlareI f it cr w = 
-    makeTLight 3 100 (V3 1 1 0.5) pos2 -- . muzzleFlashAt pos2 
+    makeTLight 3 100 (V3 1 1 0.5) flashPos
+    . muzFlareAt (V4 5 5 0 2) flarePos dir
     $ f it cr w
   where 
     --pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
-    pos2 = addZ 35 $ _crPos cr +.+ (2.5 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+    flarePos = addZ 20 $ _crPos cr +.+ (_crRad cr + itLength) *.* unitVectorAtAngle dir
+    flashPos = addZ 35 $ _crPos cr +.+ (2.5 * _crRad cr) *.* unitVectorAtAngle dir
+    dir = _crDir cr
+    itLength = _muzzleLength $ _itDimension it
+
 {- | Applies the effect to a randomly rotated creature,
  - rotation amount given by wpSpread  -}
 randSpreadDir :: ChainEffect

src/Dodge/WorldEvent.hs

@@ -21,6 +21,7 @@ import Dodge.Creature.State.Data
 import Dodge.Data
 import Dodge.Data.DamageType
 import Geometry
+import Color
 
 import Control.Lens
 import System.Random

src/Dodge/WorldEvent/Flash.hs

@@ -14,6 +14,8 @@ module Dodge.WorldEvent.Flash
     , laserGunFlashAt
     , teslaGunFlashAt
     , lowLightDirected
+    , flareCircleAt
+    , muzFlareAt
     )
     where
 import Dodge.Data
@@ -27,13 +29,14 @@ import Geometry
 
 import Data.Maybe (maybeToList)
 import Control.Lens
+import System.Random
 
 {- Cyan flash. -}
-teslaGunFlashAt :: Point2 -> World -> World
+teslaGunFlashAt :: Point3 -> World -> World
 teslaGunFlashAt = flareCircleAt cyan 0.7
 
 {- Yellow flash. -}
-laserGunFlashAt :: Point2 -> World -> World
+laserGunFlashAt :: Point3 -> World -> World
 laserGunFlashAt = flareCircleAt yellow 0.2
 
 glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World
@@ -63,13 +66,27 @@ lowLightPic len wdth col (a,b) w = case thingsHit a b w of
         _   -> blank
   where setCol = color col . setDepth (-0.5) . setLayer 2
 
-flareCircleAt :: Color -> Float -> Point2 -> World -> World
+muzFlareAt :: Color -> Point3 -> Float -> World -> World
-flareCircleAt col alphax (V2 x y) = particles %~ (theFlareCircle :)
+muzFlareAt col tranv dir w = w & particles %~ (theFlareCircle :)
   where
     theFlareCircle = Particle
-        { _ptDraw = const $ setLayer 2 . setDepth 20 . translate x y 
+        { _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape
-                            $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
+        , _ptUpdate = ptSimpleTime 2
-        , _ptUpdate = ptTimer' 1
+        }
+    theShape = rotate dir . color col $ polygon
+        [ V2 0 0
+        , V2 a (-b)
+        , V2 c d
+        ]
+    (a:b:c:d:_) = randomRs (2,20) (_randGen w)
+
+flareCircleAt :: Color -> Float -> Point3 -> World -> World
+flareCircleAt col alphax tranv = particles %~ (theFlareCircle :)
+  where
+    theFlareCircle = Particle
+        { _ptDraw = const $ setLayer 2 . translate3 tranv
+                            $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
+        , _ptUpdate = ptSimpleTime 1
         }
 
 explosionFlashAt :: Point2 -> World -> World

src/Dodge/WorldEvent/HelperParticle.hs

@@ -1,9 +1,11 @@
 {- Helper functions for particles.  -}
 module Dodge.WorldEvent.HelperParticle
+    ( ptSimpleTime
+    )
     where
 import Dodge.Data
 
 {- A simple timer update for particles.  -}
-ptTimer' :: Int -> World -> Particle -> (World, Maybe Particle)
+ptSimpleTime :: Int -> World -> Particle -> (World, Maybe Particle)
-ptTimer' 0 w _ = (w, Nothing)
+ptSimpleTime 0 w _ = (w, Nothing)
-ptTimer' n w pt = (w, Just $ pt {_ptUpdate = ptTimer' (n-1)})
+ptSimpleTime n w pt = (w, Just $ pt {_ptUpdate = ptSimpleTime (n-1)})