1: #line 4916 "./lpsrc/flx_sdl.pak"
2:
3: /*
4: * This code was created by Jeff Molofee '99
5: * (ported to Linux/SDL by Ti Leggett '01)
6: *
7: * If you've found this code useful, please let me know.
8: *
9: * Visit Jeff at http:
10: *
11: * or for port-specific comments, questions, bugreports etc.
12: * email to leggett@eecs.tulane.edu
13: */
14:
15:
16: include "SDL/SDL";
17: include "SDL/SDL_keyboard";
18: include "SDL/SDL_keysym";
19: include "SDL/SDL_video";
20: include "SDL/SDL_events";
21: include "SDL/SDL_timer";
22: include "SDL/SDL_mutex";
23: include "SDL/SDL_opengl";
24:
25: include "flx_faio";
26: include "flx_faio_sdl";
27:
28: open C_hack;
29: open Carray;
30: open MixedInt;
31: open Uint32;
32: open Uint8;
33: open Float;
34:
35: open SDL_h;
36: open SDL_video_h;
37: open SDL_keyboard_h;
38: open SDL_events_h;
39: open SDL_keysym_h;
40: open SDL_timer_h;
41: open SDL_mutex_h;
42:
43:
44: open SDL_events;
45:
46: open SDL_opengl_h;
47:
48: /* screen width, height, and bit depth */
49: val SCREEN_WIDTH = 640;
50: val SCREEN_HEIGHT = 480;
51: val SCREEN_BPP = 16;
52: macro val NUM = 50;
53:
54: /* function to reset our viewport after a window resize */
55: proc resizeWindow( wwidth : int, hheight :int)
56: {
57: var height = hheight;
58: var width = wwidth;
59:
60: /* Protect against a divide by zero */
61: if height == 0 do height = 1; done;
62: var ratio = double_of width / double_of height;
63:
64: block_sdl_events event_lock;
65: /* Setup our viewport. */
66: glViewport( 0, 0, width, height );
67:
68: /* change to the projection matrix and set our viewing volume. */
69: glMatrixMode( GL_PROJECTION );
70: glLoadIdentity( );
71:
72: /* Set our perspective */
73: gluPerspective( 45.0, ratio, 0.1, 100.0 );
74:
75: /* Make sure we're chaning the model view and not the projection */
76: glMatrixMode( GL_MODELVIEW );
77:
78: /* Reset The View */
79: glLoadIdentity( );
80: unblock_sdl_events event_lock;
81: }
82:
83: /* function to load in bitmap as a GL texture */
84: proc LoadGLTextures( )
85: {
86: /* Create storage space for the texture */
87: var TextureImage = SDL_LoadBMP(enconst c"media/textures/sdl209.bmp");
88: if isNULL TextureImage do
89: print "Can't load texture file media/textures/sdl209.bmp";
90: Quit 1;
91: done;
92:
93: /* Create The Texture */
94: glGenTextures( 1, texture );
95:
96: /* Typical Texture Generation Using Data From The Bitmap */
97: glBindTexture( GL_TEXTURE_2D, texture.[0] );
98:
99: /* Generate The Texture */
100: glTexImage2D( GL_TEXTURE_2D, 0, 3, TextureImage.->w,
101: TextureImage.->h, 0, GL_RGB,
102: GL_UNSIGNED_BYTE, TextureImage.->pixels
103: );
104:
105: /* Linear Filtering */
106: glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
107: glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
108:
109: /* Free up any memory we may have used */
110: SDL_FreeSurface( TextureImage );
111: }
112:
113: var twinkle = false;
114:
115: /* Define the star structure */
116: struct star
117: {
118: /* Stars Color */
119: r : int;
120: g : int;
121: b : int;
122: dist : float; /* Stars Distance From Center */
123: angle : float; /* Stars Current Angle */
124: };
125:
126: var stars : star ^ NUM; /* Make an array of size 'NUM' of stars */
127:
128: var zoom = -15.0f; /* Viewing Distance Away From Stars */
129: var tilt = 90.0f; /* Tilt The View */
130:
131: /* general OpenGL initialization function */
132: proc initGL()
133: {
134: /* Enable Texture Mapping ( NEW ) */
135: glEnable( GL_TEXTURE_2D );
136:
137: /* Enable smooth shading */
138: glShadeModel( GL_SMOOTH );
139:
140: /* Set the background black */
141: glClearColor( 0.0f, 0.0f, 0.0f, 0.0f );
142:
143: /* Depth buffer setup */
144: glClearDepth( 1.0 );
145:
146: /* Really Nice Perspective Calculations */
147: glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST );
148:
149: /* Blending Function For Translucency Based On Source Alpha Value */
150: glBlendFunc( GL_SRC_ALPHA, GL_ONE );
151:
152: /* Enable Blending */
153: glEnable( GL_BLEND );
154:
155: /* Create A Loop That Goes Through All The Stars */
156: var i = 0; whilst i< NUM do
157: /* Start All The Stars At Angle Zero */
158: stars.[i].angle = 0.0f;
159:
160: /* Calculate Distance From The Center */
161: stars.[i].dist = ( float_of i / float_of NUM ) * 5.0f;
162: /* Give star.[i] A Random Red Intensity */
163: stars.[i].r = Cstdlib::rand( ) % 256;
164: /* Give star.[i] A Random Green Intensity */
165: stars.[i].g = Cstdlib::rand( ) % 256;
166: /* Give star.[i] A Random Blue Intensity */
167: stars.[i].b = Cstdlib::rand( ) % 256;
168: ++i;
169: done;
170: }
171:
172: /* These are to calculate our fps */
173: var T0 = 0;
174: var Frames = 0;
175: var spin = 0.0f;
176:
177: proc rotate()
178: {
179: var i : int;
180: forall i in 0 upto NUM - 1 do
181: /* Used To Spin The Stars */
182: spin += 0.01f;
183: /* Changes The Angle Of A Star */
184: stars.[i].angle += float_of i / float_of NUM;
185: /* Changes The Distance Of A Star */
186: stars.[i].dist -= 0.01f;
187:
188: /* Is The Star In The Middle Yet */
189: if stars.[i].dist < 0.0f do
190: /* Move The Star 5 Units From The Center */
191: stars.[i].dist += 5.0f;
192: /* Give It A New Red Value */
193: stars.[i].r = Cstdlib::rand( ) % 256;
194: /* Give It A New Green Value */
195: stars.[i].g = Cstdlib::rand( ) % 256;
196: /* Give It A New Blue Value */
197: stars.[i].b = Cstdlib::rand( ) % 256;
198: done;
199: done;
200: }
201:
202: var filter = 0;
203:
204: var f_texture : uint ^ 3; /* Storage For 3 Textures ( NEW ) */
205: var texture : carray[uint] = carray f_texture;
206:
207:
208: /* Here goes our drawing code */
209: proc drawGLScene(drawing:1->0)
210: {
211: block_sdl_events event_lock;
212: drawing();
213: unblock_sdl_events event_lock;
214:
215: /* Gather our frames per second */
216: Frames++;
217: {
218: var t = SDL_GetTicks();
219: if t - T0 >= 5000 do
220: val seconds = double_of (t - T0) / 1000.0;
221: val fps = double_of Frames / seconds;
222: print Frames; print " frames in "; print seconds;
223: print " seconds = "; print fps; print " FPS"; endl;
224: T0 = t;
225: Frames = 0;
226: done;
227: };
228: rotate();
229: }
230:
231: /* whether or not the window is active */
232: var isActive = true;
233:
234: if SDL_Init(SDL_INIT_AUDIO \| SDL_INIT_VIDEO) < 0 do
235: print "Unable to init SDL"; endl;
236: System::exit(1);
237: done;
238:
239: var event_lock = SDL_CreateMutex();
240:
241:
242: proc Quit(n:int)
243: {
244: SDL_Quit;
245: System::exit 0;
246: }
247:
248: /* Fetch the video info */
249: var videoInfo = SDL_GetVideoInfo();
250:
251: if isNULL videoInfo do
252: print "Video query failed"; endl;
253: Quit 1;
254: done;
255:
256: /* the flags to pass to SDL_SetVideoMode */
257: var
258: videoFlags = SDL_OPENGL; /* Enable OpenGL in SDL */
259: videoFlags |= cast[uint] SDL_GL_DOUBLEBUFFER; /* Enable double buffering */
260: videoFlags |= SDL_HWPALETTE; /* Store the palette in hardware */
261: videoFlags |= SDL_RESIZABLE; /* Enable window resizing */
262:
263: /* This checks to see if surfaces can be stored in memory */
264: if videoInfo.->hw_available != 0 do
265: videoFlags |= SDL_HWSURFACE;
266: else
267: videoFlags |= SDL_SWSURFACE;
268: done;
269:
270: /* This checks if hardware blits can be done */
271: if videoInfo.->blit_hw != 0 do
272: videoFlags |= SDL_HWACCEL;
273: done;
274:
275: /* Sets up OpenGL double buffering */
276: ignore$ SDL_GL_SetAttribute( cast[SDL_GLattr] SDL_GL_DOUBLEBUFFER, 1 );
277:
278: /* get a SDL surface */
279: var surface = SDL_SetVideoMode
280: (SCREEN_WIDTH, SCREEN_HEIGHT, SCREEN_BPP, videoFlags )
281: ;
282:
283: /* Verify there is a surface */
284: if isNULL surface do
285: print "Video mode set failed"; endl;
286: Quit 1;
287: done;
288:
289: /* initialize OpenGL */
290: initGL();
291: LoadGLTextures();
292:
293: /* resize the initial window */
294: resizeWindow( SCREEN_WIDTH, SCREEN_HEIGHT );
295:
296:
297: proc handle_active (e:SDL_ActiveEvent)
298: {
299: isActive = e.gain != 0;
300: }
301:
302: proc handle_resize(e:SDL_ResizeEvent)
303: {
304: block_sdl_events event_lock;
305: surface = SDL_SetVideoMode(
306: e.w,
307: e.h,
308: 16, videoFlags
309: );
310: if isNULL surface do
311: print "Could not get a surface after resize"; endl;
312: done;
313: resizeWindow( e.w, e.h );
314: unblock_sdl_events event_lock;
315: }
316:
317: /* function to handle key press events */
318: proc handle_key( keysym : SDL_keysym)
319: {
320: match keysym.sym with
321: | ?k when k == SDLK_ESCAPE => { Quit 0; }
322: | ?k when k == SDLK_F1 =>
323: {
324: block_sdl_events event_lock;
325: ignore$ SDL_WM_ToggleFullScreen( surface );
326: unblock_sdl_events event_lock;
327: }
328: | ?k when k == SDLK_t =>
329: {
330: twinkle = not twinkle;
331: }
332: | ?k when k == SDLK_PAGEUP =>
333: {
334: zoom = zoom - 0.2f;
335: }
336:
337: | ?k when k == SDLK_PAGEDOWN =>
338: {
339: zoom = zoom + 0.2f;
340: }
341:
342: | ?k when k == SDLK_UP =>
343: {
344: tilt = tilt - 0.5f;
345: }
346:
347: | ?k when k == SDLK_DOWN =>
348: {
349: tilt = tilt + 0.5f;
350: }
351:
352: | _ => {}
353: endmatch;
354: }
355:
356: /* draw the scene */
357: proc draw(drawing: 1->0) {
358: if isActive call drawGLScene( drawing );
359: }
360:
361: proc keychan(x:schannel[SDL_keysym])
362: {
363: whilst true do
364: var &k : SDL_keysym <- read x;
365: handle_key k;
366: done;
367: }
368:
369: proc activechan(x:schannel[SDL_ActiveEvent])
370: {
371: whilst true do
372: var &k : SDL_ActiveEvent <- read x;
373: handle_active k;
374: done;
375: }
376:
377: proc resizechan(x:schannel[SDL_ResizeEvent])
378: {
379: whilst true do
380: var &k : SDL_ResizeEvent <- read x;
381: handle_resize k;
382: done;
383: }
384:
385: proc drawchan(x:schannel[int], drawing:1->0)
386: {
387: whilst true do
388: var &k : int <- read x;
389: draw drawing;
390: done;
391: }
392:
393: proc execute(x:schannel[int], something:1->0)
394: {
395: whilst true do
396: var &k : int <- read x;
397: something();
398: done;
399: }
400:
401: val clock = Faio::mk_alarm_clock();
402: proc poll_event(e: &SDL_Event)
403: {
404: tryagain:>
405:
406: var result = SDL_PollEvent(unref e);
407: if result > 0 do
408:
409: return;
410: done;
411: Faio::sleep$ clock, 0.1;
412: goto tryagain;
413: }
414:
415: proc dispatch_event(
416: keyboard:schannel[SDL_keysym],
417: active:schannel[SDL_ActiveEvent],
418: resize:schannel[SDL_ResizeEvent]
419: )
420: {
421: whilst true do
422:
423: var e : SDL_Event;
424: poll_event(&e);
425: match e.type_ with
426: | ?et when et == SDL_ACTIVEEVENT =>
427: { write (active, e.active); }
428:
429: | ?et when et == SDL_VIDEORESIZE =>
430: { write (resize, e.resize); }
431:
432: | ?et when et == SDL_KEYDOWN =>
433: { write (keyboard, e.key.keysym); }
434:
435: | ?et when et == SDL_QUIT =>
436: { Quit 0; }
437:
438: | _ => {}
439: endmatch;
440: done;
441: }
442:
443: /* write ticks at the desired framerate */
444: proc framerate (x:schannel[int], framerate:double)
445: {
446: whilst true do
447: Faio::sleep$ clock, framerate;
448: write (x,1);
449: done;
450: }
451:
452: /* LINEAR CONTROL MODEL: CANNOT DEADLOCK
453: ~~> async/sync connection
454: --> sync/sync connection
455:
456: SDL_event ~~> dispatcher
457: --> resize handler
458: --> active handler
459: --> key handler
460: timer ~~> framerate --> draw
461: */
462:
463: /* make our communication channels */
464: var keyboard = mk_schannel[SDL_keysym] ();
465: var active = mk_schannel[SDL_ActiveEvent] ();
466: var resize = mk_schannel[SDL_ResizeEvent] ();
467: var clicks = mk_schannel[int] ();
468: var rotation = mk_schannel[int] ();
469:
470: /* start up the fthreads and plug them together */
471: spawn_fthread { dispatch_event (keyboard, active, resize); };
472: spawn_fthread { resizechan resize; };
473: spawn_fthread { activechan active; };
474: spawn_fthread { keychan keyboard; };
475:
476: spawn_fthread { drawchan (clicks, the Drawing); };
477: spawn_fthread { framerate (clicks, 0.05); };
478: spawn_fthread { execute (rotation, the rotate); };
479: spawn_fthread { framerate (rotation, 0.01); };
480:
481:
482:
483:
484: /* Here goes our drawing code */
485: proc Drawing()
486: {
487: /* Clear The Screen And The Depth Buffer */
488: glClear( GL_COLOR_BUFFER_BIT \| GL_DEPTH_BUFFER_BIT );
489:
490: /* Select Our Texture */
491: glBindTexture( GL_TEXTURE_2D, texture.[0] );
492: glLoadIdentity( );
493:
494: /* Loop Through All The Stars */
495: var i = 0;
496: forall i in 0 upto NUM - 1 do
497: /* Reset The View Before We Draw Each Star */
498: glLoadIdentity( );
499: /* Zoom Into The Screen (Using The Value In 'zoom') */
500: glTranslatef( 0.0f, 0.0f, zoom );
501:
502: /* Tilt The View (Using The Value In 'tilt') */
503: glRotatef( tilt, 1.0f, 0.0f, 0.0f );
504: /* Rotate To The Current Stars Angle */
505: glRotatef( stars.[i].angle, 0.0f, 1.0f, 0.0f );
506:
507: /* Move Forward On The X Plane */
508: glTranslatef( stars.[i].dist, 0.0f, 0.0f );
509:
510: /* Cancel The Current Stars Angle */
511: glRotatef( -stars.[i].angle, 0.0f, 1.0f, 0.0f );
512: /* Cancel The Screen Tilt */
513: glRotatef( -tilt, 1.0f, 0.0f, 0.0f );
514:
515: /* Twinkling Stars Enabled */
516: if twinkle do
517: /* Assign A Color Using Bytes */
518: glColor4ub( utiny_of stars.[NUM - i - 1].r,
519: utiny_of stars.[NUM - i - 1].g,
520: utiny_of stars.[NUM - i - 1].b, 255ut );
521: /* Begin Drawing The Textured Quad */
522: glBegin( GL_QUADS );
523: glTexCoord2f( 0.0f, 0.0f );
524: glVertex3f( -1.0f, -1.0f, 0.0f );
525: glTexCoord2f( 1.0f, 0.0f);
526: glVertex3f( 1.0f, -1.0f, 0.0f );
527: glTexCoord2f( 1.0f, 1.0f );
528: glVertex3f( 1.0f, 1.0f, 0.0f );
529: glTexCoord2f( 0.0f, 1.0f );
530: glVertex3f( -1.0f, 1.0f, 0.0f );
531: glEnd( );
532: done;
533:
534: /* Rotate The Star On The Z Axis */
535: glRotatef( spin, 0.0f, 0.0f, 1.0f );
536:
537: /* Assign A Color Using Bytes */
538: glColor4ub( utiny_of stars.[i].r, utiny_of stars.[i].g, utiny_of stars.[i].b, 255ut );
539:
540: /* Begin Drawing The Textured Quad */
541: glBegin( GL_QUADS );
542: glTexCoord2f( 0.0f, 0.0f ); glVertex3f( -1.0f, -1.0f, 0.0f );
543: glTexCoord2f( 1.0f, 0.0f ); glVertex3f( 1.0f, -1.0f, 0.0f );
544: glTexCoord2f( 1.0f, 1.0f ); glVertex3f( 1.0f, 1.0f, 0.0f );
545: glTexCoord2f( 0.0f, 1.0f ); glVertex3f( -1.0f, 1.0f, 0.0f );
546: glEnd( );
547:
548: done;
549:
550: /* Draw it to the screen */
551: SDL_GL_SwapBuffers( );
552: }