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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
-- Note: this code uses the old, inherited from sdl1, surface-based
-- API for displaying on screen. It can't be used together with the new
-- renderer API. You should instead copy the surface to a texture ASAP
-- and then display the texture using the renderer in the usual
-- sdl2 way.
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (threadDelay)
import Control.Monad (forM_)
import Data.ByteString (readFile)
import Data.Text (Text, unpack)
import Data.Text.IO (putStrLn)
import Prelude hiding (putStrLn, readFile)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import qualified SDL
import qualified SDL.Font
red :: SDL.Font.Color
red = SDL.V4 255 0 0 0
gray :: SDL.Font.Color
gray = SDL.V4 128 128 128 255
-- A sequence of example actions to be perfomed and displayed.
examples :: [(Text, SDL.Window -> FilePath -> IO ())]
examples = [
("Blitting solid",
\window path -> do
font <- SDL.Font.load path 70
text <- SDL.Font.solid font red "Solid!"
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Blitting shaded",
\window path -> do
font <- SDL.Font.load path 70
text <- SDL.Font.shaded font red gray "Shaded!"
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Blitting blended",
\window path -> do
font <- SDL.Font.load path 70
text <- SDL.Font.blended font red "Blended!"
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Blitting styled",
\window path -> do
font <- SDL.Font.load path 65
let styles = [SDL.Font.Bold, SDL.Font.Underline, SDL.Font.Italic]
SDL.Font.setStyle font styles
print =<< SDL.Font.getStyle font
text <- SDL.Font.blended font red "Styled!"
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Blitting outlined",
\window path -> do
font <- SDL.Font.load path 65
SDL.Font.setOutline font 3
print =<< SDL.Font.getOutline font
text <- SDL.Font.blended font red "Outlined!"
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Decoding from bytestring",
\window path -> do
bytes <- readFile path
font <- SDL.Font.decode bytes 40
let chars = "Decoded~~~!"
putStrLn "How big will the surface be?"
print =<< SDL.Font.size font chars
text <- SDL.Font.blended font gray chars
putStrLn "Style and family names?"
print =<< SDL.Font.styleName font
print =<< SDL.Font.familyName font
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Render a single glyph",
\window path -> do
font <- SDL.Font.load path 100
text <- SDL.Font.blendedGlyph font red 'ŏ'
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window),
("Check existence of weird chars, blit them",
\window path -> do
font <- SDL.Font.load path 80
putStrLn " Glyphs provided or not:"
let chars = "☃Δ✭!"
exist <- mapM (SDL.Font.glyphProvided font) $ unpack chars
print $ zip (unpack chars) exist
putStrLn " Metrics:"
metrics <- mapM (SDL.Font.glyphMetrics font) $ unpack chars
print $ zip (unpack chars) metrics
text <- SDL.Font.blended font red chars
SDL.Font.free font
screen <- SDL.getWindowSurface window
SDL.surfaceBlit text Nothing screen Nothing
SDL.freeSurface text
SDL.updateWindowSurface window)
]
main :: IO ()
main = do
SDL.initialize [SDL.InitVideo]
SDL.Font.initialize
getArgs >>= \case
[] -> do
putStrLn "Usage: cabal run path/to/font.(ttf|fon)"
exitFailure
-- Run each of the examples within a newly-created window.
(path:_) ->
forM_ examples $ \(name, action) -> do
putStrLn name
window <- SDL.createWindow name SDL.defaultWindow
SDL.showWindow window
action window path
threadDelay 1000000
SDL.destroyWindow window
SDL.Font.quit
SDL.quit
|
