Work on inventory ui
This commit is contained in:
+51
-68
@@ -1,6 +1,5 @@
|
||||
module Dodge.Render.List (
|
||||
renderListAt,
|
||||
listCursorNSW,
|
||||
drawList,
|
||||
drawSelectionList,
|
||||
listPicturesYgapScaleYoff,
|
||||
@@ -10,15 +9,15 @@ module Dodge.Render.List (
|
||||
drawListYoff,
|
||||
stackPicturesAt,
|
||||
toTopLeft,
|
||||
listCursorChooseBorderScale ,
|
||||
listCursorChooseBorderScale,
|
||||
) where
|
||||
|
||||
import Dodge.ScreenPos
|
||||
import Data.Maybe
|
||||
import Dodge.Base.Window
|
||||
import Dodge.Data.CardinalPoint
|
||||
import Dodge.Data.Config
|
||||
import Dodge.Data.SelectionList
|
||||
import Dodge.ScreenPos
|
||||
import Dodge.SelectionList
|
||||
import Dodge.SelectionSections
|
||||
import Geometry
|
||||
@@ -30,39 +29,13 @@ drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Pi
|
||||
drawSelectionList ldps cfig sl =
|
||||
translateScreenPos
|
||||
cfig
|
||||
(ldps ^. ldpPos) $
|
||||
listPicturesYgapScaleYoff
|
||||
(_ldpVerticalGap ldps)
|
||||
(_ldpScale ldps)
|
||||
0
|
||||
(makeSelectionListPictures sl)
|
||||
<> drawSelectionCursor sl ldps
|
||||
|
||||
makeSelectionListPictures :: SelectionList a -> [Picture]
|
||||
makeSelectionListPictures = concatMap f . getShownItems
|
||||
where
|
||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
||||
|
||||
drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
|
||||
drawCursorAt mi lis ldps = fromMaybe mempty $ do
|
||||
i <- mi
|
||||
selit <- lis !? i
|
||||
let j = sum . map _siHeight $ take i lis
|
||||
col = _siColor selit
|
||||
return $
|
||||
listCursorChooseBorderScale
|
||||
(ldps ^. ldpPos)
|
||||
$ listPicturesYgapScaleYoff
|
||||
(_ldpVerticalGap ldps)
|
||||
(_ldpScale ldps)
|
||||
(ldps ^. ldpCursorSides)
|
||||
j
|
||||
(_siOffX selit)
|
||||
col
|
||||
wdth
|
||||
(_siHeight selit)
|
||||
where
|
||||
wdth = case _ldpWidth ldps of
|
||||
FixedSelectionWidth x -> x
|
||||
_ -> 1
|
||||
0
|
||||
(makeSelectionListPictures sl)
|
||||
<> drawSelectionCursor sl ldps
|
||||
|
||||
drawSelectionCursor :: SelectionList a -> ListDisplayParams -> Picture
|
||||
drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
|
||||
@@ -73,43 +46,61 @@ drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
|
||||
"" | not (sl ^. slRegexInput) -> id
|
||||
_ -> fmap (+ 1)
|
||||
|
||||
makeSelectionListPictures :: SelectionList a -> [Picture]
|
||||
makeSelectionListPictures = concatMap f . getShownItems
|
||||
where
|
||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
||||
|
||||
drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
|
||||
drawCursorAt mi lis ldps = fromMaybe mempty $ do
|
||||
i <- mi
|
||||
selit <- lis !? i
|
||||
return $
|
||||
listCursorChooseBorderScale
|
||||
(_ldpVerticalGap ldps)
|
||||
(_ldpScale ldps)
|
||||
(ldps ^. ldpCursorSides)
|
||||
(sum . map _siHeight $ take i lis)
|
||||
(_siOffX selit)
|
||||
(_siColor selit)
|
||||
(getLDPWidth ldps)
|
||||
(_siHeight selit)
|
||||
|
||||
getLDPWidth :: ListDisplayParams -> Int
|
||||
getLDPWidth ldps = case _ldpWidth ldps of
|
||||
FixedSelectionWidth x -> x
|
||||
_ -> 1
|
||||
|
||||
drawListYoff :: Int -> [Picture] -> Picture
|
||||
drawListYoff = listPicturesYgapScaleYoff 0 1
|
||||
|
||||
listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
|
||||
listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s) [i ..]
|
||||
listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
|
||||
|
||||
stackPicturesAt :: [Picture] -> Picture
|
||||
stackPicturesAt = stackPicturesAtOff 0
|
||||
|
||||
stackPicturesAtOff :: Int -> [Picture] -> Picture
|
||||
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..]
|
||||
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
|
||||
|
||||
selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
|
||||
selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
|
||||
yint <- selSecSelPos i j sss
|
||||
selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
|
||||
selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
|
||||
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
yint <- selSecYint i j sss
|
||||
xint <- sss ^? sssSections . ix i . ssIndent
|
||||
si <- sss ^? sssSections . ix i . ssItems . ix j
|
||||
return $ listCursorDisplayParams ldp borders yint xint (_siColor si) xsize (length $ _siPictures si)
|
||||
|
||||
listCursorDisplayParams ::
|
||||
ListDisplayParams ->
|
||||
[CardinalPoint] ->
|
||||
Int ->
|
||||
Int ->
|
||||
Color ->
|
||||
Int ->
|
||||
Int ->
|
||||
Picture
|
||||
listCursorDisplayParams ldp borders a b c d =
|
||||
listCursorChooseBorderScale ygap s borders a b c d
|
||||
where
|
||||
ygap = _ldpVerticalGap ldp
|
||||
s = _ldpScale ldp
|
||||
return $
|
||||
listCursorChooseBorderScale
|
||||
(ldp ^. ldpVerticalGap)
|
||||
(ldp ^. ldpScale)
|
||||
(ldp ^. ldpCursorSides)
|
||||
yint
|
||||
xint
|
||||
(_siColor si)
|
||||
xsize
|
||||
(length $ _siPictures si)
|
||||
|
||||
-- displays a cursor that should match up to list text pictures
|
||||
-- the width of a character appears to be 9(?!)
|
||||
-- this is probably because it is 8 pixels plus one for the border
|
||||
listCursorChooseBorderScale ::
|
||||
Float ->
|
||||
Float ->
|
||||
@@ -130,11 +121,6 @@ listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
|
||||
wth = 10 * (fromIntegral cursxsize + 1)
|
||||
hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1)
|
||||
|
||||
-- displays a cursor that should match up to list text pictures
|
||||
listCursorChooseBorder ::
|
||||
[CardinalPoint] -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorChooseBorder = listCursorChooseBorderScale 10 1
|
||||
|
||||
-- note we cannot simply scale lines because they are drawn as solid rectangles
|
||||
chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
|
||||
chooseCursorBorders w h = foldMap (line . toLine)
|
||||
@@ -145,9 +131,6 @@ chooseCursorBorders w h = foldMap (line . toLine)
|
||||
toLine South = [V2 w h', V2 0 h']
|
||||
toLine West = [V2 0 h', V2 0 0]
|
||||
|
||||
listCursorNSW :: Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d
|
||||
|
||||
--fillScreenText :: Configuration -> String -> Picture
|
||||
--fillScreenText cfig str =
|
||||
-- scale wscale hscale
|
||||
@@ -168,9 +151,9 @@ listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d
|
||||
-- thescale = hw * 0.02 / fromIntegral (length str)
|
||||
-- hw = halfWidth cfig
|
||||
|
||||
drawListElement :: Float -> Float -> Int -> Picture -> Picture
|
||||
drawListElement ygap s yint =
|
||||
translate 0 (negate ((s * 20 + ygap) * (fromIntegral yint + 1)))
|
||||
drawListElement :: Float -> Float -> Int -> Int -> Picture -> Picture
|
||||
drawListElement ygap s xint yint =
|
||||
translate (s * 10 * fromIntegral xint) (negate ((s * 20 + ygap) * (fromIntegral yint + 1)))
|
||||
. scale (s * 0.1) (s * 0.1)
|
||||
|
||||
renderListAt :: Float -> Float -> [(String, Color)] -> Picture
|
||||
|
||||
Reference in New Issue
Block a user