~alcinnz/Typograffiti

ref: gitlab Typograffiti/app/Main.hs -rw-r--r-- 1.8 KiB
3e126a74 — Adrian Cochrane Merge pull request #15 from alcinnz/customized-fonts 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