graphics-drawingcombinators-1.4.3: 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.Sprite -> Draw.Font -> String -> Draw.Image Any
circleText sprite font str = mconcat
  [ unitText font str
  , Draw.scale 0.5 0.5 %% Draw.sprite sprite
  , Draw.tint (Draw.Color 0 0 1 0.5) Draw.circle
  ]

main :: IO ()
main = do
    initScreen
    args <- getArgs
    (font, sprite) <-
      case args of
        [fontName, spriteName] -> do
          font <- Draw.openFont fontName
          sprite <- Draw.openSprite spriteName
          return (font, sprite)
        _ -> fail "Usage: drawingcombinators-example some_font.ttf some_image.[png|jpg|...]"

    doneRef <- newIORef False
    GLFW.setWindowCloseCallback $ do
      writeIORef doneRef True
      return True
    waitClose doneRef $ quadrants (circleText sprite 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