diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index dba2a80f8..4c40d0022 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -2,6 +2,7 @@ module Dodge.Item.Display ( itemDisplay, selectedItemDisplay, itemString, + itemBaseName, ) where import Data.Maybe diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index 37cdf6a92..567c48186 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -43,7 +43,7 @@ invDisplayParams w = secondColumnParams :: ListDisplayParams secondColumnParams = defaultListDisplayParams - & ldpPos . spPixelOff .~ V2 subInvX (-61) + & ldpPos . spPixelOff .~ V2 subInvX (-71) & ldpCursorSides .~ [North, South, West] subInvX :: Float @@ -73,4 +73,3 @@ optionListDisplayParams = & ldpVerticalGap .~ 0 & ldpWidth .~ FixedSelectionWidth 50 & ldpCursorSides .~ [North, South, West] - diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index d2111f7ef..f4214ac68 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,8 +3,7 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Dodge.Render.HUD.Carte -import Dodge.ScreenPos +import Dodge.Item.Display import Control.Lens import Control.Monad import qualified Data.Map.Strict as M @@ -24,7 +23,9 @@ import Dodge.Inventory import Dodge.Item.Info import Dodge.ListDisplayParams import Dodge.Render.Connectors +import Dodge.Render.HUD.Carte import Dodge.Render.List +import Dodge.ScreenPos import Dodge.SelectionSections import Dodge.SelectionSections.Draw import Dodge.Tweak.Show @@ -45,7 +46,13 @@ drawHUD cfig w = case w ^. hud . hudElement of <> drawSubInventory subinv cfig w drawHP :: Configuration -> World -> Picture -drawHP cfig = dShadCol white . displayHP 0 cfig +drawHP cfig = + dShadCol white + . translate (halfWidth cfig) (halfHeight cfig - 40) + . scale 0.2 0.2 + . textRight + . show + . (^?! cWorld . lWorld . creatures . ix 0 . crHP) drawInventory :: SelectionSections () -> World -> Configuration -> Picture drawInventory sss = drawSelectionSections sss . invDisplayParams @@ -121,35 +128,51 @@ drawRBOptions cfig w = fromMaybe mempty $ do sss <- w ^? hud . hudElement . diSections (i', j) <- sss ^? sssExtra . sssSelPos . _Just curpos <- selSecSelPos i' j sss - let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str) - let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext)) + let ytext = drawListElement 0 1 curpos . text + midstr = case ae of + DoNotMoveEquipment -> "" + PutOnEquipment{} -> " PUT ON" + MoveEquipment{} -> " MOVE TO" + SwapEquipment{} -> " MOVE TO" + ReplaceEquipment{} -> " PUT ON" + RemoveEquipment{} -> "TAKE OFF" + extrastr = case ae of + SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} -> + "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp + ReplaceEquipment{_allocRemoveID = rid} -> + "REMOVES " ++ otheritem rid + _ -> "" return $ - toTopLeft cfig (translate 342 0 $ drawListYoff (curpos - i) (map (text . eqPosText) es)) - <> case ae of - DoNotMoveEquipment -> mempty - PutOnEquipment{} -> - midtext "PUT ONTO" - MoveEquipment{} -> - midtext "MOVE TO" <> extratext [] - SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} -> - midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp) - ReplaceEquipment{_allocRemoveID = rid} -> - midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid) - RemoveEquipment{} -> - midtext "TAKE OFF" + toTopLeft cfig + $ translate 290 (-1) (ytext midstr) + <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North,South] curpos 0 white 21 1) + <> translate 380 (-1) (drawListYoff (curpos - i) (map (text . eqPosText) es)) + <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es)) + <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1))) + <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i) + <> translate 380 (-1) (maybetopborder i curpos) + <> translate 380 (-1) (maybebottomborder i (length es) curpos) + <> translate 460 (-1) (ytext extrastr) where - deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of - Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) - Nothing -> "" - otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j) + maybetopborder 0 curpos= listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1 + maybetopborder _ _ = mempty + maybebottomborder a b curpos + | a == b - 1 + = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1 + | otherwise = mempty + otheritem j = fromMaybe "" $ do + itm <- you w ^? crInv . ix j + return $ itemBaseName itm examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do tweaki <- mtweaki -- consider moving this functionality out into a tweaks module tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki - return $ toTopLeft cfig $ translate subInvX (-60) - $ listCursorNSW tweaki 0 white (length $ showTweak tparam) 15 + return $ + toTopLeft cfig $ + translate subInvX (-60) $ + listCursorNSW tweaki 0 white (length $ showTweak tparam) 15 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra sss cfig w = fromMaybe mempty $ do @@ -173,8 +196,9 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do invcursor i = fromMaybe mempty $ do sss' <- w ^? hud . hudElement . diSections let idp = invDisplayParams w - return $ translateScreenPos cfig (idp ^. ldpPos) - $ selSecDrawCursor 17 [North, South, East] idp sss' 0 i + return $ + translateScreenPos cfig (idp ^. ldpPos) $ + selSecDrawCursor 17 [North, South, East] idp sss' 0 i displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do @@ -238,12 +262,10 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp invHead :: Configuration -> String -> Picture invHead cfig = translateScreenPos cfig (fromTopLeft (V2 subInvX 80)) - -- (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 80) . dShadCol white . scale 0.4 0.4 . textJustifyLeft - --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w --locTexts = map fst locs @@ -255,7 +277,6 @@ invHead cfig = -- h :: String -> Point2 -> Point2 -- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y - --selectedCloseObjectLink :: Configuration -> World -> Picture --selectedCloseObjectLink cfig w = mempty @@ -288,7 +309,6 @@ invHead cfig = -- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5) -- return . winScale cfig . color col $ lConnect p itScreenPos - textSelItems :: [String] -> [SelectionItem ()] textSelItems = map (picsToSelectable . (: [])) @@ -303,16 +323,6 @@ picsToSelectable pics = , _siPayload = () } - - -displayHP :: Int -> Configuration -> World -> Picture -displayHP cid cfig = - translate (halfWidth cfig) (halfHeight cfig -40) - . scale 0.2 0.2 - . textRight - . show - . (^?! cWorld . lWorld . creatures . ix cid . crHP) - -- there are still more ListDisplayParams to integrate here selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 selNumTextEndPos cfig ldp sss i j = do diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index d56639982..517d9da8f 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -10,6 +10,7 @@ module Dodge.Render.List ( drawListYoff, stackPicturesAt, toTopLeft, + listCursorChooseBorderScale , ) where import Dodge.ScreenPos diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index ef56f9d2a..bb5e25d54 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -18,9 +18,10 @@ import Dodge.Data.Universe --import qualified Data.Map.Strict as M --import qualified IntMapHelp as IM testStringInit :: Universe -> [String] -testStringInit u = getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys) - <> ["---"] - <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys) +testStringInit _ = mempty +-- getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys) +-- <> ["---"] +-- <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys) -- [show $ u ^. uvWorld . input . smoothScrollAmount -- , show $ getSmoothScrollValue (u ^. uvWorld . input)