{-# LANGUAGE LambdaCase #-} module Dodge.Render.List ( renderListAt, drawList, drawSelectionList, drawSelectionListBackground, drawListYgapScaleYoff, drawListElement, selSecDrawCursor, dShadCol, drawListYoff, stackPicturesAt, toTopLeft, listCursorChooseBorderScale, selSecDrawCursorAt, drawTitleBackground, -- should be renamed, made sensible ) where import Dodge.ListDisplayParams import qualified Data.IntMap.Strict as IM import Data.Maybe import Dodge.Base.Window import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.ScreenPos import Dodge.SelectionSections import Geometry import LensHelp import ListHelp import Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = translateScreenPos cfig (ldps ^. ldpPos) $ drawListYgapScaleYoff (ldps ^. ldpVerticalGap) (ldps ^. ldpScale) 0 (makeSelectionListPictures sl) <> drawCursorAt (sl ^. slSelPos) (sl ^. slItems) ldps (BoundaryCursor [North, South]) drawTitleBackground :: Configuration -> Picture drawTitleBackground cfig = translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 75)) . polygon . reverse $ rectNSWE 70 0 0 560 drawSelectionListBackground :: ListDisplayParams -> Configuration -> Int -- list length -> Picture drawSelectionListBackground ldp cfig l = translateScreenPos cfig (ldp ^. ldpPos) . polygon . reverse $ rectNSWE 5 s (-5) e where s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)) e = 555 -- HACK isOverTerminalScreen makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures = concatMap f . _slItems where f si = map (color (_siColor si) . text) $ _siPictures si drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> CursorDisplay -> Picture drawCursorAt mi lis ldps curs = fromMaybe mempty $ do i <- mi selit <- lis !? i return $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) curs (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 = drawListYgapScaleYoff 0 1 drawListYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture drawListYgapScaleYoff 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 0) [i, i -1 ..] selSecDrawCursorAt :: Int -> ListDisplayParams -> CursorDisplay -> IM.IntMap (SelectionSection a) -> (Int, Int) -> Picture selSecDrawCursorAt xsize ldp curs sss (i, j) = fromMaybe mempty $ do yint <- selSecYint i j sss xint <- sss ^? ix i . ssIndent si <- sss ^? ix i . ssItems . ix j return $ listCursorChooseBorderScale (ldp ^. ldpVerticalGap) (ldp ^. ldpScale) curs yint (xint + _siOffX si) (_siColor si) xsize (_siHeight si) selSecDrawCursor :: Int -> ListDisplayParams -> CursorDisplay -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int) -> Picture selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs -- displays a cursor that should match up to list text pictures listCursorChooseBorderScale :: Float -> Float -> CursorDisplay -> Int -> Int -> Color -> Int -> Int -> Picture listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize = translate ((10 * fromIntegral xint - 5) * s) (- (ygap + (s * 20 + ygap) * fromIntegral yint)) . color col $ chooseCursorBorders (s * wth) (s * hgt) curs where wth = 10 * (fromIntegral cursxsize + 1) hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1) -- note we cannot simply scale lines because they are drawn as solid rectangles chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture chooseCursorBorders w h = \case BoundaryCursor ps -> foldMap (line . toLine) ps BackdropCursor -> polygon . reverse $ rectNSWE 0 h' 0 w where h' = negate h toLine North = [V2 0 0, V2 w 0] toLine East = [V2 w 0, V2 w h'] toLine South = [V2 w h', V2 0 h'] toLine West = [V2 0 h', V2 0 0] --fillScreenText :: Configuration -> String -> Picture --fillScreenText cfig str = -- scale wscale hscale -- . centerText -- $ str -- where -- wscale = hw * 0.02 / fromIntegral (length str) -- hscale = hh * 0.01 -- hw = halfWidth cfig -- hh = halfHeight cfig --fillWidthText :: Configuration -> String -> Picture --fillWidthText cfig str = -- scale thescale thescale -- . centerText -- $ str -- where -- thescale = hw * 0.02 / fromIntegral (length str) -- hw = halfWidth cfig 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 renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str) --inverseText :: String -> Color -> Picture --inverseText str col = -- translate3 (V3 0 0 (0.5)) -- (color (V4 0 1 0 0.1) ( text str)) -- <> -- translate3 (V3 0 0 (0.4)) -- (color col (polygon [0,V2 l 0, V2 l 200, V2 0 200])) -- where -- l = 100 * fromIntegral (length str) -- given a list of pictures that are each the size of a "text" call, displays them as -- a list on the screen drawList :: [Picture] -> Picture drawList = drawListYgapScaleYoff 0 1 0 --TODO put the following functions in an appropriate place -- | Colour picture and add black drop shadow. 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 (- halfWidth cfig) (halfHeight cfig)