diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index c2af2bec2..1637b5da3 100644 --- a/src/Dodge/Data/HUD.hs +++ b/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) diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 6a4c0cc29..59c297cf1 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 59fd50532..8009a040f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 - { _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) diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 453a8f22d..e6163f99a 100644 --- a/src/Dodge/Render/List.hs +++ b/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 diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 963a340e7..9b66dfef7 100644 --- a/src/Dodge/Update/Input.hs +++ b/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 - _ -> w & thepointer .~ TweakInventory mi + DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory + _ -> 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 diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 52e0790e2..4ef1c0128 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/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