Display root+tree selection when aiming

src/Dodge/Render/HUD.hs

@@ -6,6 +6,10 @@ module Dodge.Render.HUD (
     selNumPosCardinal, -- this shoud probably be pushed back here
 ) where
 
+import Dodge.Creature.Test
+import Dodge.DoubleTree
+import Dodge.Data.DoubleTree
+import Dodge.Data.ComposedItem
 import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -59,6 +63,7 @@ drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Pi
 drawInventory sss w cfig =
     drawSelectionSections sss ldp cfig
         <> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
+        <> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
 --        <> drawSSMultiCursor sss (w ^? hud . hudElement . diSelection . _Just) 
 --                (w ^? hud . hudElement . diSelectionExtra)
 --                ldp curs cfig
@@ -72,8 +77,33 @@ drawInventory sss w cfig =
     curs = invCursorParams w
     iextra = fromMaybe mempty $ do
         inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
-        let x = invAdj inv
-        return $ inventoryExtra sss cfig w x
+        return . inventoryExtra sss cfig w $ invAdj inv
+
+drawRootCursor :: World
+    -> IM.IntMap (SelectionSection ())
+    -> Maybe (Int,Int)
+    -> ListDisplayParams
+    -> Configuration
+    -> Picture
+drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    guard $ crIsAiming cr
+    (i,j) <- msel
+    guard $ i == 0
+    inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
+    (x,y) <- getRootItemBounds j $ inv
+    return $ drawSSMultiCursor sss (Just (0,x)) (Just (y- x)) ldp 
+        (BoundaryCursor [minBound .. maxBound])  cfig 
+
+getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int,Int)
+getRootItemBounds i inv = do
+    let ia = allInvLocs inv
+    itm <- ia ^? ix i . _2
+    let root = locToTop itm
+    x <- locRightmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
+    y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
+    return (x,y)
+  
 
 drawDIMouseOver :: World -> Picture
 drawDIMouseOver w = fromMaybe mempty $ do