Cleanup

src/Dodge/Data/HUD.hs

@@ -20,9 +20,8 @@ data HUDElement
 
 data SubInventory
     = NoSubInventory
-    | TweakInventory {_tweakInvSel :: Maybe Int}
+    | ExamineInventory {_examineInvSel :: Maybe Int}
     | CombineInventory {_combineInvSel :: Maybe Int}
-    | InspectInventory
     | LockedInventory
     | DisplayTerminal {_termID :: Int}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Debug/Terminal.hs

@@ -32,7 +32,7 @@ applyTerminalCommand s = case s of
             (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
         . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
             . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
-    ['I','S',x,y] ->  (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y])
+    ['I','S',x,y] ->  uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y]
     "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal
     "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Flesh
     _ -> id

src/Dodge/Render/HUD.hs

@@ -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
+defaultListDisplayParams =
-    { _ldpVerticalGap = 10
+    ListDisplayParams
-    , _ldpScale = 1
+        { _ldpVerticalGap = 10
-    , _ldpPosX = 0
+        , _ldpScale = 1
-    , _ldpPosY = 0
+        , _ldpPosX = 0
-    , _ldpCursorType = NoCursor
+        , _ldpPosY = 0
-    , _ldpWidth = FixedSelectionWidth 15
+        , _ldpCursorType = NoCursor
-    } 
+        , _ldpWidth = FixedSelectionWidth 15
-
+        }
-subInvListDisplayParams :: ListDisplayParams
-subInvListDisplayParams = ListDisplayParams
-    { _ldpVerticalGap = 10
-    , _ldpScale = 1
-    , _ldpPosX = subInvX
-    , _ldpPosY = 60
-    , _ldpCursorType = NoCursor
-    , _ldpWidth = FixedSelectionWidth 15
-    }
 
 defaultSubInvSelectionList :: SelectionList a
-defaultSubInvSelectionList = SelectionList
+defaultSubInvSelectionList =
-    { _slItems = []
+    SelectionList
-    , _slSelPos = Nothing
+        { _slItems = []
-    , _slLength = 0
+        , _slSelPos = Nothing
-    }
+        , _slLength = 15
+        }
 
 invDisplayParams :: World -> ListDisplayParams
-invDisplayParams w = defaultListDisplayParams
+invDisplayParams w =
-    & ldpWidth .~ FixedSelectionWidth topInvW
+    defaultListDisplayParams
-    & ldpCursorType .~ BorderCursor selcursortype
+        & ldpWidth .~ FixedSelectionWidth topInvW
-    & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
+        & ldpCursorType .~ BorderCursor selcursortype
+        & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
   where
     selcursortype
-        | ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
+        | isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
-        | otherwise = [North,South,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 ->
+    NoSubInventory -> drawNoSubInventory cfig w
-        pictures
+    ExamineInventory mtweaki ->
-            [ closeobjectcursor
+        titledSub
-            , equipcursors
+            "TWEAK"
-            , equipcursor -- the order is important, this should go on top of the other equipcursors
+            (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm)
-            , rboptions
+            <> examineInventoryExtra mtweaki itm cfig
-            ]
-    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
-            ]
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
     CombineInventory mi ->
-        titledSub "COMBINE" (combineListSelection w)
+        titledSub
-            [ fromMaybe mempty $ do
+            "COMBINE"
-                i <- mi
+            (combineListSelection w mi)
-                cpos <- combinePoss w !? i
+            <> combineInventoryExtra mi cfig w
-                col <- (combineItemListYou w !? i) <&> _itInvColor . snd
+  where
-                return $
+    titledSub subtitle subitems =
-                    pictures
+        invHead cfig subtitle
-                        [ fromMaybe mempty $ do
+            <> drawSelectionList secondColumnParams cfig subitems
-                            strs <- fmap (fst . snd) (combineListInfo w !? i)
+    itm = yourItem w
-                            return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
+
-                        , fromMaybe mempty $ do
+drawNoSubInventory :: Configuration -> World -> Picture
-                            csize <- combineSizes w !? i
+drawNoSubInventory cfig w =
-                            return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
+    pictures
-                        , fromMaybe mempty $ do
+        [ closeobjectcursor
-                            lnks <- map fst (combineItemListYou w) !? i
+        , equipcursors
-                            return $
+        , equipcursor -- the order is important, this should go on top of the other equipcursors
-                                lnkMidPosInvSelsCol cfig w cpos col lnks
+        , rboptions
-                                    <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+        ]
-                                    <> combineCounts cfig w lnks
-                        ]
-            ]
-    InspectInventory ->
-        titledSub "INSPECT" (defaultSubInvSelectionList & slItems .~ textSelItems (itmInfo it))
-            [ selcursor' listCursorNESW
-            ]
   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)
+        Just (i, _) ->
-    itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
+            drawCursorAt
-    cr = you w
+                (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
-    it = yourItem w
+                cfig
-    selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
+                (Just i)
-    curpos = invSelPos w
+                (inventorySelectionList w)
-    cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you 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)
+examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
-            then drawRBOptions cfig w (_rbOptions w)
+examineInventoryExtra mtweaki mitm cfig =
-            else mempty
+    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
+            , drawSelectionList secondColumnParams cfig (thesellist tm)
-                . displayTermInput tm
-                . reverse
-                . take (_tmMaxLines tm)
-                $ _tmDisplayedLines 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{} ->
+    EquipOptions{}
-        if ButtonRight `M.member` _mouseButtons (_input w)
+        | ButtonRight `M.member` _mouseButtons (_input w) -> 47
-            then 47
+        | otherwise -> topInvW
-            else topInvW
 
-combineListSelection :: World -> SelectionList ()
+combineListSelection :: World -> Maybe Int -> SelectionList ()
-combineListSelection w = defaultSubInvSelectionList & slItems .~ combineListSelectionItems w
+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 =
+mapWall cfig thehud wl
-    if _wlSeen wl
+    | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
-        then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
+    | otherwise  = Nothing
-        else 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
+picsToSelectable wdth pics =
-    { _siPictures = pics
+    SelectionItem
-    , _siHeight = length pics
+        { _siPictures = pics
-    , _siIsSelectable = True
+        , _siHeight = length pics
-    , _siWidth = wdth
+        , _siIsSelectable = True
-    , _siColor = white
+        , _siWidth = wdth
-    , _siOffX = 0
+        , _siColor = white
-    , _siPayload = ()
+        , _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)

src/Dodge/Render/List.hs

@@ -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

src/Dodge/Update/Input.hs

@@ -79,7 +79,6 @@ updateKeyInGame  uv sc InitialPress = case sc of
     ScancodeT -> over uvWorld testEvent uv
     ScancodeX -> uv & uvWorld %~ toggleTweakInv
     ScancodeC -> over uvWorld toggleCombineInv uv
-    ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
     _ -> uv
   where
     w = _uvWorld uv
@@ -108,13 +107,8 @@ toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
 
 toggleTweakInv :: World -> World
 toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
-    DisplayInventory TweakInventory{} -> w & thepointer .~ NoSubInventory
+    DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory
-    _ -> w & thepointer .~ TweakInventory mi
+    _ -> w & thepointer .~ ExamineInventory mi
   where
     thepointer = cWorld . lWorld . hud . hudElement . subInventory
     mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
-
-toggleInspectInv :: HUDElement -> HUDElement
-toggleInspectInv he = case he of
-    DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
-    _ -> DisplayInventory InspectInventory

src/Dodge/Update/Scroll.hs

@@ -32,7 +32,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
         | lbDown -> w & cWorld . camPos . camZoom +~ y
         | invKeyDown -> changeSwapInvSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
-    DisplayInventory (TweakInventory mi)
+    DisplayInventory (ExamineInventory mi)
         | invKeyDown && rbDown -> w & moveTweakSel yi
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
         | rbDown -> w & changeTweakParam mi yi
@@ -87,7 +87,7 @@ scrollRBOption y w
 
 moveTweakSel :: Int -> World -> World
 moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
-    Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
+    Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . examineInvSel . _Just %~ (`mod` length l) . subtract i
     _ -> w
 
 changeTweakParam :: Maybe Int -> Int -> World -> World