loop/src/Dodge/Render/List.hs

module Dodge.Render.List (
    renderListAt,
    listCursorNSW,
    listPicturesAt,
    drawSelectionList,
    listPicturesAtScaleOff,
    listTextPictureAtScale,
    selSecDrawCursor,
    dShadCol,
    listPicturesAtOff,
    stackPicturesAt,
) where

import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.SelectionList
import Dodge.SelectionSections
import Geometry
import LensHelp
import ListHelp
import Picture

drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionList ldps cfig sl =
    listPicturesAtScaleOff
        (_ldpVerticalGap ldps)
        (_ldpScale ldps)
        (_ldpPosX ldps)
        (_ldpPosY ldps)
        cfig
        0 --(_slOffset sl)
        (makeSelectionListPictures sl)
        <> drawSelectionCursor ldps cfig sl

makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures sl = concatMap f $ getShownItems sl
  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
    i <- mi
    selit <- lis !? i
    f <- case _ldpCursorType ldps of
        BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
        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)
  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)
  where
    -- the following is quite hacky
    f = case sl ^. slRegex of
        _ | sl ^. slRegexInput -> const (Just 0)
        "" | 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 ..]

listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Configuration -> Int -> [Picture] -> Picture
listPicturesAtScaleOff ygap s tx ty cfig i =
    mconcat
        . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..]

stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0

stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i, i -1 ..]

selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
selSecDrawCursor xsize borders cfig 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)

listCursorDisplayParams ::
    ListDisplayParams ->
    [CardinalPoint] ->
    Configuration ->
    Int ->
    Int ->
    Color ->
    Int ->
    Int ->
    Picture
listCursorDisplayParams ldp borders =
    listCursorChooseBorderScale ygap s borders xoff yoff
  where
    ygap = _ldpVerticalGap ldp
    s = _ldpScale ldp
    xoff = _ldpPosX ldp
    yoff = _ldpPosY ldp

-- 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 ->
    [CardinalPoint] ->
    Float ->
    Float ->
    Configuration ->
    Int ->
    Int ->
    Color ->
    Int ->
    Int ->
    Picture
listCursorChooseBorderScale ygap s borders xoff yoff cfig 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)))
        . color col
        $ chooseCursorBorders (s * wth) (s * hgt) borders
  where
    x = 9
    wth = x * fromIntegral cursxsize + 10
    hgt = 20 * fromIntegral cursysize -- TODO this should be changed!

-- displays a cursor that should match up to list text pictures
listCursorChooseBorder ::
    [CardinalPoint] -> Float -> Float -> Configuration -> 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)
  where
    toLine North = [V2 0 h, V2 w h]
    toLine East = [V2 w h, V2 w 0]
    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 = listCursorChooseBorder [North, South, West]

--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

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)))
        . 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)

--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