Work on rendering lists
This commit is contained in:
@@ -119,8 +119,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
curpos <- selSecSelPos i' j sss
|
||||
let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
|
||||
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
|
||||
let midtext str = listTextPictureAtScale 10 1 252 0 cfig curpos (text str)
|
||||
let extratext str = listTextPictureAtScale 10 1 432 0 cfig curpos (text (str ++ deactivatetext))
|
||||
return $
|
||||
listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
|
||||
<> case ae of
|
||||
@@ -241,8 +241,6 @@ drawCarte :: Configuration -> World -> Picture
|
||||
drawCarte cfig w =
|
||||
pictures $
|
||||
renderListAt 0 0 cfig locs :
|
||||
-- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
|
||||
-- ++
|
||||
mapOverlay w
|
||||
++ [mainListCursor white iPos cfig]
|
||||
where
|
||||
@@ -265,9 +263,8 @@ mapOverlay w =
|
||||
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
||||
[foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
|
||||
where
|
||||
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
||||
|
||||
lw = w ^. cWorld . lWorld
|
||||
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
||||
|
||||
drawMapWall :: HUD -> Wall -> Picture
|
||||
drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
|
||||
|
||||
+39
-57
@@ -1,16 +1,23 @@
|
||||
module Dodge.Render.List where
|
||||
module Dodge.Render.List (
|
||||
renderListAt,
|
||||
listCursorNSW,
|
||||
listPicturesAt,
|
||||
drawSelectionList,
|
||||
listPicturesAtScaleOff,
|
||||
listTextPictureAtScale,
|
||||
selSecDrawCursor,
|
||||
dShadCol,
|
||||
listPicturesAtOff,
|
||||
stackPicturesAt,
|
||||
) where
|
||||
|
||||
--import Picture.Text
|
||||
|
||||
--import Data.Foldable
|
||||
|
||||
import Dodge.SelectionSections
|
||||
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
|
||||
@@ -33,8 +40,6 @@ makeSelectionListPictures sl = concatMap f $ getShownItems sl
|
||||
where
|
||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
||||
|
||||
--f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
|
||||
|
||||
drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
|
||||
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
||||
i <- mi
|
||||
@@ -65,16 +70,18 @@ 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 ..]
|
||||
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 ..]
|
||||
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 ..]
|
||||
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
|
||||
@@ -120,7 +127,7 @@ listCursorChooseBorderScale ::
|
||||
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
|
||||
translate
|
||||
--(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
|
||||
(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
|
||||
@@ -130,8 +137,6 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz
|
||||
hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
|
||||
|
||||
-- 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 ::
|
||||
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorChooseBorder = listCursorChooseBorderScale 10 1
|
||||
@@ -145,49 +150,32 @@ chooseCursorBorders w h = foldMap (line . toLine)
|
||||
toLine South = [V2 w 0, V2 0 0]
|
||||
toLine West = [V2 0 0, V2 0 h]
|
||||
|
||||
listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNS = listCursorChooseBorder [North, South]
|
||||
|
||||
listCursorNES :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNES = listCursorChooseBorder [North, South, East]
|
||||
|
||||
listCursorNESW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNESW = listCursorChooseBorder [North, South, East, West]
|
||||
|
||||
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
|
||||
--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
|
||||
|
||||
listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
|
||||
listTextPictureAt xoff yoff cfig yint =
|
||||
translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
|
||||
. scale 0.1 0.1
|
||||
where
|
||||
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 + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
translate (xoff - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
|
||||
. scale (s * 0.1) (s * 0.1)
|
||||
where
|
||||
hw = halfWidth cfig
|
||||
@@ -196,15 +184,9 @@ listTextPictureAtScale ygap s xoff yoff cfig yint =
|
||||
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
|
||||
]
|
||||
dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
|
||||
|
||||
Reference in New Issue
Block a user