Cleanup

2022-12-27 14:14:03 +00:00
parent 2def9800fa
commit 85738adff1
6 changed files with 169 additions and 160 deletions
@@ -3,9 +3,6 @@ module Dodge.Render.HUD (
    drawHUD,
 ) where

-import Dodge.Inventory.SelectionList
-import Dodge.Data.CardinalPoint
-import Dodge.Data.SelectionList
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -14,11 +11,15 @@ import qualified Data.Vector as V
 import Dodge.Base
 import Dodge.Clock
 import Dodge.Combine
-import Dodge.Data.World
+import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
+import Dodge.Data.SelectionList
+import Dodge.Data.World
 import Dodge.Inventory
 import Dodge.Inventory.ItemSpace
+import Dodge.Inventory.SelectionList
 import Dodge.Item.Display
+import Dodge.Item.Info
 import Dodge.Render.Connectors
 import Dodge.Render.List
 import Dodge.Tweak.Show
@@ -47,41 +48,37 @@ drawInGameHUD sl cfig w =
        ]

 defaultListDisplayParams :: ListDisplayParams
-defaultListDisplayParams  = ListDisplayParams
-    { _ldpVerticalGap = 10
-    , _ldpScale = 1
-    , _ldpPosX = 0
-    , _ldpPosY = 0
-    , _ldpCursorType = NoCursor
-    , _ldpWidth = FixedSelectionWidth 15
-    } 
-
-subInvListDisplayParams :: ListDisplayParams
-subInvListDisplayParams = ListDisplayParams
-    { _ldpVerticalGap = 10
-    , _ldpScale = 1
-    , _ldpPosX = subInvX
-    , _ldpPosY = 60
-    , _ldpCursorType = NoCursor
-    , _ldpWidth = FixedSelectionWidth 15
-    }
+defaultListDisplayParams =
+    ListDisplayParams
+        { _ldpVerticalGap = 10
+        , _ldpScale = 1
+        , _ldpPosX = 0
+        , _ldpPosY = 0
+        , _ldpCursorType = NoCursor
+        , _ldpWidth = FixedSelectionWidth 15
+        }

 defaultSubInvSelectionList :: SelectionList a
-defaultSubInvSelectionList = SelectionList
-    { _slItems = []
-    , _slSelPos = Nothing
-    , _slLength = 0
-    }
+defaultSubInvSelectionList =
+    SelectionList
+        { _slItems = []
+        , _slSelPos = Nothing
+        , _slLength = 15
+        }

 invDisplayParams :: World -> ListDisplayParams
-invDisplayParams w = defaultListDisplayParams
-    & ldpWidth .~ FixedSelectionWidth topInvW
-    & ldpCursorType .~ BorderCursor selcursortype
-    & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
+invDisplayParams w =
+    defaultListDisplayParams
+        & ldpWidth .~ FixedSelectionWidth topInvW
+        & ldpCursorType .~ BorderCursor selcursortype
+        & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
  where
    selcursortype
-        | ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
-        | otherwise = [North,South,West]
+        | isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
+        | otherwise = [North, South, West]
+    isexaminesub = case w ^? cWorld . lWorld . hud . hudElement . subInventory of
+        Just ExamineInventory{} -> True
+        _ -> False

 inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture
 inventoryDisplay w = drawSelectionList (invDisplayParams w)
@@ -89,78 +86,116 @@ inventoryDisplay w = drawSelectionList (invDisplayParams w)
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-    NoSubInventory ->
-        pictures
-            [ closeobjectcursor
-            , equipcursors
-            , equipcursor -- the order is important, this should go on top of the other equipcursors
-            , rboptions
-            ]
-    TweakInventory mtweaki ->
-        titledSub "TWEAK" (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems it)
-            [ selcursor' listCursorNESW
-            , fromMaybe mempty $ do
-                tweaki <- mtweaki
-                -- consider moving this functionality out into a tweaks module
-                tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
-                return $
-                    lnkMidInvSel cfig w curpos tweaki
-                        <> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
-            ]
+    NoSubInventory -> drawNoSubInventory cfig w
+    ExamineInventory mtweaki ->
+        titledSub
+            "TWEAK"
+            (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm)
+            <> examineInventoryExtra mtweaki itm cfig
    DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
    CombineInventory mi ->
-        titledSub "COMBINE" (combineListSelection w)
-            [ fromMaybe mempty $ do
-                i <- mi
-                cpos <- combinePoss w !? i
-                col <- (combineItemListYou w !? i) <&> _itInvColor . snd
-                return $
-                    pictures
-                        [ fromMaybe mempty $ do
-                            strs <- fmap (fst . snd) (combineListInfo w !? i)
-                            return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
-                        , fromMaybe mempty $ do
-                            csize <- combineSizes w !? i
-                            return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
-                        , fromMaybe mempty $ do
-                            lnks <- map fst (combineItemListYou w) !? i
-                            return $
-                                lnkMidPosInvSelsCol cfig w cpos col lnks
-                                    <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
-                                    <> combineCounts cfig w lnks
-                        ]
-            ]
-    InspectInventory ->
-        titledSub "INSPECT" (defaultSubInvSelectionList & slItems .~ textSelItems (itmInfo it))
-            [ selcursor' listCursorNESW
-            ]
+        titledSub
+            "COMBINE"
+            (combineListSelection w mi)
+            <> combineInventoryExtra mi cfig w
+  where
+    titledSub subtitle subitems =
+        invHead cfig subtitle
+            <> drawSelectionList secondColumnParams cfig subitems
+    itm = yourItem w
+
+drawNoSubInventory :: Configuration -> World -> Picture
+drawNoSubInventory cfig w =
+    pictures
+        [ closeobjectcursor
+        , equipcursors
+        , equipcursor -- the order is important, this should go on top of the other equipcursors
+        , rboptions
+        ]
  where
-    titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
-        ,drawSelectionList subInvListDisplayParams cfig subitems] <>
-        extrapics
    closeobjectcursor = case selectedCloseObject w of
        Nothing -> mempty
-        Just (i,_) -> drawCursorAt (invDisplayParams w & ldpCursorType .~ BorderCursor [North,South]) cfig (Just i) (inventorySelectionList w)
-    itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
-    cr = you w
-    it = yourItem w
-    selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
-    curpos = invSelPos w
-    cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
+        Just (i, _) ->
+            drawCursorAt
+                (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
+                cfig
+                (Just i)
+                (inventorySelectionList w)
    equipcursor = case _crLeftInvSel cr of
        Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
        _ -> mempty
    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
+    cr = you w
+    rboptions
+        | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
+        | otherwise = mempty
    f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-    rboptions =
-        if ButtonRight `M.member` _mouseButtons (_input w)
-            then drawRBOptions cfig w (_rbOptions w)
-            else mempty
+
+examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
+examineInventoryExtra mtweaki mitm cfig =
+    pictures
+        [ fromMaybe mempty $ do
+            tweaki <- mtweaki
+            -- consider moving this functionality out into a tweaks module
+            tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
+            return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
+        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
+        ]
+
+combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture
+combineInventoryExtra mi cfig w =
+    pictures
+        [ fromMaybe mempty $ do
+            i <- mi
+            cpos <- combinePoss w !? i
+            col <- (combineItemListYou w !? i) <&> _itInvColor . snd
+            return $
+                pictures
+                    [ fromMaybe mempty $ do
+                        strs <- fmap (fst . snd) (combineListInfo w !? i)
+                        return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
+                    , fromMaybe mempty $ do
+                        lnks <- map fst (combineItemListYou w) !? i
+                        return $
+                            lnkMidPosInvSelsCol cfig w cpos col lnks
+                                <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+                                <> combineCounts cfig w lnks
+                    ]
+        ]
+
+secondColumnParams :: ListDisplayParams
+secondColumnParams =
+    defaultListDisplayParams
+        & ldpPosX .~ subInvX
+        & ldpPosY .~ 60
+        & ldpCursorType .~ BorderCursor [North, South, West]
+
+thirdColumnParams :: ListDisplayParams
+thirdColumnParams =
+    defaultListDisplayParams
+        & ldpPosX .~ 9 * fromIntegral topInvW + 275
+        & ldpPosY .~ 60
+
+thirdColumnPara :: [String] -> SelectionList ()
+thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
+  where
+    f str =
+        SelectionItem
+            { _siPictures = [text str]
+            , _siHeight = 1
+            , _siIsSelectable = True
+            , _siWidth = length str
+            , _siColor = white
+            , _siOffX = 0
+            , _siPayload = ()
+            }

 itmInfo :: Maybe Item -> [String]
 itmInfo mit = fromMaybe [] $ do
    itm <- mit
-    return (map show . M.assocs . _iyModules $ _itType itm)
+    return $
+        itmBaseInfo (itm ^. itType . iyBase) :
+        (map show . M.assocs . _iyModules $ _itType itm)

 displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
@@ -168,13 +203,16 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
    return $
        pictures
            [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
-            , renderListAt subInvX 60 cfig
-                . displayTermInput tm
-                . reverse
-                . take (_tmMaxLines tm)
-                $ _tmDisplayedLines tm
+            , drawSelectionList secondColumnParams cfig (thesellist tm)
            ]
  where
+    toselitm (str, col) = SelectionItem [color col $ text str] 1 True (length str) col 0 ()
+    thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm))
+    thelist tm =
+        map toselitm . displayTermInput tm
+            . reverse
+            . take (_tmMaxLines tm)
+            $ _tmDisplayedLines tm
    displayTermInput tm = case _tmInput tm of
        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
    displayInputText tm s
@@ -225,28 +263,6 @@ topInvW = 15
 subInvX :: Float
 subInvX = 9 * fromIntegral topInvW + 50

-lnkMidInvSel :: Configuration -> World -> Int -> Int -> Picture
-lnkMidInvSel cfig w lefti midi =
-    winScale cfig
-        . color white
-        . zConnect rp
-        $ selNumMidHeight cfig w lefti
-  where
-    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
-    rp = V2 (190 - hw) (hh - (20 * fromIntegral midi + 77.5))
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-
--lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture
--lnkMidPosInvSels cfig w i = winScale cfig
--    . color white
--    . concatMap (zConnect rp . selNumMidHeight cfig w)
--  where
----    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
--    rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
--    hh = halfHeight cfig
--    hw = halfWidth  cfig
-
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
  where
@@ -260,7 +276,6 @@ lnkMidPosInvSelsCol cfig w i col =
    winScale cfig
        . foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
  where
-    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
    rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
    hh = halfHeight cfig
    hw = halfWidth cfig
@@ -278,13 +293,15 @@ topCursorTypeWidth ctype width cfig w i =
 determineInvSelCursorWidth :: World -> Int
 determineInvSelCursorWidth w = case _rbOptions w of
    NoRightButtonOptions -> topInvW
-    EquipOptions{} ->
-        if ButtonRight `M.member` _mouseButtons (_input w)
-            then 47
-            else topInvW
+    EquipOptions{}
+        | ButtonRight `M.member` _mouseButtons (_input w) -> 47
+        | otherwise -> topInvW

-combineListSelection :: World -> SelectionList ()
-combineListSelection w = defaultSubInvSelectionList & slItems .~ combineListSelectionItems w
+combineListSelection :: World -> Maybe Int -> SelectionList ()
+combineListSelection w mi =
+    defaultSubInvSelectionList
+        & slItems .~ combineListSelectionItems w
+        & slSelPos .~ mi

 combineListSelectionItems :: World -> [SelectionItem ()]
 combineListSelectionItems w = case combineListSelectionItems' w of
@@ -292,10 +309,9 @@ combineListSelectionItems w = case combineListSelectionItems' w of
    xs -> xs
  where
    thetext = "NO POSSIBLE COMBINATIONS"
-    

 combineListSelectionItems' :: World -> [SelectionItem ()]
-combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
+combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou

 ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
 ammoTweakSelectionItems = textSelItems . ammoTweakStrings
@@ -309,12 +325,12 @@ tweakString :: TweakParam -> String
 tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp

 invHead :: Configuration -> String -> Picture
-invHead cfig s =
+invHead cfig =
    winScale cfig
        . translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
        . dShadCol white
        . scale 0.4 0.4
-        $ text s
+        . text

 drawCarte :: Configuration -> World -> Picture
 drawCarte cfig w =
@@ -343,10 +359,9 @@ mapOverlay cfig w =
    (mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)

 mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
-mapWall cfig thehud wl =
-    if _wlSeen wl
-        then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
-        else Nothing
+mapWall cfig thehud wl
+    | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
+    | otherwise  = Nothing
  where
    t = normalizeV (y -.- x)
    n2 = 20 *.* vNormal t
@@ -389,18 +404,19 @@ mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0

 picsToSelectable :: Int -> [Picture] -> SelectionItem ()
-picsToSelectable wdth pics = SelectionItem
-    { _siPictures = pics
-    , _siHeight = length pics
-    , _siIsSelectable = True
-    , _siWidth = wdth
-    , _siColor = white
-    , _siOffX = 0
-    , _siPayload = ()
-    }
+picsToSelectable wdth pics =
+    SelectionItem
+        { _siPictures = pics
+        , _siHeight = length pics
+        , _siIsSelectable = True
+        , _siWidth = wdth
+        , _siColor = white
+        , _siOffX = 0
+        , _siPayload = ()
+        }

 textSelItems :: [String] -> [SelectionItem ()]
-textSelItems = map (picsToSelectable 15 . (:[]) . text)
+textSelItems = map (picsToSelectable 15 . (: []) . text)

 itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
@@ -435,10 +451,10 @@ openCursorAt wth col xoff yoff yint w =
            ]

 displayHP :: Int -> Configuration -> World -> Picture
-displayHP cid cfig w =
+displayHP cid cfig =
    translate (halfWidth cfig -80) (halfHeight cfig -20)
        . scale 0.2 0.2
        . text
        . leftPad 5 ' '
        . show
-        $ w ^?! cWorld . lWorld . creatures . ix cid . crHP
+        . (^?! cWorld . lWorld . creatures . ix cid . crHP)
@@ -1,6 +1,6 @@
 module Dodge.Render.List where

-import Data.Foldable
+--import Data.Foldable
 import Data.Maybe
 import Dodge.Base.WinScale
 import Dodge.Base.Window
@@ -102,7 +102,7 @@ listCursorChooseBorder = listCursorChooseBorderScale 10 1

 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
-chooseCursorBorders wth hgt = fold . map (line . toLine)
+chooseCursorBorders wth hgt = foldMap (line . toLine)
  where
    top = 0
    bot = - hgt