Display root+tree selection when aiming

src/Dodge/DoubleTree.hs

@@ -195,6 +195,16 @@ locUp (LocLDT c@LeftwardLDT{} t) = Just $ LocLDT (_cldtUp c)
 locUp (LocLDT c@RightwardLDT{} t) = Just $ LocLDT (_cldtUp c) 
     (LDT (_cldtParent c) (_cldtFarLeft c) (_cldtCloseLeft c ++ ((_cldtLink c,t):_cldtCloseRight c)))
 
+locToTop :: LocationLDT b a -> LocationLDT b a
+locToTop loc = maybe loc locToTop $ locUp loc
+--locToTop = fix $ \x -> fromMaybe x $ locUp x
+
+locLeftmost :: LocationLDT b a -> LocationLDT b a
+locLeftmost loc = maybe loc locLeftmost $ alaf Last foldMap Just $ locGoLeft loc
+
+locRightmost :: LocationLDT b a -> LocationLDT b a
+locRightmost loc = maybe loc locRightmost $ alaf First foldMap Just $ locGoRight loc
+
 -- should probably do tests for these
 locGoLeft :: LocationLDT b a -> [LocationLDT b a]
 locGoLeft (LocLDT c (LDT v l r)) = 

src/Dodge/Item/Grammar.hs

@@ -48,7 +48,7 @@ itemToBreakLists ::
     ComposedItem ->
     ([(ItemStructuralFunction, ComposeLinkType)], [(ItemStructuralFunction, ComposeLinkType)])
 itemToBreakLists ci = case (itm ^. itType, ci ^. cItemFunction) of
-    (HELD TORCH,_) -> (getAmmoLinks itm,[])
+    (HELD TORCH, _) -> (getAmmoLinks itm, [])
     (_, WeaponPlatformSF) ->
         ( getAmmoLinks itm
         , [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
@@ -103,8 +103,11 @@ laserLinkTest :: Item -> LinkTest
 laserLinkTest itm = LTest (llleft itm) (llright itm)
 
 llleft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
-llleft itm = _tryLeftLink 
-    . uncurry useBreakL . itemToBreakLists $ CItem itm WeaponTargetingSF
+llleft itm =
+    _tryLeftLink
+        . uncurry useBreakL
+        . itemToBreakLists
+        $ CItem itm WeaponTargetingSF
 
 llright :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
 llright itm pci = case pci ^. _1 . itType of
@@ -179,8 +182,9 @@ invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _
 -- location ids
 -- consider explicitly reseting the inventory ids (but this probably really
 -- should be done upstream anyway in the actually creature inventory)
+-- The first Int in the maybe is the root, the second the parent
 invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
-invAdj im = IM.unions . map g $ invLDT im
+invAdj = IM.unions . map g . invLDT
   where
     g = dtToLRAdj getid . ldtToDT
     getid (itm, _, _) =

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

src/Dodge/SelectionSections/Draw.hs

@@ -58,7 +58,8 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^
             ysize = sum . fmap _siHeight $ selitms
             maxoff = maximum . fmap _siOffX $ selitms
             minoff = minimum . fmap _siOffX $ selitms
-        col <- fmap (_siColor . fst) $ IM.minView selitms
+        let col = white
+--        col <- fmap (_siColor . fst) $ IM.minView selitms
         return $
             listCursorChooseBorderScale
                 (ldp ^. ldpVerticalGap)