This commit is contained in:
2021-12-08 22:01:25 +00:00
parent a9139db0a8
commit eeda4f3e39
12 changed files with 98 additions and 36 deletions
+24 -24
View File
@@ -22,45 +22,45 @@ tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
Nothing -> w Nothing -> w
itemEffect :: Creature -> Item -> World -> World itemEffect :: Creature -> Item -> World -> World
--itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
itemEffect cr it w = case it ^? itUse of itemEffect cr it w = case it ^? itUse of
Just RightUse {_rUse = eff,_useMods = usemods} -> foldr ($) eff usemods it cr w Just RightUse {_rUse = eff,_useMods = usemods} -> foldr ($) eff usemods it cr w
Just LeftUse {} -> lhammer setEquipLeftItem Just LeftUse {} -> lhammer setEquipLeftItem
-- Just LeftUse {} -> w Just EquipUse{} -> lhammer setEquipment
-- & lSelHammerPosition .~ HammerDown
-- & docycle
--Just EquipUse -> w & creatures . ix (_crID cr) . crInvEquipped . at (_crInvSel cr) %~ f
Just EquipUse -> lhammer setEquipment
Just NoUse -> w Just NoUse -> w
Nothing -> w Nothing -> w
where where
f Nothing = Just () lhammer f' = w
f (Just ()) = Nothing
-- toggleEquip invid =
lhammer f = w
& lSelHammerPosition .~ HammerDown & lSelHammerPosition .~ HammerDown
& case _lSelHammerPosition w of & case _lSelHammerPosition w of
HammerUp -> creatures . ix (_crID cr) %~ f HammerUp -> creatures . ix (_crID cr) %~ f'
_ -> id _ -> id
setEquipLeftItem cr = case _crLeftInvSel cr of setEquipLeftItem cr' = case _crLeftInvSel cr' of
Just i | i == _crInvSel cr -> cr & crLeftInvSel .~ Nothing Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
_ -> cr & crLeftInvSel .~ (Just $ _crInvSel cr) _ -> cr' & crLeftInvSel ?~ _crInvSel cr'
setEquipment = crInvEquipped . at (_crInvSel cr) %~ f setEquipment = toggleEquipmentAt (_crInvSel cr)
docycle | _lSelHammerPosition w == HammerUp = creatures . ix (_crID cr) . crLeftInvSel %~ cyclelsel
| otherwise = id toggleEquipmentAt :: Int -> Creature -> Creature
cyclelsel mi = case mi of toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f
Just i | i == _crInvSel cr -> Nothing where
_ -> Just $ _crInvSel cr f Nothing = Just ()
f (Just ()) = Nothing
--this is ugly --this is ugly
useLeftItem :: Int -> World -> World useLeftItem :: Int -> World -> World
useLeftItem cid w | _crInvLock $ _creatures w IM.! cid = w useLeftItem cid w
| _crInvLock $ _creatures w IM.! cid = w
| otherwise = useLeftItem' cid w | otherwise = useLeftItem' cid w
useLeftItem' :: Int -> World -> World useLeftItem' :: Int -> World -> World
useLeftItem' cid w = case cr ^? crInv . ix crinvsel . itUse . lUse of useLeftItem' cid w = case cr ^? crInv . ix crinvsel . itUse of
Just f -> f cr crinvsel (w & creatures . ix cid . crLeftInvSel ?~ crinvsel) Just EquipUse{} -> w
Nothing -> case _crLeftInvSel cr of & lSelHammerPosition .~ HammerDown
& case _lSelHammerPosition w of
HammerUp -> creatures . ix cid %~ toggleEquipmentAt crinvsel
_ -> id
Just LeftUse {_lUse = f} -> f cr crinvsel (w & creatures . ix cid . crLeftInvSel ?~ crinvsel)
_ -> case _crLeftInvSel cr of
Just invid -> case _itUse $ _crInv cr IM.! invid of Just invid -> case _itUse $ _crInv cr IM.! invid of
LeftUse {_lUse = f} -> f cr invid w LeftUse {_lUse = f} -> f cr invid w
_ -> w & creatures . ix cid . crLeftInvSel .~ Nothing _ -> w & creatures . ix cid . crLeftInvSel .~ Nothing
+5 -1
View File
@@ -19,6 +19,7 @@ import Picture
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
--import StrictHelp --import StrictHelp
import qualified Data.IntSet as IS
import Data.Maybe import Data.Maybe
import Data.Function import Data.Function
import Control.Lens import Control.Lens
@@ -134,8 +135,11 @@ invItemUpdate = itUse %~ useupdate
. (useDelay . rateTime %~ decreaseToZero) . (useDelay . rateTime %~ decreaseToZero)
invSideEff :: Creature -> World -> World invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) invSideEff cr w = weaponReloadSounds cr
. flip (IS.foldr useeq) (_crInvEquipped cr)
$ IM.foldrWithKey f w (_crInv cr)
where where
useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
f i it w' = case it ^? itEffect . itInvEffect of f i it w' = case it ^? itEffect . itInvEffect of
Nothing -> w' & doitemupdate Nothing -> w' & doitemupdate
Just g -> g (_itEffect it) cr i w' & doitemupdate Just g -> g (_itEffect it) cr i w' & doitemupdate
+2
View File
@@ -318,6 +318,8 @@ data ItemUse
, _useHammer :: HammerType , _useHammer :: HammerType
} }
| EquipUse | EquipUse
{ _eqUse :: Creature -> Int -> World -> World
}
| NoUse | NoUse
_itUseAimStance :: Item -> AimStance _itUseAimStance :: Item -> AimStance
_itUseAimStance = _aimStance . _useAim . _itUse _itUseAimStance = _aimStance . _useAim . _itUse
+1 -1
View File
@@ -146,7 +146,7 @@ defaultEquipment = Item
, _itInvSize = 1 , _itInvSize = 1
, _itDimension = defItDimCol yellow , _itDimension = defItDimCol yellow
, _itConsumption = NoConsumption , _itConsumption = NoConsumption
, _itUse = EquipUse , _itUse = EquipUse {_eqUse = \_ _ -> id}
, _itScroll = \ _ _ -> id , _itScroll = \ _ _ -> id
, _itAttachment = NoItAttachment , _itAttachment = NoItAttachment
, _itParams = NoParams , _itParams = NoParams
+11 -1
View File
@@ -36,12 +36,12 @@ import qualified IntMapHelp as IM
import ListHelp import ListHelp
import Color import Color
import qualified Data.IntSet as IS
import Data.Maybe import Data.Maybe
--import Data.List --import Data.List
--import System.Random --import System.Random
import Control.Lens import Control.Lens
-- | after this the item at the inventory position will no longer exist -- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position -> Int -- ^ Inventory position
@@ -51,6 +51,8 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
_ -> w & creatures . ix cid . crInv %~ f _ -> w & creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel %~ g & creatures . ix cid . crInvSel %~ g
& creatures . ix cid . crLeftInvSel . _Just %~ g & creatures . ix cid . crLeftInvSel . _Just %~ g
& creatures . ix cid . crInvEquipped %~ IS.delete invid
& creatures . ix cid . crInvEquipped %~ IS.map g
where where
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
f inv = let (xs,ys) = IM.split invid inv f inv = let (xs,ys) = IM.split invid inv
@@ -155,6 +157,7 @@ changeSwapInvSel k w
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi ) updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel) . (crLeftInvSel . _Just %~ updateLeftInvSel)
. (crInvSel %~ (`mod` n) . subtract k) . (crInvSel %~ (`mod` n) . subtract k)
. (crInvEquipped %~ swapIntSetKeys i swapi)
swapi = (i - k) `mod` n swapi = (i - k) `mod` n
updateLeftInvSel li | i == li = swapi updateLeftInvSel li | i == li = swapi
| swapi == li = i | swapi == li = i
@@ -164,6 +167,13 @@ changeSwapInvSel k w
n = length $ _crInv $ _creatures w IM.! _yourID w n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w numCO = length $ _closeObjects w
swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
swapIntSetKeys i j is
| i `IS.member` is && j `IS.member` is = is
| i `IS.member` is = j `IS.insert` (i `IS.delete` is)
| j `IS.member` is = i `IS.insert` (j `IS.delete` is)
| otherwise = is
changeAugInvSel :: Int -> World -> World changeAugInvSel :: Int -> World -> World
changeAugInvSel i w changeAugInvSel i w
| n == 0 = w | n == 0 = w
+1
View File
@@ -19,6 +19,7 @@ data ItAttachment
| ItCharMode {_itCharMode :: Seq.Seq Char } | ItCharMode {_itCharMode :: Seq.Seq Char }
| ItTargetPos { _itTargetPos :: Point2 } | ItTargetPos { _itTargetPos :: Point2 }
| ItInt { _itInt :: Int } | ItInt { _itInt :: Int }
| ItMInt { _itMInt :: Maybe Int }
| ItFloat { _itFloat :: Float } | ItFloat { _itFloat :: Float }
| ItBool { _itBool :: Bool } | ItBool { _itBool :: Bool }
| NoItAttachment | NoItAttachment
+19 -1
View File
@@ -8,21 +8,39 @@ import Dodge.Item.Weapon.BatteryGuns
import Dodge.Creature.Test import Dodge.Creature.Test
import Dodge.Wall.Reflect import Dodge.Wall.Reflect
import Dodge.Wall import Dodge.Wall
import Dodge.Magnet
import Picture import Picture
import Geometry import Geometry
import ShapePicture import ShapePicture
import Shape import Shape
import qualified IntMapHelp as IM
import qualified Data.IntMap.Strict as IM
import Control.Lens import Control.Lens
magShield :: Item magShield :: Item
magShield = defaultEquipment magShield = defaultEquipment
{ _itType = MAGSHIELD { _itType = MAGSHIELD
, _itName = "MAGSHIELD" , _itName = "MAGSHIELD"
, _itUse = EquipUse useMagShield
, _itEquipPict = \_ _ -> (,) emptySH blank , _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing , _itID = Nothing
, _itAttachment = ItMInt Nothing
} }
useMagShield :: Creature -> Int -> World -> World
useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
where
themagnet = Magnet
{_mgID = mgid
,_mgUpdate = Just . (mgUpdate .~ const Nothing)
,_mgPos = _crPos cr
,_mgField = curveAroundField
}
mgid = case it ^? itAttachment . itMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets w
it = _crInv cr IM.! invid
flameShield :: Item flameShield :: Item
flameShield = defaultEquipment flameShield = defaultEquipment
{ _itType = FLAMESHIELD { _itType = FLAMESHIELD
+10 -3
View File
@@ -33,8 +33,14 @@ defaultAimParams = AimParams
} }
useAmmoParams :: Item -> Creature -> World -> World useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it = withVelWthHiteff (muzvel *.* _amBulVel b) (_rifling $ _itParams it) (_amBulWth b) (_amBulEff b) useAmmoParams it = withVelWthHiteff
(muzvel *.* _amBulVel b)
(_rifling $ _itParams it)
(_amBulWth b)
muzlength
(_amBulEff b)
where where
muzlength = 20
muzvel = _muzVel $ _itParams it muzvel = _muzVel $ _itParams it
b = _aoType $ _itConsumption it b = _aoType $ _itConsumption it
@@ -49,14 +55,15 @@ withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature :: Point2 -- ^ Velocity, x direction is forward with respect to the creature
-> Float -- ^ drag -> Float -- ^ drag
-> Float -- ^ Bullet width -> Float -- ^ Bullet width
-> Float -- ^ Distance away from creature to create
-> HitEffect -- ^ Bullet effect when hitting creature, wall etc -> HitEffect -- ^ Bullet effect when hitting creature, wall etc
-> Creature -> Creature
-> World -> World
-> World -> World
withVelWthHiteff vel drag width hiteff cr = particles .:~ newbul withVelWthHiteff vel drag width muzlength hiteff cr = particles .:~ newbul
where where
newbul = aGenBulAt (Just (_crID cr)) pos (rotateV dir vel) drag hiteff width newbul = aGenBulAt (Just (_crID cr)) pos (rotateV dir vel) drag hiteff width
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle dir pos = _crPos cr +.+ muzlength *.* unitVectorAtAngle dir
dir = _crDir cr dir = _crDir cr
{- | Creates a bullet with a given velocity, width, and 'HitEffect' -} {- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
+2 -2
View File
@@ -163,13 +163,13 @@ baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
autoRifle :: Item autoRifle :: Item
autoRifle = rifle autoRifle = repeater
& itName .~ "AUTORIFLE" & itName .~ "AUTORIFLE"
& itType .~ AUTORIFLE & itType .~ AUTORIFLE
& itUse . useMods %~ ((ammoCheckI :) . tail) & itUse . useMods %~ ((ammoCheckI :) . tail)
-- & itUse . useDelay . rateMax .~ 6 -- & itUse . useDelay . rateMax .~ 6
assaultRifle :: Item assaultRifle :: Item
assaultRifle = rifle assaultRifle = repeater
& itName .~ "ASSAULTRIFLE" & itName .~ "ASSAULTRIFLE"
& itType .~ ASSAULTRIFLE & itType .~ ASSAULTRIFLE
& itUse . useDelay . rateMax .~ 18 & itUse . useDelay . rateMax .~ 18
+19
View File
@@ -8,3 +8,22 @@ dampField :: Magnet -> Particle -> Particle
dampField mg pt = case pt of dampField mg pt = case pt of
BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & btVel' *~ 0.5 BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & btVel' *~ 0.5
_ -> pt _ -> pt
curveLeftField :: Magnet -> Particle -> Particle
curveLeftField mg pt = case pt of
BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 500 -> pt & btVel' %~ rotateV 0.2
_ -> pt
curveAroundField :: Magnet -> Particle -> Particle
curveAroundField mg pt = case pt of
BulletPt{} | dist btpos mgpos < 500 -> pt & btVel' %~ rotateToCircle
where
mgpos = _mgPos mg
btpos = head $ _btTrail' pt
rotateToCircle vel
| (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
|| (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )
= rotateV rot vel
| otherwise = rotateV (negate rot) vel
rot = 0.5
_ -> pt
+3 -1
View File
@@ -7,6 +7,7 @@ import Dodge.FloorItem
import Dodge.Wall.Delete import Dodge.Wall.Delete
import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.Explosion
import Dodge.Item.Weapon.BatteryGuns import Dodge.Item.Weapon.BatteryGuns
import Dodge.Item.Weapon.BulletGun.Cane
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Item.Draw import Dodge.Item.Draw
@@ -29,7 +30,8 @@ putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMa
} }
lasTurret :: MachineType lasTurret :: MachineType
lasTurret = Turret lasTurret = Turret
{ _tuWeapon = lasGun --{ _tuWeapon = lasGun
{ _tuWeapon = autoRifle
, _tuTurnSpeed = 0.1 , _tuTurnSpeed = 0.1
, _tuFireTime = 0 , _tuFireTime = 0
} }
+1 -2
View File
@@ -1,5 +1,4 @@
{- Functions that affect the world according to what pressed buttons are stored in a Set. {- Functions that affect the world according to what pressed buttons are stored in a Set. -}
-}
module Dodge.Update.UsingInput module Dodge.Update.UsingInput
( updateUsingInput ( updateUsingInput
) where ) where