Partial inventory display update

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -17,11 +17,17 @@ data LoadAction
     | LoadPrime {_actionTime :: Int, _actionSound :: SoundID}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data InvSel 
+data InvSel -- should be ManipulatedObject?
     = InvSel {_iselPos :: Int, _iselAction :: InvSelAction}
     | Brute
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data SelPos
+    = SelItem Int
+    | SelNothing
+    | SelCloseObject Int
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 data InvSelAction
     = NoInvSelAction
     | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction}

src/Dodge/Data/SelectionList.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Data.SelectionList where
+import Picture.Data
 import Color
 import Control.Lens
 import Dodge.Data.CardinalPoint
@@ -35,14 +36,20 @@ data SelectionSections a = SelectionSections
     , _sssMaxSize :: Int
     }
 
+data SSRestriction = NoSSRestriction
+    | SSRestriction
+        { _ssrSize :: Int
+        , _ssrOffset :: Int
+        }
+
 data SelectionSection a = SelectionSection
     { _ssItems :: [SelectionItem a]
     , _ssSelPos :: Maybe Int
-    , _ssRegex  :: String
-    , _ssRegexInput :: Bool
     , _ssMinSize :: Int
+    , _ssPriority :: Int
     , _ssOffset :: Int
-    , _ssShownItems :: IntMap (SelectionItem a)
+    , _ssRestriction :: SSRestriction
+    , _ssShownItems :: [Picture]
     }
     
 
@@ -85,5 +92,8 @@ makeLenses ''ListDisplayParams
 makeLenses ''SelectionList
 makeLenses ''SelectionItem
 makeLenses ''SelectionIntMap
+makeLenses ''SelectionSection
+makeLenses ''SelectionSections
+makeLenses ''SSRestriction
 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList

src/Dodge/DisplayInventory.hs

@@ -0,0 +1,102 @@
+module Dodge.DisplayInventory where
+
+import Picture.Base
+import Dodge.Render.HUD
+import Dodge.SelectionList
+import LensHelp
+import Dodge.Inventory.CheckSlots
+import Dodge.Inventory.Color
+import Dodge.Base.You
+import Dodge.Inventory.SelectionList
+import qualified Data.IntMap.Strict as IM
+import Dodge.Data.Config
+import Dodge.Default.World
+import Dodge.Data.SelectionList
+import Dodge.Data.World
+
+makeDisplayInventory :: World -> Configuration -> SelectionSections ()
+makeDisplayInventory w cfig = defaultDisplaySections
+    { _sssSections = restrictsections    
+    , _sssSelPos = Just 0
+    , _sssMaxSize = availablelines
+    }
+  where
+    initialsections =  IM.fromList
+        [ (0, inventorysection)
+        , (1, makeYouSection w)
+        , (2, closesection)
+        ]
+    inventorysection = makeInventorySection w
+    closesection = makeCloseObjectsSection w
+    itotallength = length . foldMap _siPictures $ _ssItems inventorysection
+    ctotallength = length . foldMap _siPictures $ _ssItems closesection
+    availablelines = getAvailableListLines (invDisplayParams w) cfig
+    iavailablelines = availablelines - 6
+    minlengths = sum $ fmap _ssMinSize initialsections
+    sections | itotallength + 1 + ctotallength > availablelines = restrictsections
+        | otherwise = initialsections
+    ioffset = 1
+    restrictsections = IM.fromList
+        [ (0, makeInventorySection w & ssShownItems %~ (take iavailablelines . drop ioffset))
+        , (1, makeYouSection w)
+        , (2, makeCloseObjectsSection w)
+        ]
+
+
+makeInventorySection :: World -> SelectionSection ()
+makeInventorySection w = SelectionSection
+    { _ssItems = map (invSelectionItem cr ) (IM.toList inv)
+    , _ssSelPos = Just 0
+    , _ssRestriction = NoSSRestriction
+    , _ssPriority = 0
+    , _ssOffset = 0
+--    , _ssRegex = ""
+--    , _ssRegexInput = False
+    , _ssMinSize = 5
+--    , _ssOffset = 0
+    , _ssShownItems = foldMap (f . invSelectionItem cr ) (IM.toList inv)
+    }
+  where
+    cr = you w
+    inv = _crInv cr
+    f si = map (color (_siColor si) . text) $ _siPictures si
+
+makeYouSection :: World -> SelectionSection ()
+makeYouSection w = SelectionSection
+    { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
+    , _ssSelPos = Nothing
+    , _ssOffset = 0
+    , _ssPriority = 1
+    , _ssRestriction = NoSSRestriction
+--    , _ssRegex = ""
+--    , _ssRegexInput = False
+    , _ssMinSize = 1
+--    , _ssOffset = 0
+    , _ssShownItems = [color invDimColor $ text thetext]
+    }
+  where
+    cr = you w
+    nfreeslots = crNumFreeSlots cr
+    thetext = case nfreeslots of
+        0 -> "  INVENTORY FULL"
+        1 -> "  +1 FREE SLOT"
+        x -> "  +" ++ show x ++ " FREE SLOTS"
+
+makeCloseObjectsSection :: World -> SelectionSection ()
+makeCloseObjectsSection w = SelectionSection
+    { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+    , _ssSelPos = Just 0
+    , _ssPriority = 1
+    , _ssOffset = 0
+    , _ssRestriction = NoSSRestriction
+--    , _ssRegex = ""
+--    , _ssRegexInput = False
+    , _ssMinSize = 5
+--    , _ssOffset = 0
+    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+    }
+  where
+    f si = map (color (_siColor si) . text) $ _siPictures si
+    cr = you w
+    nfreeslots = crNumFreeSlots cr
+

src/Dodge/Render/HUD.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Render.HUD (
     drawHUD,
+    invDisplayParams,
 ) where
 
 import SelectionIntMap
@@ -39,17 +40,12 @@ drawHUD :: Configuration -> World -> Picture
 drawHUD cfig w = case w ^. hud . hudElement of
     DisplayCarte -> drawCarte cfig w
     DisplayInventory {_diSections = sections, _subInventory = subinv} ->
-        drawInGameHUD sl cfig w
+        drawHP cfig w
+            <> inventoryDisplay sections w cfig
             <> drawSubInventory subinv cfig w
-  where
-    sl = makeInventorySelectionList w
 
-drawInGameHUD :: SelectionList () -> Configuration -> World -> Picture
+drawHP :: Configuration -> World -> Picture
-drawInGameHUD sl cfig w =
+drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
-    pictures
-        [ winScale cfig . dShadCol white $ displayHP 0 cfig w
-        , inventoryDisplay w cfig sl
-        ]
 
 defaultListDisplayParams :: ListDisplayParams
 defaultListDisplayParams =
@@ -76,9 +72,22 @@ invDisplayParams w =
         Just ExamineInventory{} -> True
         _ -> False
 
-inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture
+inventoryDisplay :: SelectionSections () -> World -> Configuration -> Picture
-inventoryDisplay = drawSelectionList . invDisplayParams
+inventoryDisplay sss w cfig = listPicturesAtScaleOff
-
+    (_ldpVerticalGap ldps)
+    (_ldpScale ldps)
+    (_ldpPosX ldps)
+    (_ldpPosY ldps)
+    cfig
+    0 -- offset
+    --undefined
+    pics
+  where
+    ldps = invDisplayParams w
+--    pics' = take (_sssMaxSize sss) pics
+--    totallength = length pics'
+    pics = foldMap (_ssShownItems) (_sssSections sss)
+    
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Dodge.DisplayInventory
 import Dodge.ScrollValue
 import Color
 import Control.Applicative
@@ -72,6 +73,7 @@ updateUniverse u =
         . over (uvWorld . input . textInput) (const mempty)
         . updateUniverseMid
         . updateUseInput
+        . updateInventoryDisplay
         . over uvWorld (updateCamera cfig)
         . over (uvWorld . input) updateScrollTestValue
         . over (uvWorld . cWorld . cClock) (+ 1)
@@ -79,6 +81,11 @@ updateUniverse u =
   where
     cfig = u ^. uvConfig
 
+updateInventoryDisplay :: Universe -> Universe
+updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections %~ const di
+  where
+    di = makeDisplayInventory (_uvWorld u) (_uvConfig u)
+
 maybeOpenTerminal :: Universe -> Universe
 maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
     Just InitialPress -> gotoTerminal u

src/Picture/Text.hs

@@ -0,0 +1,29 @@
+module Picture.Text where
+import Geometry.Data
+import Picture.Data
+import Color
+textGrad :: Color -> Color -> String -> Picture
+{-# INLINE textGrad #-}
+textGrad topc botc = map f . stringToListGrad topc botc
+  where
+    f (pos, col, V2 a b) = Verx pos col [a, b] BottomLayer textNum
+
+-- no premature optimisation, consider changing to use texture arrays
+stringToListGrad :: Color -> Color -> String -> [(Point3, Point4, Point2)]
+{-# INLINE stringToListGrad #-}
+stringToListGrad topc botc = concatMap (uncurry (charToTupleGrad topc botc)) . zip [0, 0.9 * dimText ..]
+  where
+    dimText = 100
+
+charToTupleGrad :: Color -> Color -> Float -> Char -> [(Point3, Point4, Point2)]
+{-# INLINE charToTupleGrad #-}
+charToTupleGrad topc botc x c =
+    [ (V3 (x -50) (-100) 0, botc, V2 offset 1)
+    , (V3 (x -50) 100 0, topc, V2 offset 0)
+    , (V3 (x + 50) 100 0, topc, V2 (offset + 1) 0)
+    , (V3 (x -50) (-100) 0, botc, V2 offset 1)
+    , (V3 (x + 50) (-100) 0, botc, V2 (offset + 1) 1)
+    , (V3 (x + 50) 100 0, topc, V2 (offset + 1) 0)
+    ]
+  where
+    offset = fromIntegral (fromEnum c) - 32