Unify inventory sections further (slow?)

src/Dodge/Creature/Impulse/UseItem.hs

@@ -123,7 +123,7 @@ useLeftItem cid w = fromMaybe w $ do
             cr ^? crInv . ix itRef . itUse . cUse
         itmIsEquipable = isJust $ do
             itRef <- mitRef
-            guard . not $ cr ^. crLeftInvSel . lisMPos /= Just itRef
+            guard $ cr ^. crLeftInvSel . lisMPos == Just itRef
             cr ^? crInv . ix itRef . itUse . equipEffect . eeUse
     if itmIsConsumable || itmIsEquipable
         then return $ useItem cr w -- I believe this ONLY sets equipment options
@@ -136,6 +136,5 @@ useLeftItem cid w = fromMaybe w $ do
                 . useL f itm cr
                 $ w
             
-  where
 
 -- TODO determine itmShouldBeUsed with reference to config options

src/Dodge/Data/SelectionList.hs

@@ -60,6 +60,7 @@ data SelectionSection a = SelectionSection
     , _ssRestriction :: SSRestriction
     , _ssShownItems :: [Picture]
     , _ssIndent :: Int
+    , _ssDescriptor :: String
     }
     
 

src/Dodge/DisplayInventory.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.DisplayInventory 
-    ( makeDisplayInventory
+    ( updateDisplayInventory
-    , updateDisplayInventory
+    , defaultDisplaySections
     ) where
 
 import Data.Maybe
@@ -23,11 +23,25 @@ import Dodge.Data.World
 
 updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
 updateDisplayInventory w cfig sss = sss
-    { _sssSections = restrictsections
+    --{ _sssSections = restrictsections
+    { _sssSections = sections
     , _sssSelPos = mspos
     , _sssMaxSize = availablelines
     }
   where
+    sections = case cr ^? crInvSel . isel of
+        Just (SelItem i _) -> updateSections availablelines (0,i) [invx ,youx, closex]
+        Just SelNothing -> updateSections availablelines (1,0) [invx ,youx, closex]
+        Just (SelCloseObject i) -> updateSections availablelines (2,i) [closex, invx ,youx]
+        _ -> error "wat"
+    invx = (0,(invsec, invitems))
+    youx = (1,(makeYouSection w, youitems))
+    closex = (2,(cosec, coitems))
+    youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()
+    thetext = case nfreeslots of
+        0 -> "  INVENTORY FULL"
+        1 -> "  +1 FREE SLOT"
+        x -> "  +" ++ show x ++ " FREE SLOTS"
     mspos = do 
         mo <- cr ^? crInvSel . isel
         case mo of
@@ -36,14 +50,12 @@ updateDisplayInventory w cfig sss = sss
             SelCloseObject {} -> Just 2
     availablelines = getAvailableListLines (invDisplayParams w) cfig
     iavailablelines = availablelines - 6
-    --invsection = makeInventorySection iavailablelines oldoffset w
+    invsection = updateSection invpos invitems iavailablelines invsec
-    invsection = updateSection "MORE INV ITEMS" invpos invitems iavailablelines w invsec
     invsectionlines = length $ _ssShownItems invsection
     restrictsections = IM.fromList
         [ (0, invsection )
         , (1, makeYouSection w)
-        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
+        , (2, updateSection copos coitems (availablelines - invsectionlines - 1) cosec)
-        , (2, updateSection "MORE CLOSE OBJECTS" copos coitems (availablelines - invsectionlines - 1) w cosec)
         ]
     cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
     invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
@@ -66,41 +78,30 @@ updateDisplayInventory w cfig sss = sss
             SelNothing -> Nothing
             SelCloseObject i -> Just i
 
+updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))]
+    -> IM.IntMap (SelectionSection a)
+updateSections _ _ [] = mempty
+updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss
+    $ updateSections (allavailablelines - length (_ssShownItems ss)) (i,j) xs
+  where
+    ss  | i == k = updateSection (Just j) y availablelines x
+        | otherwise = updateSection Nothing y availablelines x
+    availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
+
 defaultCOSection :: SelectionSection ()
-defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2
+defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2 "CLOSE OBJECTS"
 
 defaultInvSection :: SelectionSection ()
-defaultInvSection = SelectionSection mempty Nothing 5 0 0 NoSSRestriction [] 0
+defaultInvSection = SelectionSection mempty Nothing 5 0 0 NoSSRestriction [] 0 "INVENTORY ITEMS"
 
-makeDisplayInventory :: World -> Configuration -> SelectionSections ()
+updateSection 
-makeDisplayInventory w cfig = defaultDisplaySections
+    :: Maybe Int
-    { _sssSections = restrictsections    
+    -> IM.IntMap (SelectionItem a) 
-    , _sssSelPos = mspos
+    -> Int 
-    , _sssMaxSize = availablelines
+--    -> World 
-    }
+    -> SelectionSection a
-  where
+    -> SelectionSection a
-    mspos = do 
+updateSection mspos sis availablelines ss = ss
-        cr <- w ^? cWorld . lWorld . creatures . ix 0
-        mo <- cr ^? crInvSel . isel
-        case mo of
-            SelItem {} -> Just 0
-            SelNothing -> Just 1
-            SelCloseObject {} -> Just 2
-    availablelines = getAvailableListLines (invDisplayParams w) cfig
-    --iavailablelines = availablelines - 6
-    --invsection = makeInventorySection iavailablelines (Just 0) w
-    --invsectionlines = length $ _ssShownItems invsection
-    restrictsections = IM.fromList
-        [ (0, defaultInvSection )
-        , (1, makeYouSection w)
-        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
-        , (2, defaultCOSection)
-        ]
-
-updateSection :: String -> Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World 
-    -> SelectionSection ()
-    -> SelectionSection ()
-updateSection morestring mspos sis availablelines w ss = ss
     { _ssItems = sis
     , _ssCursor = scurs
     , _ssRestriction = NoSSRestriction
@@ -109,21 +110,20 @@ updateSection morestring mspos sis availablelines w ss = ss
 --    , _ssRegex = ""
 --    , _ssRegexInput = False
     , _ssMinSize = 5
---    , _ssOffset = 0
     , _ssShownItems = shownitems
     }
   where
-    moldoffset = ss ^? ssOffset
+    oldoffset = ss ^. ssOffset
     scurs = do
         csel <- mspos
+        si <- sis ^? ix csel
         let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
-        csize <- selsize
+            csize = length $ _siPictures si
-        ccolor <- selcolor
+            ccolor = _siColor si
         return $ SectionCursor (cpos - offset) csize ccolor
     mcpos = do
         csel <- mspos
         return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
-    oldoffset = fromMaybe 0 moldoffset
     xselsize = fromMaybe 1 selsize
     offset = maybe 0 offset' mcpos
     offset' jselpos
@@ -145,97 +145,20 @@ updateSection morestring mspos sis availablelines w ss = ss
     allstrings :: [(Color,String)]
     allstrings = foldMap g sis
     mustrestrict = length allstrings > availablelines
-    shownstrings :: [(Color,String)]
     shownstrings = drop offset allstrings
-    cr = you w
     h (col,str) = color col . text $ str
-    --hdown (col,str) = textGrad col (withAlpha 0 col) str
-    --hup (col,str) = textGrad (withAlpha 0 col) col str
     theindent = replicate (_ssIndent ss) ' '
-    hdown = color white . text $ theindent ++ ">>> " ++ morestring
+    hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss
-    hup = color white . text $ theindent ++ "<<< " ++ morestring
+    hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
     g si = map (_siColor si ,) $ _siPictures si
     islastitm = fromMaybe False $ do
-        i <- cr ^? crInvSel . isel . ispItem
+        i <- mspos
-        k <- fmap fst $ IM.lookupMax (_crInv cr)
+        k <- fst <$> IM.lookupMax sis
         return $ k == i
     selsize = do
         i <- mspos
         si <- sis ^? ix i
         return . length $ _siPictures si
-    selcolor = do
-        i <- mspos
-        si <- sis ^? ix i
-        return $ _siColor si
-
---makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
---makeInventorySection iavailablelines moldoffset w = SelectionSection
---    { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv
---    , _ssCursor = scurs
---    , _ssRestriction = NoSSRestriction
---    , _ssPriority = 0
---    , _ssOffset = offset
---    , _ssIndent = 0
-----    , _ssRegex = ""
-----    , _ssRegexInput = False
---    , _ssMinSize = 5
-----    , _ssOffset = 0
---    , _ssShownItems = shownitems
---    }
---  where
---    scurs = do
---        cpos <- fmap (subtract offset) selpos
---        csize <- selsize
---        ccolor <- selcolor
---        return $ SectionCursor cpos csize ccolor
---    jselpos = fromMaybe 0 selpos
---    oldoffset = fromMaybe 0 moldoffset
---    xselsize = fromMaybe 1 selsize
---    offset
---        | jselpos == 0 || not mustrestrict = 0
---        | jselpos - 1 < oldoffset = jselpos - 1
---        | islastitm = jselpos - iavailablelines + xselsize
---        | jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize
---        | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
---        | otherwise = oldoffset
---    tweakfirst (x:xs)
---        | offset > 0 = hup : map h xs
---        | otherwise = map h (x:xs)
---    tweakfirst [] =  []
---    shownitems
---        | length shownstrings > iavailablelines
---            = tweakfirst (take (iavailablelines - 1) shownstrings) 
---                ++ [hdown]
---        | otherwise = tweakfirst shownstrings
---    allstrings :: [(Color,String)]
---    allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
---    mustrestrict = length allstrings > iavailablelines
---    shownstrings :: [(Color,String)]
---    shownstrings = drop offset allstrings
---    cr = you w
---    inv = _crInv cr
---    h (col,str) = color col . text $ str
---    --hdown (col,str) = textGrad col (withAlpha 0 col) str
---    --hup (col,str) = textGrad (withAlpha 0 col) col str
---    hdown = color white $ text ">>> MORE INV ITEMS"
---    hup = color white $ text "<<< MORE INV ITEMS"
---    g si = map (_siColor si ,) $ _siPictures si
---    islastitm = fromMaybe False $ do
---        i <- cr ^? crInvSel . isel . ispItem
---        k <- fmap fst $ IM.lookupMax (_crInv cr)
---        return $ k == i
---    selpos = do
---        i <- cr ^? crInvSel . isel . ispItem
---        return . sum . fmap itSlotsTaken . fst . IM.split i $ inv
---    selsize = do
---        i <- cr ^? crInvSel . isel . ispItem
---        itm <- inv ^? ix i 
---        return $ itSlotsTaken itm
---    selcolor = do
---        i <- cr ^? crInvSel . isel . ispItem
---        itm <- inv ^? ix i 
---        return $ _itInvColor itm
-        
 
 makeYouSection :: World -> SelectionSection ()
 makeYouSection w = SelectionSection
@@ -250,6 +173,7 @@ makeYouSection w = SelectionSection
     , _ssMinSize = 1
 --    , _ssOffset = 0
     , _ssShownItems = [color invDimColor $ text thetext]
+    , _ssDescriptor = "YOUR STATUS"
     }
   where
     cr = you w
@@ -259,43 +183,3 @@ makeYouSection w = SelectionSection
         1 -> "  +1 FREE SLOT"
         x -> "  +" ++ show x ++ " FREE SLOTS"
 
---makeCloseObjectsSection :: Int -> World -> SelectionSection ()
---makeCloseObjectsSection cavailablelines w = SelectionSection
---    { _ssItems = IM.fromDistinctAscList . zip [0..] 
---        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
---    , _ssCursor = scurs
---    , _ssPriority = 1
---    , _ssOffset = 0
---    , _ssIndent = 2
---    , _ssRestriction = NoSSRestriction
-----    , _ssRegex = ""
-----    , _ssRegexInput = False
---    , _ssMinSize = 5
-----    , _ssOffset = 0
---    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
---    }
---  where
---    scurs = do
---        cpos <- selpos
---        csize <- selsize
---        ccolor <- selcolor
---        return $ SectionCursor cpos csize ccolor
---    f si = map (color (_siColor si) . text) $ _siPictures si
---    cr = you w
---    nfreeslots = crNumFreeSlots cr
---    selpos = do
---        i <- cr ^? crInvSel . isel . ispCloseObject
---        return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects
---    selsize = do
---        i <- cr ^? crInvSel . isel . ispCloseObject
---        obj <- w ^? hud . closeObjects . ix i
---        return $ closeobjectsize obj
---    closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt)
---    selcolor = do
---        i <- cr ^? crInvSel . isel . ispCloseObject
---        obj <- w ^? hud . closeObjects . ix i
---        Just $ case obj of
---            Left flit -> _itInvColor $ _flIt flit
---            Right bt -> _btColor bt
-        
-

src/Dodge/Reloading.hs

@@ -57,7 +57,7 @@ startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
     Just la -> cr & startLoadingStep la
     Nothing -> case ic ^? laCycle of
         Nothing -> cr
-        Just [] -> error ("item has empty load cycle")
+        Just [] -> error "item has empty load cycle"
         Just _ | _laLoaded ic >= _laMax ic -> cr
         Just (la : las) -> fromMaybe (error "item loading error") $ do
             i <- cr ^? crInvSel . isel . ispItem

src/Dodge/Render/HUD.hs

@@ -98,7 +98,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
         csize <- sss ^? sssSections . ix spos . ssCursor . _Just . scurSize
         return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize
     ldps = invDisplayParams w
-    pics = foldMap (_ssShownItems) (_sssSections sss)
+    pics = foldMap _ssShownItems (_sssSections sss)
     
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of

src/Dodge/Render/List.hs

@@ -119,8 +119,8 @@ listCursorDisplayParams ::
     Int ->
     Int ->
     Picture
-listCursorDisplayParams ldp borders cfig yint xint col cursxsize cursysize =
+listCursorDisplayParams ldp borders =
-    listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize
+    listCursorChooseBorderScale ygap s borders xoff yoff
   where
     ygap = _ldpVerticalGap ldp
     s = _ldpScale ldp

src/Dodge/Update/Input.hs

@@ -133,11 +133,11 @@ spaceAction w = case w ^?! hud . hudElement of
 
 toggleMap :: Universe -> Universe
 toggleMap u = case u ^?! uvWorld . hud . hudElement of
-    DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = makeDisplayInventory w cfig}
+    DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = defaultDisplaySections}
     _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
-  where
+--  where
-    w = u ^. uvWorld
+--    w = u ^. uvWorld
-    cfig = u ^. uvConfig
+--    cfig = u ^. uvConfig
 
 toggleTweakInv :: World -> World
 toggleTweakInv w = case w ^? hud . hudElement . subInventory of