~alcinnz/Typograffiti

ref: 01bae44fab3fe1437d2a31b15dbb2c9a8885ffd8 Typograffiti/app/Main.hs -rw-r--r-- 1.8 KiB
01bae44f — Schell Carl Scivally Merge pull request #5 from schell/gitlab 5 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
132be4fb Schell Scivally
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
        , windowOpenGL      = Just openGL
        , windowResizable   = True
        }

  w <- createWindow "Typograffiti" wcfg
  _ <- glCreateContext w

  runExceptT (myTextStuff w)
    >>= either (fail . show) return