~alcinnz/Typograffiti

ref: 3ed8e9c1e9f76b39e14b9be0c2f4d03a506f7a61 Typograffiti/app/Main.hs -rw-r--r-- 1.8 KiB
3ed8e9c1 — Adrian Cochrane Code cleanliness fixes, propagate exceptions, & add more spatial transforms. 1 year, 10 months 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
{-# LANGUAGE OverloadedStrings #-}
module Main where

import System.Environment (getArgs)
import Typograffiti (makeDrawText', GlyphSize(..), TextTransform(..), txt,
                     SampleText(..), defaultSample, AllocatedRendering(..),
                     SpatialTransform(..))
import Control.Monad.Except (liftEither, runExceptT)
import Control.Monad.IO.Class (MonadIO (..))
import SDL hiding (rotate)
import Graphics.GL.Core32

import Data.Function (fix)
import Data.Text.Lazy (pack)
import Control.Monad (unless)

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

    let ttfName = "assets/Lora-Regular.ttf"
    text <- pack <$> unwords <$> getArgs
    drawText <- makeDrawText' ttfName 0 (PixelSize 15 15) $ defaultSample { sampleText = text }
    runExceptT $ do
        drawText0 <- liftEither drawText
        drawText' <- drawText0 $ txt text

        fix $ \loop -> do
            events <- fmap eventPayload <$> pollEvents
            liftIO $ glClearColor 0 0 0 1
            liftIO $ glClear GL_COLOR_BUFFER_BIT

            sz@(V2 dw dh) <- liftIO $ glGetDrawableSize w
            liftIO $ glViewport 0 0 (fromIntegral dw) (fromIntegral dh)

            let offset = V2 0 $ fromIntegral dy
                V2 _ dy = arSize drawText'
            liftIO $ arDraw drawText' [
                TextTransformSpatial $ SpatialTransformTranslate $ fromIntegral dy
              ] (fromIntegral <$> sz)

            liftIO $ glSwapWindow w
            unless (QuitEvent `elem` events) loop
    return ()