Allow to equip left click items

This commit is contained in:
2021-11-27 02:01:12 +00:00
parent 774808663a
commit e7ea7377e2
21 changed files with 93 additions and 116 deletions
+6 -1
View File
@@ -223,7 +223,12 @@ dropUnselected cr w = foldr (dropItem cr) w . IM.keys
$ _crInvSel cr `IM.delete` _crInv cr
dropItem :: Creature -> Int -> World -> World
dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid
dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid . mayberemoveequip
where
cid = _crID cr
mayberemoveequip = case _crLeftInvSel cr of
Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
_ -> id
{- | Get your creature to drop the item under the cursor. -}
youDropItem :: World -> World
+18 -12
View File
@@ -26,23 +26,29 @@ tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
Nothing -> w
itemEffect
:: Creature
:: Creature
-> Item
-> World
-> World
itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
itemEffect cr it@Weapon{_itUse=eff} w = foldr ($) eff (_itUseModifiers it) it cr w
itemEffect cr it@Throwable{_itUse = eff} w = foldr ($) eff (_itUseModifiers it) it cr w
itemEffect _ _ w = w
useLeftItem
:: Int
-> World
-> World
useLeftItem cid w = case luse of
itemEffect cr it w = case it ^? itUse of
Just (Right eff) -> foldr ($) eff (_itUseModifiers it) it cr w
Just (Left _ ) -> w & creatures . ix (_crID cr) . crLeftInvSel ?~ _crInvSel cr
Nothing -> w
Just (invid, f) -> f cr invid w
--this is ugly
useLeftItem :: Int -> World -> World
useLeftItem cid w = case _crInv cr IM.! crinvsel ^? itUse . _Left of
Just f -> f cr crinvsel w & creatures . ix cid . crLeftInvSel ?~ crinvsel
Nothing -> case _crLeftInvSel cr of
Just invid -> case _itUse $ _crInv cr IM.! invid of
Left f -> f cr invid w
Right _ -> w & creatures . ix cid . crLeftInvSel .~ Nothing
Nothing -> case luse of
Nothing -> w
Just (invid, f) -> f cr invid w & creatures . ix cid . crLeftInvSel ?~ invid
where
crinvsel = _crInvSel cr
cr = _creatures w IM.! cid
luses = IM.mapMaybe (^? itLeftClickUse . _Just) (_crInv cr)
luses = IM.mapMaybe (^? itUse . _Left) (_crInv cr)
luse = listToMaybe $ IM.toList luses
+6 -41
View File
@@ -292,47 +292,10 @@ data ItemPos
data Item' = Item'
{ _iName :: String
, _iIdentity :: ItemIdentity
, _iType :: ItemType
, _iType :: Item
, _iID :: Int
, _itPos :: ItemPos
}
data ItemType = TargetItem
{ _tiMaxAmmo :: Int
, _tiLoadedAmmo :: Int
, _tiAmmo :: Ammo
, _tiReloadTime :: Int
, _tiReloadState :: Int
, _tiReloadType :: ReloadType
, _tiMaxWarmUp :: Int
, _tiCurWarmUp :: Int
, _tiMaxCoolDown :: Int
, _tiCurCoolDown :: Int
, _tiUseRate :: Int
, _tiUseTime :: Int
, _tiUse :: Item -> Creature -> World -> World
, _tiUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _tiSpread :: Float
, _tiRange :: Float
, _tiHammer :: HammerPosition
, _tiDraw :: Item -> SPic
, _tiAimingSpeed :: Float
, _tiAimingRange :: Float
, _tiZoom :: ItZoom
, _tiAimZoom :: ItZoom
, _tiEquipDraw :: Creature -> Int -> SPic
, _tiScroll :: Float -> Creature -> Item -> Item
, _tiAttachment :: ItAttachment
, _tiEffect :: ItEffect
, _tiInvDisplay :: Item -> String
, _tiInvColor :: Color
, _tiTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
, _tiWorldTrigger :: Maybe (Int -> World -> Bool)
, _tiAimStance :: AimStance
, _tiNumBarrels :: Int
, _tiDimension :: ItemDimension
, _tiCurseStatus :: CurseStatus
}
data Item
= Weapon
{ _itName :: String
@@ -348,9 +311,10 @@ data Item
, _wpCurCoolDown :: Int
, _itUseRate :: Int
, _itUseTime :: Int
, _itUse :: Item -> Creature -> World -> World
, _itUse :: Either (Creature -> Int -> World -> World)
(Item -> Creature -> World -> World)
, _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
--, _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
@@ -430,7 +394,8 @@ data Item
, _itFloorPict :: Item -> SPic
, _twMaxRange :: Float
, _twAccuracy :: Float
, _itUse :: Item -> Creature -> World -> World
, _itUse :: Either (Creature -> Int -> World -> World)
(Item -> Creature -> World -> World)
, _itUseRate :: Int
, _itUseTime :: Int
, _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
+1 -2
View File
@@ -27,9 +27,8 @@ defaultGun = Weapon
, _wpCurCoolDown = 0
, _itUseRate = 8
, _itUseTime = 0
, _itUse = \_ _ -> id
, _itUse = Right $ \_ _ -> id
, _itUseModifiers = []
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
+3 -13
View File
@@ -104,11 +104,11 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
Nothing -> closeObjScrollDir y w
Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> swapInvDir yi $ dirInvPos yi w
| otherwise -> dirInvPos yi w
| invKeyDown -> swapInvDir yi $ stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w
(_, TweakInventory)
| invKeyDown && rbDown -> w & moveYourAmmoSel yi
| invKeyDown -> dirInvPos yi w
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w
| rbDown -> w & moveYourAmmoParam yi
| otherwise -> w & moveYourAmmoSel yi
(_, _) -> w
@@ -132,14 +132,4 @@ moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pj
where
paramid = _amParamSel $ _wpAmmo $ yourItem w
swapInvDir :: Int -> World -> World
swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n)
where
i = _crInvSel $ you w
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
dirInvPos :: Int -> World -> World
dirInvPos i w = stopSoundFrom (CrReloadSound 0) $ w
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
+20 -1
View File
@@ -5,6 +5,8 @@ module Dodge.Inventory
, rmInvItem
, updateCloseObjects
, closeObjScrollDir
, swapInvDir
, dirInvPos
)
where
import Dodge.Data
@@ -13,10 +15,10 @@ import Dodge.Base.Collide
import Geometry
import FoldableHelp
import Padding
import qualified IntMapHelp as IM
--import Data.Maybe
import Data.List
import qualified Data.IntMap.Strict as IM
--import System.Random
import Control.Lens
@@ -91,3 +93,20 @@ closeObjScrollDir x
| x < 0 = over closeActiveObjects rotD
| otherwise = id
swapInvDir :: Int -> World -> World
swapInvDir k w = w & creatures . ix (_yourID w) %~ updatecreature
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
swapi = (i + k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel $ you w
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
dirInvPos :: Int -> World -> World
dirInvPos i w = w
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
+3 -4
View File
@@ -11,10 +11,9 @@ import Geometry
import Control.Lens
useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b)
where
b = _wpAmmo it
useAmmoParams :: Either a (Item -> Creature -> World -> World)
useAmmoParams = Right $ \it -> let b = _wpAmmo it
in withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b)
useAmmoParamsVelMod :: Float -> Item -> Creature -> World -> World
useAmmoParamsVelMod vfact it = withDelayedVelWthHiteff vfact (_amBulVel b) (_amBulWth b) (_amBulEff b)
+3 -3
View File
@@ -44,7 +44,7 @@ teslaGun = defaultGun
, _itUseRate = 0
, _itAimStance = TwoHandFlat
, _itUseTime = 0
, _itUse = const aTeslaArc
, _itUse = Right $ const aTeslaArc
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
@@ -77,7 +77,7 @@ lasGun = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const aLaser
, _itUse = Right $ const aLaser
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
@@ -117,7 +117,7 @@ tractorGun = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = aTractorBeam
, _itUse = Right aTractorBeam
, _itUseModifiers =
[ ammoUseCheckI
]
+1 -1
View File
@@ -23,7 +23,7 @@ import Control.Monad.State
bezierGun :: Item
bezierGun = defaultGun
{ _itName = "B-GUN"
, _itUse = \_ -> useTargetPos $ \p -> shootBezier $ fromJust p -- <- the start point
, _itUse = Right $ \_ -> useTargetPos $ \p -> shootBezier $ fromJust p -- <- the start point
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
+1 -9
View File
@@ -54,13 +54,6 @@ boostSelfL x cr invid w = case boostPoint x cr w of
. (itAttachment .~ ItInt pid)
)
boostSelf
:: Float -- ^ boost amount
-> Creature
-> World
-> World
boostSelf x cr = boostSelfL x cr (_crInvSel cr)
addBoostShockwave
:: Int
-> Point2
@@ -126,8 +119,7 @@ boosterGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> boostSelf 10
, _itLeftClickUse = Just $ boostSelfL 10
, _itUse = Left $ boostSelfL 10
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
+1 -2
View File
@@ -102,7 +102,6 @@ pistol = defaultGun
, randSpreadDir
, withMuzFlareI
]
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = pistolPic
@@ -218,7 +217,7 @@ miniGun = defaultAutoGun
, _wpMaxWarmUp = 100
, _itUseRate = 0
, _itUseTime = 0
, _itUse = useAmmoParamsVelMod vm4
, _itUse = Right $ useAmmoParamsVelMod vm4
, _itUseModifiers =
[ ammoCheckI
, withWarmUpI crankSlowS
+1 -1
View File
@@ -28,7 +28,7 @@ lasDrones = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = aDroneWithItemParams
, _itUse = Right aDroneWithItemParams
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
+5 -5
View File
@@ -34,7 +34,7 @@ grenade = Throwable
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> throwGrenade makeExplosionAt
, _itUse = Right $ \_ -> throwGrenade makeExplosionAt
, _itUseModifiers =
[ useTimeCheckI
]
@@ -227,7 +227,7 @@ remoteBomb = defaultThrowable
[(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = const throwRemoteBomb
, _itUse = Right $ const throwRemoteBomb
, _itUseModifiers =
[ hammerCheckI
]
@@ -260,7 +260,7 @@ throwRemoteBomb cr w = setLocation
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ -> explodeRemoteBomb itid i
$ Right $ \_ -> explodeRemoteBomb itid i
p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr-4) 0)
| otherwise = p'
@@ -277,7 +277,7 @@ explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
-- $ set (props . ix pjid . pjDraw) (\_ -> blank)
$ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
$ set (creatures . ix cid . crInv . ix j . itUse) (Right $ \_ -> const id)
$ resetName
$ resetPict
-- $ resetScope
@@ -305,7 +305,7 @@ retireRemoteBomb itid 0 pjid w = w
& pointToItem (_itemPositions w IM.! itid) %~
( (itAttachment . scopePos .~ V2 0 0)
. (itZoom .~ defaultItZoom)
. (itUse .~ const throwRemoteBomb)
. (itUse .~ (Right $ const throwRemoteBomb))
)
& props %~ IM.delete pjid
retireRemoteBomb itid t pjid w = setScope w
+5 -5
View File
@@ -43,7 +43,7 @@ launcher = defaultGun
, _wpReloadState = 0
, _itUseRate = 20
, _itUseTime = 0
, _itUse = aRocketWithItemParams
, _itUse = Right aRocketWithItemParams
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
@@ -244,7 +244,7 @@ remoteLauncher = defaultGun
, _wpReloadState = 0
, _itUseRate = 10
, _itUseTime = 0
, _itUse = const fireRemoteLauncher
, _itUse = Right $ const fireRemoteLauncher
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
@@ -287,7 +287,7 @@ fireRemoteLauncher cr w = setLocation
newitid = IM.newKey $ _itemPositions w
maybeitid = cr ^? crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ \_ _ -> explodeRemoteRocket itid i
$ Right $ \_ _ -> explodeRemoteRocket itid i
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
setLocation :: World -> World
setLocation w' = case maybeitid of
@@ -347,7 +347,7 @@ explodeRemoteRocket
explodeRemoteRocket itid pjid w
= set (props . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
$ set (props . ix pjid . prDraw) (const mempty)
$ set (itPoint . itUse) (\_ _ -> id)
$ set (itPoint . itUse) (Right $ \_ _ -> id)
$ resetName
$ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
where
@@ -379,7 +379,7 @@ remoteShellPic t
retireRemoteRocket :: Int -> Int -> Int -> World -> World
retireRemoteRocket itid 0 pjid w =
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . scopePos) (V2 0 0)
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const fireRemoteLauncher)
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (Right $ const fireRemoteLauncher)
(w & props %~ IM.delete pjid)
retireRemoteRocket itid t pjid w = setScope w
& props . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid)
+2 -2
View File
@@ -26,7 +26,7 @@ radar = defaultGun
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _itUse = const aRadarPulse
, _itUse = Right $ const aRadarPulse
, _itUseModifiers =
[ ammoUseCheckI
]
@@ -51,7 +51,7 @@ sonar = defaultGun
, _wpReloadState = 0
, _itUseRate = 120
, _itUseTime = 0
, _itUse = const aSonarPulse
, _itUse = Right $ const aSonarPulse
, _itUseModifiers =
[ ammoUseCheckI
]
+1 -1
View File
@@ -21,7 +21,7 @@ spawnGun cr = defaultGun
, _wpReloadTime = 80
, _wpReloadState = 0
, _itUseRate = 100
, _itUse = \_ -> spawnCrNextTo cr
, _itUse = Right $ \_ -> spawnCrNextTo cr
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
+2 -2
View File
@@ -40,7 +40,7 @@ poisonSprayer = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const aGasCloud
, _itUse = Right $ const aGasCloud
, _itUseModifiers =
[ ammoCheckI
, useTimeCheckI
@@ -66,7 +66,7 @@ flamer = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = \_ -> randWalkAngle 0.2 0.01 aFlame
, _itUse = Right $ \_ -> randWalkAngle 0.2 0.01 aFlame
, _itUseModifiers =
[ ammoUseCheckI
, withSidePushI 5
+5 -8
View File
@@ -22,9 +22,8 @@ rewindGun = defaultGun
, _itIdentity = Rewinder
, _wpMaxAmmo = 0
, _wpLoadedAmmo = 0
, _itUse = useRewindGun
, _itEffect = ItRewindEffect rewindEffect []
, _itLeftClickUse = Just $ \cr invid -> useRewindGun (_crInv cr IM.! invid) cr
, _itUse = Left $ \cr invid -> useRewindGun (_crInv cr IM.! invid) cr
}
rewindEffect :: ItEffect -> Creature -> Int -> World -> World
rewindEffect _ cr invid w = w & rewindWorlds %~ (take 250 . (w' : ))
@@ -57,12 +56,11 @@ shrinkGun = defaultGun
, _itUseRate = 0
, _itUseTime = 0
, _itAimStance = TwoHandFlat
, _itUse = useShrinkGun
, _itUse = Left $ \cr invid -> useShrinkGun (_crInv cr IM.! invid) cr
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
]
, _itLeftClickUse = Nothing
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = shrinkGunPic
@@ -95,12 +93,11 @@ blinkGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = const blinkAction
, _itUse = Left $ hammerCheckL $ shootL aSelfL
, _itUseModifiers =
[ ammoCheckI
, hammerCheckI
]
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
@@ -118,12 +115,12 @@ aSelfL cr _ = blinkAction cr
effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
, _itUse = const eff
, _itUse = Right $ const eff
}
autoEffectGun :: String -> (Creature -> World -> World) -> Item
autoEffectGun name eff = defaultAutoGun
{ _itName = name ++ "Gun"
, _itUse = const eff
, _itUse = Right $ const eff
}
forceFieldGun :: Item
forceFieldGun = defaultGun
+1 -1
View File
@@ -112,7 +112,7 @@ placeSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWall
}
pairs = rectanglePairs 9 a b
shiftedPairs = map (bimap shiftLeft shiftLeft) pairs
shiftLeft = (+.+ (a -.- b +.+ (normalizeV (b -.- a))) )
shiftLeft = (+.+ (a -.- b +.+ normalizeV (b -.- a)))
wlids = take 4 [IM.newKey $ _walls w ..]
-- old code that may help with pathing
--import Dodge.LevelGen.Pathing
+7 -1
View File
@@ -108,7 +108,13 @@ renderItemMapAt :: Float -> Float -> World -> IM.IntMap Item -> Picture
renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
displayInv :: Int -> World -> Picture
displayInv n w = renderItemMapAt 0 0 w . _crInv $ _creatures w IM.! n
displayInv n w = (renderItemMapAt 0 0 w $ _crInv cr)
<> equipcursor
where
equipcursor = case _crLeftInvSel cr of
Nothing -> mempty
Just invid -> openCursorAt 20 yellow 105 0 invid w
cr = _creatures w IM.! n
drawLocations :: World -> Picture
drawLocations w = pictures $
+1 -1
View File
@@ -20,7 +20,7 @@ corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks'
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ]
, _rmPmnts = [ spanLightI (V2 0 39.5) (V2 40 39.5) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = Tiled [makeTileFromPoly poly 2]
, _rmRandPSs = [psRandRanges (10,30) (30,60) (0,2*pi)]