~alcinnz/Typograffiti

ref: 6b33114535991e9cf0c71bfe32a0cf85a59e1bb1 Typograffiti/app/Main.hs -rw-r--r-- 1.7 KiB
6b331145 — Schell Scivally default alloc word function 6 years ago
                                                                                
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
71
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import           Control.Monad        (unless)
import           Control.Monad.Except (runExceptT)
import           Data.Function        (fix)
import           Graphics.GL
import           SDL                  hiding (rotate)
import           System.FilePath      ((</>))

import           Typograffiti


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
  let ttfName = "assets" </> "Lora-Regular.ttf"

  e <- runExceptT $ do
    -- Get the atlas
    atlas <- allocAtlas
      ttfName
      (GlyphSizeInPixels 16 16)
      asciiChars

    allocWord <- makeDefaultAllocateWord (get $ windowSize w)

    (draw, _, cache) <-
      loadText
        allocWord
        atlas
        mempty
        $ unlines
            [ "Hey there!"
            , "This is a test of the emergency word system."
            , "Quit at any time."
            ]

    -- Forever loop, drawing stuff
    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
    _ <- unloadMissingWords cache ""
    return ()
  either (fail . show) return e