diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index d7f2d7fd6..65b66778f 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -69,7 +69,9 @@ itemCombinations = , p [o PRISM,o TRANSFORMER,o PIPE] lasGun , p [o LASGUN,o PRISM] lasGunSway , p [o LASGUN,o HARDWARE] lasGunSwing - , p [o LASGUN,o PIPE] lasGunPulse +-- , p [o LASGUN,o PIPE] lasGunPulse + , p [o LASGUN,p 2 PIPE] lasGunDual + , p [o LASGUN,o PIPE, o PRISM] lasGunWidePulse , p [o LASGUN,o TRANSFORMER,o PRISM] (lasGunWide 2) , p [o TRANSFORMER,p 2 CAN] sparkGun diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 2aa5c28de..78ae90f6b 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -51,8 +51,10 @@ data CombineType | TESLAGUN | LASGUN | LASPULSE + | LASGUNDUAL | LASGUNSWING | LASGUNSWAY + | LASGUNWIDEPULSE | LASGUNWIDE Int | LASGUNFOCUS Int | SONICGUN diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7fb94dcfb..8ea6841ea 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -86,6 +86,8 @@ data World = World , _props :: IM.IntMap Prop , _instantParticles :: [Particle] , _particles :: [Particle] + , _newBeams :: WorldBeams + , _beams :: WorldBeams , _walls :: IM.IntMap Wall , _doors :: IM.IntMap Door , _machines :: IM.IntMap Machine @@ -496,6 +498,33 @@ data ItEffect ,_itEffectID :: Maybe Int } data IntID a = IntID Int a + +data WorldBeams = WorldBeams + {_blockingBeams :: [Beam] + ,_lightBeams :: [Beam] + ,_positronBeams :: [Beam] + ,_electronBeams :: [Beam] + } +{- | Linear beams. Last only one frame. + - Can interact with one another in a limited manner + -} +data Beam = Beam + { _bmDraw :: Beam -> Picture + , _bmPos :: Point2 + , _bmDir :: Float + , _bmDamage :: Int + , _bmColor :: Color + , _bmPoints :: [Point2] + , _bmFirstPoints :: [Point2] + , _bmRange :: Float + , _bmPhaseV :: Float + , _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. -} data Particle @@ -1136,3 +1165,6 @@ makeLenses ''TerminalLine makeLenses ''ItemValue makeLenses ''ScreenLayer makeLenses ''Sensor +makeLenses ''Beam +makeLenses ''BeamType +makeLenses ''WorldBeams diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index b9032a29e..677fcc134 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -38,6 +38,8 @@ defaultWorld = World , _props = IM.empty , _instantParticles = [] , _particles = [] + , _newBeams = WorldBeams [] [] [] [] + , _beams = WorldBeams [] [] [] [] , _walls = IM.empty , _blocks = IM.empty , _machines = IM.empty diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index f2c632295..8d561903f 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -1,6 +1,8 @@ module Dodge.Item.Weapon.BatteryGuns ( lasGun + , lasGunDual , lasGunWide + , lasGunWidePulse , lasGunSway , lasGunSwing , lasGunFocus @@ -14,6 +16,7 @@ import Dodge.Data import Dodge.Item.Weapon.LaserPath import Dodge.Creature.HandPos import Dodge.Particle.TeslaArc +import Dodge.Particle.Flame import Dodge.SoundLogic.LoadSound import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Damage @@ -137,27 +140,34 @@ lasGunWide n = lasGun where n' = 9 * n xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] -lasGunWidePulse :: Int -> Item -lasGunWidePulse n = lasGun - & itName .~ "PARALELLASPULSE"++show n - & itType .~ LASGUNWIDE n +lasGunWidePulse :: Item +lasGunWidePulse = lasGun + & itName .~ "LASWIDEPULSE" + & itType .~ LASGUNWIDEPULSE & itParams . lasColor .~ orange & itParams . lasDamage .~ 2 & itUse .~ ( ruseInstant shootLaser NoHammer [ ammoCheckI - , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it)) - , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8 - , withSoundForI tone440sawtoothquietS 2 + , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it)) + , withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2 + , withItemUpdate itup + $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8) , useAmmoAmount 1 - , duplicateOffsets xs + , withItemUpdate itup $ \it -> duplicateOffsets (xs it) ] & useAim . aimSpeed .~ 0.4 & useAim . aimRange .~ 1 & useAim . aimStance .~ TwoHandTwist ) where - n' = 9 * n - xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] + itup it = it + & itParams . lasCycle %~ (\i -> (i+1) `mod` 40) + & itParams . lasDamage .~ ceiling ((22 :: Float) * frac it) + & itParams . lasColor .~ frac it * orange + frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.05)) + xs it = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] + where + n' = (ceiling $ (150 :: Float) * frac it) :: Int lasGunSway :: Item lasGunSway = lasGun & itName .~ "SWAYLAS" @@ -197,6 +207,24 @@ lasGunFocus n = lasGunWide n where n' = 9 * n xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] + +lasGunDual :: Item +lasGunDual = lasGun + & itName .~ "DUALAS" + & itType .~ LASGUNDUAL + & itParams . lasColor .~ red + & itUse .~ (ruseInstant shootDualLaser NoHammer + [ ammoCheckI + , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it)) + , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8 + , withSoundForI tone440sawtoothquietS 2 + , useAmmoAmount 1 + ] + & useAim . aimSpeed .~ 0.4 + & useAim . aimRange .~ 1 + & useAim . aimStance .~ TwoHandTwist + ) + lasGunSwing :: Item lasGunSwing = lasGun & itName .~ "SWINGLAS" @@ -404,6 +432,73 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr dam = _lasDamage $ _itParams it +shootDualLaser :: Item -> Creature -> World -> World +shootDualLaser it cr w = w + & newBeams . positronBeams .:~ dualRayAt w orange dam phasev posl dirl + & newBeams . electronBeams .:~ dualRayAtNoFlame w blue dam phasev posr dirr + where + dir = _crDir cr + pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir + aimlength = aimingMuzzlePos cr it + posl = pos +.+ (-10) * vNormal (unitVectorAtAngle dir) + posr = pos +.+ 10 * vNormal (unitVectorAtAngle dir) + mwp = mouseWorldPos w + mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir + | otherwise = mwp + dirl = argV $ mwp' -.- posl + dirr = argV $ mwp' -.- posr + phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr + dam = _lasDamage $ _itParams it + +drawBeam :: Beam -> Picture +drawBeam bm = setLayer 1 $ 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 + +dualRayAt :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam +dualRayAt w col dam phasev pos dir = Beam + { _bmDraw = drawBeam + , _bmPos = pos + , _bmDir = dir + , _bmDamage = dam +-- , _ptUpdate = mvLaser phasev pos dir + , _bmRange = 800 +-- , _ptDamage = dam + , _bmPhaseV = phasev + , _bmColor = col + , _bmPoints = pos:ps + , _bmFirstPoints = [] + , _bmType = BeamCombine + $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) +-- $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (V2 5 0) + } + where + (_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w +-- ps = [pos,pos +.+ 800 *.* unitVectorAtAngle dir] +dualRayAtNoFlame :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam +dualRayAtNoFlame w col dam phasev pos dir = Beam + { _bmDraw = drawBeam + , _bmPos = pos + , _bmDir = dir + , _bmDamage = dam +-- , _ptUpdate = mvLaser phasev pos dir + , _bmRange = 800 +-- , _ptDamage = dam + , _bmPhaseV = phasev + , _bmColor = col + , _bmPoints = pos:ps + , _bmFirstPoints = [] + , _bmType = BeamCombine + $ \_ -> id +-- $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (V2 5 0) + } + where + (_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w + lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle lasRayAt col dam phasev pos dir = LaserParticle { _ptDraw = const blank diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index db623a1da..3441fa7c2 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -7,6 +7,7 @@ module Dodge.Item.Weapon.SprayGuns , flameWall ) where import Dodge.Data +import Dodge.Particle.Flame --import Dodge.Data.SoundOrigin --import Dodge.Base --import Dodge.Zone @@ -204,7 +205,8 @@ useGasParams nz it cr = _amCreateGas (_aoType (_itConsumption it)) (_nzPressure pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr)) aFlame :: Float -> Point2 -> Float -> Creature -> World -> World -aFlame pressure pos dir cr w = w & instantParticles .:~ aFlameParticle t pos vel (Just $ _crID cr) +aFlame pressure pos dir cr = makeFlame pos vel + --w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr) where - (t,_) = randomR (99,101) (_randGen w) +-- (t,_) = randomR (99,101) (_randGen w) vel = (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir diff --git a/src/Dodge/Particle/Damage.hs b/src/Dodge/Particle/Damage.hs index 2b69a714b..8a5033e5b 100644 --- a/src/Dodge/Particle/Damage.hs +++ b/src/Dodge/Particle/Damage.hs @@ -1,10 +1,12 @@ module Dodge.Particle.Damage where import Dodge.Data import Geometry +import LensHelp import System.Random import Control.Monad.State +-- TODO unify particle position in a sensible manner spawnAtBulDams :: (Point2 -> State StdGen Particle) -> Particle -> Point2 -> [Damage] spawnAtBulDams thespawn bt p = @@ -21,7 +23,9 @@ simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] where - sp = head $ _ptTrail bt + sp = case bt ^? ptTrail of + Nothing -> _ptPos bt + Just xs -> head xs bulVel = _ptVel bt ep = sp +.+ bulVel diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 241bd8323..d15d7bf7a 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -46,6 +46,8 @@ extraShapes = _foregroundShape extraPics :: Configuration -> World -> Picture extraPics cfig w = pictures (_decorations w) <> concatMapPic (dbArg _ptDraw) (_particles w) + <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w) + <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w) <> concatMapPic (dbArg _lsPict) (_lightSources w) <> testPic w <> concatMapPic clDraw (_clouds w ) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index b88d3c107..3605d7fda 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -59,6 +59,7 @@ functionalUpdate cfig w = checkEndGame . dbArg _worldEvents . updateIMl _modifications _mdUpdate . updateParticles + . updateBeams . updateIMl _props _pjUpdate . updateLightSources . updateClouds @@ -141,6 +142,74 @@ updateParticles :: World -> World updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w' where (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w +updateBeams :: World -> World +updateBeams w = w + & newBeams .~ WorldBeams [] [] [] [] + & beams .~ thebeams + & combineBeams thebeams + where + thebeams = _newBeams w + +combineBeams :: WorldBeams -> World -> World +combineBeams wbeams w = w'' + & beams . positronBeams .~ pbeams + & beams . electronBeams .~ ebeams + where + (w',pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams + (w'',ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams + +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) + +-- intersect a beam with a list of beams. +-- returns the (reversed) travel of the beam up to maybe an intersection point +intersectBeamBeams :: Beam -> [Beam] + -> ([Point2], Maybe (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))) +intersectBeamBeams bm bms = f [] $ _bmPoints bm + where + f ps (x:y:ys) = case intersectSegBeams x y bms of + Just (z,a) -> ((z:x:ps), Just (z,(x,y,bm),a)) + Nothing -> f (x:ps) (y:ys) + f ps (x:[]) = (x:ps, Nothing) + f _ _ = error "made an empty beam" + +intersectSegBeams :: Point2 -> Point2 -> [Beam] -> Maybe (Point2,(Point2,Point2,Beam)) +intersectSegBeams sp ep (bm:bms) = case intersectSegBeam sp ep bm of + Nothing -> intersectSegBeams sp ep bms + Just a@(z,_) -> maybe (Just a) Just $ intersectSegBeams sp z bms +intersectSegBeams _ _ _ = Nothing + +intersectSegBeam :: Point2 -> Point2 -> Beam -> Maybe (Point2,(Point2,Point2,Beam)) +intersectSegBeam sp ep bm = case intersectSegSegs' sp ep (_bmPoints bm) of + Nothing -> Nothing + Just (z,x,y) -> Just (z,(x,y,bm)) + +intersectSegSegs' :: Point2 -> Point2 -> [Point2] -> Maybe (Point2,Point2,Point2) +intersectSegSegs' sp ep (x:y:ys) = case intersectSegSeg sp ep x y of + Just z -> maybe (Just (z,x,y)) Just $ intersectSegSegs' sp z (y:ys) + Nothing -> intersectSegSegs' sp ep (y:ys) +intersectSegSegs' _ _ _ = Nothing + +--intersectSegSegs :: Point2 -> Point2 -> [Point2] -> Maybe Point2 +--intersectSegSegs sp ep (x:y:ys) = case intersectSegSeg sp ep x y of +-- Just z -> maybe (Just z) Just $ intersectSegSegs sp z (y:ys) +-- Nothing -> intersectSegSegs sp ep (y:ys) +--intersectSegSegs _ _ _ = Nothing +-- +--intersectSegSegss :: Point2 -> Point2 -> [[Point2]] -> Maybe Point2 +--intersectSegSegss sp ep (as:ass) = case intersectSegSegs sp ep as of +-- Just z -> maybe (Just z) Just $ intersectSegSegss sp z ass +-- Nothing -> intersectSegSegss sp ep ass +--intersectSegSegss _ _ _ = Nothing +-- +--intersectSegsSegss :: [Point2] -> [[Point2]] -> Maybe Point2 +--intersectSegsSegss (x:y:ys) ass = maybe +-- (intersectSegsSegss (y:ys) ass) +-- Just +-- (intersectSegSegss x y ass) +--intersectSegsSegss _ _ = Nothing updateInstantParticles :: World -> World updateInstantParticles w = case _instantParticles w of