loop/src/Dodge/Render/List.hs

{-# 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)