Work on combine cursors

src/Dodge/Inventory.hs

@@ -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