Refactor, try to limit dependencies
This commit is contained in:
+46
-36
@@ -1,12 +1,12 @@
|
||||
module Dodge.Render.List where
|
||||
import Dodge.Data
|
||||
import Dodge.Base.Window
|
||||
import Dodge.Base.WinScale
|
||||
import Picture
|
||||
import Geometry
|
||||
--import Control.Monad
|
||||
import Data.Maybe
|
||||
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import Dodge.Base.WinScale
|
||||
import Dodge.Base.Window
|
||||
import Dodge.Data.Universe
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
-- given a list of pictures that are each the size of a "text" call, displays them as
|
||||
-- a list on the screen
|
||||
@@ -14,62 +14,72 @@ listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
|
||||
listPicturesAt tx ty cfig = listPicturesAtOff 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 (listTextPictureAt tx ty cfig) [i ..]
|
||||
|
||||
-- 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 :: [Bool] -> 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
|
||||
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
|
||||
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 -> [Bool] -> Picture
|
||||
chooseCursorBorders wth hgt = fold . catMaybes . zipWith f
|
||||
[ line [V2 0 hgt , V2 wth hgt ]
|
||||
, line [V2 wth hgt , V2 wth 0 ]
|
||||
, line [V2 wth 0 , V2 0 0 ]
|
||||
, line [V2 0 0 , V2 0 hgt ]
|
||||
]
|
||||
chooseCursorBorders wth hgt =
|
||||
fold . catMaybes
|
||||
. zipWith
|
||||
f
|
||||
[ line [V2 0 hgt, V2 wth hgt]
|
||||
, line [V2 wth hgt, V2 wth 0]
|
||||
, line [V2 wth 0, V2 0 0]
|
||||
, line [V2 0 0, V2 0 hgt]
|
||||
]
|
||||
where
|
||||
f _ False = Nothing
|
||||
f a True = Just a
|
||||
f a True = Just a
|
||||
|
||||
listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNS = listCursorChooseBorder [True,False,True]
|
||||
listCursorNS = listCursorChooseBorder [True, False, True]
|
||||
|
||||
listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNES = listCursorChooseBorder [True,True,True]
|
||||
listCursorNES = listCursorChooseBorder [True, True, True]
|
||||
|
||||
listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNESW = listCursorChooseBorder [True,True,True,True]
|
||||
listCursorNESW = listCursorChooseBorder [True, True, True, True]
|
||||
|
||||
listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNSW = listCursorChooseBorder [True,False,True,True]
|
||||
listCursorNSW = listCursorChooseBorder [True, False, True, True]
|
||||
|
||||
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
|
||||
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
|
||||
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)
|
||||
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. -}
|
||||
|
||||
-- | 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 =
|
||||
pictures
|
||||
[ color black $ translate 1.2 (-1.2) p
|
||||
, color c p
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user