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