Cleanup

src/Dodge/Render/HUD.hs

@@ -1,9 +1,9 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.Item.Grammar
-import Dodge.Inventory.RBList
 import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -21,6 +21,7 @@ import Dodge.Default.SelectionList
 import Dodge.Equipment.Text
 import Dodge.Inventory
 import Dodge.Item.Display
+import Dodge.Item.Grammar
 import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
@@ -55,8 +56,9 @@ drawHP cfig =
         . (^?! cWorld . lWorld . creatures . ix 0 . crHP)
 
 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
-drawInventory sss w cfig = drawSelectionSections sss (invDisplayParams w) cfig
-    <> iextra
+drawInventory sss w cfig =
+    drawSelectionSections sss (invDisplayParams w) cfig
+        <> iextra
   where
     iextra = fromMaybe mempty $ do
         inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
@@ -69,7 +71,6 @@ drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     NoSubInventory -> drawRBOptions cfig w
-    --ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
     ExamineInventory -> drawExamineInventory cfig w
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
@@ -79,46 +80,16 @@ drawCombineInventory cfig sss w =
     invHead cfig "COMBINE"
         <> drawSelectionSections sss secondColumnParams cfig
         <> combineInventoryExtra sss cfig w
---drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
---drawExamineInventory cfig mtweaki w =
---    invHead cfig "EXAMINE"
---        <> examineInventoryExtra mtweaki cfig
---        <> drawSelectionList
---            secondColumnParams
---            cfig
---            ( defaultSelectionList & slItems .~ tweakItems itm
---                ++ map
---                    f
---                    ( makeParagraph 55 $
---                        yourAugmentedItem
---                            itemInfo
---                            (yourInfo (you w))
---                            (closeObjectInfo (crNumFreeSlots (you w)))
---                            w
---                    )
---            )
---  where
---    itm = yourSelectedItem w
---    f str =
---        SelectionItem
---            { _siPictures = [str]
---            , _siHeight = 1
---            , _siIsSelectable = True
---            , _siColor = white
---            , _siOffX = 0
---            , _siPayload = ()
---            }
 
 drawExamineInventory :: Configuration -> World -> Picture
 drawExamineInventory cfig w =
     invHead cfig "EXAMINE"
---        <> examineInventoryExtra mtweaki cfig
         <> drawSelectionList
             secondColumnParams
             cfig
-            ( defaultSelectionList & slItems .~ -- tweakItems itm
-              --  ++ 
-                    map
+            ( defaultSelectionList & slItems
+                .~ map -- tweakItems itm
+                --  ++
                     f
                     ( makeParagraph 55 $
                         yourAugmentedItem
@@ -129,7 +100,7 @@ drawExamineInventory cfig w =
                     )
             )
   where
---    itm = yourSelectedItem w
+    --    itm = yourSelectedItem w
     f str =
         SelectionItem
             { _siPictures = [str]
@@ -169,13 +140,7 @@ drawRBOptions cfig w = fromMaybe mempty $ do
     (i', j) <- sss ^? sssExtra . sssSelPos . _Just
     curpos <- selSecYint i' j sss
     let ytext = drawListElement 0 1 0 curpos . text
-        midstr = case ae of
-            DoNotMoveEquipment -> ""
-            PutOnEquipment{} -> "  PUT ON"
-            MoveEquipment{} -> " MOVE TO"
-            SwapEquipment{} -> " MOVE TO"
-            ReplaceEquipment{} -> "  PUT ON"
-            RemoveEquipment{} -> "TAKE OFF"
+        midstr = equipAllocString ae
         extrastr = case ae of
             SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
                 "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
@@ -207,19 +172,27 @@ drawRBOptions cfig w = fromMaybe mempty $ do
         itm <- you w ^? crInv . ix j
         return $ itemBaseName itm
 
---examineInventoryExtra :: Maybe Int -> Configuration -> Picture
---examineInventoryExtra mtweaki cfig = fromMaybe mempty $ do
---    tweaki <- mtweaki
---    return $
---        toTopLeft cfig $
---            translate subInvX (-71) $
---                listCursorChooseBorderScale 0 1 [North, South, West] tweaki 0 white 10 1
+equipAllocString :: EquipmentAllocation -> String
+equipAllocString = \case
+    DoNotMoveEquipment -> ""
+    PutOnEquipment{} -> "  PUT ON"
+    MoveEquipment{} -> " MOVE TO"
+    SwapEquipment{} -> " MOVE TO"
+    ReplaceEquipment{} -> "  PUT ON"
+    RemoveEquipment{} -> "TAKE OFF"
 
-inventoryExtra :: SelectionSections () ->  Configuration -> World 
-    -> IM.IntMap (Maybe (Int,Int),[Int],[Int]) -> Picture
-inventoryExtra sss cfig w is = translate (negate 5) 0 $ IM.foldMapWithKey (inventoryExtraH sss cfig w) $ fmap (\(_,a,b) -> a<>b) is
+inventoryExtra ::
+    SelectionSections () ->
+    Configuration ->
+    World ->
+    IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
+    Picture
+inventoryExtra sss cfig w =
+    translate (negate 5) 0
+        . IM.foldMapWithKey (inventoryExtraH sss cfig w)
+        . fmap (\(_, a, b) -> a <> b)
 
-inventoryExtraH :: SelectionSections () ->  Configuration -> World -> Int -> [Int] -> Picture
+inventoryExtraH :: SelectionSections () -> Configuration -> World -> Int -> [Int] -> Picture
 inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
     p <- snum i
     let ps = mapMaybe snum is
@@ -233,24 +206,21 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     cpos <- selSecYint i j sss
     si <- sss ^? sssSections . ix i . ssItems . ix j
     let col = _siColor si
-    return $
-        mconcat
-            [ fromMaybe mempty $ do
-                strs <- si ^? siPayload . ciInfo
-                return
-                    . translate 160 0
-                    -- it would be better to get the width of the selection list from elsewhere
-                    . translateScreenPos cfig (secondColumnParams ^. ldpPos)
-                    $ drawListYoff cpos $ map (color red . text) strs
-            , fromMaybe mempty $ do
-                lnks <- si ^? siPayload . ciInvIDs
-                return $
-                    lnkMidPosInvSelsCol cfig w j col lnks
-                        <> foldMap invcursor lnks
---                        <> combineCounts cfig w lnks
-            ]
+    mconcat
+        [ do
+            strs <- si ^? siPayload . ciInfo
+            return
+                . translate 160 0
+                -- it would be better to get the width of the selection list from elsewhere
+                . translateScreenPos cfig (secondColumnParams ^. ldpPos)
+                $ drawListYoff cpos $ map (color red . text) strs
+        , do
+            lnks <- si ^? siPayload . ciInvIDs
+            return (lnkMidPosInvSelsCol cfig w j col lnks)
+                <> foldMap invcursor lnks
+        ]
   where
-    invcursor i = fromMaybe mempty $ do
+    invcursor i = do
         sss' <- w ^? hud . hudElement . diSections
         let idp = invDisplayParams w & ldpCursorSides .~ [North, South, East, West]
         return $
@@ -282,24 +252,6 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
         | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
         | otherwise = []
 
---combineCounts :: Configuration -> World -> [Int] -> Picture
---combineCounts cfig w = foldMap f . group
---  where
-----    f (i : is) = fromMaybe mempty $ do
-----        _ <- yourInv w ^? ix i . itUse . useAmount
-----        sss <- w ^? hud . hudElement . diSections
-----        --p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
-----        col <- selSecSelCol 0 i sss
-----        yint <- selSecYint 0 i sss
-----        --return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
-----        return
-----            . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
-----            . color col
-----            . drawListElement 0 1 15 yint
-----            . text
-----            $ ('-' : show (length is + 1))
---    f _ = mempty
-
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = foldMap f
   where
@@ -389,8 +341,9 @@ selNumPos cfig ldp sss i j = do
     indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
     return $
         screenPosAbs cfig (ldp ^. ldpPos)
-            + V2 (10 * s * fromIntegral indent) 
-                    (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
+            + V2
+                (10 * s * fromIntegral indent)
+                (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
   where
     s = _ldpScale ldp
     ygap = _ldpVerticalGap ldp

src/Dodge/TestString.hs

@@ -20,7 +20,8 @@ import Dodge.Data.Universe
 import qualified IntMapHelp as IM
 
 testStringInit :: Universe -> [String]
-testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
+testStringInit _ = [fromMaybe mempty (Just "A" <> Just "B")]
+--testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
 --testStringInit u = (topTestPart u
 --    <>) $ map showh $ 
 ----    (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <>