diff --git a/src/Dodge/Beam.hs b/src/Dodge/Beam.hs index 832794ed5..fd36b1d5c 100644 --- a/src/Dodge/Beam.hs +++ b/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,_)) diff --git a/src/Dodge/Beam/Draw.hs b/src/Dodge/Beam/Draw.hs new file mode 100644 index 000000000..a27a6e9d1 --- /dev/null +++ b/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 diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs index 2800c3301..924e4a7bc 100644 --- a/src/Dodge/Combine/Module.hs +++ b/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 - SPLITLAS -> itParams . lasBeam .~ BeamCombine splitBeamCombine - STATICLAS -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine) + INCENDLAS -> itParams . lasBeam .~ BeamCombine FlameBeamCombine + SPLITLAS -> itParams . lasBeam .~ BeamCombine SplitBeamCombine + STATICLAS -> (itParams . lasBeam .~ BeamCombine TeslaBeamCombine) . (itParams . subParams ?~ teslaParams) WEPTELE -> makeDirectedTele LAUNCHHOME -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 808f8b6d1..c4e8d8464 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/Beam.hs b/src/Dodge/Data/Beam.hs new file mode 100644 index 000000000..0463d107c --- /dev/null +++ b/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 diff --git a/src/Dodge/Data/Item/Params.hs b/src/Dodge/Data/Item/Params.hs new file mode 100644 index 000000000..3757933d7 --- /dev/null +++ b/src/Dodge/Data/Item/Params.hs @@ -0,0 +1,3 @@ +module Dodge.Data.Item.Params where + + diff --git a/src/Dodge/Data/Targeting.hs b/src/Dodge/Data/Targeting.hs index e7aa84e62..af52b3e1c 100644 --- a/src/Dodge/Data/Targeting.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index b66b934c7..c3337132d 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 1d816980f..9c25ed8b8 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 _bmDraw) (_electronBeams $ _beams w) + <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w) + <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w) <> concatMapPic (dbArg _lsPict) (_lightSources w) <> testPic cfig w <> concatMapPic clDraw (_clouds w ) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 75ff69dce..98e5bdce2 100644 --- a/src/Dodge/Update.hs +++ b/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