Tweak parameters on bezier gun, abstract out random accuracy direction

2021-03-16 13:56:19 +01:00
parent ca5ff88522
commit 875679d25f
6 changed files with 69 additions and 87 deletions
@@ -1,7 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.CreatureAction 
    ( module Dodge.CreatureAction
-    , useItemContinuous
+    , useItem
    , tryUseItem
    )
    where
@@ -9,10 +9,10 @@ import qualified Data.IntMap as IM
 import Control.Lens
 import Data.Maybe (fromMaybe)

-useItemContinuous :: Int -> World -> World
-useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
-                            Just HammerUp -> useItem1 n $ setHammerDown w
-                            Just NoHammer -> useItem1 n w
+useItem :: Int -> World -> World
+useItem n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+                            Just HammerUp -> equippedItemEffect n $ setHammerDown w
+                            Just NoHammer -> equippedItemEffect n w
                            _             -> setHammerDown w
    where 
        cr = _creatures w IM.! n
@@ -20,16 +20,16 @@ useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of

 tryUseItem :: Int -> World -> World
 tryUseItem cid w = case w ^? creatures . ix cid of
-    Just cr -> useItem2 cid (_crInv cr IM.! _crInvSel cr) w
+    Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w
    Nothing -> w

-useItem1 :: Int -> World -> World
-useItem1 n w = useItem2 n it w
+equippedItemEffect :: Int -> World -> World
+equippedItemEffect n w = itemEffect n it w
    where c = (_creatures w IM.! n)
          it = _crInv c IM.! _crInvSel c

-useItem2 :: Int -> Item -> World -> World
-useItem2 n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w
-useItem2 n (Weapon {_wpFire=eff}) w = eff n w
-useItem2 n (Throwable {_twFire = eff}) w = eff n w
-useItem2 _ _ w = w
+itemEffect :: Int -> Item -> World -> World
+itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w
+itemEffect n (Weapon {_wpFire=eff}) w = eff n w
+itemEffect n (Throwable {_twFire = eff}) w = eff n w
+itemEffect _ _ w = w
@@ -19,6 +19,7 @@ import Dodge.Item.Draw
 import Dodge.Item.Weapon.Bullet
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.Recock

 import Geometry
 import Picture
@@ -329,12 +330,46 @@ launcher = defaultGun
    }
 bezierGun = defaultAutoGun
    { _itName = "B-GUN"
-    , _wpFire = bezierShoot
+    , _wpFire = maybeSetTarget shootBezier
    , _itAttachment = Nothing
    , _itScrollUp   = removeItAttachment 0
    , _itScrollDown = removeItAttachment 0
+    , _itHammer = HammerUp
+    , _itEffect = bezierRecock
+    , _itZoom = basicItZoom
+    , _itAimingRange = 0
    }

+maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World
+maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of
+        Just (ItTargetPos targetp) -> f targetp cid w
+        _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp)
+    where 
+        mp = mouseWorldPos w
+        cr = _creatures w IM.! cid
+        itRef = _crInvSel cr
+
+shootBezier :: Point2 -> Int -> World -> World
+shootBezier targetp cid w = (shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05
+                                . withRandomDir 0.5)
+                                bezBul cid w
+    where
+        bezBul = mkBezierBul startp controlp targetp
+        controlp = mouseWorldPos w
+        cr = _creatures w IM.! cid
+        dir = _crDir cr
+        startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
+          
+mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
+mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
+    where 
+        bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos')
+                                (threeEff' bulHitCr' bulHitWall' bulHitFF') 5
+        (randPos,randPos') = flip evalState (_randGen w) 
+                                    $ do a <- randInCirc 10
+                                         b <- randInCirc 10
+                                         return (a,b)
+
 removeItAttachment :: Int -> Int -> World -> World
 removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing
    where cr = _creatures w IM.! i
@@ -1338,7 +1373,6 @@ remoteBomb = defaultThrowable


 throwGrenade :: Int -> Int -> World -> World
--throwGrenade n w = rmInvItem n $ over particles addG $ set randGen g w
 throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w
    where addG = IM.insert i
                   $ Particle { _ptPos = p
@@ -1364,14 +1398,6 @@ throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randG
          dir = argV v 
          setWp :: World -> World
          setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
-          --maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just
-          --setWpLocation :: World -> World
-          --setWpLocation w' = case maybewpid of
-          --                  Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid
-          --                                & itemPositions %~ IM.insert newitid (InInv n j)
-          --                  _ -> w'
-          --newitid = newKey $ _itemPositions w
-          --wpid = fromMaybe newitid maybewpid

 throwArmReset :: Int -> ItEffect
 throwArmReset x =
@@ -1396,43 +1422,6 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
                            $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
                        ]

-bezTest cid w = mkBezierBul (0,11) (0,20) (0,20) cid w
-
-bezierTarget :: Int -> World -> World
-bezierTarget cid w = setTarget w
-    where
-        j = _crInvSel $ _creatures w IM.! cid
-        setTarget = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierControl p
-        p = mouseWorldPos w
-
-bezierControl :: Point2 -> Int -> World -> World
-bezierControl targetp cid w = resetGun $ shootWithSound 0 (mkBezierBul startp controlp targetp) cid w
-    where 
-        j = _crInvSel $ _creatures w IM.! cid
-        controlp = mouseWorldPos w
-        cr = _creatures w IM.! cid
-        dir = _crDir cr
-        startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
-        resetGun = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierTarget
-
-bezierShoot :: Int -> World -> World
-bezierShoot cid w = case w ^? creatures . ix cid . crInv . ix itRef . itAttachment of
-    Just (Just (ItTargetPos targetp)) -> shootWithSound 0 (mkBezierBul startp controlp targetp) cid w
-    _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos controlp)
-    where 
-        j = _crInvSel $ _creatures w IM.! cid
-        controlp = mouseWorldPos w
-        cr = _creatures w IM.! cid
-        dir = _crDir cr
-        startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
-        itRef = _crInvSel cr
-
-mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World
-mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w
-    where 
-        bbul = aCurveBulAt (Just cid) white startp controlp targetp 
-                                (threeEff' bulHitCr' bulHitWall' bulHitFF') 5
-
 fireRemoteLauncher :: Int -> World -> World
 fireRemoteLauncher cid w = setLocation $ resetFire $ resetName 
                                $ soundOnce (fromIntegral launcherSound)
@@ -32,7 +32,6 @@ withWarmUp t f cid w
            | t > 0  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
                                            $ set (pointerToItem . wpFireState) 2
                                                w
-          --  | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
            | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
                                            $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
                                            $ set (pointerToItem . wpFireState) 2
@@ -97,6 +96,22 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> am
                            && _wpLoadedAmmo item > 0
          reloadCondition = _wpLoadedAmmo item == 0

+withMuzFlare :: (Int -> World -> World) -> Int -> World -> World
+withMuzFlare f cid w = over tempLightSources (tLightAt 4 pos :)
+                      . lowLightAt pos2 $ f cid w
+    where cr = _creatures w IM.! cid
+          dir = _crDir cr
+          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+          pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+
+withRandomDir :: Float -> (Int -> World -> World) -> Int -> World -> World
+withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a) 
+                            . f cid 
+                            . over (creatures . ix cid . crDir) (+ a)
+                            $ set randGen g
+                              w
+    where (a, g) = randomR (-acc,acc) $ _randGen w
+
 withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
 withAccVelWthHiteff' acc vel width hiteff cid w 
    = over particles' ((:) newbul)
@@ -13,16 +13,13 @@ import Control.Lens
 import Data.Maybe
 import Data.Char
 import Data.List
-import Data.Function
+import Data.Function (on)

 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM

 import SDL

--import Graphics.Gloss
--import Graphics.Gloss.Interface.IO.Game
-
 -- }}}

 pauseGame :: World -> World
@@ -52,7 +49,6 @@ handlePressedKeyEvent w True _ = Just w
 handlePressedKeyEvent w _    keycode
    = case keycode of
        KeycodeEscape -> Nothing
--        KeycodeEscape -> Just $ pauseGame $ escapeMap w
        KeycodeC      -> Just $ pauseGame $ escapeMap w
        KeycodeF      -> Just $ dropItem w
        KeycodeM      -> Just $ toggleMap w
@@ -149,14 +145,11 @@ mouseActionsCr keys cr
        = set ( crState . stance . posture) AtEase cr
    where lbPressed = ButtonLeft `S.member` keys
          rbPressed = ButtonRight `S.member` keys
--          wUp       = MouseButton WheelUp `S.member` keys
--         -- wUp       = Char 'q' `S.member` keys
--          wDown     = MouseButton WheelDown `S.member` keys

 mouseActionsWorld :: S.Set MouseButton -> World -> World
 mouseActionsWorld keys w 
    | lbPressed && rbPressed 
-        = useItemContinuous (_yourID w) w
+        = useItem (_yourID w) w
    | mbPressed 
        = set lbClickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w
    | otherwise
@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Prototypes where

+import Dodge.Item.Weapon.Recock
+
 import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.Base
@@ -18,9 +20,6 @@ import qualified Data.Set as S
 import Data.Graph.Inductive.Graph hiding ((&))
 import Data.List

--import Graphics.Gloss
--import Graphics.Gloss.Data.Vector
-
 -- defalt datatypes / prototypes {{{
 basicWall = Wall { _wlLine = [(0,0),(50,0)]
                   , _wlID = 0
@@ -233,18 +232,4 @@ youLight =
        }


-wpRecock :: ItEffect
--wpRecock = NoItEffect
-wpRecock = ItInvEffect {_itInvEffect = f
-                       ,_itEffectCounter = 0
-                       }
-    where f cr i = creatures . ix (_crID cr) . crInv 
-                           --  . ix i . itHammer %~ ($!) (fmap $! (moveHammerUp `seq` moveHammerUp))
-                           --  . ix i . itHammer %~ ($!) (fmap $! moveHammerUp)
-                           --  . ix i . itHammer . _Just %~ ($!) moveHammerUp
-                           %~ IM.adjust fOnIt i
-          moveHammerUp !HammerDown = HammerReleased
-          moveHammerUp !HammerReleased = HammerUp
-          moveHammerUp !HammerUp       = HammerUp
-          fOnIt it = it & itHammer %~ moveHammerUp