Commit before partial cleanup, continue weapon effect refactor

2024-09-21 16:04:23 +01:00
parent bb18831393
commit 9dff2fcd7a
37 changed files with 817 additions and 856 deletions
@@ -86,27 +86,27 @@ heldEffect effecttype = case effecttype of
 --        , withTempLight 1 100 (V3 0 0 1)
 --        , ammoCheckI
 --        ]
-    LasWideMod n -> foldl' (&) (shootLaser . _ldtValue)
-        [ useAmmoAmount 1
-        , withItem $ \it ->
-            duplicateNumBarrels
--                ( min
--                    (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
-                    (it ^?! itParams . lasCycle `div` lasWideRate)
--                )
-        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
-        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
-        , withSoundForI tone440sawtoothquietS 2
-        , withItemUpdateFirst (increasecycleLasWide n)
-        , ammoCheckI
-        ]
-    DualBeamMod -> foldl' (&) (shootDualLaser . _ldtValue)
-        [ useAmmoAmount 1
-        , withSoundForI tone440sawtoothquietS 2
-        , withItem $ \it -> withCrPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
-        , withItem $ \it -> withCrPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
-        , ammoCheckI
-        ]
+--    LasWideMod n -> foldl' (&) (shootLaser . _ldtValue)
+--        [ useAmmoAmount 1
+--        , withItem $ \it ->
+--            duplicateNumBarrels
+----                ( min
+----                    (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
+--                    (it ^?! itParams . lasCycle `div` lasWideRate)
+----                )
+--        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
+--        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+--        , withSoundForI tone440sawtoothquietS 2
+--        , withItemUpdateFirst (increasecycleLasWide n)
+--        , ammoCheckI
+--        ]
+--    DualBeamMod -> foldl' (&) (shootDualLaser . _ldtValue)
+--        [ useAmmoAmount 1
+--        , withSoundForI tone440sawtoothquietS 2
+--        , withItem $ \it -> withCrPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
+--        , withItem $ \it -> withCrPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
+--        , ammoCheckI
+--        ]
 --    LasMod -> foldl' (&) (shootLaser . _ldtValue)
 --        [ useAmmoAmount 1
 --        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
@@ -122,13 +122,13 @@ heldEffect effecttype = case effecttype of
 --        --, ammoCheckI
 --        , blCheck
 --        ]
-    ShatterMod -> foldl' (&) (shootShatter . _ldtValue)
-        [ useAmmoAmount 1
-        , --        , withSoundStart tap3S
-          useTimeCheck
-        , ammoCheckI
-        , blCheck
-        ]
+--    ShatterMod -> foldl' (&) (shootShatter . _ldtValue)
+--        [ useAmmoAmount 1
+--        , --        , withSoundStart tap3S
+--          useTimeCheck
+--        , ammoCheckI
+--        , blCheck
+--        ]
 --    BangCaneMod -> bulletGunEffect
 --        [ withFlare
 --        , withSmoke 1 black 20 200 5
@@ -319,16 +319,16 @@ heldEffect effecttype = case effecttype of
    FireRemoteShellMod -> undefined
    ExplodeRemoteShellMod -> undefined
    DoNothingMod -> const $ const id
-    ForceFieldMod -> undefined
+--    ForceFieldMod -> undefined
    DetectorMod _ -> undefined
  where
 --    f = do
 --        nzpres <- state $ randomR (3, 4)
 --        return $ sprayNozzles . ix 0 . nzPressure .~ nzpres
-    increasecycleLasWide n it = case _heldHammer (_itUse it) of
-        HammerUp -> it & itParams . lasCycle .~ 1
-        _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
-    thegapDualBeam = _dbGap . _itParams
+--    increasecycleLasWide n it = case _heldHammer (_itUse it) of
+--        HammerUp -> it & itParams . lasCycle .~ 1
+--        _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
+--    thegapDualBeam = _dbGap . _itParams
    --directedTelPos _ cr w = (p, a)
    --  where
    --    p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
@@ -499,15 +499,24 @@ useLoadedAmmo itm cr (cme,w) (mz,x,mid) = (,) (cme & cmeSound .~ True) $
    MuzzleTractor -> shootTractorBeam itm cr w
    MuzzleLauncher -> createProjectile' mid mz itm cr w 
    MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mz itm cr w
+    MuzzleShatter -> shootShatter itm cr w
+    MuzzleForceField -> useForceFieldGun itm cr w
+    MuzzleDetector -> itemDetectorEffect itm cr w 

-walkNozzle mz itm cr w = w
-    & randGen .~ g
-  where
-    nz = _mzEffect mz
-    (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
-    aspeed = _nzWalkSpeed nz
-    maxa = _nzMaxWalkAngle nz
-    wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
+itemDetectorEffect :: Item -> Creature -> World -> World
+itemDetectorEffect itm cr w = fromMaybe w $ do
+    HELDDETECTOR dt <- itm ^? itType . iyBase . ibtHeld
+    return $ detectorEffect dt itm cr w
+
+walkNozzle :: Muzzle -> Item -> Creature -> World -> World
+walkNozzle _ _ _ w = w
+--    & randGen .~ g
+--  where
+--    nz = _mzEffect mz
+--    (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
+--    aspeed = _nzWalkSpeed nz
+--    maxa = _nzMaxWalkAngle nz
+--    wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
    

 shootTractorBeam :: Item -> Creature -> World -> World
@@ -549,6 +558,7 @@ shootLaser' itm cr mz w = w
    inacc = _mzInaccuracy mz
    dir = _crDir cr + _mzRot mz + a

+removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
    magid <- mid
    return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
@@ -559,10 +569,10 @@ shootBullet itm cr w (mz,x,mid) = fromMaybe w $ do
    -- should be able to pass the magazine in from elsewhere?
    thebullet <- cr ^? crInv . ix magid . itUse . amagParams . ampBullet
    return $ w & flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
-            & makeMuzzleFlare mz itm cr
-            & makeMuzzleSmoke mz itm cr
-  where
-    cid = _crID cr
+--            & makeMuzzleFlare mz itm cr
+--            & makeMuzzleSmoke mz itm cr
+--  where
+--    cid = _crID cr

 -- the random generator is not updated here, not sure if that is a problem
 makeBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
@@ -610,7 +620,7 @@ useMod hm = case hm of
    FireRemoteShellMod -> undefined
    ExplodeRemoteShellMod -> undefined
    DoNothingMod -> undefined
-    ForceFieldMod -> undefined
+--    ForceFieldMod -> undefined
    DetectorMod _ -> undefined
 --    HeldModNothing -> []
 --    PoisonSprayerMod ->
@@ -664,27 +674,27 @@ useMod hm = case hm of
 --        , withItemUpdateFirst increasecycleLasCircle
 --        , ammoCheckI
 --        ]
-    LasWideMod n ->
-        [ useAmmoAmount 1
-        , withItem $ \it ->
-            duplicateNumBarrels
--                ( min
--                    (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
-                    (it ^?! itParams . lasCycle `div` lasWideRate)
--                )
-        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
-        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
-        , withSoundForI tone440sawtoothquietS 2
-        , withItemUpdateFirst (increasecycleLasWide n)
-        , ammoCheckI
-        ]
-    DualBeamMod ->
-        [ useAmmoAmount 1
-        , withSoundForI tone440sawtoothquietS 2
-        , withItem $ \it -> withCrPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
-        , withItem $ \it -> withCrPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
-        , ammoCheckI
-        ]
+--    LasWideMod n ->
+--        [ useAmmoAmount 1
+--        , withItem $ \it ->
+--            duplicateNumBarrels
+----                ( min
+----                    (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
+--                    (it ^?! itParams . lasCycle `div` lasWideRate)
+----                )
+--        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
+--        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
+--        , withSoundForI tone440sawtoothquietS 2
+--        , withItemUpdateFirst (increasecycleLasWide n)
+--        , ammoCheckI
+--        ]
+--    DualBeamMod ->
+--        [ useAmmoAmount 1
+--        , withSoundForI tone440sawtoothquietS 2
+--        , withItem $ \it -> withCrPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
+--        , withItem $ \it -> withCrPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
+--        , ammoCheckI
+--        ]
 --    LasMod ->
 --        [ useAmmoAmount 1
 --        , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
@@ -700,13 +710,13 @@ useMod hm = case hm of
 --        --, ammoCheckI
 --        , blCheck
 --        ]
-    ShatterMod ->
-        [ useAmmoAmount 1
-        , --        , withSoundStart tap3S
-          useTimeCheck
-        , ammoCheckI
-        , blCheck
-        ]
+--    ShatterMod ->
+--        [ useAmmoAmount 1
+--        , --        , withSoundStart tap3S
+--          useTimeCheck
+--        , ammoCheckI
+--        , blCheck
+--        ]
 --    AmmoCheckMod -> [ammoCheckI]
 --    AmmoUseCheckMod -> [useAmmoAmount 1, useTimeCheck, ammoCheckI]
 --    AmmoHammerTimeUseOneMod ->
@@ -910,10 +920,10 @@ useMod hm = case hm of
    --increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
    ----f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
    --fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
-    increasecycleLasWide n it = case _heldHammer (_itUse it) of
-        HammerUp -> it & itParams . lasCycle .~ 1
-        _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
-    thegapDualBeam = _dbGap . _itParams
+--    increasecycleLasWide n it = case _heldHammer (_itUse it) of
+--        HammerUp -> it & itParams . lasCycle .~ 1
+--        _ -> it & itParams . lasCycle %~ (min (n * lasWideRate) . (+ 1))
+--    thegapDualBeam = _dbGap . _itParams
    --directedTelPos _ cr w = (p, a)
    --  where
    --    p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
@@ -937,12 +947,12 @@ useHeld hu = case hu of
    HeldDoNothing -> const $ const id
 --    HeldUseAmmoParams -> shootBullet
 --    HeldOverNozzlesUseGasParams -> overNozzles useGasParams
-    HeldPJCreation -> usePjCreation
-    HeldPJCreationX _ -> usePjCreationX
+--    HeldPJCreation -> usePjCreation
+--    HeldPJCreationX _ -> usePjCreationX
    HeldFireRemoteShell -> fireRemoteShell
    HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
 --    HeldTeslaArc -> shootTeslaArc . _ldtValue
-    HeldLaser -> shootLaser . _ldtValue
+--    HeldLaser -> shootLaser . _ldtValue
    HeldCircleLaser -> circleLaser . _ldtValue
    HeldDualLaser -> shootDualLaser . _ldtValue
    HeldTractor -> aTractorBeam . _ldtValue
@@ -1042,6 +1052,8 @@ useGasParams mmagid mz itm cr w =
 gasCreate :: GasFuel -> GasCreate -> GasCreate
 gasCreate = flip const

+
+doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
 doGenFloat (ConstFloat x) g = (x,g)
 doGenFloat (UniRandFloat x y) g = randomR (x,y) g

@@ -1103,14 +1115,14 @@ mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParam

 -- | assumes that the item is held
 shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
-shootTeslaArc it cr mz w =
+shootTeslaArc itm cr mz w =
    w'
        & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
  where
    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-    (w', ip) = makeTeslaArc (_itParams it) pos dir w
-    pos = _crPos cr +.+ aimingMuzzleLength cr it *.* unitVectorAtAngle dir
-    dir = _crDir cr
+    (w', ip) = makeTeslaArc (_itParams itm) pos dir w
+    pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
+    dir = _crDir cr + _mzRot mz

 -- I believe because the targeting returns to nothing straight after you release
 -- the rmb, it is possible for this to do nothing