justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Stop equip after combining

Browse Source
This commit is contained in:
justin
2023-05-15 06:46:09 +01:00
parent 1cec50c5ab
commit 0735b46266
13 changed files with 38 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse.hs
+1 -1
View File
@@ -46,7 +46,7 @@ followImpulse cr w imp = case imp of
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useItem cr, cr)
UseItem -> (useItemRightClick cr, cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelItem i NoInvSelAction)
Melee cid' ->
( hitCr cid'
src/Dodge/Creature/Impulse/UseItem.hs
+12 -18
View File
@@ -1,8 +1,8 @@
module Dodge.Creature.Impulse.UseItem (
useItem,
doTopInvLeftClick,
useItemRightClick,
useItemLeftClick,
itemEffect,
tryUseL,
useItemHotkey,
) where
import Dodge.Hotkey
@@ -22,8 +22,8 @@ import Dodge.Reloading
import qualified IntMapHelp as IM
import qualified SDL
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
useItemRightClick :: Creature -> World -> World
useItemRightClick cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
it <- cr ^? crInv . ix itRef
@@ -113,25 +113,19 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
doTopInvLeftClick :: Creature -> World -> World
doTopInvLeftClick cr w = fromMaybe w $ do
useItemLeftClick :: Creature -> World -> World
useItemLeftClick cr w = fromMaybe w $ do
guard . not $ _crInvLock cr
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
ituse <- cr ^? crInv . ix invid . itUse
case ituse of
ConsumeUse{} -> return $ useItem cr w
EquipUse{} -> return $ useItem cr w
LeftUse{} -> return $ equipAndUse (_leftUseOnEquip ituse) invid cr w
ConsumeUse{} -> return $ useItemRightClick cr w
EquipUse{} -> return $ useItemRightClick cr w
LeftUse{} -> return $ useItemRightClick cr w
_ -> Nothing
equipAndUse :: Bool -> Int -> Creature -> World -> World
equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
Nothing | useonequip -> tryUseL (_crID cr) invid $ useItem cr w
| otherwise -> useItem cr w
_ -> tryUseL (_crID cr) invid w
tryUseL :: Int -> Int -> World -> World
tryUseL crid invid w = fromMaybe w $ do
useItemHotkey :: Int -> Int -> World -> World
useItemHotkey crid invid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
itm <- cr ^? crInv . ix invid
luse <- itm ^? itUse . leftUse
src/Dodge/Creature/YourControl.hs
+3 -3
View File
@@ -48,7 +48,7 @@ handleHotkeys w
hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
useHotKey :: World -> Int -> World
useHotKey w invid = tryUseL 0 invid w
useHotKey w invid = useItemHotkey 0 invid w
allHotkeys :: [SDL.Scancode]
allHotkeys = map hotkeyToScancode [minBound .. maxBound]
@@ -161,8 +161,8 @@ mouseActionsCr pkeys cr
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
| isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w
| isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w
| isDown SDL.ButtonMiddle =
w & wCam . camRot -~ rotation
| otherwise = w
src/Dodge/Data/Item/Use.hs
-1
View File
@@ -42,7 +42,6 @@ data ItemUse
, _leftHammer :: HammerPosition
, _equipEffect :: EquipEffect
, _leftConsumption :: LeftConsumption
, _leftUseOnEquip :: Bool
}
| ConsumeUse
{ _cUse :: Cuse
src/Dodge/Default/Item/Use.hs
-1
View File
@@ -18,7 +18,6 @@ defaultLeftUse =
, _leftHammer = HammerUp
, _equipEffect = defaultEquip
, _leftConsumption = defaultLeftLoadable
, _leftUseOnEquip = False
}
defaultEquipUse :: ItemUse
src/Dodge/Inventory.hs
-6
View File
@@ -54,7 +54,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
& doanyitemeffect
& dounequipfunction --the ordering of these is
& pointcid . crInv %~ f -- important
-- & pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& pointcid . crEquipment . each %~ g
@@ -100,11 +99,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
g x
| x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x
-- g' Nothing = Nothing
-- g' (Just x)
-- | x == invid = Nothing
-- | x > invid || Just x == maxk = Just $ max 0 $ x - 1
-- | otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
src/Dodge/Menu/PushPop.hs
+1 -1
View File
@@ -4,7 +4,7 @@ import Dodge.Data.Universe
import LensHelp
popScreen :: Universe -> Universe
popScreen = uvScreenLayers %~ tail
popScreen = (uvScreenLayers . ix 0 . scDisplayTime .~ 0) . (uvScreenLayers %~ tail)
pushScreen :: (Universe -> ScreenLayer) -> Universe -> Universe
pushScreen ml u = u & uvScreenLayers .:~ ml u
src/Dodge/Render/HUD.hs
+2 -2
View File
@@ -204,7 +204,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
where
invcursor i = fromMaybe mempty $ do
sss' <- w ^? hud . hudElement . diSections
let idp = (invDisplayParams w & ldpCursorSides .~ [North, South, East, West])
let idp = invDisplayParams w & ldpCursorSides .~ [North, South, East, West]
return $
translateScreenPos cfig (idp ^. ldpPos) $
selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i))
@@ -261,7 +261,7 @@ lnkMidPosInvSelsCol cfig w i col = foldMap f
lp <- selNumPos cfig (invDisplayParams w) sss 0 j
rp <- selNumPos cfig secondColumnParams combinesss 0 i
invcol <- selSecSelCol 0 j sss
return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col white white invcol
return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col col col invcol
tweakItems :: Maybe Item -> [SelectionItem ()]
tweakItems = textSelItems . ammoTweakStrings
src/Dodge/Render/List.hs
+9 -12
View File
@@ -2,7 +2,7 @@ module Dodge.Render.List (
renderListAt,
drawList,
drawSelectionList,
listPicturesYgapScaleYoff,
drawListYgapScaleYoff,
drawListElement,
selSecDrawCursor,
dShadCol,
@@ -30,7 +30,7 @@ drawSelectionList ldps cfig sl =
translateScreenPos
cfig
(ldps ^. ldpPos)
$ listPicturesYgapScaleYoff
$ drawListYgapScaleYoff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0
@@ -72,10 +72,10 @@ getLDPWidth ldps = case _ldpWidth ldps of
_ -> 1
drawListYoff :: Int -> [Picture] -> Picture
drawListYoff = listPicturesYgapScaleYoff 0 1
drawListYoff = drawListYgapScaleYoff 0 1
listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
drawListYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
drawListYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
stackPicturesAt :: [Picture] -> Picture
stackPicturesAt = stackPicturesAtOff 0
@@ -113,8 +113,8 @@ listCursorChooseBorderScale ::
Picture
listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
translate
((10 * s * (fromIntegral xint) - 5 * s))
(- (ygap + (s * 20 + ygap) * (fromIntegral yint) + 1))
((10 * fromIntegral xint - 5) * s)
(- (ygap + (s * 20 + ygap) * fromIntegral yint ))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
where
@@ -162,7 +162,7 @@ renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color
-- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen
drawList :: [Picture] -> Picture
drawList = listPicturesYgapScaleYoff 0 1 0
drawList = drawListYgapScaleYoff 0 1 0
--TODO put the following functions in an appropriate place
@@ -172,7 +172,4 @@ dShadCol :: Color -> Picture -> Picture
dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
toTopLeft :: Configuration -> Picture -> Picture
toTopLeft cfig = translate (- hw) (hh)
where
hw = halfWidth cfig
hh = halfHeight cfig
toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)
src/Dodge/SelectionList.hs
-35
View File
@@ -3,13 +3,10 @@ module Dodge.SelectionList (
getAvailableListLines,
) where
import Color
import Data.Maybe
import Dodge.Data.ScreenPos
import Dodge.Data.Universe
import LensHelp
import Linear
import Regex
getAvailableListLines :: ListDisplayParams -> Configuration -> Int
getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
@@ -25,35 +22,3 @@ getShownItems :: SelectionList a -> [SelectionItem a]
getShownItems sl = case sl ^. slRegexList of
[] -> sl ^. slItems
xs -> fmap fst xs
makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)]
makeRegexList sl = case sl ^. slRegex of
"" | not (sl ^. slRegexInput) -> []
str ->
( SelectionInfo
{ _siPictures = ["FILTER: " ++ str]
, _siHeight = 1
, _siIsSelectable = False
, --, _siWidth = length $ "FILTER: "++str
_siColor = white
, _siOffX = 0
}
, Nothing
) :
filter (doregex str) (zip (_slItems sl) $ fmap Just [0 ..])
where
doregex str = regexList str . _siPictures . fst
setShownItems :: SelectionList a -> SelectionList a
setShownItems sl = sl & slRegexList .~ makeRegexList sl
moveSelectionListSelection :: Int -> SelectionList a -> SelectionList a
moveSelectionListSelection yi sl = sl & slSelPos %~ f
where
f x
| maxsel == 0 = Nothing
| isNothing x = Just 0
| otherwise = fmap ((`mod` maxsel) . subtract yi) x
maxsel = case _slRegex sl of
"" -> length (_slItems sl)
_ -> length (_slRegexList sl)
src/Dodge/SelectionSections/Draw.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Picture.Base
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
drawSelectionSections sss ldp cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
listPicturesYgapScaleYoff
drawListYgapScaleYoff
(_ldpVerticalGap ldp)
(_ldpScale ldp)
0
src/Dodge/Update/Input/InGame.hs
+2 -1
View File
@@ -253,7 +253,8 @@ tryCombine :: SelectionSections CombinableItem -> World -> World
tryCombine sss w = fromMaybe w $ do
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
return $ createAndSelectItem it (foldr (rmInvItem 0) w (sort is))
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
src/Dodge/Update/Input/ScreenLayer.hs
+7 -30
View File
@@ -79,44 +79,21 @@ mouseClickOptionsList screen u = fromMaybe u $ do
return $ f u
_ -> u
mouseOverSelectionList ::
ListDisplayParams ->
ScreenLayer ->
Universe ->
Universe
mouseOverSelectionList :: ListDisplayParams -> ScreenLayer -> Universe -> Universe
mouseOverSelectionList ldps screen u = fromMaybe u $ do
yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
guard $
(mmoving || (_scDisplayTime screen <= 1))
&& isselectable yi
&& yi >= 0
&& yi < ymax
-- && x > xl && x < xr
return $ u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yi
guard $ mmoving || (_scDisplayTime screen <= 1)
let myi = do
guard (yi >= 0 && yi < ymax && isselectable yi)
return yi
return $ u & uvScreenLayers . _head . scSelectionList . slSelPos .~ myi
where
-- | x > xl && x < xr
-- && ylower == yupper
-- && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
-- && isselectable =
-- u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
-- | otherwise = u
sl = _scSelectionList screen
isselectable yi =
fromMaybe False $
u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
ymax = maybe 0 length $ sl ^? slItems
ymax = maybe 0 length $ screen ^? scSelectionList . slItems
mmoving = u ^. uvWorld . input . mouseMoving
-- ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
-- yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
-- xl = _ldpPosX ldps - hw
-- xr = xl + _ldpScale ldps * 26 * 9
-- V2 _ y = u ^. uvWorld . input . mousePos
-- cfig = u ^. uvConfig
-- hh = halfHeight cfig
-- hw = halfWidth cfig
ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
ldpVerticalSelection cfig ldp (V2 _ y)
| yupper == ylower = Just yupper