Refactor beams

src/Dodge/Beam.hs

@@ -19,6 +19,16 @@ import Picture
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 
+doBeamCombine :: BeamCombineType 
+    -> (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World 
+    -> World
+doBeamCombine bct = case bct of
+    FlameBeamCombine -> flameBeamCombine
+    LasBeamCombine   -> lasBeamCombine
+    TeslaBeamCombine -> teslaBeamCombine
+    SplitBeamCombine -> splitBeamCombine
+    NoBeamCombine -> const id
 flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
     -> World -> World
 flameBeamCombine (p,(a,b,_),(x,y,_))

src/Dodge/Beam/Draw.hs

@@ -0,0 +1,17 @@
+module Dodge.Beam.Draw where
+import Dodge.Data.Beam
+import Picture
+
+drawBeam :: BeamDraw -> Beam -> Picture
+drawBeam bd = case bd of
+    BasicBeamDraw -> basicDrawBeam
+    BeamDrawColor _ -> basicDrawBeam
+
+basicDrawBeam :: Beam -> Picture
+basicDrawBeam bm = setLayer BloomNoZWrite $ pictures
+    [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
+    , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
+    ]
+  where
+    col = _bmColor bm
+    ps = _bmFirstPoints bm

src/Dodge/Combine/Module.hs

@@ -4,7 +4,6 @@ import Dodge.Tesla
 import Dodge.Item.Weapon.ExtraEffect
 import LensHelp
 import Geometry
-import Dodge.Beam
 
 moduleModification :: ItemModuleType -> Item -> Item
 moduleModification imt = case imt of
@@ -24,9 +23,9 @@ moduleModification imt = case imt of
         . (itConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
     FLECHETRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
     BEZIERTRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
-    INCENDLAS   -> itParams . lasBeam .~ BeamCombine flameBeamCombine
+    INCENDLAS   -> itParams . lasBeam .~ BeamCombine FlameBeamCombine
-    SPLITLAS    -> itParams . lasBeam .~ BeamCombine splitBeamCombine
+    SPLITLAS    -> itParams . lasBeam .~ BeamCombine SplitBeamCombine
-    STATICLAS   -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine)
+    STATICLAS   -> (itParams . lasBeam .~ BeamCombine TeslaBeamCombine)
         . (itParams . subParams ?~ teslaParams)
     WEPTELE     -> makeDirectedTele
     LAUNCHHOME  -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Beam
     , module Dodge.Data.Targeting
     , module Dodge.Data.ItEffect
     , module Dodge.Data.Hammer
@@ -66,6 +67,7 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.Beam
 import Dodge.Data.Targeting
 import Dodge.Data.ItEffect
 import Dodge.Data.Hammer
@@ -434,15 +436,6 @@ data Item = Item
     , _itValue      :: ItemValue
     , _itParams     :: ItemParams
     }
-data Targeting
-    = NoTargeting
-    | Targeting
-        { _tgPos    :: Maybe Point2
-        , _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
-        , _tgDraw   :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
-        , _tgID     :: Maybe Int
-        , _tgActive :: Bool
-        }
 
 data IntID a = IntID Int a
 
@@ -452,27 +445,6 @@ data WorldBeams = WorldBeams
     ,_positronBeams :: [Beam]
     ,_electronBeams :: [Beam]
     }
-{- | Linear beams. Last only one frame.
- - Can interact with one another in a limited manner
- - can probably be moved to a separate file
- -}
-data Beam = Beam
-    { _bmDraw   :: Beam -> Picture
-    , _bmPos    :: Point2
-    , _bmDir    :: Float
-    , _bmDamage :: Int
-    , _bmColor  :: Color
-    , _bmPoints :: [Point2]
-    , _bmFirstPoints :: [Point2]
-    , _bmRange  :: Float
-    , _bmPhaseV :: Float
-    , _bmOrigin :: Maybe Int
-    , _bmType   :: BeamType
-    }
-data BeamType 
-    = BeamCombine 
-        {_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
-    | BeamSimple
 
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
@@ -1226,13 +1198,10 @@ makeLenses ''ItemParams
 makeLenses ''ItemTweaks
 makeLenses ''Gust
 makeLenses ''GunBarrels
-makeLenses ''Targeting
 makeLenses ''Nozzle
 makeLenses ''TerminalLine
 makeLenses ''Equipment
 makeLenses ''ScreenLayer
-makeLenses ''Beam
-makeLenses ''BeamType
 makeLenses ''WorldBeams
 makeLenses ''TerminalCommand
 makeLenses ''TerminalInput

src/Dodge/Data/Beam.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Beam where
+import Geometry.Data
+import Color
+import Control.Lens
+
+{- | Linear beams. Last only one frame.
+ - Can interact with one another in a limited manner
+ - can probably be moved to a separate file
+ -}
+data Beam = Beam
+    { _bmDraw   :: BeamDraw -- Beam -> Picture
+    , _bmPos    :: Point2
+    , _bmDir    :: Float
+    , _bmDamage :: Int
+    , _bmColor  :: Color
+    , _bmPoints :: [Point2]
+    , _bmFirstPoints :: [Point2]
+    , _bmRange  :: Float
+    , _bmPhaseV :: Float
+    , _bmOrigin :: Maybe Int
+    , _bmType   :: BeamType
+    }
+data BeamDraw = BasicBeamDraw
+    | BeamDrawColor Color
+
+data BeamCombineType = FlameBeamCombine
+    | LasBeamCombine
+    | TeslaBeamCombine
+    | SplitBeamCombine
+    | NoBeamCombine
+data BeamType 
+    = BeamCombine 
+        { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World
+        }
+    | BeamSimple
+makeLenses ''BeamType
+makeLenses ''Beam

src/Dodge/Data/Item/Params.hs

@@ -0,0 +1,3 @@
+module Dodge.Data.Item.Params where
+
+

src/Dodge/Data/Targeting.hs

@@ -1,14 +1,24 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Data.Targeting where
-
+import Geometry.Data
+import Control.Lens
+data Targeting
+    = NoTargeting
+    | Targeting
+        { _tgPos    :: Maybe Point2
+        , _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
+        , _tgDraw   :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
+        , _tgID     :: Maybe Int
+        , _tgActive :: Bool
+        }
 data TargetUpdate = NoTargetUpdate
     | TargetLaserUpdate
     | TargetRBPressUpdate
     | TargetRBCreatureUpdate
     | TargetCursorUpdate
-
 data TargetDraw = NoTargetDraw
     | TargetDistanceDraw
     | SimpleDrawTarget
     | TargetRBCreatureDraw
+makeLenses ''Targeting

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -188,7 +188,7 @@ dualBeam = lasGun
         , _lasColor2 = green
         , _lasCycle = 0
         , _lasDamage = 11
-        , _lasBeam = BeamCombine lasBeamCombine
+        , _lasBeam = BeamCombine LasBeamCombine
         , _subParams = Nothing
         , _dbGap = 20
         }
@@ -356,18 +356,9 @@ shootDualLaser it cr w = w'
     phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
     dam = _lasDamage $ _itParams it
 
-drawBeam :: Beam -> Picture
-drawBeam bm = setLayer BloomNoZWrite $ pictures
-    [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
-    , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
-    ]
-  where
-    col = _bmColor bm
-    ps = _bmFirstPoints bm
-
 basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
 basicBeamAt itid w col dam phasev pos dir = Beam
-    { _bmDraw = drawBeam
+    { _bmDraw = BasicBeamDraw --drawBeam
     , _bmPos = pos
     , _bmDir = dir
     , _bmDamage = dam
@@ -377,7 +368,7 @@ basicBeamAt itid w col dam phasev pos dir = Beam
     , _bmPoints = pos:ps
     , _bmFirstPoints = []
     , _bmOrigin = Just itid
-    , _bmType = BeamCombine $ const id
+    , _bmType = BeamCombine NoBeamCombine
     }
   where
     (_,ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.Targeting.Draw
+import Dodge.Beam.Draw
 import Dodge.RadarSweep.Draw
 import Dodge.Projectile.Draw
 import Dodge.Item.Draw.SPic
@@ -124,8 +125,8 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawBul (_bullets w)
     <> concatMapPic drawBlip (_radarBlips    w)
     <> concatMapPic drawFlare (_flares    w)
-    <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
+    <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w)
-    <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
+    <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)
     <> testPic cfig w
     <> concatMapPic clDraw (_clouds w      )

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.Beam
 import Dodge.Projectile.Update
 import Dodge.Creature.Update
 import Dodge.RadarSweep
@@ -270,7 +271,7 @@ combineBeams wbeams w = w''
 combineBeamBeams :: [Beam] -> World -> Beam -> (World,Beam)
 combineBeamBeams bms w bm = case intersectBeamBeams bm bms of
     (ps,Nothing) -> (w, bm & bmFirstPoints .~ ps)
-    (ps,Just a)  -> (_beamCombine (_bmType bm) a w, bm & bmFirstPoints .~ ps)
+    (ps,Just a)  -> (doBeamCombine (_beamCombine (_bmType bm)) a w, bm & bmFirstPoints .~ ps)
 
 -- intersect a beam with a list of beams.
 -- returns the (reversed) travel of the beam up to maybe an intersection point