diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple (defaultMain) + +main :: IO () +main = defaultMain diff --git a/font-opengl-basic4x6.cabal b/font-opengl-basic4x6.cabal new file mode 100644 --- /dev/null +++ b/font-opengl-basic4x6.cabal @@ -0,0 +1,61 @@ +name: font-opengl-basic4x6 +version: 0.0.1 +category: Graphics +synopsis: Basic4x6 font for OpenGL +description: Basic4x6 font for OpenGL containing digits and symbols. It is + called \"4x6\" because it was drawn in 4x6 grids on graph paper. + . + This library might not be a good idea, but I needed to display + some simple values and didn't want to introduce any heavy + dependencies. + . + Run executable 'show-font-basic4x6' for a demo. + +author: Brian Lewis +maintainer: Brian Lewis +license: PublicDomain + +-- -- -- -- -- -- -- -- -- -- + +cabal-version: >= 1.6 +build-type: Custom + +-- -- -- -- -- -- -- -- -- -- + +library + exposed-modules: + Graphics.Fonts.OpenGL.Basic4x6 + + build-depends: + OpenGL == 2.4.*, + base == 4.* + + ghc-options: -Wall -O2 + if impl(ghc >= 6.8) + ghc-options: -fwarn-tabs + + hs-source-dirs: + src + +-- -- -- -- -- -- -- -- -- -- + +executable show-font-basic4x6 + main-is: Main.hs + + build-depends: + GLFW-b == 0.*, + OpenGL == 2.4.*, + base == 4.* + + ghc-options: -Wall -O2 + if impl(ghc >= 6.8) + ghc-options: -fwarn-tabs + + hs-source-dirs: + src + +-- -- -- -- -- -- -- -- -- -- + +source-repository head + type: git + location: git://github.com/bsl/font-opengl-basic4x6.git diff --git a/src/Graphics/Fonts/OpenGL/Basic4x6.hs b/src/Graphics/Fonts/OpenGL/Basic4x6.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Fonts/OpenGL/Basic4x6.hs @@ -0,0 +1,178 @@ +module Graphics.Fonts.OpenGL.Basic4x6 + ( -- * Digits + digit0, digit1, digit2, digit3, digit4, digit5, digit6, digit7, digit8, digit9 + -- * Symbols + , exclamation, percent, plus, minus, period, slash, colon, lessThan, equal, greaterThan + ) + where + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +import qualified Graphics.Rendering.OpenGL as GL + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +digit0 :: IO () +digit0 = + renderQuads + [ (-2,3), (-2,-3), (-1,-3), (-1,3) + , (-1,3), (-1,2), (1,2), (1,3) + , (-1,-2), (-1,-3), (1,-3), (1,-2) + , (1,3), (1,-3), (2,-3), (2,3) + ] + +digit1 :: IO () +digit1 = + renderQuads + [ (-0.5,3), (-0.5,-3), (0.5,-3), (0.5,3) + ] + +digit2 :: IO () +digit2 = + renderQuads + [ (-2,3), (-2,2), (1,2), (1,3) + , (1,3), (1,-1), (2,-1), (2,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (-2,0), (-2,-3), (-1,-3), (-1,0) + , (-1,-2), (-1,-3), (2,-3), (2,-2) + ] + +digit3 :: IO () +digit3 = + renderQuads + [ (-2,3), (-2,2), (1,2), (1,3) + , (1,3), (1,-3), (2,-3), (2,3) + , (-2,0), (-2,-1), (1,-1), (1,0) + , (-2,-2), (-2,-3), (1,-3), (1,-2) + ] + +digit4 :: IO () +digit4 = + renderQuads + [ (-2,3), (-2,-1), (-1,-1), (-1,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (1,3), (1,-3), (2,-3), (2,3) + ] + +digit5 :: IO () +digit5 = + renderQuads + [ (-1,3), (-1,2), (2,2), (2,3) + , (-2,3), (-2,-1), (-1,-1), (-1,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (1,0), (1,-3), (2,-3), (2,0) + , (-2,-2), (-2,-3), (1,-3), (1,-2) + ] + +digit6 :: IO () +digit6 = + renderQuads + [ (-1,3), (-1,2), (2,2), (2,3) + , (-2,3), (-2,-3), (-1,-3), (-1,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (-1,-2), (-1,-3), (1,-3), (1,-2) + , (1,0), (1,-3), (2,-3), (2,0) + ] + +digit7 :: IO () +digit7 = + renderQuads + [ (-2,3), (-2,2), (1,2), (1,3) + , (1,3), (1,-3), (2,-3), (2,3) + ] + +digit8 :: IO () +digit8 = + renderQuads + [ (-2,3), (-2,-3), (-1,-3), (-1,3) + , (-1,3), (-1,2), (1,2), (1,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (-1,-2), (-1,-3), (1,-3), (1,-2) + , (1,3), (1,-3), (2,-3), (2,3) + ] + +digit9 :: IO () +digit9 = + renderQuads + [ (-2,3), (-2,-1), (-1,-1), (-1,3) + , (-1,3), (-1,2), (1,2), (1,3) + , (-1,0), (-1,-1), (1,-1), (1,0) + , (1,3), (1,-3), (2,-3), (2,3) + ] + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +exclamation :: IO () +exclamation = + renderQuads + [ (-0.5,3), (-0.5,-1), (0.5,-1), (0.5,3) + , (-0.5,-2), (-0.5,-3), (0.5,-3), (0.5,-2) + ] + +percent :: IO () +percent = + renderQuads + [ (1,3), (-2,-3), (-1,-3), (2,3) + , (-2,3), (-2,2), (-1,2), (-1,3) + , (1,-2), (1,-3), (2,-3), (2,-2) + ] + +plus :: IO () +plus = + renderQuads + [ (-2,0.5), (-2,-0.5), (-0.5,-0.5), (-0.5,0.5) + , (-0.5,2), (-0.5,-2), (0.5,-2), (0.5,2) + , (0.5,0.5), (0.5,-0.5), (2,-0.5), (2,0.5) + ] + +minus :: IO () +minus = + renderQuads + [ (-2,0.5), (-2,-0.5), (2,-0.5), (2,0.5) + ] + +period :: IO () +period = + renderQuads + [ (-0.5,-2), (-0.5,-3), (0.5,-3), (0.5,-2) + ] + +slash :: IO () +slash = + renderQuads + [ (1,3), (-2,-3), (-1,-3), (2,3) + ] + +colon :: IO () +colon = + renderQuads + [ (-0.5,1.5), (-0.5,0.5), (0.5,0.5), (0.5,1.5) + , (-0.5,-0.5), (-0.5,-1.5), (0.5,-1.5), (0.5,-0.5) + ] + +lessThan :: IO () +lessThan = + renderQuads + [ (1,3), (-2,0), (-1,0), (2,3) + , (-2,0), (1,-3), (2,-3), (-1,0) + ] + +equal :: IO () +equal = + renderQuads + [ (-2,1.5), (-2,0.5), (2,0.5), (2,1.5) + , (-2,-0.5), (-2,-1.5), (2,-1.5), (2,-0.5) + ] + +greaterThan :: IO () +greaterThan = + renderQuads + [ (-2,3), (1,0), (2,0), (-1,3) + , (1,0), (-2,-3), (-1,-3), (2,0) + ] + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +renderQuads :: [(GL.GLfloat, GL.GLfloat)] -> IO () +renderQuads = + GL.renderPrimitive GL.Quads . mapM_ (\(x, y) -> GL.vertex (GL.Vertex2 x y)) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,107 @@ +module Main (main) where + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +import Control.Exception (finally) +import Control.Monad (liftM2, unless, when) + +import Graphics.Rendering.OpenGL (($=)) + +import qualified Graphics.Rendering.OpenGL as GL +import qualified Graphics.UI.GLFW as GLFW + +import Graphics.Fonts.OpenGL.Basic4x6 + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +main :: IO () +main = withGraphics showFont + +showFont :: IO () +showFont = do + GLFW.resetTime + + quitting <- liftM2 (||) (GLFW.keyIsPressed GLFW.KeyEsc) + (GLFW.keyIsPressed (GLFW.CharKey 'Q')) + + GL.clear [GL.ColorBuffer] + GL.color (GL.Color4 p1 p1 p1 p1) + + -- display digits + GL.loadIdentity + GL.ortho2D n50 p50 n50 p50 + + GL.translate (GL.Vector3 (n50 + 4) (p50 - 4) 0) + mapM_ + (>> GL.translate (GL.Vector3 p6 0 0)) + [digit0, digit1, digit2, digit3, digit4, digit5, digit6, digit7, digit8, digit9] + + -- display symbols + GL.loadIdentity + GL.ortho2D n50 p50 n50 p50 + + GL.translate (GL.Vector3 (n50 + 4) (p50 - 12) 0) + mapM_ + (>> GL.translate (GL.Vector3 p6 0 0)) + [exclamation, percent, plus, minus, period, slash, colon, lessThan, equal, greaterThan] + + -- display "2+2=4" + GL.loadIdentity + GL.ortho2D n100 p100 n100 p100 + + GL.translate (GL.Vector3 (n100 + 6) (p100 - 50) 0) + mapM_ + (>> GL.translate (GL.Vector3 p6 0 0)) + [digit2, plus, digit2, equal, digit4] + + -- display "97.3%" + GL.loadIdentity + GL.ortho2D n100 p100 n100 p100 + + GL.translate (GL.Vector3 (n100 + 6) (p100 - 60) 0) + mapM_ + (>> GL.translate (GL.Vector3 p6 0 0)) + [digit9, digit7, period, digit3, percent] + + GLFW.swapBuffers + + t <- fmap (secondsPerFrame -) GLFW.getTime + when (t > 0) (GLFW.sleep t) + + unless quitting showFont + where + secondsPerFrame = recip (fromIntegral framesPerSecond) + framesPerSecond = 30 :: Integer + + p1 = 1 :: GL.GLdouble + p6 = 6 :: GL.GLdouble + p50 = 50 :: GL.GLdouble + p100 = 100 :: GL.GLdouble + n50 = negate p50 + n100 = negate p100 + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +withGraphics :: IO a -> IO a +withGraphics action = + (startGraphics >> action) `finally` stopGraphics + +startGraphics :: IO () +startGraphics = do + GLFW.initialize + GLFW.openWindow GLFW.defaultDisplayOptions + { GLFW.displayOptions_width = 600 + , GLFW.displayOptions_height = 600 + , GLFW.displayOptions_numRedBits = 5 + , GLFW.displayOptions_numGreenBits = 5 + , GLFW.displayOptions_numBlueBits = 5 + , GLFW.displayOptions_numFsaaSamples = Just 4 + } + GL.blend $= GL.Enabled + GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) + GL.multisample $= GL.Enabled + +stopGraphics :: IO () +stopGraphics = do + GLFW.closeWindow + GLFW.terminate