~alcinnz/fontconfig-pure

ref: 196a28a861cb1c498e32724568504b7f38edb621 fontconfig-pure/fontconfig-harfbuzz/app/Main.hs -rw-r--r-- 1.4 KiB
196a28a8 — Adrian Cochrane Bugfixing regarding bridging over to Harfbuzz, exposing more FreeType info. 1 year, 10 months ago
                                                                                
8abf2980 Adrian Cochrane
196a28a8 Adrian Cochrane
8abf2980 Adrian Cochrane
196a28a8 Adrian Cochrane
8abf2980 Adrian Cochrane
196a28a8 Adrian Cochrane
8abf2980 Adrian Cochrane
196a28a8 Adrian Cochrane
8abf2980 Adrian Cochrane
196a28a8 Adrian Cochrane
8abf2980 Adrian Cochrane
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