Fix blinking bug, shrinker and shield broken

This commit is contained in:
2021-11-28 00:34:16 +00:00
parent fe02739621
commit 3e64e33232
10 changed files with 36 additions and 42 deletions
+8 -16
View File
@@ -2,8 +2,7 @@ module Dodge.Creature.Impulse.UseItem
( useItem
, tryUseItem
, useLeftItem
)
where
) where
import Dodge.Data
import Dodge.Inventory
@@ -12,28 +11,21 @@ import Control.Lens
import Data.Maybe
useItem :: Int -> World -> World
useItem n w = itemEffect c it w
useItem cid w = itemEffect cr it w
where
c = _creatures w IM.! n
it = _crInv c IM.! _crInvSel c
cr = _creatures w IM.! cid
it = _crInv cr IM.! _crInvSel cr
tryUseItem
:: Creature
-> World
-> World
tryUseItem :: Creature -> World -> World
tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
Just cr -> itemEffect cr (_crInv cr IM.! _crInvSel cr) 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
Just (RightUse {_rUse = eff,_useMods = usemods}) -> foldr ($) eff usemods it cr w
Just (LeftUse {}) -> w & creatures . ix (_crID cr) . crLeftInvSel ?~ _crInvSel cr
Just RightUse {_rUse = eff,_useMods = usemods} -> foldr ($) eff usemods it cr w
Just LeftUse {} -> w & creatures . ix (_crID cr) . crLeftInvSel ?~ _crInvSel cr
_ -> w
--this is ugly
+2 -1
View File
@@ -121,13 +121,14 @@ heldItemUpdate :: Item -> Item
heldItemUpdate = invItemUpdate
. (itUse %~ useupdate)
where
useupdate = (useDelay . rateTime %~ decreaseToZero)
useupdate = id
invItemUpdate :: Item -> Item
invItemUpdate = itUse %~ useupdate
where
useupdate = (useHammer . hammerPosition %~ moveHammerUp)
. (useDelay . warmTime %~ decreaseToZero)
. (useDelay . rateTime %~ decreaseToZero)
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
+3 -4
View File
@@ -107,7 +107,6 @@ data World = World
, _selLocation :: Int
, _sideEffects :: World -> IO World
, _inventoryMode :: InventoryMode
, _lClickHammer :: HammerPosition
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using and IntMap
@@ -342,9 +341,9 @@ data ItemAmmo
}
data Item
= Weapon
{ _itName :: String
, _wpAmmo :: ItemAmmo
, _itUse :: ItemUse
{ _itName :: String
, _wpAmmo :: ItemAmmo
, _itUse :: ItemUse
, _wpSpread :: Float
, _wpRange :: Float
, _itFloorPict :: Item -> SPic
+3
View File
@@ -8,5 +8,8 @@ import Control.Lens
applyTerminalString :: String -> World -> World
applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
applyTerminalString "LOADME" w = w & creatures . ix 0 . crInv .~ stackedInventory
applyTerminalString "LM" w = w & creatures . ix 0 . crInv .~ stackedInventory
applyTerminalString _ w = w
loadme :: a
loadme = undefined
-1
View File
@@ -77,7 +77,6 @@ defaultWorld = World
, _config = defaultConfig
, _sideEffects = return
, _inventoryMode = TopInventory
, _lClickHammer = HammerUp
, _foregroundShape = mempty
, _distortions = []
, _gameRooms = []
+3 -5
View File
@@ -258,16 +258,14 @@ ammoUseCheck f item cr w
Arbitrary inventory position. -}
hammerCheckL
:: (Creature -> Int -> World -> World) -- ^ Underlying effect
-> Creature
-> Int
-> World
-> World
-> Creature -> Int -> World -> World
hammerCheckL f cr invid w = case (_crInv cr IM.! invid) ^? itUse . useHammer . hammerPosition of
Just HammerUp -> f cr invid $ setHammerDown w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix invid . itUse . useHammer . hammerPosition .~ HammerDown
setHammerDown = creatures . ix cid . crInv . ix invid
. itUse . useHammer . hammerPosition .~ HammerDown
{- | Applies a world effect after an ammo check.
Arbitrary inventory position. -}
shootL
+7 -4
View File
@@ -48,9 +48,9 @@ useRewindGun _ _ w = case _rewindWorlds w of
-- & creatures . ix (_crID cr) .~ cr
& upbuts
& rewindWorlds .~ ws
& lClickHammer .~ HammerUp
upbuts = (keys .~ _keys w) . (mouseButtons .~ _mouseButtons w)
-- needs to shift this item to the current inventory slot
shrinkGun :: Item
shrinkGun = defaultGun
{ _itName = "SHRINKER"
@@ -60,7 +60,8 @@ shrinkGun = defaultGun
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
}
, _itUse = defaultlUse {_lUse = \cr invid -> useShrinkGun (_crInv cr IM.! invid) cr}
, _itUse = defaultlUse {_lUse = hammerCheckL $ \cr invid -> useShrinkGun (_crInv cr IM.! invid) cr}
& useHammer .~ upHammer
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = shrinkGunPic
@@ -90,10 +91,12 @@ blinkGun = defaultGun
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
}
, _itUse = defaultlUse {_lUse = hammerCheckL $ shootL aSelfL}
, _itUse = defaultlUse
{_lUse = hammerCheckL $ shootL aSelfL
} & useHammer .~ upHammer
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
}
+1 -1
View File
@@ -108,7 +108,7 @@ 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 cr)
displayInv n w = renderItemMapAt 0 0 w (_crInv cr)
<> equipcursor
where
equipcursor = case _crLeftInvSel cr of
+6 -6
View File
@@ -65,13 +65,13 @@ room2 :: RandomGen g => Int -> State g (SubCompTree Room)
room2 = lasCenSensEdge
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom i = join $ uncurry takeOneWeighted $ unzip
startRoom _ = join $ uncurry takeOneWeighted $ unzip
[ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
, (,) 1 rezBoxesWp
, (,) 1 rezBoxesThenWeaponRoom
, (,) 1 rezBoxThenWeaponRoom
, (,) 1 rezBoxesWpCrit
, (,) 1 $ runPastStart i
-- , (,) 1 rezBoxesWp
-- , (,) 1 rezBoxesThenWeaponRoom
-- , (,) 1 rezBoxThenWeaponRoom
-- , (,) 1 rezBoxesWpCrit
-- , (,) 1 $ runPastStart i
]
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
+3 -4
View File
@@ -19,18 +19,17 @@ updateUsingInput w = if _carteDisplay w
updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons pkeys w
| lbPressed && rbPressed
= useItem (_yourID w) w & lClickHammer .~ HammerDown
| lbPressed && canLeftClick = useLeftItem (_yourID w) w
= useItem (_yourID w) w
| lbPressed = useLeftItem (_yourID w) w
| lbPressed = w
| mbPressed = w & clickMousePos .~ _mousePos w
& cameraRot -~ rotation
| otherwise = w & lClickHammer .~ HammerUp
| otherwise = w
where
lbPressed = ButtonLeft `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys
mbPressed = ButtonMiddle `S.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w)
canLeftClick = _lClickHammer w == HammerUp
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte pkeys w