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

Allow dropping items by dragging off inventory

Browse Source
This commit is contained in:
justin
2024-11-19 22:24:03 +00:00
parent 13339c9a12
commit 2dc5d35744
11 changed files with 145 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+8 -5
View File
@@ -14,7 +14,7 @@ module Dodge.Creature.Action (
sizeSelf,
youDropItem,
pickUpItem,
-- pickUpItemID,
-- pickUpItemID,
) where
import Control.Applicative
@@ -174,9 +174,12 @@ dropExcept cr invid w =
foldr (dropItem cr) w . IM.keys $
invid `IM.delete` _crInv cr
-- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World
dropItem cr invid = rmInvItem (_crID cr) invid .
copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
dropItem cr invid =
rmInvItem (_crID cr) invid
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
where
itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
@@ -190,8 +193,9 @@ youDropItem w = fromMaybe w $ do
return $
w
& dropItem cr curpos
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
where
-- & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
cr = you w
sizeSelf :: Float -> Creature -> World -> Maybe World
@@ -216,4 +220,3 @@ sizeSelf x cr w
raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR)
cid = _crID cr
cpos = _crPos cr
src/Dodge/Data/Input.hs
+1 -1
View File
@@ -22,7 +22,7 @@ data MouseContext
| MouseInGame
| MouseMenuClick {_mcoMenuClick :: Int}
| MouseMenuCursor
| OverInvDrag
| OverInvDrag {_mcoDragPos :: Maybe Int}
| OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverInvFilt { _mcoInvFilt :: (Int,Int)}
src/Dodge/DisplayInventory.hs
+1 -1
View File
@@ -172,7 +172,7 @@ filterSectionsPair endstr filtfn itms filtdescription mfilt =
, itms'
)
where
filtsis = fromMaybe mempty $ do
filtsis = fold $ do
str <- mfilt
return $
IM.singleton
src/Dodge/Item/Draw.hs
+2 -2
View File
@@ -3,11 +3,11 @@ module Dodge.Item.Draw (
itemEquipPict,
) where
import Data.Foldable
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Geometry.Data
import Control.Lens
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Data.Creature
import Dodge.Item.Draw.SPic
@@ -19,7 +19,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
&& itm ^? itLocation . ilIsSelected == Just True
-> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
ituse -> fromMaybe mempty $ do
ituse -> fold $ do
attachpos <- ituse ^? uequipEffect . eeAttachPos
i <- itm ^? itLocation . ilInvID
epos <- cr ^? crInvEquipped . ix i
src/Dodge/Render/HUD.hs
+1 -4
View File
@@ -66,10 +66,6 @@ drawInventory sss w cfig =
<> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
<> iextra
<> drawMouseOver cfig w
-- <> translateScreenPos
-- cfig
-- (ldp ^. ldpPos)
-- (drawDISelections w)
where
ldp = invDisplayParams w
curs = invCursorParams w
@@ -110,6 +106,7 @@ getRootItemBounds i inv = do
y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
return (x, y)
-- this should display while dragging a single inv item
drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w = concat (invsel <|> combinvsel
<|> drawDragSelect cfig w)
src/Dodge/Render/List.hs
+1 -1
View File
@@ -111,7 +111,7 @@ selSecDrawCursorAt ::
IM.IntMap (SelectionSection a) ->
(Int, Int) ->
Picture
selSecDrawCursorAt xsize ldp curs sss (i, j) = fromMaybe mempty $ do
selSecDrawCursorAt xsize ldp curs sss (i, j) = fold $ do
yint <- selSecYint i j sss
xint <- sss ^? ix i . ssIndent
si <- sss ^? ix i . ssItems . ix j
src/Dodge/Render/Picture.hs
+9 -2
View File
@@ -84,7 +84,8 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseMenuClick {} -> drawMenuClick 5
MouseMenuCursor -> drawMenuCursor 5
MouseInGame -> drawPlus 5
OverInvDrag -> drawDrag 5
OverInvDrag (Just _) -> drawDrag 5
OverInvDrag Nothing -> drawDragDrop 5
OverInvDragSelect {} -> drawDragSelect 5
OverInvSelect {} -> drawSelect 5
OverInvFilt {} -> drawCombFilter 5
@@ -157,6 +158,12 @@ drawDragSelect x = polygonWire $ rectWH (0.5 * x) x
drawDrag :: Float -> Picture
drawDrag x = line [V2 0 x,V2 0 (-x)]
drawDragDrop :: Float -> Picture
drawDragDrop x = line [V2 (-x) x,V2 0 x,V2 0 (-x)]
<> line [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)]
where
y = 0.7 * x
drawSelect :: Float -> Picture
drawSelect x = polygonWire $ rectWH x (0.5 * x)
-- line [V2 (-x) 0, V2 0 0]
@@ -188,7 +195,7 @@ drawGapPlus x =
]
aimDelaySweep :: World -> Picture
aimDelaySweep w = fromMaybe mempty $ do
aimDelaySweep w = fold $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
aimstatus <- cr ^? crStance . posture
guard (aimstatus == Aiming)
src/Dodge/Update.hs
+5 -2
View File
@@ -354,14 +354,13 @@ checkTermDist w = fromMaybe w $ do
updateMouseContext :: Configuration -> Universe -> Universe
updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
OverInvDrag | lbheld -> u
OverInvDrag {} -> u & uvWorld . input . mouseContext .~ invdrag
OverInvDragSelect{} -> u
_ -> u & uvWorld . input . mouseContext
.~ fromMaybe
aimcontext
(overmenu <|> overinv <|> overcomb <|> overterm)
where
lbheld = ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)
overmenu = do
screen <- u ^? uvScreenLayers . ix 0
return $ case screen ^. scOptions of
@@ -384,6 +383,10 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = MouseInGame
mpos = w ^. input . mousePos
invdrag = fromMaybe (OverInvDrag Nothing) $ do
sss <- w ^? hud . hudElement . diSections
(0,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
return $ OverInvDrag $ Just j
overinv = do
sss <- w ^? hud . hudElement . diSections
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
src/Dodge/Update/Input/InGame.hs
+13 -2
View File
@@ -103,7 +103,8 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
sss <- w ^? hud . hudElement . diSections
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag -> fromMaybe w $ do
OverInvDrag Nothing -> w
OverInvDrag {} -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
let mpos = w ^. input . mousePos
sel <- w ^? hud . hudElement . diSelection . _Just
@@ -113,8 +114,18 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
where
ldp = invDisplayParams w
dropSelected :: World -> World
dropSelected w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0,j) <- w ^? hud . hudElement . diSelection . _Just
x <- w ^? hud . hudElement . diSelectionExtra
return $ foldl' (flip $ dropItem cr) w (reverse [j .. j+x])
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
j <- mpos
return $ w & input . mouseContext .~ OverInvSelect (0,j)
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra
@@ -174,7 +185,7 @@ startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen 0 w) $ d
return $ setmichosen x w
where
setmichosen x =
(input . mouseContext .~ OverInvDrag)
(input . mouseContext .~ OverInvDrag (Just b))
. (hud . hudElement . diSelectionExtra .~ x)
shiftInvItems ::