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