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

Work on combine cursors

Browse Source
This commit is contained in:
justin
2023-02-17 18:00:40 +00:00
parent 30ce713534
commit 90133fb54b
5 changed files with 91 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+1 -3
View File
@@ -178,9 +178,7 @@ dropExcept cr invid w =
invid `IM.delete` _crInv cr
dropItem :: Creature -> Int -> World -> World
dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . mayberemoveequip
where
cid = _crID cr
dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid -- . mayberemoveequip
-- the following should be done in rmInvItem
-- mayberemoveequip = case _crLeftInvSel cr of
src/Dodge/Data/SelectionList.hs
-4
View File
@@ -45,11 +45,7 @@ data SectionCursor = SectionCursor
data SelectionSection a = SelectionSection
{ _ssItems :: IntMap (SelectionItem a)
, _ssCursor :: Maybe SectionCursor
-- , _ssSelPos :: Maybe Int
-- , _ssSelSize :: Maybe Int
-- , _ssSelColor :: Maybe Color
, _ssMinSize :: Int
--, _ssPriority :: Int
, _ssOffset :: Int
, _ssShownItems :: [Picture]
, _ssIndent :: Int
src/Dodge/Inventory.hs
+53 -20
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
selSecSelPos,
ssLookupDown,
ssLookupGT,
ssSetCursor,
@@ -9,9 +10,9 @@ module Dodge.Inventory (
rmSelectedInvItem,
invSelSize,
selNumPos,
selNumTextPos,
selNumTextEndPos,
selNumCol,
selNumMidHeight,
selNumEndMidHeight,
augmentedInvSizes,
rmInvItem,
updateCloseObjects,
@@ -63,9 +64,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
w
& pointcid . crInv %~ f
& pointcid %~ crCancelReloading
-- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING
-- & pointcid . crManipulation . manObject . inInventory . ispItem %~ g
-- & pointcid . crManipulation . manObject %~ h
& pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& dounequipfunction
@@ -74,7 +72,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
& pointcid . crInvEquipped %~ IM.mapKeys g
& updatemanipulation
where
-- TODO check whether this can be mapKeysMonotonic
getcid = cWorld . lWorld . creatures . ix cid
pointcid = cWorld . lWorld . creatures . ix cid
@@ -96,10 +93,10 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> pointcid . crEquipment . at epos .~ Nothing
Nothing -> id
maxk = fmap fst $ IM.lookupMax $ cr ^?! crInv
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
f inv =
let (xs, ys) = IM.split invid inv
in xs `IM.union` IM.mapKeys (subtract 1) ys
in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
-- the following might not work if a non-player creature drops their last item
g x
| x > invid || Just x == maxk = max 0 $ x - 1
@@ -128,8 +125,18 @@ trimapAugmentInv f x g w =
where
n = length $ yourInv w
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures
invSelSize :: ManipulatedObject -> World -> Int
invSelSize mo w = case mo of
InInventory (SelItem i _) -> fromMaybe 1 $ fmap itSlotsTaken
$ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i
InNearby (SelCloseObject i) -> fromMaybe 1 $ fmap closeObjectSize
$ w ^? hud . closeObjects . ix i
InInventory SortInventory -> 1
InNearby SortNearby -> 1
SelNothing -> 1
closeObjectSize :: Either FloorItem Button -> Int
closeObjectSize e = case e of
@@ -141,23 +148,49 @@ closeObjectCol e = case e of
Left flit -> _itInvColor $ _flIt flit
Right _ -> yellow
selNumPos :: Int -> World -> Int
selNumPos i w = sum . fst $ IM.split i (augmentedInvSizes w)
selNumTextPos :: Configuration -> World -> Int -> Point2
selNumTextPos cfig w i = V2 (150 - hw) (hh - (20 * fromIntegral ipos + 20))
selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelPos i j sss = do
ss <- sss ^? sssSections . ix i
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap (length . _siPictures)
. fst $ IM.split j (ss ^. ssItems)
where
secpos = sum . fmap (length . _ssItems) . fst $ IM.split i $ sss ^. sssSections
selNumPos :: ManipulatedObject -> World -> Maybe Int
selNumPos mo w = w ^? hud . hudElement . diSections >>=
case mo of
InInventory SortInventory -> selSecSelPos (-1) 0
InInventory (SelItem i _) -> selSecSelPos 0 i
SelNothing -> selSecSelPos 1 0
InNearby SortNearby -> selSecSelPos 2 0
InNearby (SelCloseObject i) -> selSecSelPos 3 i
-- there are still more ListDisplayParams to integrate here
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
selNumTextEndPos cfig ldp sss i j = do
ipos <- selSecSelPos i j sss
return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
where
s = _ldpScale ldp
ygap = _ldpVerticalGap ldp
hh = halfHeight cfig
hw = halfWidth cfig
ipos = selNumPos i w
selNumMidHeight :: Configuration -> World -> Int -> Point2
selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos + 7.5))
selNumEndMidHeight :: Configuration -> ListDisplayParams -> SelectionSections a -> Int
-> Int -> Maybe Point2
selNumEndMidHeight cfig ldp sss i j = do
ipos <- selSecSelPos i j sss
size <- selSecSelSize i j sss
--let bump = negate $ (10 * s + ygap) * fromIntegral size
return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
where
s = _ldpScale ldp
ygap = _ldpVerticalGap ldp
hh = halfHeight cfig
hw = halfWidth cfig
ipos = selNumPos i w
bump = negate $ 10 * fromIntegral (invSelSize i w)
selNumCol :: Int -> World -> Color
selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
src/Dodge/Render/HUD.hs
+28 -15
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
invDisplayParams,
) where
import Dodge.Inventory
import SelectionIntMap
import Dodge.Data.Combine
import Dodge.Default.SelectionList
@@ -19,9 +20,6 @@ import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Inventory
--import Dodge.Inventory.ItemSpace
--import Dodge.Item.Display
import Dodge.Item.Info
import Dodge.Render.Connectors
import Dodge.Render.List
@@ -167,15 +165,20 @@ drawNoSubInventory cfig w =
, rboptions
]
where
equipcursor = case cr ^. crLeftInvSel . lisMPos of
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
equipcursor = fromMaybe mempty $ do
invid <- cr ^. crLeftInvSel . lisMPos
sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid
f col invid epos = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
cr = you w
rboptions
| ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
| otherwise = mempty
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
@@ -199,9 +202,14 @@ combineInventoryExtra sm mi cfig w = fromMaybe mempty $ do
lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
return $
lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
-- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
<> foldMap invcursor lnks
<> combineCounts cfig w lnks
]
where
invcursor i = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
secondColumnParams :: ListDisplayParams
secondColumnParams =
@@ -304,16 +312,21 @@ subInvX = 9 * fromIntegral topInvW + 50
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
where
f (i : is) = case yourInv w ^? ix i . itUse . useAmount of
Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
_ -> mempty
f (i : is) = fromMaybe mempty $ do
_ <- yourInv w ^? ix i . itUse . useAmount
sss <- w ^? hud . hudElement . diSections
p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
return $ color (selNumCol i w) $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
f _ = mempty
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col =
winScale cfig
. foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
lnkMidPosInvSelsCol cfig w i col = winScale cfig
. foldMap f
where
f j = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
return $ zConnectCol rp (V2 18 0 + h) col white white (selNumCol j w)
rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
hh = halfHeight cfig
hw = halfWidth cfig
@@ -326,7 +339,7 @@ topCursorTypeWidth ::
Int ->
Picture
topCursorTypeWidth ctype width cfig w i =
ctype 0 0 cfig (selNumPos i w) 0 (selNumCol i w) width (invSelSize i w)
ctype 0 0 cfig (fromMaybe 0 (selNumPos (InInventory (SelItem i NoInvSelAction)) w)) 0 (selNumCol i w) width (invSelSize (InInventory (SelItem i NoInvSelAction)) w)
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
src/Dodge/Render/List.hs
+9 -1
View File
@@ -1,6 +1,7 @@
module Dodge.Render.List where
--import Picture.Text
import Dodge.Inventory
import SelectionIntMap
import qualified Data.IntMap.Strict as IM
--import Data.Foldable
@@ -109,6 +110,13 @@ stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..]
selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do
yint <- selSecSelPos i j sss
xint <- sss ^? sssSections . ix i . ssIndent
si <- sss ^? sssSections . ix i . ssItems . ix j
return $ listCursorDisplayParams ldp borders cfig yint xint (_siColor si) xsize (length $ _siPictures si)
listCursorDisplayParams ::
ListDisplayParams ->
[CardinalPoint] ->
@@ -153,7 +161,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz
where
x = 9
wth = x * fromIntegral cursxsize + 9
hgt = 20 * fromIntegral cursysize
hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
-- displays a cursor that should match up to list text pictures
-- the width of a character appears to be 9(?!)