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
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
program lesson43;
(*
* This code was created by Jeff Molofee '99
* (ported to Linux/SDL by Ti Leggett '01)
*
* If you've found this code useful, please let me know.
*
* Visit Jeff at http://nehe.gamedev.net/
*
* or for port-specific comments, questions, bugreports etc.
* email to leggett@eecs.tulane.edu
*)
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}
{$APPTYPE Console}
uses
moduleloader in '../../../JEDI-SDL/SDL/Pas/moduleloader.pas',
SDL in '../../../JEDI-SDL/SDL/Pas/sdl.pas',
gl in '../../../JEDI-SDL/OpenGL/Pas/gl.pas',
glu in '../../../JEDI-SDL/OpenGL/Pas/glu.pas',
ctypes in '../../../ctypes/ctypes.pas',
FreeType in '../../freetype.pas',
UFreeType in 'UFreeType.pas',
math,
sysutils;
const
// screen width, height, and bit depth
SCREEN_WIDTH = 640;
SCREEN_HEIGHT = 480;
SCREEN_BPP = 16;
var
our_font: TFontData;
// This is our SDL surface
surface: PSDL_Surface;
cnt1, cnt2: GLfloat;
(* function to release/destroy our resources and restoring the old desktop *)
procedure Quit(returnCode: integer);
begin
// clean up the window
SDL_Quit( );
// and exit appropriately
Halt( returnCode );
end;
(* function to reset our viewport after a window resize *)
function resizeWindow(width: integer; height: integer): boolean;
var
// Height / width ration
ratio: GLfloat;
begin
// Protect against a divide by zero
if ( height = 0 ) then
height := 1;
ratio := width / height;
// Setup our viewport.
glViewport( 0, 0, GLsizei(width), GLsizei(height) );
// change to the projection matrix and set our viewing volume.
glMatrixMode( GL_PROJECTION );
glLoadIdentity( );
// Set our perspective
gluPerspective( 45.0, ratio, 0.1, 100.0 );
// Make sure we're chaning the model view and not the projection
glMatrixMode( GL_MODELVIEW );
// Reset The View
glLoadIdentity( );
Result := true;
end;
(* function to handle key press events *)
procedure handleKeyPress(keysym: PSDL_keysym);
begin
case ( keysym^.sym ) of
SDLK_ESCAPE:
begin
// ESC key was pressed
Quit( 0 );
end;
SDLK_F1:
begin
// F1 key was pressed
// this toggles fullscreen mode
SDL_WM_ToggleFullScreen( surface );
end;
end;
end;
(* general OpenGL initialization function *)
function initGL(): boolean;
begin
// Enable smooth shading
glShadeModel( GL_SMOOTH );
// Set the background black
glClearColor( 0.0, 0.0, 0.0, 0.0 );
// Depth buffer setup
glClearDepth( 1.0 );
// Enables Depth Testing
glEnable( GL_DEPTH_TEST );
// The Type Of Depth Test To Do
glDepthFunc( GL_LEQUAL );
// Really Nice Perspective Calculations
glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST );
our_font := TFontData.Create('Test.ttf', 16);
Result := true;
end;
(* Here goes our drawing code *)
function drawGLScene(): boolean;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear Screen And Depth Buffer
glLoadIdentity(); // Reset The Current Modelview Matrix
glTranslatef(0.0, 0.0, -1.0); // Move One Unit Into The Screen
// Blue Text
glColor3ub(0, 0, $ff);
// Position The WGL Text On The Screen
glRasterPos2f(-0.40, 0.35);
// Here We Print Some Text Using Our FreeType Font
// The only really important command is the actual print() call,
// but for the sake of making the results a bit more interesting
// I have put in some code to rotate and scale the text.
// Red text
glColor3ub($ff, 0, 0);
glPushMatrix();
glLoadIdentity();
glRotatef(cnt1, 0, 0,1);
glScalef(1, 0.8 + 0.3*cos(cnt1/5) ,1);
glTranslatef(-180, 0, 0);
TFreeType.print(our_font, 320, 240, 'Active FreeType Text - ' + FloatToStr(cnt1));
glPopMatrix();
//Uncomment this to test out print's ability to handle newlines.
//TFreeType.print(our_font, 320, 200, 'Here'#13'there'#13'be'#13#13'newlines'#13'.');
cnt1 := cnt1 + 0.051; // Increase The First Counter
cnt2 := cnt2 + 0.005; // Increase The First Counter
SDL_GL_SwapBuffers( );
Result := true;
end;
var
// Flags to pass to SDL_SetVideoMode
videoFlags: integer;
// main loop variable
done: boolean = false;
// used to collect events
event: TSDL_Event;
// this holds some info about our display
videoInfo: PSDL_VideoInfo;
// whether or not the window is active
isActive: boolean = true;
begin
// initialize SDL
if ( SDL_Init( SDL_INIT_VIDEO ) < 0 ) then
begin
writeln( ErrOutput, 'Video initialization failed: ' + SDL_GetError() );
Quit( 1 );
end;
// Fetch the video info
videoInfo := SDL_GetVideoInfo( );
if ( videoInfo = nil ) then
begin
writeln( ErrOutput, 'Video query failed: ' + SDL_GetError() );
Quit( 1 );
end;
SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); // Enable double buffering
// the flags to pass to SDL_SetVideoMode
videoFlags := SDL_OPENGL; // Enable OpenGL in SDL
videoFlags := videoFlags or SDL_HWPALETTE; // Store the palette in hardware
videoFlags := videoFlags or SDL_RESIZABLE; // Enable window resizing
// This checks to see if surfaces can be stored in memory
if ( videoInfo^.hw_available <> 0 ) then
videoFlags := videoFlags or SDL_HWSURFACE
else
videoFlags := videoFlags or SDL_SWSURFACE;
// This checks if hardware blits can be done
if ( videoInfo^.blit_hw <> 0 ) then
videoFlags := videoFlags or SDL_HWACCEL;
// Sets up OpenGL double buffering
SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
// get a SDL surface
surface := SDL_SetVideoMode( SCREEN_WIDTH, SCREEN_HEIGHT, SCREEN_BPP,
videoFlags );
// Verify there is a surface
if ( surface = nil ) then
begin
writeln( ErrOutput, 'Video mode set failed: ' + SDL_GetError() );
Quit( 1 );
end;
// initialize OpenGL
initGL();
// resize the initial window
resizeWindow( SCREEN_WIDTH, SCREEN_HEIGHT );
// wait for events
while ( not done ) do
begin
{ handle the events in the queue }
while ( SDL_PollEvent( @event ) <> 0 ) do
begin
case( event.type_ ) of
SDL_ACTIVEEVENT:
begin
// Something's happend with our focus
// If we are iconified, we shouldn't draw the screen
if ( (event.active.state and SDL_APPACTIVE) <> 0 ) then
begin
if ( event.active.gain = 0 ) then
isActive := false
else
isActive := true;
end;
end;
SDL_VIDEORESIZE:
begin
// handle resize event
{$IFDEF UNIX}
surface := SDL_SetVideoMode( event.resize.w,
event.resize.h,
16, videoFlags );
if ( surface = nil ) then
begin
writeln( ErrOutput, 'Could not get a surface after resize: ' + SDL_GetError( ) );
Quit( 1 );
end;
{$ENDIF}
resizeWindow( event.resize.w, event.resize.h );
end;
SDL_KEYDOWN:
begin
// handle key presses
handleKeyPress( @event.key.keysym );
end;
SDL_QUITEV:
begin
// handle quit requests
done := true;
end;
end;
end;
// draw the scene
if ( isActive ) then
drawGLScene( );
end;
// clean ourselves up and exit
Quit( 0 );
end.
|