loop/src/Dodge/Render/List.hs

module Dodge.Render.List where

import Data.Foldable
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Dodge.Base.WinScale
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Geometry
import ListHelp
import Picture
--import LensHelp

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 _siPictures $ _slItems sl
        --case sl ^. slSizeRestriction of
--    SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl
--    _ -> concatMap _siPictures $ _slItems sl

drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do
    i <- _slSelPos sl
    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 col wdth (_siHeight selit)
  where
    lis = _slItems sl
    wdth = case _ldpWidth ldps of
        FixedSelectionWidth x -> x
        _ -> 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 (listTextPictureAt 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 (listTextPictureAt tx ty cfig) [i, i -1 ..]

-- 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 ->
    Set CardinalPoint ->
    Float ->
    Float ->
    Configuration ->
    Int ->
    Color ->
    Int ->
    Int ->
    Picture
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cursysize =
    winScale cfig
        . translate
            (15 - (9 * s) + xoff - halfWidth cfig)
            (halfHeight cfig + negate (yoff - s * 12.5) - ((s * 10 + ygap) * (fromIntegral yint + 1)))
        . color col
        $ chooseCursorBorders (s * wth) (s * hgt) borders
  where
    x = 9
    wth = x * fromIntegral cursxsize + 9
    hgt = 20 * fromIntegral cursysize

-- 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
listCursorChooseBorder ::
    Set CardinalPoint -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize =
    winScale cfig
        . translate
            (6 + xoff - halfWidth cfig)
            (halfHeight cfig + 12.5 - (20 * fromIntegral yint + yoff + 20 + hgt))
        . color col
        $ chooseCursorBorders wth hgt borders
  where
    x = 9
    wth = x * fromIntegral cursxsize + 9
    hgt = 20 * fromIntegral cursysize

-- note we cannot simply scale lines because they are drawn as solid rectangles
chooseCursorBorders :: Float -> Float -> Set CardinalPoint -> Picture
chooseCursorBorders wth hgt = fold . Set.map (line . toLine)
  where
    top = 0
    bot = - hgt
    lef = 0
    toLine North = [V2 lef top, V2 wth top]
    toLine East = [V2 wth top, V2 wth bot]
    toLine South = [V2 wth bot, V2 lef bot]
    toLine West = [V2 lef bot, V2 lef top]

listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNS = listCursorChooseBorder (Set.fromList [North, South])

listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNES = listCursorChooseBorder (Set.fromList [North, South, East])

listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNESW = listCursorChooseBorder (Set.fromList [North, South, East, West])

listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder (Set.fromList [North, South, West])

fillScreenText :: Configuration -> String -> Picture
fillScreenText cfig str =
    winScale cfig
        . 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 =
    winScale cfig
        . scale thescale thescale
        . centerText
        $ str
  where
    thescale = hw * 0.02 / fromIntegral (length str)
    hw = halfWidth cfig

listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAt xoff yoff cfig yint =
    winScale cfig
        . translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
        . scale 0.1 0.1
  where
    hw = halfWidth cfig
    hh = halfHeight cfig

listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAtScale ygap s xoff yoff cfig yint =
    winScale cfig
        . translate (xoff + 15 - 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)

--    concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [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 =
    pictures
        [ color black $ translate 1.2 (-1.2) p
        , color c p
        ]