Refactor close objects hud display
This commit is contained in:
+40
-38
@@ -4,10 +4,10 @@ module Dodge.Render.HUD (
|
||||
drawHUD,
|
||||
) where
|
||||
|
||||
import qualified Data.IntSet as IS
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import qualified Data.IntSet as IS
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
--import qualified Data.Vector as V
|
||||
@@ -47,19 +47,9 @@ drawHUD :: Configuration -> World -> Picture
|
||||
drawHUD cfig w = case w ^. hud . hudElement of
|
||||
DisplayCarte -> drawCarte cfig w
|
||||
DisplayInventory{_diSections = sections, _subInventory = subinv} ->
|
||||
drawHP cfig w
|
||||
<> drawInventory sections w cfig
|
||||
drawInventory sections w cfig
|
||||
<> drawSubInventory subinv cfig w
|
||||
|
||||
drawHP :: Configuration -> World -> Picture
|
||||
drawHP cfig =
|
||||
dShadCol white
|
||||
. translate (halfWidth cfig) (halfHeight cfig - 40)
|
||||
. scale 0.2 0.2
|
||||
. textRight
|
||||
. show
|
||||
. (^?! cWorld . lWorld . creatures . ix 0 . crHP)
|
||||
|
||||
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
|
||||
drawInventory sss w cfig =
|
||||
drawSelectionSections sss ldp cfig
|
||||
@@ -72,8 +62,9 @@ drawInventory sss w cfig =
|
||||
curs = invCursorParams w
|
||||
iextra = fromMaybe mempty $ do
|
||||
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
||||
guard . not . isFilteringInv =<< (w ^? hud . hudElement . diSections)
|
||||
return . inventoryExtra sss cfig w $ invAdj inv
|
||||
case w ^? hud . hudElement . diInvFilter . _Just of
|
||||
Just (_ : _) -> Nothing
|
||||
_ -> return . inventoryExtra sss cfig w $ invAdj inv
|
||||
|
||||
drawRootCursor ::
|
||||
World ->
|
||||
@@ -109,13 +100,17 @@ getRootItemBounds i inv = do
|
||||
|
||||
-- this should display while dragging a single inv item
|
||||
drawMouseOver :: Configuration -> World -> Picture
|
||||
drawMouseOver cfig w = concat (invsel <|> combinvsel
|
||||
<|> drawDragSelect cfig w)
|
||||
<> concat (drawDragSelected cfig w)
|
||||
drawMouseOver cfig w =
|
||||
concat
|
||||
( invsel <|> combinvsel
|
||||
<|> drawDragSelect cfig w
|
||||
)
|
||||
<> concat (drawDragSelected cfig w)
|
||||
where
|
||||
invsel = do
|
||||
(j, i) <- w ^? input . mouseContext . mcoInvSelect <|>
|
||||
w ^? input . mouseContext . mcoInvFilt
|
||||
(j, i) <-
|
||||
w ^? input . mouseContext . mcoInvSelect
|
||||
<|> w ^? input . mouseContext . mcoInvFilt
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
let idp = invDisplayParams w
|
||||
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
|
||||
@@ -123,8 +118,9 @@ drawMouseOver cfig w = concat (invsel <|> combinvsel
|
||||
$ selSecDrawCursorAt 15 idp curs sss (j, i)
|
||||
curs = BackdropCursor
|
||||
combinvsel = do
|
||||
(j, i) <- (w ^? input . mouseContext . mcoCombSelect)
|
||||
<|> (w ^? input . mouseContext . mcoCombCombine)
|
||||
(j, i) <-
|
||||
(w ^? input . mouseContext . mcoCombSelect)
|
||||
<|> (w ^? input . mouseContext . mcoCombCombine)
|
||||
sss <- w ^? hud . hudElement . subInventory . ciSections
|
||||
let idp = secondColumnParams
|
||||
return . translateScreenPos cfig (idp ^. ldpPos)
|
||||
@@ -135,23 +131,27 @@ drawDragSelected :: Configuration -> World -> Maybe Picture
|
||||
drawDragSelected cfig w = do
|
||||
ys <- w ^? hud . hudElement . diSelectionExtra
|
||||
guard $ not (IS.null ys)
|
||||
(i,_) <- w ^? hud . hudElement . diSelection . _Just
|
||||
(i, _) <- w ^? hud . hudElement . diSelection . _Just
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
let idp = invDisplayParams w
|
||||
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (i, x) <>)
|
||||
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
|
||||
. color (withAlpha 0.2 white) . IS.foldr f mempty $ ys
|
||||
. color (withAlpha 0.2 white)
|
||||
. IS.foldr f mempty
|
||||
$ ys
|
||||
|
||||
drawDragSelect :: Configuration -> World -> Maybe Picture
|
||||
drawDragSelect cfig w = do
|
||||
OverInvDragSelect (i,j) mselend <- w ^? input . mouseContext
|
||||
(a,b) <- mselend
|
||||
OverInvDragSelect (i, j) mselend <- w ^? input . mouseContext
|
||||
(a, b) <- mselend
|
||||
guard $ i == a
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
let idp = invDisplayParams w
|
||||
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
|
||||
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
|
||||
. color (withAlpha 0.2 white) . foldMap f $ [min j b .. max j b]
|
||||
. color (withAlpha 0.2 white)
|
||||
. foldMap f
|
||||
$ [min j b .. max j b]
|
||||
|
||||
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
|
||||
drawSubInventory subinv cfig w = case subinv of
|
||||
@@ -181,14 +181,15 @@ drawExamineInventory cfig w =
|
||||
<> drawSelectionList
|
||||
secondColumnParams
|
||||
cfig
|
||||
( map f
|
||||
( makeParagraph 55 $
|
||||
yourAugmentedItem
|
||||
itemInfo
|
||||
(yourInfo (you w))
|
||||
(closeObjectInfo (crNumFreeSlots (you w)))
|
||||
w
|
||||
)
|
||||
( map
|
||||
f
|
||||
( makeParagraph 55 $
|
||||
yourAugmentedItem
|
||||
itemInfo
|
||||
(yourInfo (you w))
|
||||
(closeObjectInfo (crNumFreeSlots (you w)))
|
||||
w
|
||||
)
|
||||
)
|
||||
where
|
||||
f str =
|
||||
@@ -216,7 +217,7 @@ floorItemPickupInfo n itm
|
||||
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
|
||||
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
|
||||
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
|
||||
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
|
||||
Just (SelCloseObject i) -> g . Left $ w ^?! hud . closeItems . ix i
|
||||
_ -> x
|
||||
|
||||
drawRBOptions :: Configuration -> World -> Picture
|
||||
@@ -323,7 +324,7 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
|
||||
let col = _siColor si
|
||||
lnks <- si ^? siPayload . ciInvIDs
|
||||
return (lnkMidPosInvSelsCol cfig w j col lnks)
|
||||
<> foldMap invcursor lnks
|
||||
<> foldMap invcursor lnks
|
||||
where
|
||||
invcursor i = do
|
||||
sss' <- w ^? hud . hudElement . diSections
|
||||
@@ -344,7 +345,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
|
||||
invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
||||
<> drawSelectionList secondColumnParams cfig (thesellist tm)
|
||||
<> color (withAlpha 0.5 green) (drawSelectionListBackground secondColumnParams cfig 15)
|
||||
-- when changing the 15, change isOverTerminalScreen
|
||||
-- when changing the 15, change isOverTerminalScreen
|
||||
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
|
||||
where
|
||||
toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
|
||||
@@ -361,7 +362,8 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
|
||||
displayInputText tm s
|
||||
| _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM (tm ^. tmType) ++ s
|
||||
| otherwise = ""
|
||||
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
|
||||
|
||||
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
|
||||
|
||||
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
|
||||
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
|
||||
|
||||
Reference in New Issue
Block a user