1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
|
--------------------------------------------------------------------------------
-- |
-- Module : Graphics.UI.GLUT.Fonts
-- Copyright : (c) Sven Panne 2002-2005
-- License : BSD-style (see the file libraries/GLUT/LICENSE)
--
-- Maintainer : sven.panne@aedion.de
-- Stability : stable
-- Portability : portable
--
-- GLUT supports two types of font rendering: stroke fonts, meaning each
-- character is rendered as a set of line segments; and bitmap fonts, where each
-- character is a bitmap generated with
-- 'Graphics.Rendering.OpenGL.GL.Bitmaps.bitmap'. Stroke fonts have the
-- advantage that because they are geometry, they can be arbitrarily scale and
-- rendered. Bitmap fonts are less flexible since they are rendered as bitmaps
-- but are usually faster than stroke fonts.
--
--------------------------------------------------------------------------------
module Graphics.UI.GLUT.Fonts (
Font(..), BitmapFont(..), StrokeFont(..),
) where
import Data.Char
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import Graphics.Rendering.OpenGL ( GLint, GLfloat )
import Graphics.UI.GLUT.Raw
--------------------------------------------------------------------------------
class Font a where
-- | Render the string in the named font, without using any display lists.
-- Rendering a nonexistent character has no effect.
--
-- If the font is a bitmap font, 'renderString' automatically sets the OpenGL
-- unpack pixel storage modes it needs appropriately and saves and restores
-- the previous modes before returning. The generated call to
-- 'Graphics.Rendering.OpenGL.GL.bitmap' will adjust the current raster
-- position based on the width of the string.
-- If the font is a stroke font,
-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.translate' is used to translate
-- the current model view matrix to advance the width of the string.
renderString :: a -> String -> IO ()
-- | For a bitmap font, return the width in pixels of a string. For a stroke
-- font, return the width in units. While the width of characters in a font
-- may vary (though fixed width fonts do not vary), the maximum height
-- characteristics of a particular font are fixed.
stringWidth :: a -> String -> IO GLint
-- | (/freeglut only/) For a bitmap font, return the maximum height of the
-- characters in the given font measured in pixels. For a stroke font,
-- return the width in units.
fontHeight :: a -> IO GLfloat
instance Font BitmapFont where
renderString = bitmapString
stringWidth = bitmapLength
fontHeight = bitmapHeight
instance Font StrokeFont where
renderString = strokeString
stringWidth = strokeLength
fontHeight = strokeHeight
--------------------------------------------------------------------------------
-- | The bitmap fonts available in GLUT. The exact bitmap to be used is
-- defined by the standard X glyph bitmaps for the X font with the given name.
data BitmapFont
= Fixed8By13 -- ^ A fixed width font with every character fitting in an 8
-- by 13 pixel rectangle.
-- (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)
| Fixed9By15 -- ^ A fixed width font with every character fitting in an 9
-- by 15 pixel rectangle.
-- (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)
| TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.
-- (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)
| TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.
-- (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)
| Helvetica10 -- ^ A 10-point proportional spaced Helvetica font.
-- (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)
| Helvetica12 -- ^ A 12-point proportional spaced Helvetica font.
-- (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)
| Helvetica18 -- ^ A 18-point proportional spaced Helvetica font.
-- (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)
deriving ( Eq, Ord, Show )
-- Alas, fonts in GLUT are not denoted by some integral value, but by opaque
-- pointers on the C side. Even worse: For WinDoze, they are simply small ints,
-- casted to void*, for other platforms addresses of global variables are used.
-- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable
-- way is using integers on the Haskell side and doing the marshaling via some
-- small C wrappers around those macros. *sigh*
type GLUTbitmapFont = Ptr ()
marhshalBitmapFont :: BitmapFont -> IO GLUTbitmapFont
marhshalBitmapFont x = case x of
Fixed8By13 -> hs_GLUT_marshalBitmapFont 0
Fixed9By15 -> hs_GLUT_marshalBitmapFont 1
TimesRoman10 -> hs_GLUT_marshalBitmapFont 2
TimesRoman24 -> hs_GLUT_marshalBitmapFont 3
Helvetica10 -> hs_GLUT_marshalBitmapFont 4
Helvetica12 -> hs_GLUT_marshalBitmapFont 5
Helvetica18 -> hs_GLUT_marshalBitmapFont 6
--------------------------------------------------------------------------------
-- | The stroke fonts available in GLUT.
data StrokeFont
= Roman -- ^ A proportionally spaced Roman Simplex font for ASCII
-- characters 32 through 127. The maximum top character in the
-- font is 119.05 units; the bottom descends 33.33 units.
| MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as
-- 'Roman') for ASCII characters 32 through 127. The maximum
-- top character in the font is 119.05 units; the bottom
-- descends 33.33 units. Each character is 104.76 units wide.
deriving ( Eq, Ord, Show )
-- Same remarks as for GLUTbitmapFont
type GLUTstrokeFont = Ptr ()
marhshalStrokeFont :: StrokeFont -> IO GLUTstrokeFont
marhshalStrokeFont x = case x of
Roman -> hs_GLUT_marshalStrokeFont 0
MonoRoman -> hs_GLUT_marshalStrokeFont 1
--------------------------------------------------------------------------------
bitmapString :: BitmapFont -> String -> IO ()
bitmapString f s = do
i <- marhshalBitmapFont f
mapM_ (\c -> withChar c (glutBitmapCharacter i)) s
withChar :: Char -> (CInt -> IO a) -> IO a
withChar c f = f . fromIntegral . ord $ c
--------------------------------------------------------------------------------
strokeString :: StrokeFont -> String -> IO ()
strokeString f s = do
i <- marhshalStrokeFont f
mapM_ (\c -> withChar c (glutStrokeCharacter i)) s
--------------------------------------------------------------------------------
bitmapLength :: BitmapFont -- ^ Bitmap font to use.
-> String -- ^ String to return width of (not confined to 8
-- bits).
-> IO GLint -- ^ Width in pixels.
bitmapLength f s = do
i <- marhshalBitmapFont f
fmap fromIntegral $ withCString s (glutBitmapLength i . castPtr)
--------------------------------------------------------------------------------
strokeLength :: StrokeFont -- ^ Stroke font to use.
-> String -- ^ String to return width of (not confined to 8
-- bits).
-> IO GLint -- ^ Width in units.
strokeLength f s = do
i <- marhshalStrokeFont f
fmap fromIntegral $ withCString s (glutStrokeLength i . castPtr)
--------------------------------------------------------------------------------
bitmapHeight :: BitmapFont -- ^ Bitmap font to use.
-> IO GLfloat -- ^ Height in pixels.
bitmapHeight f = fmap fromIntegral $ glutBitmapHeight =<< marhshalBitmapFont f
--------------------------------------------------------------------------------
strokeHeight :: StrokeFont -- ^ Stroke font to use.
-> IO GLfloat -- ^ Height in units.
strokeHeight f = glutStrokeHeight =<< marhshalStrokeFont f
|