List rendering work
This commit is contained in:
+43
-40
@@ -9,6 +9,7 @@ module Dodge.Render.List (
|
||||
dShadCol,
|
||||
listPicturesAtOff,
|
||||
stackPicturesAt,
|
||||
toTopLeft,
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
@@ -25,23 +26,23 @@ import Picture
|
||||
|
||||
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
|
||||
drawSelectionList ldps cfig sl =
|
||||
listPicturesAtScaleOff
|
||||
toTopLeft cfig (listPicturesAtScaleOff
|
||||
(_ldpVerticalGap ldps)
|
||||
(_ldpScale ldps)
|
||||
(_ldpPosX ldps)
|
||||
(_ldpPosY ldps)
|
||||
cfig
|
||||
0 --(_slOffset sl)
|
||||
(makeSelectionListPictures sl)
|
||||
<> drawSelectionCursor ldps cfig sl
|
||||
<> drawSelectionCursor ldps sl
|
||||
)
|
||||
|
||||
makeSelectionListPictures :: SelectionList a -> [Picture]
|
||||
makeSelectionListPictures sl = concatMap f $ getShownItems sl
|
||||
makeSelectionListPictures = concatMap f . getShownItems
|
||||
where
|
||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
||||
|
||||
drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
|
||||
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
||||
drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture
|
||||
drawCursorAt ldps mi lis = fromMaybe mempty $ do
|
||||
i <- mi
|
||||
selit <- lis !? i
|
||||
f <- case _ldpCursorType ldps of
|
||||
@@ -49,14 +50,14 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
||||
NoCursor -> Nothing
|
||||
let j = sum . map _siHeight $ take i lis
|
||||
col = _siColor selit
|
||||
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
|
||||
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit)
|
||||
where
|
||||
wdth = case _ldpWidth ldps of
|
||||
FixedSelectionWidth x -> x
|
||||
_ -> 1
|
||||
|
||||
drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
|
||||
drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl)
|
||||
drawSelectionCursor :: ListDisplayParams -> SelectionList a -> Picture
|
||||
drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownItems sl)
|
||||
where
|
||||
-- the following is quite hacky
|
||||
f = case sl ^. slRegex of
|
||||
@@ -64,36 +65,31 @@ drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (
|
||||
"" | not (sl ^. slRegexInput) -> id
|
||||
_ -> fmap (+ 1)
|
||||
|
||||
-- given a list of pictures that are each the size of a "text" call, displays them as
|
||||
-- a list on the screen
|
||||
listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
|
||||
listPicturesAt tx ty cfig = listPicturesAtScaleOff 10 1 tx ty cfig 0
|
||||
|
||||
listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
|
||||
listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i ..]
|
||||
listPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture
|
||||
listPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i ..]
|
||||
|
||||
listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Configuration -> Int -> [Picture] -> Picture
|
||||
listPicturesAtScaleOff ygap s tx ty cfig i =
|
||||
listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Int -> [Picture] -> Picture
|
||||
listPicturesAtScaleOff ygap s tx ty i =
|
||||
mconcat
|
||||
. zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..]
|
||||
. zipWith (listTextPictureAtScale ygap s tx ty) [i ..]
|
||||
|
||||
stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
|
||||
stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
|
||||
stackPicturesAt :: Float -> Float -> [Picture] -> Picture
|
||||
stackPicturesAt tx ty = stackPicturesAtOff tx ty 0
|
||||
|
||||
stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
|
||||
stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i, i -1 ..]
|
||||
stackPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture
|
||||
stackPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i, i -1 ..]
|
||||
|
||||
selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
|
||||
selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do
|
||||
selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
|
||||
selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
|
||||
yint <- selSecSelPos i j sss
|
||||
xint <- sss ^? sssSections . ix i . ssIndent
|
||||
si <- sss ^? sssSections . ix i . ssItems . ix j
|
||||
return $ listCursorDisplayParams ldp borders cfig yint xint (_siColor si) xsize (length $ _siPictures si)
|
||||
return $ listCursorDisplayParams ldp borders yint xint (_siColor si) xsize (length $ _siPictures si)
|
||||
|
||||
listCursorDisplayParams ::
|
||||
ListDisplayParams ->
|
||||
[CardinalPoint] ->
|
||||
Configuration ->
|
||||
Int ->
|
||||
Int ->
|
||||
Color ->
|
||||
@@ -117,18 +113,17 @@ listCursorChooseBorderScale ::
|
||||
[CardinalPoint] ->
|
||||
Float ->
|
||||
Float ->
|
||||
Configuration ->
|
||||
Int ->
|
||||
Int ->
|
||||
Color ->
|
||||
Int ->
|
||||
Int ->
|
||||
Picture
|
||||
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
|
||||
listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize =
|
||||
translate
|
||||
--(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
|
||||
(xoff + (10 * s * (fromIntegral xint -1)) - halfWidth cfig)
|
||||
(halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
(xoff + (10 * s * (fromIntegral xint -1)))
|
||||
( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
. color col
|
||||
$ chooseCursorBorders (s * wth) (s * hgt) borders
|
||||
where
|
||||
@@ -138,7 +133,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz
|
||||
|
||||
-- displays a cursor that should match up to list text pictures
|
||||
listCursorChooseBorder ::
|
||||
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
[CardinalPoint] -> Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorChooseBorder = listCursorChooseBorderScale 10 1
|
||||
|
||||
-- note we cannot simply scale lines because they are drawn as solid rectangles
|
||||
@@ -150,7 +145,7 @@ chooseCursorBorders w h = foldMap (line . toLine)
|
||||
toLine South = [V2 w 0, V2 0 0]
|
||||
toLine West = [V2 0 0, V2 0 h]
|
||||
|
||||
listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNSW :: Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNSW = listCursorChooseBorder [North, South, West]
|
||||
|
||||
--fillScreenText :: Configuration -> String -> Picture
|
||||
@@ -173,16 +168,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
|
||||
-- thescale = hw * 0.02 / fromIntegral (length str)
|
||||
-- hw = halfWidth cfig
|
||||
|
||||
listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
|
||||
listTextPictureAtScale ygap s xoff yoff cfig yint =
|
||||
translate (xoff - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
listTextPictureAtScale :: Float -> Float -> Float -> Float -> Int -> Picture -> Picture
|
||||
listTextPictureAtScale ygap s xoff yoff yint =
|
||||
translate (xoff) (negate yoff - ((s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
. scale (s * 0.1) (s * 0.1)
|
||||
where
|
||||
hw = halfWidth cfig
|
||||
hh = halfHeight cfig
|
||||
|
||||
renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture
|
||||
renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str)
|
||||
renderListAt :: Float -> Float -> [(String, Color)] -> Picture
|
||||
renderListAt tx ty = listPicturesAt tx ty . map (\(str, col) -> color col $ text str)
|
||||
|
||||
-- given a list of pictures that are each the size of a "text" call, displays them as
|
||||
-- a list on the screen
|
||||
listPicturesAt :: Float -> Float -> [Picture] -> Picture
|
||||
listPicturesAt tx ty = listPicturesAtScaleOff 10 1 tx ty 0
|
||||
|
||||
--TODO put the following functions in an appropriate place
|
||||
|
||||
@@ -190,3 +187,9 @@ renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color
|
||||
dShadCol :: Color -> Picture -> Picture
|
||||
{-# INLINE dShadCol #-}
|
||||
dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
|
||||
|
||||
toTopLeft :: Configuration -> Picture -> Picture
|
||||
toTopLeft cfig = translate (-hw) (hh)
|
||||
where
|
||||
hw = halfWidth cfig
|
||||
hh = halfHeight cfig
|
||||
|
||||
Reference in New Issue
Block a user