Add (ugly) support for fractional volumes

2022-04-05 09:26:57 +01:00
parent 31d5bcd0bb
commit bca1236a85
12 changed files with 228 additions and 38 deletions
@@ -5,9 +5,7 @@ import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Default
 import Dodge.Default.Wall
 import Dodge.Picture.Layer
-import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Creature.Test
-import Dodge.Wall.Reflect
 import Dodge.Wall
 import Dodge.Magnet
 import Picture
@@ -118,15 +116,12 @@ shieldWall crid = defaultWall
    ,_wlStructure = CreaturePart crid shieldWallDamage
    }

+-- TODO the reflection should be controled by the particle
 shieldWallDamage :: Damage -> Wall -> Int -> World -> World
-shieldWallDamage dm wl crid w = case _dmType dm of
-    Lasering -> 
-        w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
+shieldWallDamage dm _ crid w = case _dmType dm of
+--    Lasering -> w 
    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
    _ -> w
-  where
-    df = _dmFrom dm
-    da = _dmAt dm

 createShieldWall :: Creature -> Int -> World -> World
 createShieldWall cr invid w = case _itEffectID $ _itEffect it of
@@ -1,7 +1,10 @@
 module Dodge.Item.Weapon.BatteryGuns
    ( lasGun
    , lasGunWide
+    , lasGunSway
+    , lasGunSwing
    , lasGunFocus
+    , lasGunPulse
    , sparkGun
    , teslaGun
    , tractorGun
@@ -93,32 +96,126 @@ teslaGunPic _ = noPic $ colorSH blue $
  where
    xa = 1
    xb = 9
+lasGunPulse :: Item
+lasGunPulse = lasGun
+    & itName .~ "PULSELAS"
+    & itType .~ LASPULSE
+    & itUse . useMods .~
+        [ ammoCheckI
+        , 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
+        ]
+  where
+    itup it = it
+        & itParams . lasCycle %~ (\i -> (i+1) `mod` 20)
+        & itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
+        & itParams . lasColor .~ frac it * orange
+    frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1))
+    
+
 lasGunWide :: Int -> Item
-lasGunWide n = lasGun 
+lasGunWide n = lasGun
    & itName .~ "PARALELLAS"++show n
    & itType .~ LASGUNWIDE n
-    & itUse . useMods .~
+    & itParams . lasColor .~ orange
+    & itParams . lasDamage .~ 2
+    & itUse .~ ( ruseInstant shootLaser NoHammer
        [ ammoCheckI
-        , withTempLight 1 100 (V3 1 1 0)
+        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+        , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
        , withSoundForI tone440sawtoothquietS 2
-        , duplicateOffsets xs
        , useAmmoAmount 1
+        , duplicateOffsets xs
        ]
+        & useAim . aimSpeed .~ 0.4
+        & useAim . aimRange .~ 1
+        & useAim . aimStance .~ TwoHandTwist
+        )
  where
-    xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2)  | x <- [0..n-1] ]
+    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
+    & 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
+        , useAmmoAmount 1
+        , duplicateOffsets xs
+        ]
+        & 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] ]
+lasGunSway :: Item
+lasGunSway = lasGun
+    & itName .~ "SWAYLAS"
+    & itType .~ LASGUNSWAY
+    & itParams . lasColor .~ orange
+    & itParams . lasDamage .~ 11
+    & 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
+        , useAmmoAmount 1
+        , withItemUpdate itup $ \it -> duplicateOffsets (x it)
+        ]
+        & useAim . aimSpeed .~ 0.4
+        & useAim . aimRange .~ 1
+        & useAim . aimStance .~ TwoHandTwist
+        )
+  where
+    itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
+    x it = [ 15 * sin (pi * fromIntegral x' * 0.05) ]
+      where
+        x' = _lasCycle $ _itParams it
 lasGunFocus :: Int -> Item
-lasGunFocus n = lasGun 
+lasGunFocus n = lasGunWide n
    & itName .~ "FOCALAS"++show n
    & itType .~ LASGUNFOCUS n
+    & itParams . lasColor .~ red
    & itUse . useMods .~
        [ ammoCheckI
-        , withTempLight 1 100 (V3 1 1 0)
+        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+        , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
        , withSoundForI tone440sawtoothquietS 2
-        , duplicateOffsetsFocus xs
        , useAmmoAmount 1
+        , duplicateOffsetsFocus xs
        ]
  where
-    xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2)  | x <- [0..n-1] ]
+    n' = 9 * n
+    xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
+lasGunSwing :: Item
+lasGunSwing = lasGun
+    & itName .~ "SWINGLAS"
+    & itType .~ LASGUNSWING
+    & itParams . lasColor .~ orange
+    & itUse . useMods .~
+        [ ammoCheckI
+        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+        , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
+        , withSoundForI tone440sawtoothquietS 2
+        , useAmmoAmount 1
+        , withItemUpdate itup $ \it -> duplicateOffsetsFocus (x it)
+        ]
+  where
+    itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 200)
+    x it = [-y,y]
+      where
+        y = 15 * sin (pi * fromIntegral x' * 0.01)
+        x' = _lasCycle $ _itParams it
 lasGun :: Item
 lasGun = defaultAutoBatteryGun 
    { _itName = "LASGUN"
@@ -130,14 +227,20 @@ lasGun = defaultAutoBatteryGun
        }
    , _itUse = ruseInstant shootLaser NoHammer
        [ ammoCheckI
-        , withTempLight 1 100 (V3 1 1 0)
+        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
        , withSoundForI tone440sawtoothquietS 2
+        , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
        , useAmmoAmount 1
        ]
        & useAim . aimSpeed .~ 0.4
        & useAim . aimRange .~ 1
        & useAim . aimStance .~ TwoHandTwist
-    , _itParams = Refracting  {_phaseV = 1}
+    , _itParams = Refracting  
+        { _phaseV = 1
+        , _lasColor = yellow
+        , _lasCycle = 0
+        , _lasDamage = 11
+        }
    , _itTweaks = Tweakable
        { _tweakParams = IM.fromList [(0,lasGunTweak)]
        , _tweakSel = 0
@@ -294,17 +397,21 @@ updateArc :: ItemParams
 updateArc = createNewArc

 shootLaser :: Item -> Creature -> World -> World
-shootLaser it cr = (instantParticles .:~ lasRayAt phasev pos dir)
-    . flareCircleAt yellow 0.8 (pos `v2z` 20)
+shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
  where 
    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
    dir = _crDir cr
    phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
+    dam = _lasDamage $ _itParams it

-lasRayAt :: Float -> Point2 -> Float -> Particle
-lasRayAt phasev pos dir = Particle
+lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
+lasRayAt col dam phasev pos dir = LaserParticle
    { _ptDraw = const blank
    , _ptUpdate = mvLaser phasev pos dir
+    , _ptRange = 800
+    , _ptDamage = dam
+    , _ptPhaseV = phasev
+    , _ptColor = col
    }
 mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
    -> Point2 
@@ -313,15 +420,17 @@ mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
    -> Particle 
    -> (World, Maybe Particle)
 mvLaser phasev pos dir w pt
-    = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 11 p1 p2 p3 NoDamageEffect) pos xp thHit w
+    = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering dam p1 p2 p3 NoDamageEffect) pos xp thHit w
      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
      )
  where
+    dam = _ptDamage pt
    xp = pos +.+ 800 *.* unitVectorAtAngle dir
    (thHit, ps) = reflectLaserAlong phasev [] pos xp w
+    col = _ptColor pt
    pic = setLayer 1 $ pictures
-        [ setDepth 19   . color (brightX 0 0.5 yellow) $ thickLine 20 (pos:ps)
-        , setDepth 19.5 . color (brightX 10 1 yellow)  $ thickLine 3  (pos:ps)
+        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
+        , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  (pos:ps)
        ]
 aTractorBeam :: Item -> Creature -> World -> World
 aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
@@ -2,6 +2,7 @@ module Dodge.Item.Weapon.LaserPath
    ( reflectLaserAlong
    ) where
 import Dodge.Data
+import Dodge.Wall.Reflect
 --import Dodge.Creature.HandPos
 import Dodge.WorldEvent
 --import Dodge.Default
@@ -18,12 +19,16 @@ import Data.Tuple

 -- 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
 reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World 
    -> (Maybe (Point2,Either Creature Wall),[Point2])
 reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl) 
        $ thingsHitExceptCrLongLine Nothing sp ep w of
    Just (p,Right wl) 
-        | _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w
+        | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p 
+            (p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w
+        | _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p 
+            (refract sp ep wl p) w
        | otherwise -> (Just (p,Right wl), [p])
    Just (p,obj) -> (Just (p,obj), [p])
    Nothing -> (Nothing, [ep])
@@ -7,9 +7,12 @@ module Dodge.Item.Weapon.TriggerType
    , useAmmoUpTo
    , lockInvFor
    , withMuzFlareI
+    , withMuzPos
    , withOldDir
    , trigDoAlso
    , withTempLight
+    , withItem
+    , withItemUpdate
    , ammoUseCheck
    , rateIncAB
    , torqueBefore
@@ -23,6 +26,7 @@ module Dodge.Item.Weapon.TriggerType
    , withSoundItemChoiceStart
    , withSoundContinue
    , withSoundForI
+    , withSoundForVol
    , withSmoke
    , withThickSmokeI
    , withThinSmokeI
@@ -60,7 +64,7 @@ import Dodge.Reloading
 import Dodge.WorldEvent
 import Dodge.RandomHelp
 import Dodge.Inventory.Lock
--import Dodge.Creature.HandPos
+import Dodge.Creature.HandPos
 --import Dodge.Default
 import Dodge.Base
 import Sound.Data
@@ -229,6 +233,17 @@ withSoundForI soundid playTime f item cr
    = soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
    . f item cr

+{- | Adds a sound to a creature based world effect. 
+The sound is emitted from the creature's position. -}
+withSoundForVol
+    :: Float -- ^ volume
+    -> SoundID -- ^ Sound id
+    -> Int -- ^ Frames to play
+    -> ChainEffect
+withSoundForVol vol soundid playTime f item cr 
+    = soundContinueVol vol (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
+    . f item cr
+
 afterRecoil
    :: Float    -- ^ Recoil amount
    -> ChainEffect
@@ -347,6 +362,10 @@ shootL f cr invid w
        && _rateTime (_useDelay (_itUse item)) == 0
        && _ammoLoaded (_itConsumption item) > 0
    reloadCondition = _ammoLoaded (_itConsumption item) == 0
+withItem :: (Item -> ChainEffect) -> ChainEffect
+withItem g f it = g it f it
+withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
+withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~ up)
 withTempLight :: Int -> Float -> V3 Float -> ChainEffect
 withTempLight time rad col eff item cr = eff item cr 
    . over tempLightSources (theTLS :)
@@ -368,6 +387,14 @@ withMuzFlareI f it cr w = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) flashPos
    flashPos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 5 0 20)
    muzzleOffset = V3 (_muzPos (_dimPortage (_itDimension it))) 0 0
    cdir = _crDir cr
+
+withMuzPos :: (Point3 -> World -> World) -> ChainEffect
+withMuzPos g f it cr w = g (pos `v2z` 20)
+    $ f it cr w
+  where
+    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
+    dir = _crDir cr
+
 {- | Applies the effect to a randomly rotated creature,
 - rotation amount given by inaccuracy in itParams  -}
 applyInaccuracy :: ChainEffect
@@ -541,7 +568,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
    poss = map (rotateV (_crDir cr) . V2 0 ) xs
    f pos = eff item $ cr 
        & crPos %~ (+.+ pos)
-        & crDir .~ argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
+        & crDir .~ thedir pos
+    thedir pos 
+        | dist (mouseWorldPos w) (_crPos cr) < aimingMuzzlePos cr item
+                    = argV (_crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
+                                -.- (_crPos cr +.+ pos))
+        | otherwise = argV (mouseWorldPos w -.- (_crPos cr +.+ pos))

 duplicateOffsets :: [Float] -> ChainEffect
 duplicateOffsets xs eff item cr w = foldr f w poss