graphics-drawingcombinators-1.4.4: example.hs

import Control.Monad
import Data.IORef
import Data.Monoid
import Graphics.DrawingCombinators ((%%))
import qualified Graphics.DrawingCombinators as Draw
import qualified Graphics.UI.GLFW as GLFW

import System.Environment(getArgs)

resX, resY :: Int
resX = 640
resY = 480

initScreen :: IO ()
initScreen = do
  True <- GLFW.initialize
  True <- GLFW.openWindow GLFW.defaultDisplayOptions {
    GLFW.displayOptions_width = resX,
    GLFW.displayOptions_height = resY
    }

  return ()

unitText :: Draw.Font -> String -> Draw.Image Any
unitText font str = (Draw.translate (-1,0) %% Draw.scale (2/w) (2/w) %% Draw.text font str)
                        `mappend`
                    Draw.tint (Draw.Color 1 0 0 1) (Draw.line (-1,0) (1,0))
    where
    w = Draw.textWidth font str

quadrants :: (Monoid a) => Draw.Image a -> Draw.Image a
quadrants img = mconcat [
    (Draw.translate (-0.5,0.5) %%),
    (Draw.translate (0.5,0.5)   `Draw.compose` Draw.rotate (-pi/2) %%),
    (Draw.translate (0.5,-0.5)  `Draw.compose` Draw.rotate pi %%),
    (Draw.translate (-0.5,-0.5) `Draw.compose` Draw.rotate (pi/2) %%)] (Draw.scale 0.5 0.5 %% img)

circleText :: Draw.Font -> String -> Draw.Image Any
circleText font str = unitText font str `mappend` Draw.tint (Draw.Color 0 0 1 0.5) Draw.circle

main :: IO ()
main = do
    initScreen
    args <- getArgs
    font <- case args of
        [fontName] -> do
            font <- Draw.openFont fontName
            return font
        _ -> error "Usage: drawingcombinators-example some_font.ttf"


    doneRef <- newIORef False
    GLFW.setWindowCloseCallback $ do
      writeIORef doneRef True
      return True
    waitClose doneRef $ quadrants (circleText font "Hello, World!")
    GLFW.terminate
    return ()
    where

    waitClose doneRef image = do
      isDone <- readIORef doneRef
      unless isDone $ do
        Draw.clearRender image
        GLFW.swapBuffers
        GLFW.pollEvents
        waitClose doneRef $ Draw.rotate (-0.01) %% image