Commit before messing with main inventory display

src/Dodge/Combine.hs

@@ -103,8 +103,8 @@ fullModuleName :: ItemModuleType -> String
 fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
 
 toggleCombineInv :: World -> World
-toggleCombineInv w = case w ^. hud . hudElement of
+toggleCombineInv w = case w ^? hud . hudElement . subInventory of
-    DisplayInventory CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
+    Just CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
     _ -> w & enterCombineInv
 
 enterCombineInv :: World -> World

src/Dodge/Data/HUD.hs

@@ -15,6 +15,7 @@ import Geometry.Data
 data HUDElement
     = DisplayInventory 
         { _subInventory :: SubInventory
+        , _diSections :: SelectionSections ()
         }
     | DisplayCarte
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/SelectionList.hs

@@ -23,13 +23,29 @@ data ListDisplayParams = ListDisplayParams
 data SelectionList a = SelectionList
     { _slItems :: [SelectionItem a]
     , _slSelPos :: Maybe Int
-    , _slLength :: Int
     , _slRegex  :: String
     , _slRegexInput :: Bool
     , _slRegexList :: [(SelectionItem a, Maybe Int)]
     }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data SelectionSections a = SelectionSections
+    { _sssSections :: IntMap (SelectionSection a)
+    , _sssSelPos :: Maybe Int
+    , _sssMaxSize :: Int
+    }
+
+data SelectionSection a = SelectionSection
+    { _ssItems :: [SelectionItem a]
+    , _ssSelPos :: Maybe Int
+    , _ssRegex  :: String
+    , _ssRegexInput :: Bool
+    , _ssMinSize :: Int
+    , _ssOffset :: Int
+    , _ssShownItems :: IntMap (SelectionItem a)
+    }
+    
+
 data SelectionIntMap a = SelectionIntMap
     { _smItems :: [SelectionItem a]
     , _smSelPos :: Maybe Int

src/Dodge/Default/SelectionList.hs

@@ -6,7 +6,7 @@ defaultSelectionList :: SelectionList a
 defaultSelectionList = SelectionList
     {_slItems = []
     , _slSelPos = Nothing
-    , _slLength = 0
+--    , _slLength = 0
     , _slRegex = ""
     , _slRegexInput = False
     , _slRegexList = []

src/Dodge/Default/World.hs

@@ -1,6 +1,6 @@
 module Dodge.Default.World where
 
---import Dodge.Data.SelectionList
+import Dodge.Data.SelectionList
 import Data.Graph.Inductive.Graph hiding ((&))
 import qualified Data.Map as M
 import Dodge.Data.World
@@ -142,10 +142,17 @@ defaultLWorld =
         , _lClock = 0
         }
 
+defaultDisplaySections :: SelectionSections a
+defaultDisplaySections = SelectionSections
+    { _sssSections = mempty
+    , _sssSelPos = Just 0
+    , _sssMaxSize = 20
+    }
+
 defaultHUD :: HUD
 defaultHUD =
     HUD
-        { _hudElement = DisplayInventory NoSubInventory
+        { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultDisplaySections}
         , _carteCenter = V2 0 0
         , _carteZoom = 0.5
         , _carteRot = 0

src/Dodge/Inventory/Add.hs

@@ -35,20 +35,11 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
     maybeInvSlot = checkInvSlotsYou it w
     updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid
 
---{- | Pick up a specific item. -}
+createAndSelectItem :: Item -> World -> World
---putItemInInv :: Int -> FloorItem -> World -> World
+createAndSelectItem itm w = case createPutItem itm w of
---putItemInInv cid flit w = case maybeInvSlot of
+    (Just i, w') -> w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i NoInvSelAction
---    Nothing -> w
+    (Nothing, w') -> w'
---    Just i  -> w
+
---        & updateItLocation i
---        & floorItems %~ IM.delete (_flItID flit)
---        & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it
---  where
---    it = _flIt flit
---    maybeInvSlot = checkInvSlotsYou it w
---    updateItLocation invid w' = case _itID it of
---        Nothing -> w'
---        Just j  -> w' & itemPositions . ix j .~ InInv cid invid
 createPutItem :: Item -> World -> (Maybe Int, World)
 createPutItem it w =
     uncurry (putItemInInvID 0) $

src/Dodge/Menu/Option.hs

@@ -66,7 +66,6 @@ makeOptionsSelectionList maxlines mselpos u mos pmo =
     defaultSelectionList
         { _slItems = optionsToSelections maxlines u mos pmo
         , _slSelPos = mselpos
-        , _slLength = length $ optionsToSelections maxlines u mos pmo
         }
 
 optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]

src/Dodge/Render/HUD.hs

@@ -38,7 +38,7 @@ import SDL (MouseButton (..))
 drawHUD :: Configuration -> World -> Picture
 drawHUD cfig w = case w ^. hud . hudElement of
     DisplayCarte -> drawCarte cfig w
-    DisplayInventory subinv ->
+    DisplayInventory {_diSections = sections, _subInventory = subinv} ->
         drawInGameHUD sl cfig w
             <> drawSubInventory subinv cfig w
   where
@@ -241,7 +241,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
     toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 ()
     thesellist tm = defaultSelectionList 
         { _slItems = thelist tm
-        , _slLength = length (thelist tm)
+--        , _slLength = length (thelist tm)
         }
     thelist tm =
         map toselitm . displayTermInput tm

src/Dodge/Render/List.hs

@@ -1,5 +1,6 @@
 module Dodge.Render.List where
 
+--import Picture.Text
 import SelectionIntMap
 import qualified Data.IntMap.Strict as IM
 --import Data.Foldable
@@ -43,6 +44,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures sl = concatMap f $ getShownItems sl
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
+    --f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
 
 makeSelectionMapPictures :: SelectionIntMap a -> [Picture]
 makeSelectionMapPictures sl = foldMap f $ _smShownItems sl

src/Dodge/Update/Input.hs

@@ -5,6 +5,7 @@ module Dodge.Update.Input (
     doSubInvRegexInput,
 ) where
 
+import Dodge.DisplayInventory
 import SelectionIntMap
 import qualified Data.Map.Strict as M
 import Data.Char
@@ -91,7 +92,7 @@ updateKeyInGame uv sc InitialPress = case sc of
     ScancodeSpace -> over uvWorld spaceAction uv
     ScancodeP -> pauseGame uv
     ScancodeF -> over uvWorld youDropItem uv
-    ScancodeM -> over uvWorld toggleMap uv
+    ScancodeM -> toggleMap uv
     ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
     ScancodeT -> over uvWorld testEvent uv
     ScancodeX -> uv & uvWorld %~ toggleTweakInv
@@ -119,24 +120,28 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
 spaceAction :: World -> World
 spaceAction w = case w ^?! hud . hudElement of
     DisplayCarte -> w & hud . carteCenter .~ theLoc
-    DisplayInventory NoSubInventory -> case selectedCloseObject w of
+    DisplayInventory {_subInventory = NoSubInventory} -> case selectedCloseObject w of
         Just (_, Left flit) -> pickUpItem 0 flit w
         Just (_, Right but) -> doButtonEvent (_btEvent but) but w
         _ -> w
-    DisplayInventory DisplayTerminal{} -> w & hud . hudElement . subInventory .~ NoSubInventory
+    DisplayInventory {_subInventory = DisplayTerminal{}} 
+        -> w & hud . hudElement . subInventory .~ NoSubInventory
     _ -> w & hud . hudElement . subInventory .~ NoSubInventory
   where
     --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
     theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
 
-toggleMap :: World -> World
+toggleMap :: Universe -> Universe
-toggleMap w = case w ^?! hud . hudElement of
+toggleMap u = case u ^?! uvWorld . hud . hudElement of
-    DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
+    DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = makeDisplayInventory w cfig}
-    _ -> w & hud . hudElement .~ DisplayCarte
+    _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
+  where
+    w = u ^. uvWorld
+    cfig = u ^. uvConfig
 
 toggleTweakInv :: World -> World
-toggleTweakInv w = case w ^. hud . hudElement of
+toggleTweakInv w = case w ^? hud . hudElement . subInventory of
-    DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory
+    Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
     _ -> w & thepointer .~ ExamineInventory mi
   where
     thepointer = hud . hudElement . subInventory

src/Dodge/Update/Scroll.hs

@@ -22,7 +22,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     DisplayCarte
         | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
         | otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
-    DisplayInventory NoSubInventory
+    DisplayInventory {_subInventory = NoSubInventory}
         -- functions that modify the inventory should be centralised so that
         -- this lock can be sensibly applied, perhaps
         | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
@@ -33,13 +33,14 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         | lbDown -> w & cWorld . camPos . camZoom +~ y
         | invKeyDown -> changeSwapInvSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
-    DisplayInventory (ExamineInventory mi)
+    DisplayInventory {_subInventory = ExamineInventory mi}
         | invKeyDown && rbDown -> w & moveTweakSel yi
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
         | rbDown -> w & changeTweakParam mi yi
         | otherwise -> w & moveTweakSel yi
-    DisplayInventory (CombineInventory SelectionIntMap {_smRegexInput = False}) -> w & moveCombineSel yi
+    DisplayInventory {_subInventory = CombineInventory SelectionIntMap {_smRegexInput = False}} 
-    DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w
+        -> w & moveCombineSel yi
+    DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
     _ -> w
   where
     y = fromIntegral yi

src/Dodge/Update/UsingInput.hs

@@ -3,14 +3,13 @@ module Dodge.Update.UsingInput (
     updateUsingInput,
 ) where
 
-import Dodge.Combine
-import SelectionIntMap
-import Dodge.Data.Combine
-import Dodge.Data.SelectionList
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Dodge.Base.You
+import Dodge.Combine
 import Dodge.Creature.Impulse.UseItem
+import Dodge.Data.Combine
+import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.InputFocus
 import Dodge.Inventory
@@ -19,10 +18,11 @@ import Dodge.Terminal.LeftButton
 import Geometry
 import ListHelp
 import SDL
+import SelectionIntMap
 
 updateUsingInput :: World -> World
 updateUsingInput w = case w ^. hud . hudElement of
-    DisplayInventory subinv ->
+    DisplayInventory {_subInventory = subinv} ->
         pressedMBEffects subinv (_mouseButtons (_input w)) w
     DisplayCarte ->
         updatePressedButtonsCarte (_mouseButtons (_input w)) w
@@ -30,9 +30,9 @@ updateUsingInput w = case w ^. hud . hudElement of
 pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World
 pressedMBEffects subinv pkeys w = case subinv of
     NoSubInventory -> pressedMBEffectsNoInventory pkeys w
-    CombineInventory SelectionIntMap {_smSelPos = mi, _smRegexInput = False}
+    CombineInventory SelectionIntMap{_smSelPos = mi, _smRegexInput = False}
         | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
-    CombineInventory SelectionIntMap {_smRegexInput = True} 
+    CombineInventory SelectionIntMap{_smRegexInput = True}
         | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
     DisplayTerminal tmid
         | lbinitialpress && inTermFocus w ->
@@ -43,9 +43,9 @@ pressedMBEffects subinv pkeys w = case subinv of
   where
     lbinitialpress = pkeys ^? ix ButtonLeft == Just False
     maybeexitcombine w'
-        | ButtonRight `M.member` _mouseButtons (_input w) 
+        | ButtonRight `M.member` _mouseButtons (_input w) =
-            = (hud . hudElement . subInventory . subInvMap %~ setShownIntMap)
+            (hud . hudElement . subInventory . subInvMap %~ setShownIntMap) $
-                $ (hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
+                (hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
         | otherwise = w' & hud . hudElement . subInventory .~ NoSubInventory
 
 pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World
@@ -58,7 +58,7 @@ pressedMBEffectsNoInventory pkeys w
     | otherwise = w
   where
     inTopInv = case w ^. hud . hudElement of
-        DisplayInventory NoSubInventory -> True
+        DisplayInventory {_subInventory = NoSubInventory} -> True
         _ -> False
     isDown but = but `M.member` pkeys
     rotation = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
@@ -68,13 +68,7 @@ pressedMBEffectsNoInventory pkeys w
 doCombine :: Int -> World -> World
 doCombine i w = case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of
     Nothing -> w
-    Just (CombinableItem is it _) ->
+    Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
-        selectinv --enterCombineInv
-            . createPutItem it
-            $ foldr (rmInvItem 0) w (sort is)
-  where
-    selectinv (Just i', w') = w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i' NoInvSelAction
-    selectinv (Nothing, w') = w'
 
 updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
 updatePressedButtonsCarte pkeys w
@@ -92,4 +86,5 @@ updatePressedButtonsCarte pkeys w
     isDown but = but `M.member` pkeys
     rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
     czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w))
-    trans = rotateV (w ^. hud . carteRot) $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))
+    trans = rotateV (w ^. hud . carteRot) 
+        $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))

src/SelectionIntMap.hs

@@ -56,3 +56,5 @@ getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1)
   where
     yint = getIthPos i (sm ^. smShownItems)
     
+selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
+selectionSectionsToIntMap ss = undefined