This commit is contained in:
2024-11-10 23:20:48 +00:00
parent 713d3e3265
commit 4434093d81
+39 -30
View File
@@ -7,26 +7,25 @@ module Dodge.Render.HUD (
) where
import Control.Applicative
import Dodge.Terminal.Type
import Dodge.CharacterEnums
import Dodge.Creature.Test
import Dodge.DoubleTree
import Dodge.Data.DoubleTree
import Dodge.Data.ComposedItem
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
--import qualified Data.Vector as V
import Dodge.Base
import Dodge.CharacterEnums
--import Dodge.Clock
import Dodge.Creature.Info
import Dodge.Creature.Test
import Dodge.Data.CardinalPoint
import Dodge.Data.Combine
import Dodge.Data.ComposedItem
import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Default.SelectionList
import Dodge.DoubleTree
import Dodge.Equipment.Text
import Dodge.Inventory
import Dodge.Item.Display
@@ -39,6 +38,7 @@ import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Dodge.Terminal.Type
import Geometry
import qualified IntMapHelp as IM
import Justify
@@ -81,55 +81,64 @@ drawInventory sss w cfig =
guard . not . isFilteringInv =<< (w ^? hud . hudElement . diSections)
return . inventoryExtra sss cfig w $ invAdj inv
drawRootCursor :: World
-> IM.IntMap (SelectionSection ())
-> Maybe (Int,Int)
-> ListDisplayParams
-> Configuration
-> Picture
drawRootCursor ::
World ->
IM.IntMap (SelectionSection ()) ->
Maybe (Int, Int) ->
ListDisplayParams ->
Configuration ->
Picture
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
guard $ crIsAiming cr
(i,j) <- msel
(i, j) <- msel
guard $ i == 0
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
(x,y) <- getRootItemBounds j inv
return $ drawSSMultiCursor sss (Just (0,x)) (Just (y- x)) ldp
(BoundaryCursor [minBound ..]) cfig
(x, y) <- getRootItemBounds j inv
return $
drawSSMultiCursor
sss
(Just (0, x))
(Just (y - x))
ldp
(BoundaryCursor [minBound ..])
cfig
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int,Int)
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
getRootItemBounds i inv = do
let ia = allInvLocs inv
itm <- ia ^? ix i . _2
let root = locToTop itm
x <- locRightmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
return (x,y)
return (x, y)
drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
where
where
invsel = do
(j, i) <- w ^? input . mouseContext . mcoInv
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white)
$ selSecDrawCursorAt 15 idp curs sss (j, i)
curs = BackdropCursor
combinvsel = do
(j, i) <- w ^? input . mouseContext . mcoCombInv
sss <- w ^? hud . hudElement . subInventory . ciSections
let idp = invDisplayParams w
return . translateScreenPos cfig (secondColumnParams ^. ldpPos)
. color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (j, i)
let idp = secondColumnParams
return . translateScreenPos cfig (idp ^. ldpPos)
. color (withAlpha 0.2 white)
$ selSecDrawCursorAt 15 idp curs sss (j, i)
getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
Just (MouseInvSelect s (Just e)) -> Just (s, e)
_ -> case w ^? hud . hudElement . diSelectionExtra of
Just x | x > 0 -> do
(i,j) <- w ^? hud . hudElement . diSelection . _Just
return ((i,j),(i,j+x))
(i, j) <- w ^? hud . hudElement . diSelection . _Just
return ((i, j), (i, j + x))
_ -> Nothing
drawDISelections :: World -> Picture
@@ -138,8 +147,8 @@ drawDISelections w = fromMaybe mempty $ do
guard $ i == a
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i,x)
return . color (withAlpha 0.2 white) . foldMap f $ [min j b..max j b]
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
return . 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
@@ -364,7 +373,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
| _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM (tm ^. tmType) ++ s
| otherwise = ""
displayBlinkCursor hasfoc
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
| hasfoc = [cFilledRect]
| otherwise = [cWireRect]