{-# 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