Cleanup
This commit is contained in:
+39
-30
@@ -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]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user