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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
--------------------------------------------------------------------------------
-- |
-- 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 ( ord )
import Foreign.C.String ( CString, withCString )
import Foreign.C.Types ( CInt )
import Foreign.Ptr ( Ptr )
import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLfloat )
import Graphics.UI.GLUT.Extensions
#ifdef __HUGS__
{-# CFILES cbits/HsGLUT.c #-}
#endif
--------------------------------------------------------------------------------
#include "HsGLUTExt.h"
--------------------------------------------------------------------------------
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 ()
foreign import ccall unsafe "hs_GLUT_marshalBitmapFont"
hs_GLUT_marshalBitmapFont :: CInt -> IO GLUTbitmapFont
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 ()
foreign import ccall unsafe "hs_GLUT_marshalStrokeFont"
hs_GLUT_marshalStrokeFont :: CInt -> IO GLUTstrokeFont
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
foreign import CALLCONV "glutBitmapCharacter" glutBitmapCharacter ::
GLUTbitmapFont -> CInt -> IO ()
--------------------------------------------------------------------------------
strokeString :: StrokeFont -> String -> IO ()
strokeString f s = do
i <- marhshalStrokeFont f
mapM_ (\c -> withChar c (glutStrokeCharacter i)) s
foreign import CALLCONV unsafe "glutStrokeCharacter"
glutStrokeCharacter :: GLUTstrokeFont -> CInt -> IO ()
--------------------------------------------------------------------------------
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)
foreign import CALLCONV unsafe "glutBitmapLength"
glutBitmapLength :: GLUTbitmapFont -> CString -> IO CInt
--------------------------------------------------------------------------------
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)
foreign import CALLCONV unsafe "glutStrokeLength"
glutStrokeLength :: GLUTstrokeFont -> CString -> IO CInt
--------------------------------------------------------------------------------
bitmapHeight :: BitmapFont -- ^ Bitmap font to use.
-> IO GLfloat -- ^ Height in pixels.
bitmapHeight f = fmap fromIntegral $ glutBitmapHeight =<< marhshalBitmapFont f
EXTENSION_ENTRY(unsafe,"freeglut",glutBitmapHeight,GLUTbitmapFont -> IO CInt)
--------------------------------------------------------------------------------
strokeHeight :: StrokeFont -- ^ Stroke font to use.
-> IO GLfloat -- ^ Height in units.
strokeHeight f = glutStrokeHeight =<< marhshalStrokeFont f
EXTENSION_ENTRY(unsafe,"freeglut",glutStrokeHeight,GLUTstrokeFont -> IO GLfloat)
|
