~alcinnz/Typograffiti

ref: c33b23ec7794caa5cf571dd58e9ebc26f5b51231 Typograffiti/app/Main.hs -rw-r--r-- 2.4 KiB
c33b23ec — Adrian Cochrane Implement script for rendering pre-shaped text. 1 year, 7 months ago
                                                                                
9ed93aa2 Adrian Cochrane
f793b68c Adrian Cochrane
9ed93aa2 Adrian Cochrane
831fe433 Adrian Cochrane
d85314ac Adrian Cochrane
831fe433 Adrian Cochrane
d85314ac Adrian Cochrane
831fe433 Adrian Cochrane
f793b68c Adrian Cochrane
831fe433 Adrian Cochrane
f793b68c Adrian Cochrane
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
{-# 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"
    args <- getArgs
    let text = pack $ case args of
          [] -> unlines [
            "Decoder Ring Theatre brings you the continuing adventures",
            "of Canada's greatest superhero, that scourge of the underworld,",
            "hunter of those who pray upon the innocent,",
            "that marvelous masked mystery man",
            "known only as The Red Panda!",
            "",
            "The Red Panda, masked crucader for justice, hides his secret identity",
            "as one of the city's wealthiest men in his neverending battle",
            "against crime & corruption. Only his trusty driver, Kit Baxter",
            "who joins him in the guise of The Flying Squirrel,",
            "knows who wears the mask of The Red Panda!"]
          _ -> unwords args
    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)

            liftIO $ arDraw drawText' [
                TextTransformSpatial $ SpatialTransformTranslate $ fromIntegral 10
              ] (fromIntegral <$> sz)

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