/
CharChart.hs
78 lines (64 loc) · 2.14 KB
/
CharChart.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
module GigglesIsYou.CharChart where
import Data.Char
import Data.Traversable
import Graphics.Gloss
import qualified Graphics.UI.GLUT.Fonts as GLUT
import GigglesIsYou.Pictures
import GigglesIsYou.Types
type CharChart = [(Char, PixelSize)]
fontHeight :: Float
fontHeight = 100
loadCharChart :: IO CharChart
loadCharChart = do
for [32..127] $ \i -> do
let c = chr i
let s = [c]
w <- GLUT.stringWidth GLUT.Roman s
pure (c, (fromIntegral w, fontHeight))
textPixelSize :: CharChart -> String -> PixelSize
textPixelSize _ []
= 0
textPixelSize charChart (c:s)
= let (charWidth, charHeight) = charPixelSize charChart c
(strWidth, strHeight) = textPixelSize charChart s
in (charWidth + strWidth, max charHeight strHeight)
charPixelSize :: CharChart -> Char -> PixelSize
charPixelSize charChart c = case lookup c charChart of
Nothing
-> error $ "you need to add " ++ show c ++ " to loadCharChart"
Just pixelSize
-> pixelSize
centeredText :: CharChart -> String -> Picture
centeredText charChart s
= translate2D (negate (textPixelSize charChart s / 2))
$ text s
-- Takes a word with newlines in it, e.g. "BA\nBA", "BOX", or "GIG\nGLES", and
-- draws it over multiple lines so it fits snuggly inside the given box.
boxedText :: CharChart -> String -> PixelSize -> Picture
boxedText charChart multilineString boxSize
= boxed (totalWidth, totalHeight) boxSize
$ translate2D (recenter (0, fontHeight) (0, totalHeight))
$ mconcat
$ [ translate2D (fromIntegral y * (0, negate lineHeight))
(centeredText charChart str)
| (y, str) <- zip [(0::Int)..] strs
]
where
strs :: [String]
strs = lines multilineString
gapBetweenLines :: Float
gapBetweenLines = 50
lineHeight :: Float
lineHeight = fontHeight + gapBetweenLines
totalHeight :: Float
totalHeight = fontHeight * fromIntegral (length strs)
+ gapBetweenLines * fromIntegral (length strs - 1)
totalWidth :: Float
totalWidth
| null strs
= 1
| otherwise
= maximum [ w
| s <- strs
, let (w, _h) = textPixelSize charChart s
]