Commit before attempting to unify hammers for used items

src/Dodge/Combine/Combinations.hs

@@ -60,11 +60,11 @@ itemCombinations =
     , po [FLAMETHROWER,cr PUMP] flameTorrent
 
     , p [o $ cr PRISM,o $ cr TRANSFORMER,o $ cr PIPE] lasGun
-    , p [o LASGUN,o $ cr PRISM] lasSway
+--    , p [o LASGUN,o $ cr PRISM] lasSway
-    , p [o LASGUN,o $ cr HARDWARE] lasSwing
+--    , p [o LASGUN,o $ cr HARDWARE] lasSwing
 --    , p [o LASGUN,o PIPE] lasGunPulse
-    , p [o LASGUN,p 2 $ cr PIPE] lasDual
+    , p [p 2 LASGUN,p 1 $ cr HARDWARE] dualBeam
-    , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
+--    , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
     , p [o LASGUN,o $ cr TRANSFORMER] (lasGunWide 2)
 
     , p [o $ cr TRANSFORMER,p 2 $ cr CAN] sparkGun
@@ -145,7 +145,7 @@ moduleCombinations =
             ]
         )
     ,   ( ModDualBeam
-        ,   [lasDual]
+        ,   [dualBeam]
         ,   [amod [cr INCENDIARYMODULE] INCENDLAS
             ,amod [cr TRANSFORMER]      SPLITLAS
             ,amod [cr STATICMODULE]     STATICLAS

src/Dodge/Combine/Data.hs

@@ -109,11 +109,11 @@ data ItemBaseType
     | TESLAGUN
     | LASGUN
     | LASPULSE
-    | LASGUNDUAL
+    | DUALBEAM
     | LASGUNSWING
     | LASGUNSWAY
     | LASGUNWIDEPULSE
-    | LASGUNWIDE Int
+    | LASGUNWIDE {_xNum :: Int}
     | LASGUNFOCUS Int
     | SONICGUN
     | TRACTORGUN

src/Dodge/Combine/Graph.hs

@@ -49,7 +49,7 @@ maxShowX bt = case bt of
     MINIGUNX  _ -> Just 3
     GRAPECANNON _ -> Just 1
     LAUNCHERX _ -> Just 2
---    LASGUNWIDE _ -> Just 2
+    LASGUNWIDE _ -> Just 2
 --    LASGUNFOCUS _ -> Just 2
     _ -> Nothing
 
@@ -59,7 +59,7 @@ itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) itemCombinat
   where
     f (abts,bt) 
         | bt `elem` bts = []
-        | any (not . belowNumX) bts = []
+        | (not . all belowNumX) bts = []
         | otherwise =  (CombNode $ Right abts,CombNode $  Left bt,0) :  map g abts
       where
         bts = map snd abts
@@ -96,7 +96,7 @@ myParams = defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]}
 --    & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]]
     & globalAttributesL .~ [GraphAttrs [RankDir FromLeft]]
     & clusterByL .~ clusterFunc
-    & isDotClusterL .~ (const False)
+    & isDotClusterL .~ const False
     & clusterIDL .~ setClusterID
     & fmtClusterL .~ clusterFormatting
     & fmtEdgeL .~ edgeFormatting

src/Dodge/Creature.hs

@@ -228,6 +228,9 @@ inventoryX c = case c of
            , makeTypeCraftNum 2 MICROCHIP 
            ]
     'J' -> [ lasGun
+            , lasGun
+            , dualBeam
+            , lasWidePulse
             , makeTypeCraftNum 10 TRANSFORMER
             ]
     _ -> []

src/Dodge/Data.hs

@@ -795,6 +795,7 @@ data ItemParams
         , _lasDamage :: Int
         , _lasBeam :: BeamType
         , _subParams :: Maybe ItemParams
+        , _dbGap    :: Float
         }
     | Attracting    {_attractionPower :: Point2}
     | BulletShooter

src/Dodge/Item.hs

@@ -60,7 +60,7 @@ itemFromBase ibt = case ibt of
     TESLAGUN    -> teslaGun
     LASGUN  -> lasGun
     LASPULSE    -> lasPulse
-    LASGUNDUAL  -> lasDual
+    DUALBEAM    -> dualBeam
     LASGUNSWING     -> lasSwing
     LASGUNSWAY  -> lasSway
     LASGUNWIDEPULSE     -> lasWidePulse
@@ -201,7 +201,7 @@ baseToFamily ibt = case ibt of
     TESLAGUN            -> HeldFamily
     LASGUN              -> HeldFamily
     LASPULSE            -> HeldFamily
-    LASGUNDUAL          -> HeldFamily
+    DUALBEAM            -> HeldFamily
     LASGUNSWING         -> HeldFamily
     LASGUNSWAY          -> HeldFamily
     LASGUNWIDEPULSE     -> HeldFamily

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -1,6 +1,6 @@
 module Dodge.Item.Weapon.BatteryGuns
     ( lasGun
-    , lasDual
+    , dualBeam
     , lasGunWide
     , lasWidePulse
     , lasSway
@@ -207,31 +207,35 @@ lasFocus n = lasGunWide n
     n' = 9 * n
     xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
 
-lasDual :: Item
+dualBeam :: Item
-lasDual = lasGun
+dualBeam = lasGun
-    & itType . iyBase .~ LASGUNDUAL
+    & itType . iyBase .~ DUALBEAM
+    & itDimension . dimPortage . muzPos .~ 0
+    & itDimension .dimSPic .~ dualBeamPic
     & itParams .~ DualBeam
         { _phaseV = 1
-        , _lasColor = orange
+        , _lasColor = red
-        , _lasColor2 = blue
+        , _lasColor2 = green
         , _lasCycle = 0
         , _lasDamage = 11
         , _lasBeam = BeamCombine lasBeamCombine
         , _subParams = Nothing
+        , _dbGap = 20
         }
     & itUse .~ (ruseInstant shootDualLaser NoHammer
         [ ammoCheckI
---        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+        , withItem $ \it -> withMuzPosShift (V2 0 (thegap it))  $ flareCircleAt (_lasColor $ _itParams it) 0.8
-        , withItem $ \it -> withMuzPosShift (V2 0 10)    $ flareCircleAt (_lasColor $ _itParams it) 0.8
+        , withItem $ \it -> withMuzPosShift (V2 0 (-thegap it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
-        , withItem $ \it -> withMuzPosShift (V2 0 (-10)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
         , withSoundForI tone440sawtoothquietS 2
         , useAmmoAmount 1
         ]
         & useAim . aimWeight .~ 6
         & useAim . aimRange .~ 1
-        & useAim . aimStance .~ TwoHandTwist
+        & useAim . aimStance .~ TwoHandFlat
         )
     & itType . iyModules . at ModDualBeam ?~ EMPTYMODULE
+  where
+    thegap = _dbGap . _itParams
 lasSwing :: Item
 lasSwing = lasGun
     & itType . iyBase .~ LASGUNSWING
@@ -297,6 +301,19 @@ lasGunPic it =
     amFrac = fractionLoadedAmmo it
     col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
 
+dualBeamPic :: Item -> SPic
+dualBeamPic it = 
+    ( colorSH blue $ 
+           upperPrismPoly 4 (rectNESW gap 3 (-gap) 1)
+        <> upperPrismPoly 4 (rectNESW gap (-1) (-gap) (-3))
+        <> upperPrismPoly 1 (rectNESW gap 3 (-gap) (-3))
+    , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW gap 1 (-gap) (-1)
+    )
+  where
+    amFrac = fractionLoadedAmmo it
+    col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
+    gap = _dbGap (_itParams it) - 3
+
 lasGunTweak :: TweakParam
 lasGunTweak = TweakParam
     { _doTweak = thetweak
@@ -380,7 +397,6 @@ shootTeslaArc it cr w = w'
     pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
 
-
 shootLaser :: Item -> Creature -> World -> World
 shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
   where 
@@ -389,7 +405,6 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam
     phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
     dam = _lasDamage $ _itParams it
 
-
 shootDualLaser :: Item -> Creature -> World -> World
 shootDualLaser it cr w = w'
     & newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
@@ -399,8 +414,9 @@ shootDualLaser it cr w = w'
     dir = _crDir cr
     pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
     aimlength = aimingMuzzlePos cr it
-    posl = pos +.+ (-10) * vNormal (unitVectorAtAngle dir)
+    gap = _dbGap . _itParams $ it
-    posr = pos +.+ 10 * vNormal (unitVectorAtAngle dir)
+    posl = pos +.+ (-gap) *.* vNormal (unitVectorAtAngle dir)
+    posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
     mwp = mouseWorldPos w
     mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
         | otherwise = mwp

src/Dodge/Item/Weapon/LaserPath.hs

@@ -22,35 +22,36 @@ reflectLaserAlong phasev sp ep w = case thingHitFilt (const True) _wlDraw sp ep
     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)) 
+            (p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl)) 
             w
         | wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev 
-            (p +.+ normalizeV (refract sp ep wl p))
+            (p +.+ normalizeV (refract phasev sp ep wl p))
-            (refract sp ep wl p) 
+            (refract phasev sp ep wl p) 
             w
         | otherwise -> (Just (p,Right wl), [p])
     Just (p,obj) -> (Just (p,obj), [p])
     Nothing -> (Nothing, [ep])
+refract :: Float -> Point2 -> Point2 -> Wall -> Point2 -> Point2
+{-# INLINE refract #-}
+refract phasev x y wl p 
+    | isEntering = p +.+ rotateV angleRef  (normalDist wlNormal)
+    | otherwise  = p +.+ rotateV angleRef' (normalDist wlNormal')
   where 
-    refract x y wl p 
+    wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
-        | isEntering = p +.+ rotateV angleRef  (normalDist wlNormal)
+    wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
-        | otherwise  = p +.+ rotateV angleRef' (normalDist wlNormal')
+    normalDist wlnormal  = magV (p -.- y) *.* normalizeV wlnormal
-      where 
+    angleInc = piRange $ argV wlNormal - argV (x -.- y)
-        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
+    angleRef 
-        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
+        | reflectExternal = angleInc
-        normalDist wlnormal  = magV (p -.- y) *.* normalizeV wlnormal
+        | otherwise = asin $ sin angleInc / phasev
-        angleInc = piRange $ argV wlNormal - argV (x -.- y)
+    piRange a' 
-        angleRef 
+        | a' > pi = a' - 2 * pi
-            | reflectExternal = angleInc
+        | a' > negate pi = a'
-            | otherwise = asin $ sin angleInc / phasev
+        | otherwise  = a' + 2 * pi
-        piRange a' 
+    isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
-            | a' > pi = a' - 2 * pi
+    angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
-            | a' > negate pi = a'
+    angleRef' 
-            | otherwise  = a' + 2 * pi
+        | reflectInternal = angleInc'
-        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
+        | otherwise = asin $ phasev * sin angleInc'
-        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
+    reflectInternal = 1 < abs (phasev * sin angleInc')
-        angleRef' 
+    reflectExternal = 1 < abs (sin angleInc / phasev)
-            | reflectInternal = angleInc'
-            | otherwise = asin $ phasev * sin angleInc'
-        reflectInternal = 1 < abs (phasev * sin angleInc')
-        reflectExternal = 1 < abs (sin angleInc / phasev)

src/Dodge/Item/Weapon/TriggerType.hs

@@ -14,6 +14,7 @@ module Dodge.Item.Weapon.TriggerType
     , withTempLight
     , withItem
     , withItemUpdate
+    , withItemUpdate'
     , ammoUseCheck
     , rateIncAB
     , torqueBefore
@@ -367,6 +368,10 @@ shootL f item cr w
 --    reloadCondition = _laLoaded (_itConsumption item) == 0
 withItem :: (Item -> ChainEffect) -> ChainEffect
 withItem g f it = g it f it
+
+withItemUpdate' :: (Item -> Item) -> ChainEffect
+withItemUpdate' up f it cr = f it cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
+
 withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
 withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
 withTempLight :: Int -> Float -> V3 Float -> ChainEffect

src/Dodge/Particle/Bullet/Draw.hs

@@ -8,4 +8,5 @@ drawBul :: Particle -> Picture
 drawBul pt = setLayer BloomNoZWrite
     . setDepth 20 
     . color (_ptColor pt) 
-    $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
+    -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
+    $ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)

src/Dodge/Particle/Spark.hs

@@ -73,6 +73,7 @@ colSparkRandDir randDir time col pos baseDir w = w
     dir = a + baseDir
     spark = BulletPt
         { _ptDraw = drawBul
+        --{ _ptDraw = const mempty
         , _ptUpdate = mvBullet
         , _btDrag   = 0.9
         , _ptVel = rotateV dir (V2 5 0)

src/Dodge/Wall/DamageEffect.hs

@@ -22,7 +22,8 @@ defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial w
 
 stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
 stoneWallDamage dm wl = case _dmType dm of
-    LASERING    -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
+    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
+--    LASERING    -> a 0 $ id
     PIERCING    -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> a d $ wlDustAt wl outTo
     SHATTERING  -> a d $ muchWlDustAt wl outTo
@@ -48,7 +49,7 @@ stoneWallDamage dm wl = case _dmType dm of
 
 windowWallDamage :: Damage -> Wall -> World -> (World,Int)
 windowWallDamage dm wl w = w & case _dmType dm of
-    LASERING    -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
+    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
     PIERCING    -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> a d $ dosplint . wlDustAt wl outTo
     SHATTERING  -> a d $ dosplint . muchWlDustAt wl outTo
@@ -80,7 +81,7 @@ windowWallDamage dm wl w = w & case _dmType dm of
 
 crystalWallDamage :: Damage -> Wall -> World -> (World,Int)
 crystalWallDamage dm wl = case _dmType dm of
-    LASERING    -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
+    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
     PIERCING    -> a 0 $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> a 0 $ wlDustAt wl outTo
     SHATTERING  -> a d $ muchWlDustAt wl outTo