Add border to terminal display
This commit is contained in:
+66
-67
@@ -2,21 +2,18 @@
|
||||
|
||||
module Dodge.Render.HUD (drawHUD) where
|
||||
|
||||
import Linear
|
||||
import Dodge.Clock
|
||||
import qualified Data.Vector as V
|
||||
import Dodge.Terminal
|
||||
import Dodge.Inventory.CheckSlots
|
||||
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
|
||||
import qualified Data.Vector as V
|
||||
-- import qualified Data.Vector as V
|
||||
import Dodge.Base
|
||||
import Dodge.CharacterEnums
|
||||
--import Dodge.Clock
|
||||
import Dodge.Clock
|
||||
-- import Dodge.Clock
|
||||
import Dodge.Creature.Info
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Data.CardinalPoint
|
||||
@@ -30,6 +27,7 @@ import Dodge.Data.World
|
||||
import Dodge.DoubleTree
|
||||
import Dodge.Equipment.Text
|
||||
import Dodge.Inventory
|
||||
import Dodge.Inventory.CheckSlots
|
||||
import Dodge.Item.Display
|
||||
import Dodge.Item.Grammar
|
||||
import Dodge.Item.Info
|
||||
@@ -41,10 +39,12 @@ import Dodge.Render.List
|
||||
import Dodge.ScreenPos
|
||||
import Dodge.SelectionSections
|
||||
import Dodge.SelectionSections.Draw
|
||||
import Dodge.Terminal
|
||||
import Dodge.Terminal.Type
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
import Justify
|
||||
import Linear
|
||||
import NewInt
|
||||
import Picture
|
||||
import SDL (MouseButton (..))
|
||||
@@ -52,18 +52,19 @@ import SDL (MouseButton (..))
|
||||
drawHUD :: Config -> World -> Picture
|
||||
drawHUD cfig w = case w ^. hud of
|
||||
-- DisplayCarte -> drawCarte cfig w
|
||||
HUD {_diSections = sections, _subInventory = subinv} ->
|
||||
HUD{_diSections = sections, _subInventory = subinv} ->
|
||||
drawInventory sections w cfig subinv
|
||||
<> drawSubInventory subinv cfig w
|
||||
|
||||
drawInventory :: IM.IntMap (SelSection ()) -> World -> Config -> SubInventory -> Picture
|
||||
drawInventory sss w cfig = \case
|
||||
-- DisplayTerminal {} -> mempty
|
||||
_ -> drawSelectionSections sss invDP cfig
|
||||
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
|
||||
<> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
|
||||
<> itemconnections
|
||||
<> drawMouseOver cfig w
|
||||
drawInventory sss w cfig = \case
|
||||
-- DisplayTerminal {} -> mempty
|
||||
_ ->
|
||||
drawSelectionSections sss invDP cfig
|
||||
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
|
||||
<> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
|
||||
<> itemconnections
|
||||
<> drawMouseOver cfig w
|
||||
where
|
||||
f = fmap (\(Sel x y _) -> (x, y))
|
||||
curs = invCursorParams w
|
||||
@@ -118,8 +119,9 @@ drawMouseOver cfig w =
|
||||
w ^? input . mouseContext . mcoInvSelect
|
||||
<|> w ^? input . mouseContext . mcoInvFilt
|
||||
sss <- w ^? hud . diSections
|
||||
return . translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.3*^white)
|
||||
return
|
||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.3 *^ white)
|
||||
-- . color white
|
||||
$ selSecDrawCursorAt invDP curs sss (j, i)
|
||||
-- curs = BoundaryCursor [West]
|
||||
@@ -130,8 +132,9 @@ drawMouseOver cfig w =
|
||||
<|> (w ^? input . mouseContext . mcoCombCombine)
|
||||
sss <- w ^? hud . subInventory . ciSections
|
||||
let idp = secondColumnLDP
|
||||
return . translateScreenPos cfig (idp ^. ldpPos)
|
||||
. color (0.3*white)
|
||||
return
|
||||
. translateScreenPos cfig (idp ^. ldpPos)
|
||||
. color (0.3 * white)
|
||||
$ selSecDrawCursorAt idp curs sss (j, i)
|
||||
|
||||
drawDragSelected :: Config -> World -> Maybe Picture
|
||||
@@ -146,8 +149,9 @@ drawDragSelected cfig w = do
|
||||
Sel i _ _ <- w ^? hud . diSelection . _Just
|
||||
sss <- w ^? hud . diSections
|
||||
let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
|
||||
return . translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.2*^white)
|
||||
return
|
||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.2 *^ white)
|
||||
. IS.foldr f mempty
|
||||
$ ys
|
||||
|
||||
@@ -156,8 +160,9 @@ drawDragSelecting cfig w = do
|
||||
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
||||
sss <- w ^? hud . diSections
|
||||
let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
|
||||
return . translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.2*^white)
|
||||
return
|
||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||
. color (0.2 *^ white)
|
||||
. foldMap f
|
||||
$ [min j b .. max j b]
|
||||
|
||||
@@ -166,8 +171,10 @@ drawSubInventory subinv cfig w = case subinv of
|
||||
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
||||
NoSubInventory{} -> drawRBOptions cfig w
|
||||
ExamineInventory -> drawExamineInventory cfig w
|
||||
DisplayTerminal tid -> foldMap (drawTerminalDisplay (w ^.cWorld.lWorld) cfig)
|
||||
(w ^? cWorld . lWorld . terminals . ix tid)
|
||||
DisplayTerminal tid ->
|
||||
foldMap
|
||||
(drawTerminalDisplay (w ^. cWorld . lWorld) cfig)
|
||||
(w ^? cWorld . lWorld . terminals . ix tid)
|
||||
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
|
||||
MapperInventory _ _ itid -> drawMapperInventory itid w
|
||||
|
||||
@@ -180,21 +187,16 @@ drawMapperInventory itid w = fold $ do
|
||||
where
|
||||
f = worldPosToScreen (w ^. wCam)
|
||||
|
||||
drawCombineInventory ::
|
||||
Config ->
|
||||
IM.IntMap (SelSection CombItem) ->
|
||||
World ->
|
||||
Picture
|
||||
drawCombineInventory :: Config -> IM.IntMap (SelSection CombItem) -> World -> Picture
|
||||
drawCombineInventory cfig sss w =
|
||||
-- invHead cfig "COMBINE"
|
||||
drawSelectionSections sss secondColumnLDP cfig
|
||||
drawSelectionSections sss secondColumnLDP cfig
|
||||
<> drawSSCursor sss secondColumnLDP curs cfig msel
|
||||
<> combineInventoryExtra sss msel cfig w
|
||||
where
|
||||
curs = BoundaryCursor [North, South, West]
|
||||
msel =
|
||||
fmap (\(Sel x y _) -> (x, y)) $
|
||||
w ^? hud . subInventory . ciSelection . _Just
|
||||
(\(Sel x y _) -> (x, y)) <$>
|
||||
(w ^? hud . subInventory . ciSelection . _Just)
|
||||
|
||||
drawExamineInventory :: Config -> World -> Picture
|
||||
drawExamineInventory cfig w =
|
||||
@@ -336,12 +338,8 @@ drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
|
||||
where
|
||||
snum = selNumPos cfig invDP sss 0
|
||||
|
||||
combineInventoryExtra ::
|
||||
IM.IntMap (SelSection CombItem) ->
|
||||
Maybe (Int, Int) ->
|
||||
Config ->
|
||||
World ->
|
||||
Picture
|
||||
combineInventoryExtra
|
||||
:: IM.IntMap (SelSection CombItem) -> Maybe (Int, Int) -> Config -> World -> Picture
|
||||
combineInventoryExtra sss msel cfig w = fold $ do
|
||||
(i, j) <- msel
|
||||
si <- sss ^? ix i . ssItems . ix j
|
||||
@@ -360,31 +358,32 @@ combineInventoryExtra sss msel cfig w = fold $ do
|
||||
(Just (0, i))
|
||||
|
||||
drawTerminalDisplay :: LWorld -> Config -> Terminal -> Picture
|
||||
drawTerminalDisplay lw cfig tm =
|
||||
drawSelectionList secondColumnLDP cfig f
|
||||
-- <> invHead cfig ("TERMINAL-" ++ show tid)
|
||||
-- <> color
|
||||
-- (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
||||
-- (drawSelectionListBackground secondColumnLDP cfig tsize)
|
||||
-- <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
|
||||
drawTerminalDisplay lw cfig tm = drawSelectionList secondColumnLDP cfig f
|
||||
where
|
||||
-- <> invHead cfig ("TERMINAL-" ++ show tid)
|
||||
-- <> color
|
||||
-- (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
||||
-- (drawSelectionListBackground secondColumnLDP cfig tsize)
|
||||
-- <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
|
||||
|
||||
tid = tm ^. tmID
|
||||
-- tsize = getMaxLinesTM + 1
|
||||
-- tsize = getMaxLinesTM + 1
|
||||
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
|
||||
-- not sure if the width (55) is correct here
|
||||
f = toselitm ("TERMINAL " ++ show tid,white) :
|
||||
(map (toselitm . (_1 %~ (" "<>))) . displayTermInput
|
||||
. reverse
|
||||
$ _tmDisplayedLines tm)
|
||||
f =
|
||||
toselitm ("TERMINAL " ++ show tid, white)
|
||||
: ( map (toselitm . (_1 %~ (" " <>)))
|
||||
. displayTermInput
|
||||
. reverse
|
||||
$ _tmDisplayedLines tm
|
||||
)
|
||||
displayTermInput = case _tmStatus tm of
|
||||
TerminalOff -> id
|
||||
TerminalDeactivated -> id
|
||||
TerminalLineRead -> (++ [(spincurs,termTextColor)])
|
||||
TerminalTextInput s ->
|
||||
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
|
||||
TerminalPressTo s ->
|
||||
(++ [(s, white)])
|
||||
spincurs = clockCycle 4 (V.fromList ["/","-","\\","|"]) lw
|
||||
TerminalLineRead -> (++ [(spincurs, termTextColor)])
|
||||
TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
|
||||
TerminalPressTo s -> (++ [(s, white)])
|
||||
spincurs = clockCycle 4 (V.fromList ["/", "-", "\\", "|"]) lw
|
||||
|
||||
lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
|
||||
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
|
||||
@@ -404,19 +403,19 @@ invHead cfig =
|
||||
. 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
|
||||
-- locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
||||
-- locTexts = map fst locs
|
||||
|
||||
--displayListEndCoords :: Config -> [String] -> [Point2]
|
||||
--displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
|
||||
-- displayListEndCoords :: Config -> [String] -> [Point2]
|
||||
-- displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
|
||||
-- where
|
||||
-- f :: Int -> Point2
|
||||
-- f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
|
||||
-- h :: String -> Point2 -> Point2
|
||||
-- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
|
||||
|
||||
--closeObjectTexts :: Config -> World -> Picture
|
||||
--closeObjectTexts cfig w = pictures $
|
||||
-- closeObjectTexts :: Config -> World -> Picture
|
||||
-- closeObjectTexts cfig w = pictures $
|
||||
-- renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
|
||||
-- : maybeToList maybeLine
|
||||
-- where
|
||||
@@ -442,8 +441,8 @@ invHead cfig =
|
||||
-- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
|
||||
-- return . winScale cfig . color col $ lConnect p itScreenPos
|
||||
|
||||
--textSelItems :: [String] -> [SelectionItem ()]
|
||||
--textSelItems = map (picsToSelectable . (: []))
|
||||
-- textSelItems :: [String] -> [SelectionItem ()]
|
||||
-- textSelItems = map (picsToSelectable . (: []))
|
||||
|
||||
-- would be nice to add parameter to orient this with NSEW, cf cursor
|
||||
selNumPos ::
|
||||
@@ -455,7 +454,7 @@ selNumPos ::
|
||||
Maybe Point2
|
||||
selNumPos = selNumPosCardinal West8
|
||||
|
||||
--selNumPos cfig ldp sss i j = do
|
||||
-- selNumPos cfig ldp sss i j = do
|
||||
-- ipos <- selSecYint i j sss
|
||||
-- size <- selSecSelSize i j sss
|
||||
-- indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
|
||||
|
||||
@@ -41,6 +41,9 @@ drawSelectionList ldps cfig sl =
|
||||
(ldps ^. ldpScale)
|
||||
0
|
||||
(makeSelectionListPictures sl)
|
||||
<> foldMap (color white . polygonWire . f) (ldps ^. ldpBorder)
|
||||
where
|
||||
f (x,y) = rectNSWE 5 (negate $ 20 * fromIntegral y + 5) (-5) (10 * fromIntegral x)
|
||||
|
||||
drawTitleBackground :: Config -> Picture
|
||||
drawTitleBackground cfig =
|
||||
|
||||
Reference in New Issue
Block a user