← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/lablgl/gutsy

« back to all changes in this revision

Viewing changes to LablGlut/src/wrap_glut.c

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2006-05-15 21:23:56 UTC
  • mfrom: (2.1.5 dapper)
  • Revision ID: james.westby@ubuntu.com-20060515212356-n5ue8ekfgxcsrm5g
Tags: 1.02-2
* Rebuild with OCaml 3.09.2.
* Updated standards version to 3.7.2, no changes needed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
LablGlut/src/wrap_glut.c
7
7
 *
8
8
 */
9
9
 
 
10
#ifdef _WIN32
 
11
#define GLUT_DISABLE_ATEXIT_HACK
 
12
#endif
10
13
#ifdef __APPLE__
11
14
#include <GLUT/glut.h>
12
15
#else
18
21
#include <string.h>
19
22
 
20
23
#include <caml/mlvalues.h>
21
 
//#include <caml/alloc.h>
 
24
#include <caml/alloc.h>
22
25
#include <caml/memory.h>
23
26
//#include <caml/fail.h>
24
27
#include <caml/callback.h>
193
196
    return Val_unit;
194
197
}
195
198
 
196
 
static char* cbname(const char glutname[])
197
 
{
198
 
    static char ret[128];
199
 
    //printf("cbname\n"); fflush(stdout);
200
 
    sprintf(ret, "ocaml_%s_cb_%i", glutname, (int) glutGetWindow());
201
 
    //printf("   %s\n", ret); fflush(stdout);
202
 
    return ret;
203
 
}
204
 
 
205
199
/* associations between callback functions and window ids are made on the 
206
200
   OCaml side. */
207
201
 
208
202
/* TODO: make these easier to read.  gcc was complaining about backslashes,
209
203
   for reasons that aren't clear to me. */
210
204
 
211
 
#define CB_0(glut_func) static void glut_func##_cb() {leave_blocking_section (); callback(*caml_named_value(cbname(#glut_func)), Val_unit); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { glut_func( & glut_func##_cb ); return Val_unit; }
212
 
 
213
 
#define CB_1(glut_func, type1, conv1) static void glut_func##_cb( type1 arg1 ) {leave_blocking_section (); callback(*caml_named_value(cbname(#glut_func)), conv1(arg1)); enter_blocking_section (); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { glut_func( & glut_func##_cb ); return Val_unit; }
214
 
 
215
 
#define CB_2(glut_func, type1, conv1,  type2, conv2) static void glut_func##_cb( type1 arg1, type2 arg2 ) {leave_blocking_section (); callback2(*caml_named_value(cbname(#glut_func)), conv1(arg1), conv2(arg2)); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { glut_func( & glut_func##_cb ); return Val_unit; }
216
 
 
217
 
#define CB_3(glut_func, type1, conv1,  type2, conv2,  type3, conv3) static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3 ) {leave_blocking_section (); callback3(*caml_named_value(cbname(#glut_func)), conv1(arg1), conv2(arg2), conv3(arg3)); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { glut_func( & glut_func##_cb ); return Val_unit; } 
218
 
 
219
 
#define CB_4(glut_func, type1, conv1, type2, conv2, type3, conv3, type4, conv4) static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 ) { value args[4]; args[0] = conv1(arg1); args[1] = conv2(arg2); args[2] = conv3(arg3); args[3] = conv4(arg4); leave_blocking_section (); callbackN (*caml_named_value(cbname(#glut_func)), 4, args); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { glut_func( & glut_func##_cb ); return Val_unit; } 
220
 
 
221
 
/* callbacks whose hooking functions have return values */
222
 
#define CB_1_(glut_func, type1, conv1, conv) static void glut_func##_cb( type1 arg1 ) {leave_blocking_section (); callback(*caml_named_value("ocaml_"#glut_func), conv1(arg1)); enter_blocking_section ();} CAMLprim value ml_##glut_func(value unit) { return conv(glut_func( & glut_func##_cb )); }
223
 
 
224
 
 
225
 
 
226
 
#if 0
 
205
#define REGISTER_CB(glut_func)                                          \
 
206
  CAMLprim value ml_##glut_func(value cb) {                             \
 
207
    glut_func(glut_func##_cb );                                         \
 
208
    if (glut_func##_value) {                                            \
 
209
      if (glut_func##_value == cb) return Val_unit;                     \
 
210
      caml_remove_global_root(&glut_func##_value);                      \
 
211
    }                                                                   \
 
212
    glut_func##_value = cb;                                             \
 
213
    caml_register_global_root(&glut_func##_value);                      \
 
214
    return Val_unit;                                                    \
 
215
  }           
 
216
 
 
217
// for callback with return value for the hooking function
 
218
#define REGISTER_CB_(glut_func, conv)                                   \
 
219
  CAMLprim value ml_##glut_func(value cb) {                             \
 
220
    value r = conv(glut_func(glut_func##_cb ));                         \
 
221
    if (glut_func##_value) {                                            \
 
222
      if (glut_func##_value == cb) return r;                            \
 
223
      caml_remove_global_root(&glut_func##_value);                      \
 
224
    }                                                                   \
 
225
    glut_func##_value = cb;                                             \
 
226
    caml_register_global_root(&glut_func##_value);                      \
 
227
    return r;                                                           \
 
228
  }           
 
229
 
 
230
// for callback with one extra argument for the hooking function
 
231
#define REGISTER__CB(glut_func, conv)                                   \
 
232
  CAMLprim value ml_##glut_func(value cb, value arg) {                  \
 
233
    glut_func(glut_func##_cb, conv(arg) );                              \
 
234
    if (glut_func##_value) {                                            \
 
235
      if (glut_func##_value == cb) return Val_unit;                     \
 
236
      caml_remove_global_root(&glut_func##_value);                      \
 
237
    }                                                                   \
 
238
    glut_func##_value = cb;                                             \
 
239
    caml_register_global_root(&glut_func##_value);                      \
 
240
    return Val_unit;                                                    \
 
241
  }           
 
242
 
 
243
#define CB_0(glut_func)                                                 \
 
244
  value glut_func##_value = 0;                                  \
 
245
  static void glut_func##_cb() {                                        \
 
246
    leave_blocking_section ();                                          \
 
247
    callback(glut_func##_value, Val_unit);                              \
 
248
    enter_blocking_section ();                                          \
 
249
  }                                                                     \
 
250
  REGISTER_CB(glut_func)
 
251
 
 
252
#define CB_1(glut_func, type1, conv1)                                   \
 
253
  value glut_func##_value = 0;                                  \
 
254
  static void glut_func##_cb( type1 arg1 ) {                            \
 
255
    leave_blocking_section ();                                          \
 
256
    callback(glut_func##_value, conv1(arg1));                           \
 
257
    enter_blocking_section ();                                          \
 
258
  }                                                                     \
 
259
  REGISTER_CB(glut_func)
 
260
 
 
261
// for callback with return value for the hooking function
 
262
#define CB_1_(glut_func, type1, conv1, conv)                            \
 
263
  value glut_func##_value = 0;                                  \
 
264
  static void glut_func##_cb( type1 arg1 ) {                            \
 
265
    leave_blocking_section ();                                          \
 
266
    callback(glut_func##_value, conv1(arg1));                           \
 
267
    enter_blocking_section ();                                          \
 
268
  }                                                                     \
 
269
  REGISTER_CB_(glut_func, conv)
 
270
 
 
271
#define CB_2(glut_func, type1, conv1,  type2, conv2)                    \
 
272
  value glut_func##_value = 0;                                  \
 
273
  static void glut_func##_cb( type1 arg1, type2 arg2 ) {                \
 
274
    leave_blocking_section ();                                          \
 
275
    callback2(glut_func##_value, conv1(arg1), conv2(arg2));            \
 
276
    enter_blocking_section ();                                          \
 
277
  }                                                                     \
 
278
  REGISTER_CB(glut_func)
 
279
 
 
280
#define CB_3(glut_func, type1, conv1,  type2, conv2,  type3, conv3)     \
 
281
  value glut_func##_value = 0;                                  \
 
282
  static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3 ) {    \
 
283
    leave_blocking_section ();                                          \
 
284
    callback3(glut_func##_value, conv1(arg1), conv2(arg2), conv3(arg3)); \
 
285
    enter_blocking_section ();                                          \
 
286
  }                                                                     \
 
287
  REGISTER_CB(glut_func)
 
288
 
 
289
#define CB_4(glut_func, type1, conv1, type2, conv2, type3, conv3, type4, conv4)\
 
290
  value glut_func##_value = 0;                                  \
 
291
  static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\
 
292
  {                                                                   \
 
293
    value args[4];                                                    \
 
294
    leave_blocking_section ();                                        \
 
295
    args[0] = conv1(arg1);                                            \
 
296
    args[1] = conv2(arg2);                                            \
 
297
    args[2] = conv3(arg3);                                            \
 
298
    args[3] = conv4(arg4);                                            \
 
299
    callbackN (glut_func##_value, 4, args);                          \
 
300
    enter_blocking_section ();                                        \
 
301
  }                                                                   \
 
302
  REGISTER_CB(glut_func)
 
303
 
 
304
// for callback with one extra argument for the hooking function
 
305
#define CB__4(glut_func, type1, conv1, type2, conv2, type3, conv3, type4, conv4, conv) \
 
306
  value glut_func##_value = 0;                                  \
 
307
  static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\
 
308
  {                                                                   \
 
309
    value args[4];                                                    \
 
310
    leave_blocking_section ();                                        \
 
311
    args[0] = conv1(arg1);                                            \
 
312
    args[1] = conv2(arg2);                                            \
 
313
    args[2] = conv3(arg3);                                            \
 
314
    args[3] = conv4(arg4);                                            \
 
315
    callbackN (glut_func##_value, 4, args);                          \
 
316
    enter_blocking_section ();                                        \
 
317
  }                                                                   \
 
318
  REGISTER__CB(glut_func, conv)
 
319
 
227
320
CB_0(glutDisplayFunc)
228
 
#else
229
 
static void glutDisplayFunc_cb(void)
230
 
{
231
 
    char * name;
232
 
    name = (char*) cbname("glutDisplayFunc");
233
 
    //printf("glutDisplayFunc: name = %s\n", name); fflush(stdout);
234
 
    leave_blocking_section ();
235
 
    callback(*caml_named_value(name), Val_unit);
236
 
    enter_blocking_section ();
237
 
    //printf("glutDisplayFunc done\n", name); fflush(stdout);
238
 
}
239
 
CAMLprim value ml_glutDisplayFunc(value unit)
240
 
{
241
 
    glutDisplayFunc(&glutDisplayFunc_cb);  
242
 
    return Val_unit; 
243
 
}
244
 
#endif
245
 
 
246
 
#if 1
247
321
CB_1(glutVisibilityFunc, int, Val_int)
248
 
#else
249
 
static void glutVisibilityFunc_cb(int state)
250
 
{
251
 
    leave_blocking_section ();
252
 
    callback(*caml_named_value(cbname("glutVisibilityFunc")), Val_int(state));
253
 
    enter_blocking_section ();
254
 
}
255
 
CAMLprim value ml_glutVisibilityFunc(value unit)
256
 
{
257
 
    glutVisibilityFunc(&glutVisibilityFunc_cb);  
258
 
    return Val_unit; 
259
 
}
260
 
#endif
261
 
 
262
 
//CB_1_(glutCreateMenu, int, Val_int,  Val_int)
263
 
//#define CB_1_(glut_func, type1, conv1, conv) static void glut_func##_cb( type1 arg1 ) { callback(*caml_named_value("ocaml_"#glut_func), conv1(arg1)); } value ml_##glut_func(value unit) { return conv(glut_func( & glut_func##_cb )); }
264
 
static void glutCreateMenu_cb( int menu_id ) 
265
 
{ 
266
 
  // ocaml_glutCreateMenu really means "menu callback on the ocaml side"
267
 
  leave_blocking_section ();
268
 
  callback(*caml_named_value("ocaml_glutCreateMenu"), Val_int(menu_id)); 
269
 
  enter_blocking_section ();
270
 
} 
271
 
CAMLprim value ml_glutCreateMenu(value unit) 
272
 
{ 
273
 
  return Val_int(glutCreateMenu(&glutCreateMenu_cb));
274
 
}
275
 
 
 
322
CB_1_(glutCreateMenu,int, Val_int, Val_int)
276
323
CB_2(glutReshapeFunc, int, Val_int,  int, Val_int)
277
324
CB_3(glutKeyboardFunc, unsigned char, Val_int,  int, Val_int,  int, Val_int)
278
325
CB_2(glutMotionFunc, int, Val_int,  int, Val_int)
290
337
CB_3(glutMenuStatusFunc, int, Val_int,  int, Val_int,  int, Val_int)
291
338
CB_0(glutOverlayDisplayFunc)
292
339
CB_4(glutMouseFunc, int, Val_int,  int, Val_int,  int, Val_int,  int, Val_int)
293
 
 
 
340
CB_0(glutIdleFunc)
294
341
 
295
342
CAMLprim value ml_glutSetIdleFuncToNull( value unit )
296
343
{
297
344
    glutIdleFunc(NULL);
298
 
    return Val_unit;
299
 
}
300
 
 
301
 
#if 0
302
 
CB_0(glutIdleFunc)
303
 
#else
304
 
static void glutIdleFunc_cb(void)
305
 
{
306
 
  leave_blocking_section ();
307
 
  callback (*caml_named_value("ocaml_glutIdleFunc"), Val_unit);
308
 
  enter_blocking_section ();
309
 
}
310
 
CAMLprim value ml_glutIdleFunc( value unit )
311
 
{
312
 
    glutIdleFunc(&glutIdleFunc_cb);
313
 
    return Val_unit;
314
 
}
315
 
#endif
316
 
 
317
 
static void glutTimerFunc_cb(int value)
318
 
{
319
 
  leave_blocking_section ();
320
 
  callback (*caml_named_value("ocaml_glutTimerFunc"), Val_int(value) );
321
 
  enter_blocking_section ();
322
 
 
323
 
}
324
 
CAMLprim value ml_glutTimerFunc( value millis_val, value val_val ) // set Timer callback
325
 
{
326
 
    unsigned int millis;
327
 
    int val;
328
 
    val = Int_val(val_val);
329
 
    millis = Int_val(millis_val);
330
 
    glutTimerFunc( millis, &glutTimerFunc_cb, val ); // register with GLUT
331
 
    return Val_unit;
 
345
    if (glutIdleFunc_value) {                                           
 
346
      caml_remove_global_root(&glutIdleFunc_value);                     
 
347
      glutIdleFunc_value = 0;
 
348
    }
 
349
    return Val_unit;
 
350
}
 
351
 
 
352
static value caml_glutTimerFunc_cb = 0;
 
353
 
 
354
CAMLprim void init_glutTimerFunc_cb(value v)
 
355
{ 
 
356
  caml_glutTimerFunc_cb = v;
 
357
  caml_register_global_root(&caml_glutTimerFunc_cb);
 
358
}
 
359
 
 
360
static void glutTimerFunc_cb(int val)
 
361
{
 
362
  leave_blocking_section ();
 
363
  callback (caml_glutTimerFunc_cb, (value) val);
 
364
  enter_blocking_section ();
 
365
}
 
366
 
 
367
CAMLprim value ml_glutTimerFunc(value millis, value timer_count) // set Timer callback
 
368
{
 
369
  glutTimerFunc(Int_val(millis), &glutTimerFunc_cb, (int) timer_count); // register with GLUT
 
370
  return Val_unit;
332
371
}
333
372
 
334
373
/* font stuff */
335
374
 
336
 
static int streq(const char s1[], const char s2[]) { 
337
 
  return !strcmp(s1, s2);
338
 
}
339
 
 
340
375
/* integer code to font */
341
376
static void* i2font(int i)
342
377
{
405
440
CB_3(glutSpecialUpFunc,  int, Val_int,  int, Val_int,  int, Val_int)
406
441
ML_1(glutIgnoreKeyRepeat, Int_val)
407
442
ML_1(glutSetKeyRepeat, Int_val)
408
 
 
409
 
static void joystick_cb(unsigned int buttonMask, int x, int y, int z)
410
 
{
411
 
  value args[4]; 
412
 
  args[0] = Val_int(buttonMask);
413
 
  args[1] = Val_int(x);
414
 
  args[2] = Val_int(y);
415
 
  args[3] = Val_int(z);
416
 
  leave_blocking_section ();
417
 
  callbackN (*caml_named_value(cbname("glutJoystickFunc")), 4, args); 
418
 
  enter_blocking_section ();
419
 
 
420
 
}
421
 
CAMLprim value ml_glutJoystickFunc(value pollInterval) 
422
 
{ 
423
 
  glutJoystickFunc( &joystick_cb, Int_val(pollInterval) );
424
 
  return Val_unit;
425
 
} 
426
 
 
 
443
CB__4(glutJoystickFunc, unsigned int, Val_int, int, Val_int, int, Val_int, int, Val_int, Int_val)
427
444
ML_0(glutForceJoystickFunc)
428
445
 
429
446