~alcinnz/Typograffiti

ref: 611a9b485d62d4f54f9e2a02d12c59c3928d2bc0 Typograffiti/app/Main.hs -rw-r--r-- 1.8 KiB
611a9b48 — Adrian Cochrane Expose highlevel API for italic & bold text. 2 years ago
                                                                                
1a43ae6f Schell Scivally
45905aa7 Schell Scivally
a77f277c Schell Scivally
45905aa7 Schell Scivally
a77f277c Schell Scivally
132be4fb Schell Scivally
45905aa7 Schell Scivally
132be4fb Schell Scivally
a77f277c Schell Scivally
45905aa7 Schell Scivally
e75651a8 Adrian Cochrane
45905aa7 Schell Scivally
1a43ae6f Schell Scivally
a77f277c Schell Scivally
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