514 lines
19 KiB
Haskell
514 lines
19 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Render.HUD (drawHUD) where
|
|
|
|
import Control.Applicative
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import qualified Data.IntSet as IS
|
|
import Data.List (elemIndex)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
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.Creature.Info
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.CardinalPoint
|
|
import Dodge.Data.Combine
|
|
import Dodge.Data.Config
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.EquipType
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.Terminal.Status
|
|
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
|
|
import Dodge.Item.InvSize
|
|
import Dodge.Item.Location
|
|
import Dodge.ListDisplayParams
|
|
import Dodge.Render.Connectors
|
|
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 (..))
|
|
|
|
drawHUD :: Config -> World -> Picture
|
|
drawHUD cfig w =
|
|
drawInventory sections w cfig subinv
|
|
<> drawSubInventory subinv cfig w
|
|
where
|
|
sections = w ^. hud . diSections
|
|
subinv = w ^. hud . subInventory
|
|
|
|
drawInventory :: IMSS () -> World -> Config -> SubInventory -> Picture
|
|
drawInventory sss w cfig = \case
|
|
DisplayTerminal{} ->
|
|
drawSelectionSections sss invDP cfig
|
|
<> itemconnections
|
|
<> drawMouseOver cfig w
|
|
_ ->
|
|
drawSelectionSections sss invDP cfig
|
|
<> foldMap (drawSSCursor sss invDP curs cfig) (w ^. hud . diSelection)
|
|
<> drawRootCursor w sss (w ^. hud . diSelection) invDP cfig
|
|
<> itemconnections
|
|
<> drawMouseOver cfig w
|
|
where
|
|
curs = invCursorParams w
|
|
itemconnections = fromMaybe mempty $ do
|
|
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
|
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
|
case w ^? hud . diInvFilter . _Just of
|
|
Just (_ : _) -> Nothing
|
|
_ -> return . drawItemConnections sss cfig $ invAdj inv
|
|
|
|
drawRootCursor ::
|
|
World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
|
|
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
guard $ crIsAiming cr
|
|
i <- msel ^? _Just . slSec
|
|
j <- msel ^? _Just . slInt
|
|
guard $ i == 0
|
|
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
|
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
|
(x, y) <- getRootItemBounds j $ _unNIntMap inv
|
|
let curs =
|
|
if null (w ^? rbState . opSel)
|
|
then BoundCurs [minBound ..]
|
|
else BoundCurs [North, South, West]
|
|
return $
|
|
drawSSMultiCursor
|
|
sss
|
|
(0, x)
|
|
(y - x)
|
|
ldp
|
|
curs
|
|
cfig
|
|
|
|
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
|
|
getRootItemBounds i inv = do
|
|
let ia = invIndents $ NIntMap inv -- why indents? why OItem?
|
|
itm <- ia ^? ix i . _2
|
|
let root = locToTop itm
|
|
x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
|
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
|
return (x, y)
|
|
|
|
drawMouseOver :: Config -> World -> Picture
|
|
drawMouseOver cfig w =
|
|
concat
|
|
(invsel <|> combinvsel <|> drawDragSelecting cfig w)
|
|
<> concat (drawDragSelected cfig w)
|
|
where
|
|
invsel = do
|
|
(j, i) <-
|
|
w ^? input . mouseContext . mcoInvSelect
|
|
<|> w ^? input . mouseContext . mcoInvFilt
|
|
sss <- w ^? hud . diSections
|
|
return
|
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
|
. color (0.3 *^ white)
|
|
-- . color white
|
|
$ selSecDrawCursor invDP curs sss (Sel j i mempty)
|
|
-- curs = BoundaryCursor [West]
|
|
curs = BackdropCurs
|
|
combinvsel = do
|
|
(j, i) <-
|
|
(w ^? input . mouseContext . mcoCombSelect)
|
|
<|> (w ^? input . mouseContext . mcoCombCombine)
|
|
sss <- w ^? hud . subInventory . ciSections
|
|
let idp = secondColumnLDP
|
|
return
|
|
. translateScreenPos cfig (idp ^. ldpPos)
|
|
. color (0.3 * white)
|
|
$ selSecDrawCursor idp curs sss (Sel j i mempty)
|
|
|
|
drawDragSelected :: Config -> World -> Maybe Picture
|
|
drawDragSelected cfig w = do
|
|
ys <- w ^? hud . diSelection . _Just . slSet
|
|
guard $
|
|
not (IS.null ys)
|
|
&& ( case w ^? hud . subInventory of
|
|
Just NoSubInventory -> True
|
|
_ -> False
|
|
)
|
|
Sel i _ _ <- w ^? hud . diSelection . _Just
|
|
sss <- w ^? hud . diSections
|
|
let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
|
|
return
|
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
|
. color (0.2 *^ white)
|
|
. IS.foldr f mempty
|
|
$ ys
|
|
|
|
drawDragSelecting :: Config -> World -> Maybe Picture
|
|
drawDragSelecting cfig w = do
|
|
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
|
sss <- w ^? hud . diSections
|
|
let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
|
|
return
|
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
|
. color (0.2 *^ white)
|
|
. foldMap f
|
|
$ [min j b .. max j b]
|
|
|
|
drawSubInventory :: SubInventory -> Config -> World -> Picture
|
|
drawSubInventory subinv cfig w = case subinv of
|
|
NoSubInventory{} -> drawRBOptions cfig w
|
|
ExamineInventory -> drawExamineInventory cfig w
|
|
DisplayTerminal tid -> drawTerminalDisplay w cfig tid
|
|
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
|
|
MapperInventory _ _ itid -> drawMapperInventory itid w
|
|
|
|
drawMapperInventory :: NewInt ItmInt -> World -> Picture
|
|
drawMapperInventory itid w = fold $ do
|
|
itm <- w ^? pointerToItemID itid
|
|
ls <- itm ^? itUse . useMapperLines
|
|
let _ = w ^. wCam . camRot
|
|
return . color red $ foldMap (\(x, y) -> line [f x, f y]) ls
|
|
where
|
|
f = worldPosToScreen (w ^. wCam)
|
|
|
|
drawCombineInventory :: Config -> IMSS CombItem -> World -> Picture
|
|
drawCombineInventory cfig sss w =
|
|
drawSelectionSections sss secondColumnLDP cfig
|
|
<> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel
|
|
<> combineInventoryExtra sss msel cfig w
|
|
where
|
|
curs = BoundCurs [North, South, West]
|
|
msel = w ^? hud . subInventory . ciSelection . _Just
|
|
|
|
drawExamineInventory :: Config -> World -> Picture
|
|
drawExamineInventory cfig w =
|
|
invHead cfig "EXAMINE"
|
|
<> drawSelectionList
|
|
secondColumnLDP
|
|
cfig
|
|
( map
|
|
f
|
|
( makeParagraph 55 $
|
|
yourAugmentedItem
|
|
itemInfo
|
|
(yourInfo (you w))
|
|
(closeObjectInfo (crNumFreeSlots (w ^. cWorld . lWorld . items) (you w)))
|
|
w
|
|
)
|
|
)
|
|
where
|
|
f str =
|
|
SelItem
|
|
{ _siPictures = [str]
|
|
, _siWidth = 55
|
|
, _siHeight = 1
|
|
, _siIsSelectable = True
|
|
, _siColor = white
|
|
, _siOffX = 0
|
|
, _siPayload = Nothing
|
|
, _siDisplayMod = NoSIDisplayMod
|
|
}
|
|
|
|
closeObjectInfo :: Int -> Either Item Button -> String
|
|
closeObjectInfo n x = case x of
|
|
Left itm -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
|
|
Right _ -> "Some sort of switch or button."
|
|
|
|
floorItemPickupInfo :: Int -> Item -> String
|
|
floorItemPickupInfo n itm
|
|
| n >= itInvHeight itm = ", but you have space to pick it up."
|
|
| otherwise = ", and you don't have space to pick it up."
|
|
|
|
-- note the use of ^?!
|
|
-- it is probably desirable for this to crash hard for now
|
|
yourAugmentedItem :: (Item -> a) -> a -> (Either Item Button -> a) -> World -> a
|
|
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
|
|
Just (SelectedItem i _ _ _) -> f $ yourInv w ^?! ix i
|
|
Just (SelCloseItem i) -> fromMaybe x $ do
|
|
j <- w ^? hud . closeItems . ix i . unNInt
|
|
flit <- w ^? cWorld . lWorld . items . ix j
|
|
return . g $ Left flit
|
|
Just (SelCloseButton i) -> fromMaybe x $ do
|
|
j <- w ^? hud . closeButtons . ix i
|
|
but <- w ^? cWorld . lWorld . buttons . ix j
|
|
return . g $ Right but
|
|
_ -> x
|
|
|
|
drawRBOptions :: Config -> World -> Picture
|
|
drawRBOptions cfig w = fold $ do
|
|
guard $ ButtonRight `M.member` _mouseButtons (_input w)
|
|
invid <- you w ^? crManipulation . manObject . imSelectedItem
|
|
itid <- you w ^? crInv . ix invid
|
|
eslist <-
|
|
fmap eqTypeToSites $
|
|
w ^? cWorld . lWorld . items . ix itid >>= equipType
|
|
i <- w ^? rbState . opSel
|
|
let ae = equipmentDesignation invid w
|
|
sss <- w ^? hud . diSections
|
|
Sel i' j _ <- w ^? hud . diSelection . _Just
|
|
curpos <- selSecYint i' j sss
|
|
itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
|
|
ind <- sss ^? ix i' . ssItems . ix j . siOffX
|
|
let ytext = drawListElement 0 1 0 curpos . text
|
|
midstr = equipAllocString ae
|
|
extrastr = case ae of
|
|
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
|
" SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
|
|
ReplaceEquipment{_allocRemoveID = rid} ->
|
|
" REMOVES " ++ otheritem rid
|
|
_ -> ""
|
|
return
|
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
|
. translate (10 * fromIntegral (ind + length itext)) 0
|
|
$ translate (290 - xt) 0 (ytext midstr)
|
|
<> translate
|
|
(120 - xt)
|
|
0
|
|
( listCursor
|
|
0
|
|
1
|
|
(BoundCurs [North, South])
|
|
curpos
|
|
0
|
|
white
|
|
25
|
|
1
|
|
)
|
|
<> translate
|
|
(380 - xt)
|
|
0
|
|
( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
|
|
<> listCursor 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
|
|
<> listCursor 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
|
|
<> listCursor 0 1 (bc West) (curpos - i) 0 white 7 i
|
|
<> maybetopborder i curpos
|
|
<> maybebottomborder i (length eslist) curpos
|
|
)
|
|
<> translate (460 - xt) 0 (ytext extrastr)
|
|
where
|
|
xt = 260
|
|
bc x = BoundCurs [x]
|
|
maybetopborder 0 curpos = listCursor 0 1 (bc North) curpos 0 white 7 1
|
|
maybetopborder _ _ = mempty
|
|
maybebottomborder a b curpos
|
|
| a == b - 1 = listCursor 0 1 (bc South) curpos 0 white 7 1
|
|
| otherwise = mempty
|
|
otheritem (NInt j) = fromMaybe "" $ do
|
|
itype <- w ^? cWorld . lWorld . items . ix j . itType
|
|
return $ itemBaseName itype
|
|
|
|
equipAllocString :: EquipmentAllocation -> String
|
|
equipAllocString = \case
|
|
DoNotMoveEquipment -> ""
|
|
PutOnEquipment{} -> " PUT ON"
|
|
MoveEquipment{} -> " MOVE TO"
|
|
SwapEquipment{} -> " MOVE TO"
|
|
ReplaceEquipment{} -> " PUT ON"
|
|
RemoveEquipment{} -> "TAKE OFF"
|
|
|
|
drawItemConnections ::
|
|
IMSS () -> Config -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) -> Picture
|
|
drawItemConnections sss cfig =
|
|
translate (negate 5) 0
|
|
. IM.foldMapWithKey (drawItemChildrenConnect sss cfig)
|
|
. fmap (\(_, a, b) -> a <> b)
|
|
|
|
drawItemChildrenConnect :: IMSS () -> Config -> Int -> [Int] -> Picture
|
|
drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
|
|
p <- snum i
|
|
let ps = mapMaybe snum is
|
|
return $ color white $ lConnectMulti ps p
|
|
where
|
|
snum = selNumPos cfig invDP sss 0
|
|
|
|
combineInventoryExtra :: IMSS CombItem -> Maybe Selection -> Config -> World -> Picture
|
|
combineInventoryExtra sss msel cfig w = fold $ do
|
|
i <- msel ^? _Just . slSec
|
|
j <- msel ^? _Just . slInt
|
|
si <- sss ^? ix i . ssItems . ix j
|
|
let col = _siColor si
|
|
lnks <- si ^? siPayload . _Just . ciInvIDs
|
|
return (lnkMidPosInvSelsCol cfig w j col lnks) <> Just (foldMap invcursor lnks)
|
|
where
|
|
invcursor i =
|
|
translateScreenPos cfig (invDP ^. ldpPos) $
|
|
selSecDrawCursor
|
|
invDP
|
|
(BoundCurs [North, South, East, West])
|
|
(w ^. hud . diSections)
|
|
(Sel 0 i mempty)
|
|
|
|
drawTerminalDisplay :: World -> Config -> Int -> Picture
|
|
drawTerminalDisplay w cfig tid = fold $ do
|
|
tm <- w ^? cWorld . lWorld . terminals . ix tid
|
|
let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
|
|
f =
|
|
-- toselitm ("TERMINAL " ++ show tid, white)
|
|
toselitm ("", 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)])
|
|
return . (each . vxPos . _z -~ 0.05) $
|
|
drawTerminalCursorLink w cfig tm
|
|
<> (
|
|
drawSelectionList (w ^. tmLDP) cfig f
|
|
<> (hackInvertText black white ("TERMINAL-" ++ show tid)
|
|
& each . vxPos *~ 0.1
|
|
& each . vxPos . _xy +~ rp)
|
|
& each . vxPos . _z -~ 0.05)
|
|
where
|
|
rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
|
|
-- <> invHead cfig ("TERMINAL-" ++ show tid)
|
|
-- <> color
|
|
-- (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
|
-- (drawSelectionListBackground secondColumnLDP cfig tsize)
|
|
-- <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
|
|
|
|
-- tsize = getMaxLinesTM + 1
|
|
-- not sure if the width (55) is correct here
|
|
spincurs = clockCycle 4 (V.fromList ["/", "-", "\\", "|"]) lw
|
|
lw = w ^. cWorld . lWorld
|
|
|
|
drawTerminalCursorLink :: World -> Config -> Terminal -> Picture
|
|
drawTerminalCursorLink w cfig tm = fold $ do
|
|
j <- elemIndex (tm ^. tmButtonID) $ w ^. hud . closeButtons
|
|
lp <- selNumPos cfig invDP (w ^. hud . diSections) 5 j
|
|
let rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
|
|
lcol <- selSecSelCol 5 j (w ^. hud . diSections)
|
|
return $
|
|
translateScreenPos
|
|
cfig
|
|
(invDP ^. ldpPos)
|
|
( selSecDrawCursor
|
|
invDP
|
|
(BoundCurs [North, South, East, West])
|
|
(w ^. hud . diSections)
|
|
(Sel 5 j mempty)
|
|
)
|
|
<>
|
|
lConnectCol (lp + V2 155 0) rp lcol white white
|
|
|
|
lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
|
|
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
|
|
where
|
|
f j = do
|
|
let sss = w ^. hud . diSections
|
|
combinesss <- w ^? hud . subInventory . ciSections
|
|
lp <- selNumPos cfig invDP sss 0 j
|
|
rp <- selNumPos cfig secondColumnLDP combinesss 0 i
|
|
invcol <- selSecSelCol 0 j sss
|
|
return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol
|
|
|
|
invHead :: Config -> String -> Picture
|
|
invHead cfig =
|
|
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
|
|
. dShadCol white
|
|
. 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
|
|
|
|
-- 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 $
|
|
-- renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
|
|
-- : maybeToList maybeLine
|
|
-- where
|
|
-- colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
|
|
-- colAndText (Right x) = (_btText x,yellow)
|
|
-- youSel = _crInvSel $ you w
|
|
-- freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
|
|
-- invPos = fromMaybe youSel freeSlot
|
|
-- mayObj = listToMaybe $ _closeObjects w
|
|
-- mayIt = mayObj >>= maybeLeft
|
|
-- maybeLeft (Left x) = Just x
|
|
-- maybeLeft _ = Nothing
|
|
-- pushout = 120
|
|
-- objPos obj = case obj of
|
|
-- Left flit -> _flItPos flit
|
|
-- Right bt -> _btPos bt
|
|
-- mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
|
|
-- maybeLine = do
|
|
-- itScreenPos <- mayScreenPos
|
|
-- (theText,col) <- fmap colAndText mayObj
|
|
-- let textWidth = 9 * fromIntegral (length theText)
|
|
-- let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
|
|
-- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
|
|
-- return . winScale cfig . color col $ lConnect p itScreenPos
|
|
|
|
-- textSelItems :: [String] -> [SelectionItem ()]
|
|
-- textSelItems = map (picsToSelectable . (: []))
|
|
|
|
-- would be nice to add parameter to orient this with NSEW, cf cursor
|
|
selNumPos :: Config -> LDParams -> IMSS a -> Int -> Int -> Maybe Point2
|
|
selNumPos = selNumPosCardinal West8
|
|
|
|
-- 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
|
|
-- return $
|
|
-- screenPosAbs cfig (ldp ^. ldpPos)
|
|
-- + V2
|
|
-- (10 * s * fromIntegral indent)
|
|
-- (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
|
|
-- where
|
|
-- s = _ldpScale ldp
|
|
-- ygap = _ldpVerticalGap ldp
|
|
|
|
-- need to be able to determine a selection item's width for this
|
|
selNumPosCardinal ::
|
|
Cardinal8 -> Config -> LDParams -> IMSS a -> Int -> Int -> Maybe Point2
|
|
selNumPosCardinal card cfig ldp sss i j = do
|
|
ipos <- selSecYint i j sss
|
|
ysize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siHeight
|
|
xsize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siWidth
|
|
itmindent <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siOffX
|
|
sindent <- fromIntegral <$> sss ^? ix i . ssIndent
|
|
let indent = itmindent + sindent
|
|
let offset = s *^ (card8Vec card * V2 (xsize * 5) (ysize * 10))
|
|
return $
|
|
screenPosAbs cfig (ldp ^. ldpPos)
|
|
+ offset
|
|
+ V2
|
|
(10 * s * (indent + xsize * 0.5))
|
|
(negate (20 * s + ygap) * (fromIntegral ipos + ysize * 0.5))
|
|
where
|
|
s = _ldpScale ldp
|
|
ygap = _ldpVerticalGap ldp
|
|
|
|
selSecSelCol :: Int -> Int -> IMSS a -> Maybe Color
|
|
selSecSelCol i j = (^? ix i . ssItems . ix j . siColor)
|