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
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Graphics.UI.GLUT
import Graphics.GL.Core32
import FreeType.Core.Base
import FreeType.FontConfig (instantiatePattern)
import Graphics.Text.Font.Choose as Font
import Typograffiti (makeDrawGlyphs)
import Data.Text.Glyphize
import Data.Text.Glyphize.Choose
import System.Environment (getArgs)
import System.Exit (exitFailure)
import Control.Monad.Except (runExceptT)
import Data.Maybe (fromMaybe)
main :: IO ()
main = do
(progName, args) <- getArgsAndInitialize
w <- createWindow progName
args <- getArgs
let query = nameParse $ case args of
[] -> "serif"
(q:_) -> q
let query' = defaultSubstitute $ configSubstitute' query MatchPattern
font <- case fontSort' query' False of
Just (f:_, _) -> return f
_ -> do
putStrLn ("Failed to locate font " ++ show query)
exitFailure
let buf = defaultBuffer { text = "sphinx of black quartz judge my vow" }
let glyphs = shape (pattern2hbfont font []) buf []
ft_With_FreeType $ \ft -> do
inst <- instantiatePattern ft font (fromMaybe 12 $ getValue' "size" font, 20)
res <- runExceptT $ do
-- render <- makeDrawGlyphs
allocAtlas ?? $ map (fst . codepoint) glyphs
return atlas
displayCallback $= do
clear [ ColorBuffer ]
flush
mainLoop