From 85ededc1582af053ec8401d477a26f7f7cf24ac4 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 2 Dec 2021 00:50:29 +0000 Subject: [PATCH] Start work on crafting/combinations --- src/Dodge/Combine.hs | 34 +++----------- src/Dodge/Combine/Combinations.hs | 50 +++++++++++++++++++++ src/Dodge/Combine/Data.hs | 14 ++++-- src/Dodge/Creature/Action.hs | 14 +----- src/Dodge/Creature/Boid.hs | 26 +++++------ src/Dodge/Data.hs | 3 ++ src/Dodge/Default.hs | 2 +- src/Dodge/Default/Weapon.hs | 1 + src/Dodge/Item/Weapon/BatteryGuns.hs | 8 ++-- src/Dodge/Item/Weapon/Bezier.hs | 2 +- src/Dodge/Item/Weapon/Booster.hs | 2 +- src/Dodge/Item/Weapon/BulletGuns.hs | 21 ++++----- src/Dodge/Item/Weapon/Drone.hs | 2 +- src/Dodge/Item/Weapon/Launcher.hs | 2 +- src/Dodge/Item/Weapon/SprayGuns.hs | 4 +- src/Dodge/Item/Weapon/TriggerType.hs | 29 ++++++++---- src/Dodge/LevelGen/StaticWalls.hs | 2 +- src/Dodge/Particle/Bullet/HitEffect.hs | 12 ++--- src/Dodge/Placement/Instance/LightSource.hs | 4 +- src/Dodge/Reloading.hs | 14 ++++++ src/Dodge/Render/HUD.hs | 8 +++- src/Dodge/Update/Camera.hs | 2 +- src/Dodge/Wall/Damage.hs | 2 +- src/Dodge/WallCreatureCollisions.hs | 22 ++++++--- src/Dodge/WorldEvent/Shockwave.hs | 4 +- src/Dodge/WorldEvent/SpawnParticle.hs | 2 +- src/Geometry/Vector.hs | 13 ++++-- src/Picture.hs | 2 +- 28 files changed, 189 insertions(+), 112 deletions(-) create mode 100644 src/Dodge/Combine/Combinations.hs diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 89c6ccd1a..56bbeb0de 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -1,37 +1,13 @@ +{-# LANGUAGE TupleSections #-} module Dodge.Combine - ( - ) - where + ( + ) where --import Dodge.Data --import Dodge.Combine.Data +--import Dodge.Combine.Combinations +--import Data.Bifunctor --import qualified Data.IntMap.Strict as IM --import qualified Data.IntSet as IS --import qualified Data.Map.Strict as M ---combineList :: IM.IntMap Item -> [(Item , IS.IntSet)] ---combineList - - ---invert :: (Ord a) => M.Map b a -> M.Map a [b] ---invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty --- ---combineList :: [([ItemType], ItemType)] ---combineList = --- [ ( [ TPistol, TPipe, THardware ] , TRifle ) --- , ( [ TRifle, THardware ] , TPistol ) --- , ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 ) --- , ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 ) --- , ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 ) --- , ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 ) --- , ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun ) --- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun ) --- , ( [ TRifle, TRifle, THardware ] , TMultGun 2 ) --- , ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 ) --- , ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 ) --- , ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 ) --- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun ) --- , ( [ TPistol, TBigTube, THardware] , TLauncher 1 ) --- , ( [ TLauncher 1, TBigTube, TPistol, THardware] , TLauncher 2) --- , ( [ TLauncher 2, TBigTube, TPistol, THardware] , TLauncher 3) --- ] diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs new file mode 100644 index 000000000..d30bd9f5a --- /dev/null +++ b/src/Dodge/Combine/Combinations.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TupleSections #-} +module Dodge.Combine.Combinations + where +--import Dodge.Data +import Dodge.Combine.Data + +import Data.Bifunctor +import qualified Data.IntMap.Strict as IM +--import qualified Data.IntSet as IS +import qualified Data.Map.Strict as M +import Control.Monad +import Data.Maybe + +combineList :: IM.IntMap ItemCombineType -> [([Int],ItemCombineType)] +combineList m = mapMaybe (pushoutmaybe . second (combine . toMultiset) . unzip) + . powlist + $ IM.toList m + where + pushoutmaybe (_,Nothing) = Nothing + pushoutmaybe (x,Just y) = Just (x,y) + +powlist :: [a] -> [[a]] +powlist = filterM (const [True,False]) + +combine :: M.Map ItemCombineType Int -> Maybe ItemCombineType +combine m = lookup m combinations + +toMultiset :: Ord a => [a] -> M.Map a Int +toMultiset = foldr (uncurry $ M.insertWith (+)) M.empty . map (,1) + +combinations :: [(M.Map ItemCombineType Int, ItemCombineType)] +combinations = map (first toMultiset) + [ ( [ TPistol, TPipe, THardware ] , TRifle ) + , ( [ NoCombineType ] , TPistol ) + , ( [ TRifle, THardware ] , TPistol ) + , ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 ) + , ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 ) + , ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 ) + , ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 ) + , ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun ) + , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun ) + , ( [ TRifle, TRifle, THardware ] , TMultGun 2 ) + , ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 ) + , ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 ) + , ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 ) + , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun ) + , ( [ TPistol, TTube, THardware] , TLauncher 1 ) + , ( [ TLauncher 1, TTube, TPistol, THardware] , TLauncher 2) + , ( [ TLauncher 2, TTube, TPistol, THardware] , TLauncher 3) + ] diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index efbb70242..4cf962f03 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -1,10 +1,13 @@ module Dodge.Combine.Data - (ItemType (..) + (ItemCombineType (..) ) where -data ItemType +data ItemCombineType = TPipe - | TBigTube + | NoCombineType + | TLongPipe + | TVeryLongPipe + | TTube | TPlate | TMChip | TMagnet @@ -14,11 +17,13 @@ data ItemType | TNailbox | TPlank | TPrism + | TIronBar | TLightSensor | TSoundSensor | THeatSensor | TCopperWire | TEmptyCan + | TEmptyTin | TPistol | TAutoGun | TRifle @@ -29,8 +34,9 @@ data ItemType | TSpreadGun Int | TLauncher Int | TBattery + | TFuelCell | TPortableFusion | TAutoFiringMech | TFiringMech | TTargetingModule - deriving (Eq,Ord) + deriving (Eq,Ord,Show) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index d14668856..6dc82052f 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -10,7 +10,7 @@ module Dodge.Creature.Action -- , startReloadingWeapon , blinkAction , sizeSelf - , crAutoReload +-- , crAutoReload , copyInvItemToFloor , youDropItem , pickUpItem @@ -144,18 +144,6 @@ performAction cr w ac = case ac of (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) NoAction -> ([],Nothing) -{- | Start reloading if clip is empty. -} -crAutoReload :: Creature -> Creature -crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of - Just 0 | _posture (_crStance cr) /= Aiming - -> cr & ptrItConsumption . reloadState .~ (strictify reloadT) - & ptrItConsumption . ammoLoaded %~ (`fromMaybe` maxA) - _ -> cr - where - ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption - ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption - reloadT = cr ^? ptrItConsumption' . reloadTime - maxA = cr ^? ptrItConsumption' . ammoMax {- | Teleport a creature to the mouse position -} blinkAction :: Creature diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 093c7364d..5c00c28cd 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -14,26 +14,26 @@ interpWith x a b = x *.* a +.+ (1 - x) *.* b invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2 invertEncircleDistP d tcr cenp cr = ypos +.+ - d *.* reflectIn (cenp -.- ypos) (safeNormalizeV (cpos -.- cenp)) + d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp)) where cpos = _crPos cr ypos = _crPos tcr encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2 -encircleDistP d tcr cenp cr = ypos +.+ d *.* safeNormalizeV (cpos -.- cenp) +encircleDistP d tcr cenp cr = ypos +.+ d *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr ypos = _crPos tcr encircleP :: Creature -> Point2 -> Creature -> Point2 -encircleP tcr cenp cr = ypos +.+ 50 *.* safeNormalizeV (cpos -.- cenp) +encircleP tcr cenp cr = ypos +.+ 50 *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr ypos = _crPos tcr --f x = 150 * sigmoid (x-10) encircleCloseP :: Creature -> Point2 -> Creature -> Point2 -encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) +encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr ypos = _crPos tcr @@ -68,7 +68,7 @@ pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp) = negate 150 *.* orthCenpTpos --d = min 150 (dist cpos tpos) --orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos) - orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp) + orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp) pincerP''' :: Creature -> Point2 -> Creature -> Point2 pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep @@ -85,15 +85,15 @@ pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep = f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos | otherwise = negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos - orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp) + orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp) cenclosep - = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) pincerP' :: Creature -> Point2 -> Creature -> Point2 pincerP' tcr cenp cr | dist cenp tpos > dist cpos tpos - = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) - | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) + | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr tpos = _crPos tcr @@ -102,10 +102,10 @@ pincerP' tcr cenp cr pincerP'' :: Creature -> Point2 -> Creature -> Point2 pincerP'' tcr cenp cr | dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos - = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ tpos -.- cenp) + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ tpos -.- cenp) | dist cenp tpos > dist cpos tpos - = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ cenp -.- tpos) - | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ cenp -.- tpos) + | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr tpos = _crPos tcr @@ -114,7 +114,7 @@ pincerP'' tcr cenp cr encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2 encircle tcr crs cr | length crs <= 1 = ypos - | otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + | otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp) where cpos = _crPos cr ypos = _crPos tcr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 52044b09a..a311c8fe7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -9,6 +9,7 @@ circular imports are probably not a good idea. {-# LANGUAGE DeriveGeneric #-} module Dodge.Data ( module Dodge.Data + , module Dodge.Combine.Data , module Dodge.Distortion.Data , module Dodge.Data.DamageType , module Dodge.Data.SoundOrigin @@ -27,6 +28,7 @@ import Dodge.Creature.Memory.Data import Dodge.Distortion.Data import Dodge.Data.SoundOrigin import Dodge.Data.DamageType +import Dodge.Combine.Data import Dodge.Config.Data import Dodge.Config.KeyConfig import Dodge.Item.Attachment.Data @@ -337,6 +339,7 @@ data Item , _itEquipPict :: Creature -> Int -> SPic , _itScroll :: Float -> Creature -> Item -> Item , _itIdentity :: ItemIdentity + , _itCombineType :: ItemCombineType , _itAttachment :: ItAttachment , _itID :: Maybe Int , _itEffect :: ItEffect diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c0d6e7242..0d644d9d7 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -176,7 +176,7 @@ applyIndividualDamage :: DamageType -> Creature -> (World -> World, Creature) applyIndividualDamage (Concussive amount fromDir push pushexp pushRad) cr = ( id , over crHP (\hp -> hp - amount) - $ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- fromDir))) + $ over crPos (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) cr ) where diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index e08fc7375..0498b9ec9 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -84,6 +84,7 @@ defaultAimParams = AimParams defaultGun :: Item defaultGun = Weapon { _itName = "default" + , _itCombineType = NoCombineType , _itCurseStatus = Uncursed , _itIdentity = Pistol , _itConsumption = defaultAmmo diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index c749aeeda..47d4575fa 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -46,7 +46,7 @@ teslaGun = defaultGun [ ammoCheckI , withTempLight 1 100 (V3 0 0 1) , withSoundForI elecCrackleS 1 - , useAmmo 1 + , useAmmoAmount 1 ] & useAim . aimSpeed .~ 0.4 & useAim . aimStance .~ TwoHandFlat @@ -73,7 +73,7 @@ lasGun = defaultAutoGun [ ammoCheckI , withTempLight 1 100 (V3 1 1 0) , withSoundForI tone440sawtoothquietS 2 - , useAmmo 1 + , useAmmoAmount 1 ] & useAim . aimSpeed .~ 0.4 & useAim . aimRange .~ 1 @@ -286,7 +286,7 @@ tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4) | x > -5 = -0.02 | otherwise = (x - 10) / 250 --p4 = vNormal p5 - p4 = vNormal $ safeNormalizeV q + p4 = vNormal $ squashNormalizeV q p3 = p1 +.+ p4 tractorSPic :: Prop -> SPic @@ -301,6 +301,6 @@ tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 co size = fromIntegral (_pjTime pj) spos = _pjPos pj xpos = _pjStartPos pj - d = safeNormalizeV $ spos -.- xpos + d = squashNormalizeV $ spos -.- xpos n = vNormal d col = mixColors 0.5 0.5 white blue diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 0fa83eb6b..40c8dd7d2 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -28,7 +28,7 @@ bezierGun = defaultGun [ ammoCheckI , useTimeCheck , withSoundStart tap2S - , useAmmo 1 + , useAmmoAmount 1 , withMuzFlareI . withRecoilI 40 . torqueBefore 0.05 diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 581230d67..907b9395e 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -27,7 +27,7 @@ boostPoint x cr w = case mayp2 of where cpos = _crPos cr r = 1.5 * _crRad cr - p1 = cpos +.+ x *.* safeNormalizeV (mouseWorldPos w -.- cpos) + p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos) mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w boostSelfL diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index d93e92006..5a5e73719 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -55,7 +55,7 @@ autoGun = defaultAutoGun ] , withSoundForI autoBS 5 --, withSoundForI seagullChatterS 5 - , useAmmo 1 + , useAmmoAmount 1 , applyInaccuracy , withMuzFlareI , withSmoke 1 black 20 200 5 @@ -103,7 +103,7 @@ pistol = defaultGun , hammerCheckI , useTimeCheck , withSoundStart tap3S - , useAmmo 1 + , useAmmoAmount 1 , applyInaccuracy , withMuzFlareI ] @@ -189,7 +189,7 @@ ltAutoGun = defaultAutoGun [ ammoCheckI , useTimeCheck , withSoundStart tap1S - , useAmmo 1 + , useAmmoAmount 1 , applyInaccuracy , torqueAfterI 0.2 , withSidePushI 50 @@ -252,7 +252,7 @@ miniGun = defaultAutoGun , afterRecoil recoilAmount , withRandomOffsetI 9 , withOldDir od3 - , useAmmo 4 + , useAmmoAmount 4 , withMuzFlareI , withSmoke 1 black 20 200 5 ] @@ -328,7 +328,7 @@ spreadGun = defaultGun , hammerCheckI , useTimeCheck , withSoundStart shotgunS - , useAmmo 1 + , useAmmoAmount 1 , withRecoilI 100 , withMuzFlareI , spreadNumI @@ -358,19 +358,20 @@ multGun = defaultGun , _itIdentity = MultGun , _itConsumption = defaultAmmo { _aoType = basicBullet - , _ammoMax = 2 + , _ammoMax = 5 , _ammoLoaded = 2 - , _reloadTime = 40 + , _reloadTime = 10 + , _reloadType = ActivePartial 1 } , _itUse = useAmmoParamsRate 20 upHammer [ ammoCheckI , hammerCheckI , useTimeCheck , withSoundStart shotgunS - , useAmmo 1 + , useAllAmmo , withRecoilI 200 , withMuzFlareI - , numI + , duplicateEachLoadedBarrel ] & useAim . aimSpeed .~ 0.4 & useAim . aimRange .~ 1 @@ -418,7 +419,7 @@ longGun = defaultGun , hammerCheckI , useTimeCheck , withSoundStart bangEchoS - , useAmmo 1 + , useAmmoAmount 1 , withThickSmokeI , torqueAfterI 0.05 , withMuzFlareI diff --git a/src/Dodge/Item/Weapon/Drone.hs b/src/Dodge/Item/Weapon/Drone.hs index 1d9032d02..e341c16b5 100644 --- a/src/Dodge/Item/Weapon/Drone.hs +++ b/src/Dodge/Item/Weapon/Drone.hs @@ -32,7 +32,7 @@ lasDrones = defaultGun [ ammoCheckI , useTimeCheck , withSoundStart tap4S - , useAmmo 1 + , useAmmoAmount 1 ] & useAim . aimSpeed .~ 0.2 & useAim . aimRange .~ 0.5 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 47889837c..9466481ed 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -52,7 +52,7 @@ launcher = defaultGun [ ammoCheckI , useTimeCheck , withSoundStart tap4S - , useAmmo 1 + , useAmmoAmount 1 ] & useAim . aimSpeed .~ 0.2 & useAim . aimRange .~ 0.5 diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index 1a068c5cb..6e87af462 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -42,7 +42,7 @@ poisonSprayer = defaultAutoGun , _itUse = ruseInstant (const aGasCloud) NoHammer [ ammoCheckI , withSoundForI foamSprayLoopS 5 - , useAmmo 1 + , useAmmoAmount 1 -- , spreadNumI ] & useAim . aimSpeed .~ 0.2 @@ -65,7 +65,7 @@ flamer = defaultAutoGun } , _itUse = ruseInstant (\_ -> randWalkAngle aFlame) NoHammer [ ammoCheckI - , useAmmo 1 + , useAmmoAmount 1 , withSidePushI 5 --, withTempLight 1 100 (V3 1 0 0) , withSidePushAfterI 20 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index a551226f1..e9c441528 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -1,7 +1,8 @@ {- | Weapon effects when pulling the trigger. -} module Dodge.Item.Weapon.TriggerType - ( useAmmo + ( useAmmoAmount + , useAllAmmo , withMuzFlareI , withOldDir , trigDoAlso @@ -25,7 +26,8 @@ module Dodge.Item.Weapon.TriggerType , withSidePushI , withWarmUp , spreadNumI - , numI + , numBarrels + , duplicateEachLoadedBarrel , randWalkAngle -- ^ should be made into a modifier, perhaps , hammerCheckI , hammerCheckL @@ -217,10 +219,11 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff cid = _crID cr push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr))) (pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w -useAmmo - :: Int -- ^ amount of ammo to use - -> ChainEffect -useAmmo amAmount eff item cr = eff item cr +useAllAmmo :: ChainEffect +useAllAmmo eff item cr = eff item cr + . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded .~ 0) +useAmmoAmount :: Int -> ChainEffect +useAmmoAmount amAmount eff item cr = eff item cr . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded -~ amAmount) {- | Applies a world effect after an item use cooldown check. -} @@ -393,8 +396,18 @@ spreadNumI eff item cr w = foldr f w dirs f dir = eff item (cr & crDir +~ dir) spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item numBul = _brlNum . _gunBarrels $ _itParams item -numI :: ChainEffect -numI eff item cr w = foldr f w poss +duplicateEachLoadedBarrel :: ChainEffect +duplicateEachLoadedBarrel eff item cr w = foldr f w poss + where + cp :: Float + cp = -0.5 * (fromIntegral numBar - 1) + poss :: [V2 Float] + poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1] + f pos = eff item (cr & crPos %~ (+.+ pos)) + numBar = _brlNum . _gunBarrels $ _itParams item + numBul = _ammoLoaded $ _itConsumption item +numBarrels :: ChainEffect +numBarrels eff item cr w = foldr f w poss where cp :: Float cp = -0.5 * fromIntegral numBul diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index d68b22de9..21e06e9b4 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -97,7 +97,7 @@ expandPolyBy x ps = map f ps expandPolyByFixed :: Float -> [Point2] -> [Point2] expandPolyByFixed x ps = map f ps where - f p = p +.+ x *.* safeNormalizeV (p -.- centroid ps) + f p = p +.+ x *.* squashNormalizeV (p -.- centroid ps) -- | Given a value and a poly, pushes points out by a fixed amount along an -- angle determined by the corner, i.e. by the two other neighbour points expandPolyCorners :: Float -> [Point2] -> [Point2] diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 9bd9a7cdf..851b694f5 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -35,7 +35,7 @@ bulHitCr bt p cr w addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) cid = _crID cr colID = _btColor' bt - p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) + p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr) bulletHitSound :: Point2 -> World -> World bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10) @@ -52,7 +52,7 @@ bulBounceArmCr' bt p cr w addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) cid = _crID cr - newDir = safeNormalizeV (p -.- _crPos cr) + newDir = squashNormalizeV (p -.- _crPos cr) pOut = p +.+ 2 *.* newDir reflectVel = magV bulVel *.* newDir addBouncer = worldEvents %~ ( over particles (bouncer :) . ) @@ -137,7 +137,7 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addB where ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) + pOut = p +.+ squashNormalizeV (sp -.- p) bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} reflectVel = reflVelWall wl (_btVel' bt) @@ -157,9 +157,9 @@ bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl . incFlamelets where ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) + pOut = p +.+ squashNormalizeV (sp -.- p) wallV = uncurry (-.-) (_wlLine wl) - reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) + reflectVel = squashNormalizeV $ reflectIn wallV (_btVel' bt) incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20) {- | Create a shockwave on wall-} bulConWall @@ -186,7 +186,7 @@ hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl where ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) + pOut = p +.+ squashNormalizeV (sp -.- p) (a, g) = randomR (-0.2,0.2) $ _randGen w sv = unitVectorAtAngle $ a + reflDirWall sp p wl cs' = take 10 $ randomRs (0,11) $ _randGen w diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index 5fe3db122..2cd67420c 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/src/Dodge/Placement/Instance/LightSource.hs @@ -65,7 +65,7 @@ aShape :: Point2 -> Point3 -> Shape aShape wallpos (V3 x y z) = girder (z+2) 20 10 pout wallpos where - pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos) + pout = V2 x y -.- 2 *.* squashNormalizeV (V2 x y -.- wallpos) vShape :: Point2 -> Point3 -> Shape vShape wallpos (V3 x y z) = @@ -127,7 +127,7 @@ spanLightI :: Point2 -> Point2 -> Placement spanLightI = spanColLightI 0.75 50 extendAway :: Point2 -> Point2 -> Point2 -extendAway p x = p +.+ safeNormalizeV (p -.- x) +extendAway p x = p +.+ squashNormalizeV (p -.- x) putColorLamp :: Point3 -> PSType putColorLamp col = PutCrit (colorLamp col 90) diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 9166e8bac..057fc7003 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -3,6 +3,7 @@ import Dodge.Data import Dodge.Base --import qualified Data.IntMap.Strict as IM +import Data.Maybe import Control.Lens startReloadingWeapon :: Creature -> World -> Maybe World @@ -34,3 +35,16 @@ stepReloading cr = case cr ^? crInv . ix isel . itConsumption . reloadState . _J & reloadState .~ Nothing' _ -> itcon & ammoLoaded .~ _ammoMax itcon & reloadState .~ Nothing' + +{- | Start reloading if clip is empty. -} +crAutoReload :: Creature -> Creature +crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of + Just 0 | _posture (_crStance cr) /= Aiming + -> cr & ptrItConsumption . reloadState .~ strictify reloadT + & ptrItConsumption . ammoLoaded %~ (`fromMaybe` maxA) + _ -> cr + where + ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption + ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption + reloadT = cr ^? ptrItConsumption' . reloadTime + maxA = cr ^? ptrItConsumption' . ammoMax diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index ea62dd1da..d5166c0b9 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -6,6 +6,7 @@ import Dodge.Data import Dodge.WinScale import Dodge.Base import Dodge.Base.Window +import Dodge.Combine.Combinations import Dodge.Inventory import Dodge.Render.Connectors import Dodge.Render.List @@ -42,7 +43,9 @@ subInventoryDisplay cfig w = case _inventoryMode w of , cursorsZ cfig cursPos it , displayMidList cfig (ammoTweakStrings it) "TWEAK" ] - CombineInventory -> invHead cfig "COMBINE" + CombineInventory -> + displayMidList cfig (combineListStrings w) "COMBINE" +-- invHead cfig "COMBINE" InspectInventory -> invHead cfig "INSPECT" where itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor) @@ -61,6 +64,9 @@ cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of hw = halfWidth cfig sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)) +combineListStrings :: World -> [String] +combineListStrings = map (show . snd) . combineList . fmap _itCombineType . yourInv + ammoTweakStrings :: Maybe Item -> [String] ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of Just l -> map tweakString $ IM.elems l diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 23117260d..80c0b74dc 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -188,7 +188,7 @@ extendedViewPoints p grs = map extend ++ map addDir (concatMap _grLinkDirs grs) ) where - extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p) + extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p) addDir a = p +.+ unitVectorAtAngle a farWallPoints :: Point2 -> World -> [Point2] diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index f08fc0458..a7a7dbb55 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -37,7 +37,7 @@ wallEff dt wl = case dt of PushDam {} -> id PoisonDam {} -> id where - outTo sp p = p +.+ safeNormalizeV (sp -.- p) + outTo sp p = p +.+ squashNormalizeV (sp -.- p) pSparkCol = brightX 100 1.5 white lSparkCol = V4 20 (-5) 0 1 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index b250ed022..9fb5a2655 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -126,8 +126,10 @@ pushOutFromWall rad cp2 (wp1,wp2) -- --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad -- isOnWall = circOnSeg wp1 wp2 cp2 rad + + pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2 -pushOutFromCorners r ls p = foldr (intersectCirclePoint r . fst) p ls +pushOutFromCorners r ls p = foldr (squashIntersectCirclePoint r . fst) p ls --pushOutFromCorners' :: World -> Creature -> Creature --pushOutFromCorners' w cr = cr & crPos .~ newPos @@ -138,8 +140,18 @@ pushOutFromCorners r ls p = foldr (intersectCirclePoint r . fst) p ls --collideCorners :: Float -> [Point2] -> Point2 -> Point2 --collideCorners rad ps p2 = foldr (intersectCirclePoint rad) p2 ps ----- collide circles with points (outer corners) -intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 -intersectCirclePoint rad p cCen +--safeIntersectCirclePoint :: Float -> Point2 -> Point2 -> Maybe Point2 +--safeIntersectCirclePoint rad p cCen +-- | dist cCen p > rad = Just cCen +-- | otherwise = (p +.+) <$> ((rad *.*) <$> (safeNormalizeV (cCen -.- p))) + +squashIntersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 +squashIntersectCirclePoint rad p cCen | dist cCen p > rad = cCen - | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) + | otherwise = p +.+ (rad *.* squashNormalizeV (cCen -.- p)) + +---- collide circles with points (outer corners) +--intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 +--intersectCirclePoint rad p cCen +-- | dist cCen p > rad = cCen +-- | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 1f861f3a7..f293d6333 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -70,7 +70,7 @@ mvShockwave is w pt damCr cr | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr | otherwise = cr & crState . crDamage %~ - (PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)) : ) + (PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p)) : ) {- Create a shockwave going from an outside circle into a center point. -} inverseShockwaveAt :: Point2 -- Center position @@ -109,7 +109,7 @@ moveInverseShockwave w pt damCr cr | dist (_crPos cr) p >= rad + _crRad cr = cr | otherwise = cr & crState . crDamage %~ - (PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)) :) + (PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr)) :) drawInverseShockwave :: Particle -> Picture drawInverseShockwave pt diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 48d8bd14b..33b66770a 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -109,7 +109,7 @@ moveFlame rotd w pt , _btPos' = pOut p , _btVel' = reflV wl } - pOut p = p +.+ safeNormalizeV (sp -.- p) + pOut p = p +.+ squashNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel ) +.+ (0.2 *.* vel) diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index ead9e63dc..2db5a5ae8 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -108,10 +108,17 @@ vNormal (V2 x y) = V2 y (negate x) vInverse :: Point2 -> Point2 vInverse (V2 x y) = V2 (-x) (-y) {- | Normalize a vector safely: on (0,0) return (0,0). -} -safeNormalizeV :: Point2 -> Point2 +squashNormalizeV :: Point2 -> Point2 +{-# INLINE squashNormalizeV #-} +squashNormalizeV p + | magV p == 0 = V2 0 0 + | otherwise = (1/magV p ) *.* p +{- | Normalize a vector safely: on (0,0) return Nothing. -} +safeNormalizeV :: Point2 -> Maybe Point2 {-# INLINE safeNormalizeV #-} -safeNormalizeV (V2 0 0) = V2 0 0 -safeNormalizeV p = (1/magV p ) *.* p +safeNormalizeV p + | magV p == 0 = Nothing + | otherwise = Just $ (1/magV p ) *.* p {- | Magnitude of a vector. -} magV :: Point2 -> Float {-# INLINE magV #-} diff --git a/src/Picture.hs b/src/Picture.hs index 0a02ea694..75196491d 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -259,7 +259,7 @@ thickLineCol ps t = pictures $ f ps ,(y +.+ n x y,c') ] : f ((y,c'):ys) f _ = [] - n a b = (t*0.5) *.* safeNormalizeV (vNormal (a -.- b)) + n a b = (t*0.5) *.* squashNormalizeV (vNormal (a -.- b)) thickCircle :: Float -> Float -> Picture {-# INLINE thickCircle #-}