diff --git a/src/Dodge/Beam.hs b/src/Dodge/Beam.hs index 7668017b9..385ba8bf0 100644 --- a/src/Dodge/Beam.hs +++ b/src/Dodge/Beam.hs @@ -65,10 +65,10 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows -> World -> Particle -> (World, Maybe Particle) -mvLaser phasev sp dir w pt - = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w - , Just pt {_ptPoints = sp:ps ,_ptUpdate = ptSimpleTime 0 } - ) +mvLaser phasev sp dir w pt = + ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w + , Just pt {_ptPoints = sp:ps ,_ptUpdate = ptSimpleTime 0 } + ) where dam = _ptDamage pt xp = sp +.+ 800 *.* unitVectorAtAngle dir @@ -76,9 +76,12 @@ mvLaser phasev sp dir w pt (thHit, ps) = reflectLaserAlong phasev sp xp w drawLaser :: Particle -> Picture -drawLaser pt = 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 +--drawLaser pt = setLayer BloomNoZWrite $ pictures + --[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps +drawLaser pt = + setLayer BloomNoZWrite $ pictures +-- [ setDepth 19 . color (brightX 1 0.5 col) $ thickLine 20 ps + [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps ] where col = _ptColor pt diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 8f2fc306f..0828a22a7 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -65,7 +65,7 @@ itemCombinations = -- , p [o LASGUN,o PIPE] lasGunPulse , p [o LASGUN,p 2 $ cr PIPE] lasDual , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse - , p [o LASGUN,o $ cr TRANSFORMER,o $ cr PRISM] (lasWide 2) + , p [o LASGUN,o $ cr TRANSFORMER] (lasGunWide 2) , p [o $ cr TRANSFORMER,p 2 $ cr CAN] sparkGun , p [o SPARKGUN,p 2 $ cr PIPE] teslaGun @@ -83,7 +83,7 @@ itemCombinations = , p [p 2 $ cr PLATE] flatShield ] - ++ map (\i -> po [LASGUNWIDE i,cr TRANSFORMER,cr PRISM] $ lasWide (i+1)) [2..9] + ++ map (\i -> po [LASGUNWIDE i,cr TRANSFORMER] $ lasGunWide (i+1)) [2..9] -- ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10] ++ map (\i -> po [cr PIPE,BANGSTICK i] $ bangStick (i+1)) [1..8] ++ map (\i -> po [REVOLVERX i,cr CAN] $ revolverX (i+1)) [1..5] @@ -182,7 +182,7 @@ batteryGuns = , lasSway , lasSwing ] ++ - [ lasWide i | i <- [1..10] + [ lasGunWide i | i <- [2..10] ] -- ++ -- [ lasFocus i | i <- [1..10]] diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index c250f5e52..2eef3b349 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -228,18 +228,7 @@ inventoryX c = case c of , makeTypeCraftNum 2 MICROCHIP ] 'J' -> [ lasGun - , lasSwing - , lasDual - , lasWide 1 - , lasWide 2 - , lasWide 3 - , lasWide 4 - , lasWide 5 - , lasWidePulse - , lasFocus 1 - , lasFocus 2 - , lasFocus 3 - , lasFocus 6 + , makeTypeCraftNum 10 TRANSFORMER ] _ -> [] diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 1edfc44e2..1120a334c 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -64,7 +64,7 @@ itemFromBase ibt = case ibt of LASGUNSWING -> lasSwing LASGUNSWAY -> lasSway LASGUNWIDEPULSE -> lasWidePulse - LASGUNWIDE i -> lasWide i + LASGUNWIDE i -> lasGunWide i LASGUNFOCUS i -> lasFocus i SONICGUN -> sonicGun TRACTORGUN -> tractorGun diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 4f1c71c52..dc597332d 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -1,7 +1,7 @@ module Dodge.Item.Weapon.BatteryGuns ( lasGun , lasDual - , lasWide + , lasGunWide , lasWidePulse , lasSway , lasSwing @@ -122,8 +122,8 @@ lasPulse = lasGun frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1)) -lasWide :: Int -> Item -lasWide n = lasGun +lasGunWide :: Int -> Item +lasGunWide n = lasGun & itType . iyBase .~ LASGUNWIDE n & itParams . lasColor .~ orange & itParams . lasDamage .~ 2 @@ -141,7 +141,7 @@ lasWide n = lasGun ) where n' = 9 * n - xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] + xs = [ 0.5 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] lasWidePulse :: Item lasWidePulse = lasGun & itType . iyBase .~ LASGUNWIDEPULSE @@ -192,7 +192,7 @@ lasSway = lasGun where x' = _lasCycle $ _itParams it lasFocus :: Int -> Item -lasFocus n = lasWide n +lasFocus n = lasGunWide n & itType . iyBase .~ LASGUNFOCUS n & itParams . lasColor .~ red & itUse . useMods .~ diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs index e46715cd8..9b5b47274 100644 --- a/src/Dodge/Item/Weapon/LaserPath.hs +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -14,19 +14,17 @@ import Data.Tuple --import Streaming --import qualified Streaming.Prelude as S --- not sure why we need to keep a list of seen walls, but seems to loop --- infinitely when removed -- this needs to be tested with both reflections and refractions --- the distance of the laser should be limited reflectLaserAlong :: Float -> Point2 -> Point2 -> World -> (Maybe (Point2,Either Creature Wall),[Point2]) -reflectLaserAlong phasev sp ep w = case thingHit sp ep w of +{-# INLINE reflectLaserAlong #-} +reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlDraw sp ep w of Just (p,Right wl) | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (p +.+ unitVectorAtAngle (reflDirWall sp p wl)) (p +.+ (dist p ep) *.* unitVectorAtAngle (reflDirWall sp p wl)) w - | wlIsSeeThrough wl && _wlSeen wl -> second (p:) $ reflectLaserAlong phasev + | wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev (p +.+ normalizeV (refract sp ep wl p)) (refract sp ep wl p) w diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 6c680a61c..34010d364 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -595,4 +595,4 @@ duplicateOffsets xs eff item cr w = foldr f w poss where poss :: [V2 Float] poss = map (rotateV (_crDir cr) . V2 0 ) xs - f pos = eff item (cr & crPos %~ (+.+ pos)) + f pos = eff item (cr & crPos +.+.~ pos) diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 882938247..9397d933a 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -5,6 +5,7 @@ Find which objects lie upon a line. module Dodge.WorldEvent.ThingsHit ( thingsHit , thingHit + , thingHitFilt , thingsHitExceptCr ) where @@ -35,6 +36,13 @@ crsHit sp ep . overlap1SegCrs sp ep . crsNearSeg sp ep +thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool) + -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall) +thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep + where + f (Left cr) = fcr cr + f (Right wl) = fwl wl + thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall) thingHit sp ep = runIdentity . S.head_ . thingsHit sp ep diff --git a/src/LensHelp.hs b/src/LensHelp.hs index 8cb3aa539..8eca24a28 100644 --- a/src/LensHelp.hs +++ b/src/LensHelp.hs @@ -5,6 +5,7 @@ module LensHelp , (++.~) , (.*.*~) , (.+.+~) + , (+.+.~) ) where import Geometry import Control.Lens @@ -23,6 +24,11 @@ infixr 4 .+.+~ {-# INLINABLE (.+.+~) #-} (.+.+~) m x = m %~ (x +.+) +infixr 4 +.+.~ +(+.+.~) :: ASetter s t Point2 Point2 -> Point2 -> s -> t +{-# INLINABLE (+.+.~) #-} +(+.+.~) m x = m %~ (+.+ x) + infixr 4 .++~ (.++~) :: ASetter s t [a] [a] -> [a] -> s -> t (.++~) m x = m %~ (x ++)