Add new weapons

2022-02-16 08:50:19 +00:00
parent 4f0f8cb4c2
commit 505e4123d7
13 changed files with 208 additions and 72 deletions
@@ -4,6 +4,7 @@ import Dodge.Data
 import Dodge.Item.Equipment
 import Dodge.Item.Craftable
 import Dodge.Item.Weapon.BulletGuns
+import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.SprayGuns

@@ -19,7 +20,9 @@ itemCombinations =

    , po [PIPE,TUBE,HARDWARE] bangCone
    , po [BANGCONE,PLANK] blunderbuss
-    , po [BLUNDERBUSS,TUBE] grapeShotCannon
+    , po [BLUNDERBUSS,TUBE] bigBlunderbuss
+    , po [BIGBLUNDERBUSS,TUBE] biggerBlunderbuss
+    , po [BIGGERBLUNDERBUSS,TUBE] biggestBlunderbuss
    , po [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
    , po [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2

@@ -28,7 +31,9 @@ itemCombinations =
    , po [BANGCANE,TIN] rifle
    , po [RIFLE,PLANK]  repeater
    , po [REPEATER,SPRING,HARDWARE] autoRifle
-    , po [REPEATER,SPRING,CAN] assaultRifle
+    , po [REPEATER,SPRING,CAN] burstRifle
+    , po [BURSTRIFLE,SPRING,HARDWARE] fastBurstRifle
+    , po [FASTBURSTRIFLE,SPRING,HARDWARE] completeBurstRifle
    , po [MOTOR,BANGCANE,BANGCANE,BANGCANE] miniGun

    , p [p 3 PIPE,o HARDWARE] bangRod
@@ -44,6 +49,8 @@ itemCombinations =
    , po [FLAMESTICK,IRONBAR,DRUM] flameThrower
    , po [FLAMESTICK,DRUM,DRUM] flameWall

+    , p [o PRISM,p 2 PIPE,o HARDWARE] lasGun
+
    , po [MAGNET,TIN] magShield

    , p [p 4 CAN] plateCraft
@@ -16,6 +16,9 @@ data CombineType
    | SMG
    | BANGCONE
    | BLUNDERBUSS
+    | BIGBLUNDERBUSS
+    | BIGGERBLUNDERBUSS
+    | BIGGESTBLUNDERBUSS
    | GRAPESHOTCANNON
    | GRENADELAUNCHER Int -- number of chambers that can be reloaded
 --    | MORTARCONE / HANDMORTAR
@@ -25,7 +28,9 @@ data CombineType
    | RIFLE
    | REPEATER
    | AUTORIFLE
-    | ASSAULTRIFLE
+    | BURSTRIFLE
+    | FASTBURSTRIFLE
+    | COMPLETEBURSTRIFLE
    | BANGROD
    | ELEPHANTGUN
    | AMR
@@ -167,7 +167,7 @@ startInventory = IM.fromList $ zip [0..] startInvList
 testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
    [ makeTypeCraftNum 9 PIPE
-    , makeTypeCraftNum 1 TUBE
+    , makeTypeCraftNum 5 TUBE
    , makeTypeCraftNum 1 MAGNET
    , makeTypeCraftNum 5 HARDWARE
    , makeTypeCraftNum 3 SPRING
@@ -909,3 +909,4 @@ makeLenses ''InventoryMode
 makeLenses ''ItemPortage
 makeLenses ''Magnet
 makeLenses ''Gust
+makeLenses ''GunBarrels
@@ -4,7 +4,9 @@ module Dodge.Item.Weapon.BulletGun.Cane
    , repeater
    , rifle
    , autoRifle
-    , assaultRifle
+    , burstRifle
+    , completeBurstRifle
+    , fastBurstRifle
    , miniGun
    , miniGun'
    ) where
@@ -171,16 +173,17 @@ autoRifle = repeater
    & itType .~ AUTORIFLE
    & itUse . useMods %~ ((ammoCheckI :) . tail)
 --    & itUse . useDelay . rateMax .~ 6
-assaultRifle :: Item
-assaultRifle = repeater
-    & itName .~ "ASSAULTRIFLE"
-    & itType .~ ASSAULTRIFLE
+burstRifle :: Item
+burstRifle = repeater
+    & itName .~ "BURSTRIFLE"
+    & itType .~ BURSTRIFLE
+    & itParams . gunBarrels . brlInaccuracy .~ 0.05
    & itUse . useDelay . rateMax .~ 18
    & itUse . useMods .~
        [ ammoHammerCheck
        , useTimeCheck
-        , torqueAfterI 0.2
-        , lockInvFor 10
+        , sideEffectOnFrame 7 (torqueSideEffect 0.2)
+        , lockInvFor 7
        , \f it -> repeatOnFrames (take (_ammoLoaded (_itConsumption it) - 1) [3,6]) f it
        , withSoundStart tap3S
        , useAmmoAmount 1
@@ -188,6 +191,42 @@ assaultRifle = repeater
        , withMuzFlareI
        , withRecoilI 50
        ]
+fastBurstRifle :: Item
+fastBurstRifle = repeater
+    & itName .~ "FASTBURSTRIFLE"
+    & itType .~ FASTBURSTRIFLE
+    & itParams . gunBarrels . brlInaccuracy .~ 0.06
+    & itUse . useDelay . rateMax .~ 18
+    & itUse . useMods .~
+        [ ammoHammerCheck
+        , useTimeCheck
+        , sideEffectOnFrame 9 (torqueSideEffect 0.4)
+        , lockInvFor 9
+        , \f it -> repeatOnFrames (take (_ammoLoaded (_itConsumption it) - 1) [2,4,6,8]) f it
+        , withSoundStart tap3S
+        , useAmmoAmount 1
+        , applyInaccuracy
+        , withMuzFlareI
+        , withRecoilI 50
+        ]
+completeBurstRifle :: Item
+completeBurstRifle = repeater
+    & itName .~ "COMPLETEBURSTRIFLE"
+    & itType .~ COMPLETEBURSTRIFLE
+    & itParams . gunBarrels . brlInaccuracy .~ 0.1
+    & itUse . useDelay . rateMax .~ 28
+    & itUse . useMods .~
+        [ ammoHammerCheck
+        , useTimeCheck
+        , sideEffectOnFrame 15 (torqueSideEffect 0.8)
+        , lockInvFor 15
+        , \f it -> repeatOnFrames (take (_ammoLoaded (_itConsumption it) - 1) [1..14]) f it
+        , withSoundStart tap3S
+        , useAmmoAmount 1
+        , applyInaccuracy
+        , withMuzFlareI
+        , withRecoilI 50
+        ]
 miniGun' :: Item
 miniGun' = miniGun & itConsumption . ammoLoaded .~ 0
 miniGun :: Item
@@ -1,6 +1,9 @@
 module Dodge.Item.Weapon.BulletGuns
    ( bangCone
    , blunderbuss
+    , bigBlunderbuss
+    , biggerBlunderbuss
+    , biggestBlunderbuss
    , grapeShotCannon
    , grenadeLauncher
    , spreadGun
@@ -100,7 +103,6 @@ autoGunPic it = noPic $
  where
    x = fromIntegral $ _ammoLoaded $ _itConsumption it

-
 bangCone :: Item
 bangCone = defaultGun 
    { _itName = "BANGCONE"
@@ -117,12 +119,13 @@ bangCone = defaultGun
        , useTimeCheck
        , withSoundStart bangEchoS
        , useAllAmmo
-        , torqueAfterI 0.6
+        , torqueAfterI 0.1
        , withRecoilI 150
        , duplicateLoaded
        , withMuzFlareI
        , applyInaccuracy
        , withRandomOffsetI 12
+        , withRandomItemUpdate coneRandItemUpdate
        , withRandomItemParams coneRandItemParams
        ]
        & useAim . aimSpeed .~ 0.4
@@ -144,6 +147,10 @@ bangCone = defaultGun
        }
    , _itTweaks = defaultBulletSelTweak
    }
+coneRandItemUpdate :: State StdGen (Item -> Item)
+coneRandItemUpdate = do
+    wth <- state $ randomR (1,5)
+    return (\it -> it & itConsumption . aoType . amBulWth .~ wth)
 coneRandItemParams :: State StdGen ItemParams
 coneRandItemParams = do
    muzv <- state $ randomR (0.5,1)
@@ -171,6 +178,7 @@ blunderbuss = bangCone
        , withMuzFlareI
        , applyInaccuracy
        , withRandomOffsetI 12
+        , withRandomItemUpdate coneRandItemUpdate
        , withRandomItemParams coneRandItemParams
        ]
        & useAim . aimStance .~ TwoHandTwist
@@ -186,6 +194,80 @@ blunderbuss = bangCone
            <> upperPrismPoly 6 (rectNSEW 4 (-4) 30 20)
        }
    }
+    & itConsumption . ammoMax .~ 25
+    & itConsumption . reloadTime .~ 30
+bigBlunderbuss :: Item
+bigBlunderbuss = blunderbuss
+    {_itName = "BIGBLUNDERBUSS"
+    ,_itType = BIGBLUNDERBUSS
+    ,_itUse = useAmmoParamsRate 20 upHammer
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheck
+        , withSoundStart bangEchoS
+        , useAllAmmo
+        , torqueAfterI 0.3
+        , withRecoilI 200
+        , duplicateLoaded
+        , withMuzFlareI
+        , applyInaccuracy
+        , withRandomOffsetI 16
+        , withRandomItemUpdate coneRandItemUpdate
+        , withRandomItemParams coneRandItemParams
+        ]
+        & useAim . aimStance .~ TwoHandTwist
+        & useAim . aimSpeed .~ 0.4
+    }
+    & itConsumption . ammoMax .~ 50
+    & itConsumption . reloadTime .~ 36
+biggerBlunderbuss :: Item
+biggerBlunderbuss = bigBlunderbuss
+    {_itName = "BIGGERBLUNDERBUSS"
+    ,_itType = BIGGERBLUNDERBUSS
+    ,_itUse = useAmmoParamsRate 20 upHammer
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheck
+        , withSoundStart bangEchoS
+        , useAllAmmo
+        , torqueAfterI 0.5
+        , withRecoilI 250
+        , duplicateLoaded
+        , withMuzFlareI
+        , applyInaccuracy
+        , withRandomOffsetI 20
+        , withRandomItemUpdate coneRandItemUpdate
+        , withRandomItemParams coneRandItemParams
+        ]
+        & useAim . aimStance .~ TwoHandTwist
+        & useAim . aimSpeed .~ 0.4
+    }
+    & itConsumption . ammoMax .~ 75
+    & itConsumption . reloadTime .~ 43
+biggestBlunderbuss :: Item
+biggestBlunderbuss = biggerBlunderbuss
+    {_itName = "BIGGESTBLUNDERBUSS"
+    ,_itType = BIGGESTBLUNDERBUSS
+    ,_itUse = useAmmoParamsRate 20 upHammer
+        [ ammoCheckI
+        , hammerCheckI
+        , useTimeCheck
+        , withSoundStart bangEchoS
+        , useAllAmmo
+        , torqueAfterI 0.7
+        , withRecoilI 300
+        , duplicateLoaded
+        , withMuzFlareI
+        , applyInaccuracy
+        , withRandomOffsetI 24
+        , withRandomItemUpdate coneRandItemUpdate
+        , withRandomItemParams coneRandItemParams
+        ]
+        & useAim . aimStance .~ TwoHandTwist
+        & useAim . aimSpeed .~ 0.4
+    }
+    & itConsumption . ammoMax .~ 100
+    & itConsumption . reloadTime .~ 50

 grapeShotCannon :: Item
 grapeShotCannon = blunderbuss
@@ -203,6 +285,7 @@ grapeShotCannon = blunderbuss
        , withMuzFlareI
        , applyInaccuracy
        , withRandomOffsetI 12
+        , withRandomItemUpdate coneRandItemUpdate
        , withRandomItemParams coneRandItemParams
        ]
        & useAim . aimStance .~ TwoHandTwist
@@ -15,7 +15,9 @@ module Dodge.Item.Weapon.TriggerType
    , torqueBefore
    , torqueBeforeAtLeast
    , torqueAfterI
+    , torqueSideEffect
    , withRandomItemParams
+    , withRandomItemUpdate
    , withSoundStart
    , withSoundItemChoiceStart
    , withSoundContinue
@@ -33,6 +35,7 @@ module Dodge.Item.Weapon.TriggerType
    , spreadNumI
    , spreadLoaded
    , repeatOnFrames
+    , sideEffectOnFrame
 --    , numBarrels
    , duplicateLoadedBarrels
    , duplicateLoaded
@@ -381,6 +384,13 @@ withOldDir
 withOldDir aFrac eff item cr
    = eff item (cr & crDir %~ tweenAngles aFrac (_crOldDir cr))

+withRandomItemUpdate
+    :: State StdGen (Item -> Item)
+    -> ChainEffect
+withRandomItemUpdate randItUp eff it cr w = eff (f it) cr $ w & randGen .~ g
+  where
+    (f,g) = runState randItUp (_randGen w)
+
 withRandomItemParams
    :: State StdGen ItemParams
    -> ChainEffect
@@ -458,6 +468,24 @@ spreadLoaded eff item cr w = foldr f w dirs
    spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
    numBulLoaded = _ammoLoaded $ _itConsumption item

+sideEffectOnFrame :: Int 
+    -> (Item -> Creature -> World -> World)
+    -> ChainEffect
+sideEffectOnFrame i sf f it cr w = f it cr w
+    & delayedEvents .:~ (i, f')
+  where
+    f' w' = fromMaybe w' $ do
+        cr' <- w' ^? creatures . ix (_crID cr)
+        return $ sf it cr' w'
+
+torqueSideEffect :: Float -> Item -> Creature -> World -> World
+torqueSideEffect torque _ cr w
+    | cid == 0  = set randGen g $ over cameraRot (+rot) w
+    | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w
+  where 
+    cid = _crID cr
+    (rot, g) = randomR (-torque,torque) $ _randGen w
+
 -- pump the updated creature into the chain in later frames
 repeatOnFrames :: [Int] -> ChainEffect
 repeatOnFrames is f it cr w = f it cr w
@@ -5,7 +5,7 @@ import Dodge.Data
 import Picture

 drawBul :: Particle -> Picture
-drawBul pt = setLayer 1 
+drawBul pt = setLayer 1
    . setDepth 20 
    . color (_ptColor pt) 
    $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
@@ -14,6 +14,7 @@ import System.Random
 treePath :: Int -> Tree ()
 treePath 0 = Node () []
 treePath x = Node () [treePath (x-1)]
+
 {- Adds a branch at a certain point down a trunk.  -}
 addBranchAt 
    :: Int      -- ^ Depth to add branch at
@@ -24,6 +25,7 @@ addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
 addBranchAt i b (Node () (x:xs))
    = Node () (addBranchAt (i-1) b x : xs)
 addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
+
 {- Randomly generate a tree containing a maximum of three nodes.  -}
 smallBranch :: RandomGen g => State g (Tree ())
 smallBranch = takeOne
@@ -33,9 +35,7 @@ smallBranch = takeOne
    , addBranchAt 0 (treePath 0) (treePath 1)
    ]

-{-
-Randomly generate a small tree.
-}
+{- Randomly generate a small tree.  -}
 aTreeStrut :: RandomGen g => State g (Tree ())
 aTreeStrut = do
    d <- state $ randomR (9,11:: Int)
@@ -16,8 +16,7 @@ module Dodge.Tree.Polymorphic
    , addToTrunk
    , inorderNumberTree
    , updateSingleNode
-    )
-    where
+    ) where
 import Dodge.RandomHelp

 import Data.Tree
@@ -25,18 +24,14 @@ import Control.Monad.State
 import System.Random
 import Control.Lens

-{- |
-Creates a linear tree.
-Safe.
-}
+{- | Creates a linear tree.
+Safe.  -}
 treeFromPost :: [a] -> a -> Tree a
 treeFromPost []     y = Node y []
 treeFromPost (x:xs) y = Node x [treeFromPost xs y]

-{- |
-Creates a tree with one trunk branch, 
-input as a list, that ends in another tree.
-}
+{- | Creates a tree with one trunk branch, 
+input as a list, that ends in another tree.  -}
 treeFromTrunk 
    :: [a]      -- ^ The trunk
    -> Tree a   -- ^ The end of the tree
@@ -44,9 +39,7 @@ treeFromTrunk
 treeFromTrunk [] t     = t
 treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]

-{- |
-Applies a function to the root of a tree.
-}
+{- | Applies a function to the root of a tree.  -}
 applyToRoot :: (a -> a) -> Tree a -> Tree a
 applyToRoot f (Node t ts) = Node (f t) ts

@@ -55,10 +48,8 @@ applyToRoot f (Node t ts) = Node (f t) ts
 --treeSize :: Tree a -> Int
 --treeSize = length . flatten

-{- |
-Applies a function to a specific node determined by a list of indices.
-Unsafe (partial function).
-}
+{- | Applies a function to a specific node determined by a list of indices.
+Unsafe (partial function).  -}
 applyToNode :: [Int] -> (a -> a) -> Tree a -> Tree a
 applyToNode [] f t = applyToRoot f t
 applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
@@ -95,56 +86,42 @@ subMap _ [] = []
 --zipTree :: Tree a -> Tree b -> Tree (a,b)
 --zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys

-{- |
-Makes each node into its child number, i.e. the index it has 
-in the list of children of its parent.
-}
+{- | Makes each node into its child number, i.e. the index it has 
+in the list of children of its parent.  -}
 treeChildNums :: Tree a -> Tree Int
 treeChildNums = setRoot 0
  where 
    setRoot :: Int -> Tree a -> Tree Int
    setRoot i (Node _ xs) = Node i (zipWith setRoot [0..] xs)

-{- |
-Makes each node into its path, i.e. the list of indices that, 
-when followed from the root, lead to the node.
-}
+{- | Makes each node into its path, i.e. the list of indices that, 
+when followed from the root, lead to the node.  -}
 treePaths :: Tree a -> Tree [a]
 treePaths (Node x xs) = (x :) <$> Node [] (map treePaths xs)

-{- |
-Picks a random path in the tree.
-Uniform probability that the path leads to any specific node.
-}
+{- | Picks a random path in the tree.
+Uniform probability that the path leads to any specific node.  -}
 randomPath :: RandomGen g => Tree a -> State g [Int]
 randomPath = takeOne . flatten . treePaths . treeChildNums

-{- |
-Apply a function to the value of a node; 
-the node is picked uniformly at random.
-}
+{- | Apply a function to the value of a node; 
+the node is picked uniformly at random.  -}
 applyToRandomNode :: RandomGen g => (a -> a) -> Tree a -> State g (Tree a)
 applyToRandomNode f t = do
    p <- randomPath t
    return $ applyToNode p f t

-{- |
-Add a forest to the end of a tree (along the trunk).
-}
+{- | Add a forest to the end of a tree (along the trunk).  -}
 addToTrunk :: Tree a -> [Tree a] -> Tree a
 addToTrunk (Node x []) f = Node x f
 addToTrunk (Node x (t:ts)) f = Node x (addToTrunk t f : ts)

-{- |
-Find the depth of a tree along the trunk.
-}
+{- | Find the depth of a tree along the trunk.  -}
 trunkDepth :: Tree a -> Int
 trunkDepth (Node _ []) = 0
 trunkDepth (Node _ (x:_)) = trunkDepth x + 1

-{- |
-Split a tree at a given point along its trunk.
-}
+{- | Split a tree at a given point along its trunk.  -}
 splitTrunkAt 
    :: Int      -- ^ Split depth
    -> Tree a -> (Tree a, [Tree a])
@@ -154,9 +131,7 @@ splitTrunkAt i (Node y (x:xs)) =
    in (Node y (t : xs) , ts)
 splitTrunkAt _ (Node _ []) = error "Trying to split to short a trunk"

-{- |
-Split a tree at a random point along its trunk.
-}
+{- | Split a tree at a random point along its trunk.  -}
 splitTrunk :: RandomGen g => Tree a -> State g (Tree a, [Tree a])
 splitTrunk t = do
    i <- state $ randomR (0, trunkDepth t)
@@ -11,13 +11,14 @@ import Dodge.RoomLink
 import Geometry.ConvexPoly
 import Geometry.Data
 import Padding
+import LensHelp hiding (Empty, (<|) , (|>))
+--import Control.Lens hiding (Empty, (<|) , (|>))

 import qualified Data.Set as S
 import Data.Tree
 import Data.Sequence hiding (zipWith)
 import Data.List (delete)
 import Data.Bifunctor
-import Control.Lens hiding (Empty, (<|) , (|>))

 type RoomInt = (Room,Int)

@@ -42,7 +43,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
    child = fst childi
    outlinks = zipCount 
        . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) 
-        $ _rmLinks parent 
+        $ _rmLinks parent
    tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
    tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi)
      where
@@ -50,7 +51,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
        tryChildLinks ((numinlink,il):ils) 
            | clipping  = tryChildLinks ils
            | otherwise = do
-                putStrLn $ show j ++ "-"++show numinlink
+                putStrLn $ show j ++ "-" ++ show numinlink
                mayrs <- posRms (newBounds ++ bounds) 
                    (first updateparent parenti) its (tseq |> shiftedt)
                case mayrs of
@@ -58,14 +59,13 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
                    Nothing -> printInfo parenti numChild childi
                        >> tryChildLinks ils
          where
-            newBounds = map pointsToPoly $ _rmBound r'
+            newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
            clipping = or (convexPolysOverlap <$> newBounds <*> bounds)
            updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
                & rmLinks %~ delete outlnk 
-                & rmPos %~ (uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk) :)
-                & rmChildren %~ (snd childi :)
+                & rmPos .:~ uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk)
+                & rmChildren .:~ snd childi
            shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
-            r' = doRoomShift . fst $ rootLabel shiftedt
            updatechild rm = rm 
                & rmMParent ?~ snd parenti
                & rmMID     ?~ snd childi
@@ -4,8 +4,7 @@ and the position that the character sees from: '_cameraViewFrom'.  -}
 module Dodge.Update.Camera 
    ( updateCamera
    , farWallPoints
-    ) 
-    where
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Zone
@@ -41,7 +41,6 @@ wallEff dt wl = case dt of
    pSparkCol = brightX 100 1.5 white
    lSparkCol = V4 20 (-5) 0 1

-
 damageBlockWith :: DamageType -> Block -> Block
 damageBlockWith dt = case dt of
    Piercing dam _ _ _ -> blHPs %~ reduceHead dam