PLplot: plplot_impl.c Source File

PLplot 5.10.0

- Main Page
- Namespaces
- Classes
- Files

- File List
- File Members

All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
plplot_impl.c
Go to the documentation of this file.
1 //
2 // Copyright 2007, 2008, 2009, 2010, 2011 Hezekiah M. Carty
3 //
4 // This file is part of PLplot.
5 //
6 // PLplot is free software: you can redistribute it and/or modify
7 // it under the terms of the GNU Lesser General Public License as published by
8 // the Free Software Foundation, either version 2 of the License, or
9 // (at your option) any later version.
10 //
11 // PLplot is distributed in the hope that it will be useful,
12 // but WITHOUT ANY WARRANTY; without even the implied warranty of
13 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 // GNU Lesser General Public License for more details.
15 //
16 // You should have received a copy of the GNU Lesser General Public License
17 // along with PLplot. If not, see <http://www.gnu.org/licenses/>.
18 //
19
20 // The "usual" OCaml includes
21 #include <caml/alloc.h>
22 #include <caml/callback.h>
23 #include <caml/fail.h>
24 #include <caml/memory.h>
25 #include <caml/misc.h>
26 #include <caml/mlvalues.h>
27 #include <caml/bigarray.h>
28
29 #include <plplotP.h>
30 #include <plplot.h>
31
32 #undef snprintf
33
34 #include <stdio.h>
35
36 #define MAX_EXCEPTION_MESSAGE_LENGTH 1000
37 #define CAML_PLPLOT_PLOTTER_FUNC_NAME "caml_plplot_plotter"
38 #define CAML_PLPLOT_MAPFORM_FUNC_NAME "caml_plplot_mapform"
39 #define CAML_PLPLOT_DEFINED_FUNC_NAME "caml_plplot_defined"
40 #define CAML_PLPLOT_LABEL_FUNC_NAME "caml_plplot_customlabel"
41 #define CAML_PLPLOT_ABORT_FUNC_NAME "caml_plplot_abort"
42 #define CAML_PLPLOT_EXIT_FUNC_NAME "caml_plplot_exit"
43 #define CAML_PLPLOT_TRANSFORM_FUNC_NAME "caml_plplot_transform"
44
45 typedef void ( *ML_PLOTTER_FUNC )( PLFLT, PLFLT, PLFLT*, PLFLT*, PLPointer );
46 typedef PLINT ( *ML_DEFINED_FUNC )( PLFLT, PLFLT );
47 typedef void ( *ML_MAPFORM_FUNC )( PLINT, PLFLT*, PLFLT* );
48 typedef void ( *ML_LABEL_FUNC )( PLINT, PLFLT, char*, PLINT, PLPointer );
49 typedef PLINT ( *ML_VARIANT_FUNC )( PLINT );
50
51 //
52 //
53 // CALLBACK WRAPPERS
54 //
55 //
56
57 // A simple routine to wrap a properly registered OCaml callback in a form
58 // usable by PLPlot routines. If an appropriate callback is not registered
59 // then the PLPlot built-in pltr0 function is used instead.
60 void ml_plotter( PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, PLPointer pltr_data )
61 {
62 CAMLparam0();
63 CAMLlocal1( result );
64
65 // Get the OCaml callback function (if there is one)
66 static value * pltr = NULL;
67 if ( pltr == NULL )
68 pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME );
69
70 // No check to see if a callback function has been designated yet,
71 // because that is checked before we get to this point.
72 result =
73 caml_callback2( *pltr, caml_copy_double( x ), caml_copy_double( y ) );
74 double new_x, new_y;
75 new_x = Double_val( Field( result, 0 ) );
76 new_y = Double_val( Field( result, 1 ) );
77
78 *tx = new_x;
79 *ty = new_y;
80
81 CAMLreturn0;
82 }
83
84 // A simple routine to wrap a properly registered OCaml callback in a form
85 // usable by PLPlot routines. If an appropriate callback is not registered
86 // then the result is always 1 (the data point is defined).
87 // This function is used in the plshade* functions to determine if a given data
88 // point is valid/defined or not.
89 PLINT ml_defined( PLFLT x, PLFLT y )
90 {
91 CAMLparam0();
92 CAMLlocal1( result );
93
94 // The result which will be returned to the user.
95 PLINT is_it_defined;
96
97 // Get the OCaml callback function (if there is one)
98 static value * defined = NULL;
99 if ( defined == NULL )
100 defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME );
101
102 // No check to see if a callback function has been designated yet,
103 // because that is checked before we get to this point.
104 result =
105 caml_callback2( *defined, caml_copy_double( x ), caml_copy_double( y ) );
106 is_it_defined = Int_val( result );
107
108 CAMLreturn( is_it_defined );
109 }
110
111 // A simple routine to wrap a properly registered OCaml callback in a form
112 // usable by PLPlot routines. If an appropriate callback is not registered
113 // then nothing is done.
114 void ml_mapform( PLINT n, PLFLT *x, PLFLT *y )
115 {
116 CAMLparam0();
117 CAMLlocal1( result );
118
119 // Get the OCaml callback function (if there is one)
120 static value * mapform = NULL;
121 if ( mapform == NULL )
122 mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME );
123
124 // No check to see if a callback function has been designated yet,
125 // because that is checked before we get to this point.
126 int i;
127 for ( i = 0; i < n; i++ )
128 {
129 result =
130 caml_callback2( *mapform,
131 caml_copy_double( x[i] ), caml_copy_double( y[i] ) );
132
133 double new_x, new_y;
134 new_x = Double_val( Field( result, 0 ) );
135 new_y = Double_val( Field( result, 1 ) );
136
137 x[i] = new_x;
138 y[i] = new_y;
139 }
140
141 CAMLreturn0;
142 }
143
144 // A simple routine to wrap a properly registered OCaml callback in a form
145 // usable by PLPlot routines.
146 void ml_labelfunc( PLINT axis, PLFLT n, char *label, PLINT length, PLPointer d )
147 {
148 CAMLparam0();
149 CAMLlocal1( result );
150
151 // Get the OCaml callback function (if there is one)
152 static value * callback = NULL;
153 if ( callback == NULL )
154 callback = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME );
155
156 // No check to see if a callback function has been designated yet,
157 // because that is checked before we get to this point.
158 result =
159 caml_callback2( *callback, Val_int( axis - 1 ), caml_copy_double( n ) );
160
161 // Copy the OCaml callback output to the proper location.
162 snprintf( label, length, "%s", String_val( result ) );
163
164 CAMLreturn0;
165 }
166
167 // OCaml callback for plsabort
168 void ml_abort( const char* message )
169 {
170 CAMLparam0();
171 CAMLlocal1( result );
172
173 // Get the OCaml callback function (if there is one)
174 static value * handler = NULL;
175 if ( handler == NULL )
176 handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME );
177
178 // No check to see if a callback function has been designated yet,
179 // because that is checked before we get to this point.
180 result =
181 caml_callback( *handler, caml_copy_string( message ) );
182
183 CAMLreturn0;
184 }
185
186 // OCaml callback for plsexit
187 int ml_exit( const char* message )
188 {
189 CAMLparam0();
190 CAMLlocal1( result );
191
192 // Get the OCaml callback function (if there is one)
193 static value * handler = NULL;
194 if ( handler == NULL )
195 handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME );
196
197 // No check to see if a callback function has been designated yet,
198 // because that is checked before we get to this point.
199 result =
200 caml_callback( *handler, caml_copy_string( message ) );
201
202 CAMLreturn( Int_val( result ) );
203 }
204
205 // A simple routine to wrap a properly registered OCaml callback in a form
206 // usable by PLPlot routines. If an appropriate callback is not registered
207 // then nothing is done.
208 void ml_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data )
209 {
210 CAMLparam0();
211 CAMLlocal1( result );
212
213 // Get the OCaml callback function (if there is one)
214 static value * transform = NULL;
215 if ( transform == NULL )
216 transform = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME );
217
218 // No check to see if a callback function has been designated yet,
219 // because that is checked before we get to this point.
220 result =
221 caml_callback2( *transform, caml_copy_double( x ), caml_copy_double( y ) );
222
223 *xt = Double_val( Field( result, 0 ) );
224 *yt = Double_val( Field( result, 1 ) );
225
226 CAMLreturn0;
227 }
228
229 // Check if the matching OCaml callback is defined. Return NULL if it is not,
230 // and the proper function pointer if it is.
231 ML_PLOTTER_FUNC get_ml_plotter_func()
232 {
233 static value * pltr = NULL;
234 if ( pltr == NULL )
235 pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME );
236
237 if ( pltr == NULL || Val_int( 0 ) == *pltr )
238 {
239 // No plotter defined
240 return NULL;
241 }
242 else
243 {
244 // Plotter is defined
245 return ml_plotter;
246 }
247 }
248 ML_DEFINED_FUNC get_ml_defined_func()
249 {
250 static value * defined = NULL;
251 if ( defined == NULL )
252 defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME );
253
254 if ( defined == NULL || Val_int( 0 ) == *defined )
255 {
256 // No plotter defined
257 return NULL;
258 }
259 else
260 {
261 // Plotter is defined
262 return ml_defined;
263 }
264 }
265 ML_MAPFORM_FUNC get_ml_mapform_func()
266 {
267 static value * mapform = NULL;
268 if ( mapform == NULL )
269 mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME );
270
271 if ( mapform == NULL || Val_int( 0 ) == *mapform )
272 {
273 // No plotter defined
274 return NULL;
275 }
276 else
277 {
278 // Plotter is defined
279 return ml_mapform;
280 }
281 }
282
283 // Custom wrapper for plslabelfunc
284 value ml_plslabelfunc( value unit )
285 {
286 CAMLparam1( unit );
287 static value * label = NULL;
288 if ( label == NULL )
289 label = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME );
290
291 if ( label == NULL || Val_int( 0 ) == *label )
292 {
293 // No plotter defined
294 plslabelfunc( NULL, NULL );
295 }
296 else
297 {
298 // Plotter is defined
299 plslabelfunc( ml_labelfunc, NULL );
300 }
301
302 CAMLreturn( Val_unit );
303 }
304
305 // Custom wrappers for plsabort and plsexit
306 value ml_plsabort( value unit )
307 {
308 CAMLparam1( unit );
309 static value * handler = NULL;
310 if ( handler == NULL )
311 handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME );
312
313 if ( handler == NULL || Val_int( 0 ) == *handler )
314 {
315 // No handler defined
316 plsabort( NULL );
317 }
318 else
319 {
320 // Handler is defined
321 plsabort( ml_abort );
322 }
323 CAMLreturn( Val_unit );
324 }
325 value ml_plsexit( value unit )
326 {
327 CAMLparam1( unit );
328 static value * handler = NULL;
329 if ( handler == NULL )
330 handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME );
331
332 if ( handler == NULL || Val_int( 0 ) == *handler )
333 {
334 // No handler defined
335 plsexit( NULL );
336 }
337 else
338 {
339 // Handler is defined
340 plsexit( ml_exit );
341 }
342 CAMLreturn( Val_unit );
343 }
344
345 // Set a global coordinate transform
346 value ml_plstransform( value unit )
347 {
348 CAMLparam1( unit );
349 static value * handler = NULL;
350 if ( handler == NULL )
351 handler = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME );
352
353 if ( handler == NULL || Val_int( 0 ) == *handler )
354 {
355 // No handler defined
356 plstransform( NULL, NULL );
357 }
358 else
359 {
360 // Handler is defined
361 plstransform( ml_transform, NULL );
362 }
363 CAMLreturn( Val_unit );
364 }
365
366 //
367 //
368 // CONTOURING, SHADING and IMAGE FUNCTIONS
369 //
370 //
371
372 //
373 // void
374 // c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx,
375 // PLINT ky, PLINT ly, PLFLT *clevel, PLINT nlevel,
376 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
377 // PLPointer pltr_data);
378 //
379 void ml_plcont( const PLFLT **f, PLINT nx, PLINT ny,
380 PLINT kx, PLINT lx, PLINT ky, PLINT ly,
381 PLFLT *clevel, PLINT nlevel )
382 {
383 if ( get_ml_plotter_func() == NULL )
384 {
385 // This is handled in PLplot, but the error is raised here to clarify
386 // what the user needs to do since the custom plotter is defined
387 // separately from the call to plcont.
388 caml_invalid_argument( "A custom plotter must be defined \
389 before calling plcont" );
390 }
391 else
392 {
393 c_plcont( f, nx, ny, kx, lx, ky, ly, clevel, nlevel,
394 get_ml_plotter_func(), (void *) 1 );
395 }
396 }
397
398 //
399 // void
400 // c_plshade(PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
401 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
402 // PLFLT shade_min, PLFLT shade_max,
403 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width,
404 // PLINT min_color, PLINT min_width,
405 // PLINT max_color, PLINT max_width,
406 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
407 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
408 // PLPointer pltr_data);
409 //
410 void ml_plshade( const PLFLT **a, PLINT nx, PLINT ny,
411 PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
412 PLFLT shade_min, PLFLT shade_max,
413 PLINT sh_cmap, PLFLT sh_color, PLFLT sh_width,
414 PLINT min_color, PLFLT min_width,
415 PLINT max_color, PLFLT max_width,
416 PLBOOL rectangular )
417 {
418 c_plshade( a, nx, ny,
419 get_ml_defined_func(),
420 left, right, bottom, top,
421 shade_min, shade_max,
422 sh_cmap, sh_color, sh_width, min_color, min_width,
423 max_color, max_width, plfill, rectangular,
424 get_ml_plotter_func(), (void *) 1 );
425 }
426
427 //
428 // void
429 // c_plshade1(PLFLT *a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
430 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
431 // PLFLT shade_min, PLFLT shade_max,
432 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width,
433 // PLINT min_color, PLINT min_width,
434 // PLINT max_color, PLINT max_width,
435 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
436 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
437 // PLPointer pltr_data);
438 //
439
440 //
441 // void
442 // c_plshades( PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
443 // PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
444 // PLFLT *clevel, PLINT nlevel, PLINT fill_width,
445 // PLINT cont_color, PLINT cont_width,
446 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
447 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
448 // PLPointer pltr_data);
449 //
450 void ml_plshades( const PLFLT **a, PLINT nx, PLINT ny,
451 PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
452 PLFLT *clevel, PLINT nlevel, PLFLT fill_width,
453 PLINT cont_color, PLFLT cont_width,
454 PLBOOL rectangular )
455 {
456 c_plshades( a, nx, ny,
457 get_ml_defined_func(),
458 xmin, xmax, ymin, ymax,
459 clevel, nlevel, fill_width,
460 cont_color, cont_width,
461 plfill, rectangular,
462 get_ml_plotter_func(),
463 (void *) 1 );
464 }
465
466 //
467 // void
468 // c_plimagefr(PLFLT **idata, PLINT nx, PLINT ny,
469 // PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax,
470 // PLFLT valuemin, PLFLT valuemax,
471 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
472 // PLPointer pltr_data);
473 //
474 void ml_plimagefr( const PLFLT **idata, PLINT nx, PLINT ny,
475 PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
476 PLFLT zmin, PLFLT zmax,
477 PLFLT valuemin, PLFLT valuemax )
478 {
479 c_plimagefr( idata, nx, ny,
480 xmin, xmax, ymin, ymax,
481 zmin, zmax,
482 valuemin, valuemax,
483 get_ml_plotter_func(),
484 (void *) 1 );
485 }
486
487 //
488 // void
489 // c_plvect(PLFLT **u, PLFLT **v, PLINT nx, PLINT ny, PLFLT scale,
490 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
491 // PLPointer pltr_data);
492 //
493 void ml_plvect( const PLFLT **u, const PLFLT **v, PLINT nx, PLINT ny, PLFLT scale )
494 {
495 c_plvect( u, v, nx, ny, scale,
496 get_ml_plotter_func(),
497 (void *) 1 );
498 }
499
500 //
501 // Wrapper to reset vector rendering
502 //
503 void ml_plsvect_reset()
504 {
505 c_plsvect( NULL, NULL, 0, 0 );
506 }
507
508 //
509 // void
510 // c_plmap( void (*mapform)(PLINT, PLFLT *, PLFLT *), const char *type,
511 // PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
512 //
513 void ml_plmap( const char *type,
514 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
515 {
516 c_plmap( get_ml_mapform_func(),
517 type, minlong, maxlong, minlat, maxlat );
518 }
519
520 //
521 // void
522 // c_plmeridians( void (*mapform)(PLINT, PLFLT *, PLFLT *),
523 // PLFLT dlong, PLFLT dlat,
524 // PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
525 //
526 void ml_plmeridians( PLFLT dlong, PLFLT dlat,
527 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
528 {
529 c_plmeridians( get_ml_mapform_func(),
530 dlong, dlat, minlong, maxlong, minlat, maxlat );
531 }
532
533 //
534 // void
535 // c_plgriddata(PLFLT *x, PLFLT *y, PLFLT *z, PLINT npts,
536 // PLFLT *xg, PLINT nptsx, PLFLT *yg, PLINT nptsy,
537 // PLFLT **zg, PLINT type, PLFLT data);
538 //
539 // This one is currently wrapped by hand, as I am not sure how to get camlidl
540 // to allocate zg in a way that makes plgriddata happy and doesn't require the
541 // user to pre-allocate the space.
542 value ml_plgriddata( value x, value y, value z,
543 value xg, value yg,
544 value type, value data )
545 {
546 CAMLparam5( x, y, z, xg, yg );
547 CAMLxparam2( type, data );
548
549 // zg holds the OCaml float array array.
550 // y_ml_array is a temporary structure which will be used to form each
551 // float array making up zg.
552 CAMLlocal2( zg, y_ml_array );
553
554 PLFLT **zg_local;
555
556 int npts, nptsx, nptsy;
557 int i, j;
558
559 // Check to make sure x, y and z are all the same length.
560 npts = Wosize_val( x ) / Double_wosize;
561 if ( ( Wosize_val( y ) / Double_wosize != Wosize_val( z ) / Double_wosize ) ||
562 ( Wosize_val( y ) / Double_wosize != npts ) ||
563 ( Wosize_val( z ) / Double_wosize != npts )
564 )
565 {
566 caml_failwith( "ml_plgriddata: x, y, z must all have the same dimensions" );
567 }
568
569 nptsx = Wosize_val( xg ) / Double_wosize;
570 nptsy = Wosize_val( yg ) / Double_wosize;
571
572 // Allocate the 2D grid in a way that will make PLplot happy
573 plAlloc2dGrid( &zg_local, nptsx, nptsy );
574
575 // Using "type + 1" because "type" is passed in as a variant type, so
576 // the indexing starts from 0 rather than 1.
577 c_plgriddata( (double *) x, (double *) y, (double *) z, npts, (double *) xg, nptsx,
578 (double *) yg, nptsy, zg_local, Int_val( type ) + 1,
579 Double_val( data ) );
580
581 // Allocate the X-dimension of the to-be-returned OCaml array
582 zg = caml_alloc( nptsx, 0 );
583
584 for ( i = 0; i < nptsx; i++ )
585 {
586 // Allocate each Y-dimension array of the OCaml array
587 y_ml_array = caml_alloc( nptsy * Double_wosize, Double_array_tag );
588 for ( j = 0; j < nptsy; j++ )
589 {
590 Store_double_field( y_ml_array, j, zg_local[i][j] );
591 }
592 caml_modify( &Field( zg, i ), y_ml_array );
593 }
594
595 // Free the memory used by the C array
596 plFree2dGrid( zg_local, nptsx, nptsy );
597
598 CAMLreturn( zg );
599 }
600
601 value ml_plgriddata_bytecode( value* argv, int argn )
602 {
603 return ml_plgriddata( argv[0], argv[1], argv[2], argv[3], argv[4],
604 argv[5], argv[6] );
605 }
606
607 //
608 // void
609 // c_plpoly3(PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLBOOL *draw, PLBOOL ifcc);
610 //
611 // plpoly3 is wrapped by hand because draw has a length of (n - 1) and camlidl
612 // does not have a way to indicate this automatically.
613 void ml_plpoly3( PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLINT ndraw, PLBOOL *draw, PLBOOL ifcc )
614 {
615 plpoly3( n, x, y, z, draw, ifcc );
616 }
617
618 // Raise Invalid_argument if the given value is <> 0
619 void plplot_check_nonzero_result( int result )
620 {
621 if ( result != 0 )
622 {
623 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
624 sprintf( exception_message, "Error, return code %d", result );
625 caml_invalid_argument( exception_message );
626 }
627 return;
628 }
629
630 // Translate the integer version of the OCaml variant to the appropriate
631 // PLplot constant.
632 int translate_parse_option( int parse_option )
633 {
634 int translated_option;
635 switch ( parse_option )
636 {
637 case 0: translated_option = PL_PARSE_PARTIAL; break;
638 case 1: translated_option = PL_PARSE_FULL; break;
639 case 2: translated_option = PL_PARSE_QUIET; break;
640 case 3: translated_option = PL_PARSE_NODELETE; break;
641 case 4: translated_option = PL_PARSE_SHOWALL; break;
642 case 5: translated_option = PL_PARSE_OVERRIDE; break;
643 case 6: translated_option = PL_PARSE_NOPROGRAM; break;
644 case 7: translated_option = PL_PARSE_NODASH; break;
645 case 8: translated_option = PL_PARSE_SKIP; break;
646 default: translated_option = -1;
647 }
648 return translated_option;
649 }
650
651 // Copy a string array
652 #define INIT_STRING_ARRAY( o ) \
653 int o ## _length; \
654 o ## _length = Wosize_val( o ); \
655 const char *c_ ## o[o ## _length]; \
656 for ( i = 0; i < o ## _length; i++ ) { c_ ## o[i] = String_val( Field( o, i ) ); }
657
658 // Copy an int array, o, of n element to the C array c
659 #define INIT_INT_ARRAY( o ) \
660 int o ## _length; \
661 o ## _length = Wosize_val( o ); \
662 int c_ ## o[o ## _length]; \
663 for ( i = 0; i < ( o ## _length ); i++ ) { ( c_ ## o )[i] = Int_val( Field( ( o ), i ) ); }
664
665 // Copy an int array, o, of n element to the C array c
666 #define INIT_INT_ARRAYS( o ) \
667 int o ## _length, o ## _inner; \
668 o ## _length = Wosize_val( o ); \
669 int *c_ ## o[o ## _length]; \
670 for ( i = 0; i < ( o ## _length ); i++ ) { \
671 INIT_INT_ARRAY( o ## _subarray ); \
672 ( c_ ## o )[i] = c_ ## o ## _subarray; \
673 }
674
675 int lor_ml_list( value list, ML_VARIANT_FUNC variant_f )
676 {
677 CAMLparam1( list );
678 int result;
679
680 result = 0;
681 while ( list != Val_emptylist )
682 {
683 // Accumulate the elements of the list
684 result = result | variant_f( Int_val( Field( list, 0 ) ) );
685 // Point to the tail of the list for the next loop
686 list = Field( list, 1 );
687 }
688
689 CAMLreturn( result );
690 }
691
692 value ml_plparseopts( value argv, value parse_method )
693 {
694 CAMLparam2( argv, parse_method );
695 int i;
696 int result;
697 int combined_parse_method;
698 // Make a copy of the command line argument strings
699 INIT_STRING_ARRAY( argv )
700
701 // OR the elements of the parse_method list together
702 combined_parse_method = lor_ml_list( parse_method, translate_parse_option );
703
704 result = plparseopts( &argv_length, c_argv, combined_parse_method );
705 if ( result != 0 )
706 {
707 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
708 sprintf( exception_message, "Invalid arguments in plparseopts, error %d", result );
709 caml_invalid_argument( exception_message );
710 }
711 CAMLreturn( Val_unit );
712 }
713
714 value ml_plstripc( value xspec, value yspec, value xmin, value xmax, value xjump,
715 value ymin, value ymax, value xlpos, value ylpos, value y_ascl,
716 value acc, value colbox, value collab, value colline, value styline,
717 value legline, value labx, value laby, value labtop )
718 {
719 // Function parameters
720 CAMLparam5( xspec, yspec, xmin, xmax, xjump );
721 CAMLxparam5( ymin, ymax, xlpos, ylpos, y_ascl );
722 CAMLxparam5( acc, colbox, collab, colline, styline );
723 CAMLxparam4( legline, labx, laby, labtop );
724 // Line attribute array copies
725 int colline_copy[4];
726 int styline_copy[4];
727 const char* legend_copy[4];
728 int i;
729 for ( i = 0; i < 4; i++ )
730 {
731 colline_copy[i] = Int_val( Field( colline, i ) );
732 styline_copy[i] = Int_val( Field( styline, i ) );
733 legend_copy[i] = String_val( Field( legline, i ) );
734 }
735 // The returned value
736 int id;
737 plstripc( &id, String_val( xspec ), String_val( yspec ),
738 Double_val( xmin ), Double_val( xmax ),
739 Double_val( xjump ), Double_val( ymin ), Double_val( ymax ),
740 Double_val( xlpos ), Double_val( ylpos ), Bool_val( y_ascl ),
741 Bool_val( acc ), Int_val( colbox ), Int_val( collab ),
742 colline_copy, styline_copy, legend_copy,
743 String_val( labx ), String_val( laby ), String_val( labtop ) );
744 // Make me do something!
745 CAMLreturn( Val_int( id ) );
746 }
747
748 value ml_plstripc_byte( value* argv, int argn )
749 {
750 return ml_plstripc( argv[0], argv[1], argv[2], argv[3], argv[4],
751 argv[5], argv[6], argv[7], argv[8], argv[9],
752 argv[10], argv[11], argv[12], argv[13], argv[14],
753 argv[15], argv[16], argv[17], argv[18] );
754 }
755
756 int translate_legend_option( int legend_option )
757 {
758 int translated_option;
759 switch ( legend_option )
760 {
761 case 0: translated_option = PL_LEGEND_NONE; break;
762 case 1: translated_option = PL_LEGEND_COLOR_BOX; break;
763 case 2: translated_option = PL_LEGEND_LINE; break;
764 case 3: translated_option = PL_LEGEND_SYMBOL; break;
765 case 4: translated_option = PL_LEGEND_TEXT_LEFT; break;
766 case 5: translated_option = PL_LEGEND_BACKGROUND; break;
767 case 6: translated_option = PL_LEGEND_BOUNDING_BOX; break;
768 case 7: translated_option = PL_LEGEND_ROW_MAJOR; break;
769 default: translated_option = -1;
770 }
771 return translated_option;
772 }
773
774 int translate_colorbar_option( int colorbar_option )
775 {
776 int translated_option;
777 switch ( colorbar_option )
778 {
779 case 0: translated_option = PL_COLORBAR_LABEL_LEFT; break;
780 case 1: translated_option = PL_COLORBAR_LABEL_RIGHT; break;
781 case 2: translated_option = PL_COLORBAR_LABEL_TOP; break;
782 case 3: translated_option = PL_COLORBAR_LABEL_BOTTOM; break;
783 case 4: translated_option = PL_COLORBAR_IMAGE; break;
784 case 5: translated_option = PL_COLORBAR_SHADE; break;
785 case 6: translated_option = PL_COLORBAR_GRADIENT; break;
786 case 7: translated_option = PL_COLORBAR_CAP_NONE; break;
787 case 8: translated_option = PL_COLORBAR_CAP_LOW; break;
788 case 9: translated_option = PL_COLORBAR_CAP_HIGH; break;
789 case 10: translated_option = PL_COLORBAR_SHADE_LABEL; break;
790 case 11: translated_option = PL_COLORBAR_ORIENT_RIGHT; break;
791 case 12: translated_option = PL_COLORBAR_ORIENT_TOP; break;
792 case 13: translated_option = PL_COLORBAR_ORIENT_LEFT; break;
793 case 14: translated_option = PL_COLORBAR_ORIENT_BOTTOM; break;
794 case 15: translated_option = PL_COLORBAR_BACKGROUND; break;
795 case 16: translated_option = PL_COLORBAR_BOUNDING_BOX; break;
796 default: translated_option = -1;
797 }
798 return translated_option;
799 }
800
801 int translate_position_option( int position_option )
802 {
803 int translated_option;
804 switch ( position_option )
805 {
806 case 0: translated_option = PL_POSITION_LEFT; break;
807 case 1: translated_option = PL_POSITION_RIGHT; break;
808 case 2: translated_option = PL_POSITION_TOP; break;
809 case 3: translated_option = PL_POSITION_BOTTOM; break;
810 case 4: translated_option = PL_POSITION_INSIDE; break;
811 case 5: translated_option = PL_POSITION_OUTSIDE; break;
812 case 6: translated_option = PL_POSITION_VIEWPORT; break;
813 case 7: translated_option = PL_POSITION_SUBPAGE; break;
814 default: translated_option = -1;
815 }
816 return translated_option;
817 }
818
819 value ml_pllegend( value opt, value position, value x, value y, value plot_width,
820 value bg_color,
821 value bb_color, value bb_style,
822 value nrow, value ncolumn,
823 value opt_array,
824 value text_offset, value text_scale, value text_spacing,
825 value text_justification, value text_colors, value text,
826 value box_colors, value box_patterns, value box_scales,
827 value box_line_widths,
828 value line_colors, value line_styles, value line_widths,
829 value symbol_colors, value symbol_scales,
830 value symbol_numbers, value symbols )
831 {
832 CAMLparam5( position, opt, x, y, plot_width );
833 CAMLxparam5( bg_color, bb_color, bb_style, nrow, ncolumn );
834 CAMLxparam5( opt_array, text_offset, text_scale, text_spacing, text_justification );
835 CAMLxparam5( text_colors, text, box_colors, box_patterns, box_scales );
836 CAMLxparam5( box_line_widths, line_colors, line_styles, line_widths, symbol_colors );
837 CAMLxparam3( symbol_scales, symbol_numbers, symbols );
838 CAMLlocal1( result );
839 result = caml_alloc( 2, 0 );
840
841 // Counter
842 int i;
843 // General legend options
844 int c_position, c_opt;
845 // Number of legend entries
846 int n_legend;
847 n_legend = Wosize_val( opt_array );
848 // Options for each legend entry
849 int c_opt_array[n_legend];
850
851 // Assume that the dimensions all line up on the OCaml side, so we don't
852 // need to do any further dimension checks.
853
854 // Define and initialize all of the C arrays to pass in to pllegend
855 INIT_STRING_ARRAY( text )
856 INIT_INT_ARRAY( text_colors )
857 INIT_INT_ARRAY( box_colors )
858 INIT_INT_ARRAY( box_patterns )
859 INIT_INT_ARRAY( line_colors )
860 INIT_INT_ARRAY( line_styles )
861 INIT_INT_ARRAY( symbol_colors )
862 INIT_INT_ARRAY( symbol_numbers )
863 INIT_STRING_ARRAY( symbols )
864
865 // Translate the legend configuration options
866 c_opt = lor_ml_list( opt, translate_legend_option );
867 c_position = lor_ml_list( position, translate_position_option );
868
869 for ( i = 0; i < n_legend; i++ )
870 {
871 c_opt_array[i] =
872 lor_ml_list( Field( opt_array, i ), translate_legend_option );
873 }
874
875 // The returned width and height of the legend
876 PLFLT width, height;
877
878 pllegend( &width, &height, c_opt, c_position, Double_val( x ), Double_val( y ),
879 Double_val( plot_width ), Int_val( bg_color ),
880 Int_val( bb_color ), Int_val( bb_style ),
881 Int_val( nrow ), Int_val( ncolumn ),
882 n_legend, c_opt_array,
883 Double_val( text_offset ), Double_val( text_scale ),
884 Double_val( text_spacing ),
885 Double_val( text_justification ),
886 c_text_colors, c_text,
887 c_box_colors, c_box_patterns, (double *) box_scales,
888 (double *) box_line_widths,
889 c_line_colors, c_line_styles, (double *) line_widths,
890 c_symbol_colors, (double *) symbol_scales, c_symbol_numbers,
891 c_symbols );
892
893 // Return a tuple with the legend's size
894 Store_field( result, 0, caml_copy_double( width ) );
895 Store_field( result, 1, caml_copy_double( height ) );
896
897 CAMLreturn( result );
898 }
899
900 value ml_pllegend_byte( value* argv, int argn )
901 {
902 return ml_pllegend( argv[0], argv[1], argv[2], argv[3], argv[4],
903 argv[5], argv[6], argv[7], argv[8], argv[9],
904 argv[10], argv[11], argv[12], argv[13], argv[14],
905 argv[15], argv[16], argv[17], argv[18], argv[19],
906 argv[20], argv[21], argv[22], argv[23], argv[24],
907 argv[25], argv[26], argv[27] );
908 }
909
910 value ml_plcolorbar( value opt, value position, value x, value y,
911 value x_length, value y_length,
912 value bg_color, value bb_color, value bb_style,
913 value low_cap_color, value high_cap_color,
914 value cont_color, value cont_width,
915 value label_opts, value label,
916 value axis_opts,
917 value ticks, value sub_ticks,
918 value values )
919 {
920 CAMLparam5( opt, position, x, y, x_length );
921 CAMLxparam5( y_length, bg_color, bb_color, bb_style, low_cap_color );
922 CAMLxparam5( high_cap_color, cont_color, cont_width, label_opts, label );
923 CAMLxparam4( axis_opts, ticks, sub_ticks, values );
924 CAMLlocal1( result );
925 result = caml_alloc( 2, 0 );
926
927 // Counter
928 int i;
929 // General colorbar options
930 int c_opt, c_position;
931 // Number of labels
932 int n_labels;
933 n_labels = Wosize_val( label_opts );
934 // Number of axes and value ranges
935 int n_axes;
936 n_axes = Wosize_val( axis_opts );
937
938 // Translate configuration options
939 c_opt = lor_ml_list( opt, translate_colorbar_option );
940 c_position = lor_ml_list( position, translate_position_option );
941
942 // Assume that the dimensions all line up on the OCaml side, so we don't
943 // need to do any further dimension checks.
944
945 // Define and initialize all of the C arrays to pass into plcolorbar
946 INIT_STRING_ARRAY( label )
947 INIT_STRING_ARRAY( axis_opts )
948 INIT_INT_ARRAY( sub_ticks );
949
950 // Label options
951 int c_label_opts[ n_labels ];
952 for ( i = 0; i < n_labels; i++ )
953 {
954 c_label_opts[i] = lor_ml_list( Field( label_opts, i ), translate_colorbar_option );
955 }
956
957 // Copy the axis/range values
958 double **c_values;
959 int n_values[ n_axes ];
960 c_values = malloc( n_axes * sizeof ( double * ) );
961 // TODO: Add allocation failure check
962 for ( i = 0; i < n_axes; i++ )
963 {
964 c_values[i] = (double *) Field( values, i );
965 n_values[i] = Wosize_val( Field( values, i ) ) / Double_wosize;
966 }
967
968 // Return values
969 PLFLT width, height;
970
971 plcolorbar( &width, &height,
972 c_opt, c_position, Double_val( x ), Double_val( y ),
973 Double_val( x_length ), Double_val( y_length ),
974 Int_val( bg_color ), Int_val( bb_color ), Int_val( bb_style ),
975 Double_val( low_cap_color ), Double_val( high_cap_color ),
976 Int_val( cont_color ), Double_val( cont_width ),
977 n_labels, c_label_opts, c_label,
978 n_axes, c_axis_opts,
979 (double *) ticks, c_sub_ticks,
980 n_values, (const PLFLT * const *) c_values );
981
982 // Return a tuple with the colorbar's size
983 Store_field( result, 0, caml_copy_double( width ) );
984 Store_field( result, 1, caml_copy_double( height ) );
985
986 CAMLreturn( result );
987 }
988
989 value ml_plcolorbar_byte( value *argv, int argn )
990 {
991 return ml_plcolorbar( argv[0], argv[1], argv[2], argv[3], argv[4],
992 argv[5], argv[6], argv[7], argv[8], argv[9],
993 argv[10], argv[11], argv[12], argv[13], argv[14],
994 argv[15], argv[16], argv[17], argv[18] );
995 }
996
997 // pltr* function implementations
998 void ml_pltr0( double x, double y, double* tx, double* ty )
999 {
1000 pltr0( x, y, tx, ty, NULL );
1001 }
1002
1003 value ml_pltr1( value xg, value yg, value x, value y )
1004 {
1005 CAMLparam4( xg, yg, x, y );
1006 CAMLlocal1( tx_ty );
1007 tx_ty = caml_alloc( 2, 0 );
1008 double tx;
1009 double ty;
1010 PLcGrid grid;
1011 grid.xg = (double *) xg;
1012 grid.yg = (double *) yg;
1013 grid.nx = Wosize_val( xg ) / Double_wosize;
1014 grid.ny = Wosize_val( yg ) / Double_wosize;
1015 pltr1( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
1016
1017 // Allocate a tuple and return it with the results
1018 Store_field( tx_ty, 0, caml_copy_double( tx ) );
1019 Store_field( tx_ty, 1, caml_copy_double( ty ) );
1020 CAMLreturn( tx_ty );
1021 }
1022
1023 value ml_pltr2( value xg, value yg, value x, value y )
1024 {
1025 CAMLparam4( xg, yg, x, y );
1026 CAMLlocal1( tx_ty );
1027 tx_ty = caml_alloc( 2, 0 );
1028 double ** c_xg;
1029 double ** c_yg;
1030 int i;
1031 int length1;
1032 int length2;
1033 PLcGrid2 grid;
1034 double tx;
1035 double ty;
1036
1037 // TODO: As of now, you will probably get a segfault of the xg and yg
1038 // dimensions don't match up properly.
1039 // Build the grid.
1040 // Length of "outer" array
1041 length1 = Wosize_val( xg );
1042 // Length of the "inner" arrays
1043 length2 = Wosize_val( Field( xg, 0 ) ) / Double_wosize;
1044 c_xg = malloc( length1 * sizeof ( double* ) );
1045 for ( i = 0; i < length1; i++ )
1046 {
1047 c_xg[i] = (double *) Field( xg, i );
1048 }
1049 c_yg = malloc( length1 * sizeof ( double* ) );
1050 for ( i = 0; i < length1; i++ )
1051 {
1052 c_yg[i] = (double *) Field( yg, i );
1053 }
1054 grid.xg = c_xg;
1055 grid.yg = c_yg;
1056 grid.nx = length1;
1057 grid.ny = length2;
1058
1059 pltr2( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
1060
1061 // Clean up
1062 free( c_xg );
1063 free( c_yg );
1064
1065 // Allocate a tuple and return it with the results
1066 Store_field( tx_ty, 0, caml_copy_double( tx ) );
1067 Store_field( tx_ty, 1, caml_copy_double( ty ) );
1068 CAMLreturn( tx_ty );
1069 }
1070
1071 // XXX Non-core functions follow XXX
1072 //*
1073 // The following functions are here for (my?) convenience. As far as I can
1074 // tell, they are not defined in the core PLplot library.
1075 //
1076
1077 // Get the current color map 0 color index
1078 int plg_current_col0( void )
1079 {
1080 return plsc->icol0;
1081 }
1082
1083 // Get the current color map 1 color index
1084 PLFLT plg_current_col1( void )
1085 {
1086 return plsc->icol1;
1087 }
1088
1089 // Get the current pen width. TODO: Remove this, as I think this information
1090 // can be retrieved from another proper PLplot function.
1091 PLFLT plgwidth( void )
1092 {
1093 return plsc->width;
1094 }
1095
1096 // Get the current character (text) height in mm. TODO: Remove this, as I
1097 // think this information can be retrieved from another proper PLplot
1098 // function
1099 PLFLT plgchrht( void )
1100 {
1101 return plsc->chrht;
1102 }