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
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Monad (unless)
import Control.Monad.Except (runExceptT, MonadError)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Function (fix)
import Graphics.GL
import SDL hiding (rotate)
import System.FilePath ((</>))
import Typograffiti
myTextStuff
:: ( MonadIO m
, MonadError TypograffitiError m
)
=> Window -> m ()
myTextStuff w = do
let ttfName = "assets" </> "Lora-Regular.ttf"
store <- newDefaultFontStore (get $ windowSize w)
RenderedText draw size <-
getTextRendering
store
ttfName
(GlyphSizeInPixels 16 16)
$ unlines
[ "Hey there!"
, "This is a test of the emergency word system."
, "Quit at any time."
]
liftIO $ print ("text size", size)
fix $ \loop -> do
events <- fmap eventPayload
<$> pollEvents
glClearColor 0 0 0 1
glClear GL_COLOR_BUFFER_BIT
(V2 dw dh) <- glGetDrawableSize w
glViewport 0 0 (fromIntegral dw) (fromIntegral dh)
draw [move 20 32, rotate (pi / 4), color 1 0 1 1, alpha 0.5]
glSwapWindow w
unless (QuitEvent `elem` events) loop
main :: IO ()
main = do
SDL.initializeAll
let openGL = defaultOpenGL
{ glProfile = Core Debug 3 3 }
wcfg = defaultWindow
{ windowInitialSize = V2 640 480
, windowGraphicsContext = OpenGLContext openGL
, windowResizable = True
}
w <- createWindow "Typograffiti" wcfg
_ <- glCreateContext w
runExceptT (myTextStuff w)
>>= either (fail . show) return