Tweak lasers

src/Dodge/Creature/State.hs

@@ -35,7 +35,6 @@ import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
 import LensHelp
-import Picture
 import qualified Quaternion as Q
 import RandomHelp
 import qualified SDL
@@ -218,7 +217,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
                     { _lpPhaseV = 1
                     , _lpDir = _crDir cr + argV (Q.qToV2 q)
                     , _lpPos = pos
-                    , _lpColor = col
+--                    , _lpColor = col
                     , _lpType = TargetingLaser (_itID itm)
                     }
   where
@@ -233,7 +232,6 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     itm = itmtree ^. dtValue . _1
     pointittarg = cWorld . lWorld . items . ix itid . itTargeting
     itid = itm ^. itID . unNInt
-    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
 
 shineTorch :: Creature -> LocationDT OItem -> World -> World
 shineTorch cr loc = fromMaybe id $ do

src/Dodge/Data/Laser.hs

@@ -5,7 +5,7 @@ module Dodge.Data.Laser where
 
 import NewInt
 import Dodge.Data.Item.Location
-import Color
+--import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -20,7 +20,6 @@ data Laser = Laser
     { _lpPhaseV :: Float
     , _lpPos :: Point2
     , _lpDir :: Float
-    , _lpColor :: Color
     , _lpType :: LaserType
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/HeldUse.hs

@@ -10,6 +10,7 @@ module Dodge.HeldUse (
     itemMuzzles,
 ) where
 
+import Dodge.Laser.Update
 import Color
 import Control.Applicative
 import Control.Monad
@@ -37,7 +38,7 @@ import Dodge.Tesla
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Linear (_xy, _xyz)
+import Linear (_xy,_xyz)
 import ListHelp
 import NewInt
 import Picture.Base
@@ -186,10 +187,10 @@ itemMuzzles loc = case itm ^. itType of
             [dbwMuzzles
                 & ix 0 . mzPos .~ V2 6 x
                 & ix 0 . mzInaccuracy .~ 0
-                & ix 0 . mzFlareType .~ LasGunFlare
+                & ix 0 . mzFlareType .~ NoLightFlare
                 & ix 0 . mzEffect .~ MuzzleLaser
             | x <- spreadAroundCenter i 3
-            ]
+            ] & ix (i `div` 2) . mzFlareType .~ LasGunFlare
     _ -> []
   where
     itm = loc ^. locDT . dtValue . _1
@@ -686,9 +687,9 @@ makeMuzzleFlare (p, q) loc = \case
             . muzFlareAt (V4 10 10 1 3) p dir
     HeavySmokeFlare -> basicMuzFlare (p ^. _xy) dir
     LasGunFlare ->
-        flareCircleAt (getLaserColor loc) 0.8 p
+        flareCircleAt (ltToCol $ getLaserDamage loc) 0.8 p
             . ( cWorld . lWorld . lights
-                    .:~ LSParam p 100 (getLaserColor loc ^. _xyz) -- p had z=10
+                    .:~ LSParam p 100 (ltToCol (getLaserDamage loc) ^. _xyz) -- p had z=10
               )
     TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam p 100 (V3 0 0 1) -- p had z=10
   where
@@ -727,9 +728,6 @@ getLaserPhaseV = const 1
 getLaserDamage :: LocationDT OItem -> LaserType
 getLaserDamage = const (DamageLaser 11)
 
-getLaserColor :: LocationDT OItem -> Color
-getLaserColor = const yellow
-
 basicMuzFlare :: Point2 -> Float -> World -> World
 basicMuzFlare pos dir =
     (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5))
@@ -866,7 +864,6 @@ creatureShootLaser (p, q) loc =
         (getLaserPhaseV loc)
         (p ^. _xy)
         (Q.qToAng q)
-        (getLaserColor loc)
 
 shootLaser ::
     SoundOrigin ->
@@ -874,17 +871,15 @@ shootLaser ::
     Float ->
     Point2 ->
     Float ->
-    Color ->
     World ->
     World
-shootLaser so lt pv p dir col =
+shootLaser so lt pv p dir =
     ( cWorld . lWorld . lasers
         .:~ Laser
             { _lpType = lt
             , _lpPhaseV = pv
             , _lpPos = p
             , _lpDir = dir
-            , _lpColor = col
             }
     )
         . soundContinue so p tone440sawtoothquietS (Just 2)
@@ -1185,7 +1180,7 @@ doGenFloat (UniRandFloat x y) g = randomR (x, y) g
 
 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser _ mc =
-    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
+    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
   where
     pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
     dir = (mc ^?! mcType . mctTurret . tuDir)

src/Dodge/Laser/Update.hs

@@ -1,4 +1,5 @@
-module Dodge.Laser.Update (updateLaser, drawLaser) where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Laser.Update (updateLaser, drawLaser, drawPulseLaser,ltToCol) where
 
 import Dodge.Damage
 import Control.Lens
@@ -17,7 +18,7 @@ updateLaser w pt =
                 thHit
                 w
         TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps
-    , drawLaser (_lpColor pt) (sp : ps)
+    , drawLaser (_lpType pt) (sp : ps)
     )
   where
     phasev = _lpPhaseV pt
@@ -26,9 +27,21 @@ updateLaser w pt =
     xp = sp +.+ 800 *.* unitVectorAtAngle dir
     (thHit, ps) = reflectLaserAlong phasev sp xp w
 
-drawLaser :: Color -> [Point2] -> Picture
-drawLaser col =
+drawLaser :: LaserType -> [Point2] -> Picture
+drawLaser lt =
     setLayer BloomLayer -- was nozwrite
         . setDepth 19.5
-        . color (brightX 10 1 col)
+        . color (brightX 10 1 (ltToCol lt))
+        . thickLine 3
+
+ltToCol :: LaserType -> Color
+ltToCol = \case
+    DamageLaser {} -> yellow
+    TargetingLaser {} -> green
+
+drawPulseLaser :: [Point2] -> Picture
+drawPulseLaser =
+    setLayer BloomLayer -- was nozwrite
+        . setDepth 19.5
+        . color (brightX 10 1 cyan)
         . thickLine 3

src/Dodge/TestString.hs

@@ -33,8 +33,8 @@ import Data.Monoid
 import RandomHelp
 
 testStringInit :: Universe -> [String]
-testStringInit u = 
-    (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crHP . _HP)
+testStringInit _ = []
+    --(fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crHP . _HP)
 --    <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
 --testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
 --testStringInit u =  map show

src/Dodge/Update.hs

@@ -702,7 +702,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
   where
     f w =
         dodam thHit w
-            & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
+            & cWorld . lWorld . flares <>~ drawPulseLaser (sp : ps)
       where
         (thHit, ps) = reflectPulseLaserAlong phasev sp xp w
     dodam thit = case thit of
@@ -721,7 +721,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
     sp = _pzPos pz
     dir = _pzDir pz
     xp = sp +.+ 800 *.* unitVectorAtAngle dir
-    g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
+    g w = w & cWorld . lWorld . flares <>~ drawPulseLaser (sp : ps)
       where
         (_, ps) = reflectPulseLaserAlong phasev sp xp w