~alcinnz/Typograffiti

ref: modular Typograffiti/typograffiti-gl/app/Main.hs -rw-r--r-- 1.8 KiB
5e06835d — Adrian Cochrane Further explain dependencies (#9) 2 years ago
                                                                                
1a43ae6f Schell Scivally
45905aa7 Schell Scivally
a77f277c Schell Scivally
45905aa7 Schell Scivally
a77f277c Schell Scivally
132be4fb Schell Scivally
c8e0b8e4 Schell Carl Scivally
132be4fb Schell Scivally
a77f277c Schell Scivally
c8e0b8e4 Schell Carl Scivally
a77f277c Schell Scivally
c8e0b8e4 Schell Carl Scivally
a77f277c Schell Scivally
c8e0b8e4 Schell Carl Scivally
a77f277c Schell Scivally
c8e0b8e4 Schell Carl 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
71
72
{-# 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.GL


myTextStuff
  :: ( MonadIO m
     , MonadError String m
     )
  => Window -> m ()
myTextStuff w = do
  let ttfName = "assets" </> "Lora-Regular.ttf"
  store <- newDefaultFontStore (get $ windowSize w)
  RenderedGlyphs 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" :: String, 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]
    --draw [move 100 100, color 1 1 1 1, scale 2 2]
    draw [move 100 100]

    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