PLplot
5.10.0
|
00001 // 00002 // Copyright 2007, 2008, 2009, 2010, 2011 Hezekiah M. Carty 00003 // 00004 // This file is part of PLplot. 00005 // 00006 // PLplot is free software: you can redistribute it and/or modify 00007 // it under the terms of the GNU Lesser General Public License as published by 00008 // the Free Software Foundation, either version 2 of the License, or 00009 // (at your option) any later version. 00010 // 00011 // PLplot is distributed in the hope that it will be useful, 00012 // but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 // GNU Lesser General Public License for more details. 00015 // 00016 // You should have received a copy of the GNU Lesser General Public License 00017 // along with PLplot. If not, see <http://www.gnu.org/licenses/>. 00018 // 00019 00020 // The "usual" OCaml includes 00021 #include <caml/alloc.h> 00022 #include <caml/callback.h> 00023 #include <caml/fail.h> 00024 #include <caml/memory.h> 00025 #include <caml/misc.h> 00026 #include <caml/mlvalues.h> 00027 #include <caml/bigarray.h> 00028 00029 #include <plplotP.h> 00030 #include <plplot.h> 00031 00032 #undef snprintf 00033 00034 #include <stdio.h> 00035 00036 #define MAX_EXCEPTION_MESSAGE_LENGTH 1000 00037 #define CAML_PLPLOT_PLOTTER_FUNC_NAME "caml_plplot_plotter" 00038 #define CAML_PLPLOT_MAPFORM_FUNC_NAME "caml_plplot_mapform" 00039 #define CAML_PLPLOT_DEFINED_FUNC_NAME "caml_plplot_defined" 00040 #define CAML_PLPLOT_LABEL_FUNC_NAME "caml_plplot_customlabel" 00041 #define CAML_PLPLOT_ABORT_FUNC_NAME "caml_plplot_abort" 00042 #define CAML_PLPLOT_EXIT_FUNC_NAME "caml_plplot_exit" 00043 #define CAML_PLPLOT_TRANSFORM_FUNC_NAME "caml_plplot_transform" 00044 00045 typedef void ( *ML_PLOTTER_FUNC )( PLFLT, PLFLT, PLFLT*, PLFLT*, PLPointer ); 00046 typedef PLINT ( *ML_DEFINED_FUNC )( PLFLT, PLFLT ); 00047 typedef void ( *ML_MAPFORM_FUNC )( PLINT, PLFLT*, PLFLT* ); 00048 typedef void ( *ML_LABEL_FUNC )( PLINT, PLFLT, char*, PLINT, PLPointer ); 00049 typedef PLINT ( *ML_VARIANT_FUNC )( PLINT ); 00050 00051 // 00052 // 00053 // CALLBACK WRAPPERS 00054 // 00055 // 00056 00057 // A simple routine to wrap a properly registered OCaml callback in a form 00058 // usable by PLPlot routines. If an appropriate callback is not registered 00059 // then the PLPlot built-in pltr0 function is used instead. 00060 void ml_plotter( PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, PLPointer pltr_data ) 00061 { 00062 CAMLparam0(); 00063 CAMLlocal1( result ); 00064 00065 // Get the OCaml callback function (if there is one) 00066 static value * pltr = NULL; 00067 if ( pltr == NULL ) 00068 pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME ); 00069 00070 // No check to see if a callback function has been designated yet, 00071 // because that is checked before we get to this point. 00072 result = 00073 caml_callback2( *pltr, caml_copy_double( x ), caml_copy_double( y ) ); 00074 double new_x, new_y; 00075 new_x = Double_val( Field( result, 0 ) ); 00076 new_y = Double_val( Field( result, 1 ) ); 00077 00078 *tx = new_x; 00079 *ty = new_y; 00080 00081 CAMLreturn0; 00082 } 00083 00084 // A simple routine to wrap a properly registered OCaml callback in a form 00085 // usable by PLPlot routines. If an appropriate callback is not registered 00086 // then the result is always 1 (the data point is defined). 00087 // This function is used in the plshade* functions to determine if a given data 00088 // point is valid/defined or not. 00089 PLINT ml_defined( PLFLT x, PLFLT y ) 00090 { 00091 CAMLparam0(); 00092 CAMLlocal1( result ); 00093 00094 // The result which will be returned to the user. 00095 PLINT is_it_defined; 00096 00097 // Get the OCaml callback function (if there is one) 00098 static value * defined = NULL; 00099 if ( defined == NULL ) 00100 defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME ); 00101 00102 // No check to see if a callback function has been designated yet, 00103 // because that is checked before we get to this point. 00104 result = 00105 caml_callback2( *defined, caml_copy_double( x ), caml_copy_double( y ) ); 00106 is_it_defined = Int_val( result ); 00107 00108 CAMLreturn( is_it_defined ); 00109 } 00110 00111 // A simple routine to wrap a properly registered OCaml callback in a form 00112 // usable by PLPlot routines. If an appropriate callback is not registered 00113 // then nothing is done. 00114 void ml_mapform( PLINT n, PLFLT *x, PLFLT *y ) 00115 { 00116 CAMLparam0(); 00117 CAMLlocal1( result ); 00118 00119 // Get the OCaml callback function (if there is one) 00120 static value * mapform = NULL; 00121 if ( mapform == NULL ) 00122 mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME ); 00123 00124 // No check to see if a callback function has been designated yet, 00125 // because that is checked before we get to this point. 00126 int i; 00127 for ( i = 0; i < n; i++ ) 00128 { 00129 result = 00130 caml_callback2( *mapform, 00131 caml_copy_double( x[i] ), caml_copy_double( y[i] ) ); 00132 00133 double new_x, new_y; 00134 new_x = Double_val( Field( result, 0 ) ); 00135 new_y = Double_val( Field( result, 1 ) ); 00136 00137 x[i] = new_x; 00138 y[i] = new_y; 00139 } 00140 00141 CAMLreturn0; 00142 } 00143 00144 // A simple routine to wrap a properly registered OCaml callback in a form 00145 // usable by PLPlot routines. 00146 void ml_labelfunc( PLINT axis, PLFLT n, char *label, PLINT length, PLPointer d ) 00147 { 00148 CAMLparam0(); 00149 CAMLlocal1( result ); 00150 00151 // Get the OCaml callback function (if there is one) 00152 static value * callback = NULL; 00153 if ( callback == NULL ) 00154 callback = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME ); 00155 00156 // No check to see if a callback function has been designated yet, 00157 // because that is checked before we get to this point. 00158 result = 00159 caml_callback2( *callback, Val_int( axis - 1 ), caml_copy_double( n ) ); 00160 00161 // Copy the OCaml callback output to the proper location. 00162 snprintf( label, length, "%s", String_val( result ) ); 00163 00164 CAMLreturn0; 00165 } 00166 00167 // OCaml callback for plsabort 00168 void ml_abort( const char* message ) 00169 { 00170 CAMLparam0(); 00171 CAMLlocal1( result ); 00172 00173 // Get the OCaml callback function (if there is one) 00174 static value * handler = NULL; 00175 if ( handler == NULL ) 00176 handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME ); 00177 00178 // No check to see if a callback function has been designated yet, 00179 // because that is checked before we get to this point. 00180 result = 00181 caml_callback( *handler, caml_copy_string( message ) ); 00182 00183 CAMLreturn0; 00184 } 00185 00186 // OCaml callback for plsexit 00187 int ml_exit( const char* message ) 00188 { 00189 CAMLparam0(); 00190 CAMLlocal1( result ); 00191 00192 // Get the OCaml callback function (if there is one) 00193 static value * handler = NULL; 00194 if ( handler == NULL ) 00195 handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME ); 00196 00197 // No check to see if a callback function has been designated yet, 00198 // because that is checked before we get to this point. 00199 result = 00200 caml_callback( *handler, caml_copy_string( message ) ); 00201 00202 CAMLreturn( Int_val( result ) ); 00203 } 00204 00205 // A simple routine to wrap a properly registered OCaml callback in a form 00206 // usable by PLPlot routines. If an appropriate callback is not registered 00207 // then nothing is done. 00208 void ml_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data ) 00209 { 00210 CAMLparam0(); 00211 CAMLlocal1( result ); 00212 00213 // Get the OCaml callback function (if there is one) 00214 static value * transform = NULL; 00215 if ( transform == NULL ) 00216 transform = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME ); 00217 00218 // No check to see if a callback function has been designated yet, 00219 // because that is checked before we get to this point. 00220 result = 00221 caml_callback2( *transform, caml_copy_double( x ), caml_copy_double( y ) ); 00222 00223 *xt = Double_val( Field( result, 0 ) ); 00224 *yt = Double_val( Field( result, 1 ) ); 00225 00226 CAMLreturn0; 00227 } 00228 00229 // Check if the matching OCaml callback is defined. Return NULL if it is not, 00230 // and the proper function pointer if it is. 00231 ML_PLOTTER_FUNC get_ml_plotter_func() 00232 { 00233 static value * pltr = NULL; 00234 if ( pltr == NULL ) 00235 pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME ); 00236 00237 if ( pltr == NULL || Val_int( 0 ) == *pltr ) 00238 { 00239 // No plotter defined 00240 return NULL; 00241 } 00242 else 00243 { 00244 // Plotter is defined 00245 return ml_plotter; 00246 } 00247 } 00248 ML_DEFINED_FUNC get_ml_defined_func() 00249 { 00250 static value * defined = NULL; 00251 if ( defined == NULL ) 00252 defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME ); 00253 00254 if ( defined == NULL || Val_int( 0 ) == *defined ) 00255 { 00256 // No plotter defined 00257 return NULL; 00258 } 00259 else 00260 { 00261 // Plotter is defined 00262 return ml_defined; 00263 } 00264 } 00265 ML_MAPFORM_FUNC get_ml_mapform_func() 00266 { 00267 static value * mapform = NULL; 00268 if ( mapform == NULL ) 00269 mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME ); 00270 00271 if ( mapform == NULL || Val_int( 0 ) == *mapform ) 00272 { 00273 // No plotter defined 00274 return NULL; 00275 } 00276 else 00277 { 00278 // Plotter is defined 00279 return ml_mapform; 00280 } 00281 } 00282 00283 // Custom wrapper for plslabelfunc 00284 value ml_plslabelfunc( value unit ) 00285 { 00286 CAMLparam1( unit ); 00287 static value * label = NULL; 00288 if ( label == NULL ) 00289 label = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME ); 00290 00291 if ( label == NULL || Val_int( 0 ) == *label ) 00292 { 00293 // No plotter defined 00294 plslabelfunc( NULL, NULL ); 00295 } 00296 else 00297 { 00298 // Plotter is defined 00299 plslabelfunc( ml_labelfunc, NULL ); 00300 } 00301 00302 CAMLreturn( Val_unit ); 00303 } 00304 00305 // Custom wrappers for plsabort and plsexit 00306 value ml_plsabort( value unit ) 00307 { 00308 CAMLparam1( unit ); 00309 static value * handler = NULL; 00310 if ( handler == NULL ) 00311 handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME ); 00312 00313 if ( handler == NULL || Val_int( 0 ) == *handler ) 00314 { 00315 // No handler defined 00316 plsabort( NULL ); 00317 } 00318 else 00319 { 00320 // Handler is defined 00321 plsabort( ml_abort ); 00322 } 00323 CAMLreturn( Val_unit ); 00324 } 00325 value ml_plsexit( value unit ) 00326 { 00327 CAMLparam1( unit ); 00328 static value * handler = NULL; 00329 if ( handler == NULL ) 00330 handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME ); 00331 00332 if ( handler == NULL || Val_int( 0 ) == *handler ) 00333 { 00334 // No handler defined 00335 plsexit( NULL ); 00336 } 00337 else 00338 { 00339 // Handler is defined 00340 plsexit( ml_exit ); 00341 } 00342 CAMLreturn( Val_unit ); 00343 } 00344 00345 // Set a global coordinate transform 00346 value ml_plstransform( value unit ) 00347 { 00348 CAMLparam1( unit ); 00349 static value * handler = NULL; 00350 if ( handler == NULL ) 00351 handler = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME ); 00352 00353 if ( handler == NULL || Val_int( 0 ) == *handler ) 00354 { 00355 // No handler defined 00356 plstransform( NULL, NULL ); 00357 } 00358 else 00359 { 00360 // Handler is defined 00361 plstransform( ml_transform, NULL ); 00362 } 00363 CAMLreturn( Val_unit ); 00364 } 00365 00366 // 00367 // 00368 // CONTOURING, SHADING and IMAGE FUNCTIONS 00369 // 00370 // 00371 00372 // 00373 // void 00374 // c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx, 00375 // PLINT ky, PLINT ly, PLFLT *clevel, PLINT nlevel, 00376 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00377 // PLPointer pltr_data); 00378 // 00379 void ml_plcont( const PLFLT **f, PLINT nx, PLINT ny, 00380 PLINT kx, PLINT lx, PLINT ky, PLINT ly, 00381 PLFLT *clevel, PLINT nlevel ) 00382 { 00383 if ( get_ml_plotter_func() == NULL ) 00384 { 00385 // This is handled in PLplot, but the error is raised here to clarify 00386 // what the user needs to do since the custom plotter is defined 00387 // separately from the call to plcont. 00388 caml_invalid_argument( "A custom plotter must be defined \ 00389 before calling plcont" ); 00390 } 00391 else 00392 { 00393 c_plcont( f, nx, ny, kx, lx, ky, ly, clevel, nlevel, 00394 get_ml_plotter_func(), (void *) 1 ); 00395 } 00396 } 00397 00398 // 00399 // void 00400 // c_plshade(PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT), 00401 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top, 00402 // PLFLT shade_min, PLFLT shade_max, 00403 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width, 00404 // PLINT min_color, PLINT min_width, 00405 // PLINT max_color, PLINT max_width, 00406 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular, 00407 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00408 // PLPointer pltr_data); 00409 // 00410 void ml_plshade( const PLFLT **a, PLINT nx, PLINT ny, 00411 PLFLT left, PLFLT right, PLFLT bottom, PLFLT top, 00412 PLFLT shade_min, PLFLT shade_max, 00413 PLINT sh_cmap, PLFLT sh_color, PLFLT sh_width, 00414 PLINT min_color, PLFLT min_width, 00415 PLINT max_color, PLFLT max_width, 00416 PLBOOL rectangular ) 00417 { 00418 c_plshade( a, nx, ny, 00419 get_ml_defined_func(), 00420 left, right, bottom, top, 00421 shade_min, shade_max, 00422 sh_cmap, sh_color, sh_width, min_color, min_width, 00423 max_color, max_width, plfill, rectangular, 00424 get_ml_plotter_func(), (void *) 1 ); 00425 } 00426 00427 // 00428 // void 00429 // c_plshade1(PLFLT *a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT), 00430 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top, 00431 // PLFLT shade_min, PLFLT shade_max, 00432 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width, 00433 // PLINT min_color, PLINT min_width, 00434 // PLINT max_color, PLINT max_width, 00435 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular, 00436 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00437 // PLPointer pltr_data); 00438 // 00439 00440 // 00441 // void 00442 // c_plshades( PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT), 00443 // PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, 00444 // PLFLT *clevel, PLINT nlevel, PLINT fill_width, 00445 // PLINT cont_color, PLINT cont_width, 00446 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular, 00447 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00448 // PLPointer pltr_data); 00449 // 00450 void ml_plshades( const PLFLT **a, PLINT nx, PLINT ny, 00451 PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, 00452 PLFLT *clevel, PLINT nlevel, PLFLT fill_width, 00453 PLINT cont_color, PLFLT cont_width, 00454 PLBOOL rectangular ) 00455 { 00456 c_plshades( a, nx, ny, 00457 get_ml_defined_func(), 00458 xmin, xmax, ymin, ymax, 00459 clevel, nlevel, fill_width, 00460 cont_color, cont_width, 00461 plfill, rectangular, 00462 get_ml_plotter_func(), 00463 (void *) 1 ); 00464 } 00465 00466 // 00467 // void 00468 // c_plimagefr(PLFLT **idata, PLINT nx, PLINT ny, 00469 // PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax, 00470 // PLFLT valuemin, PLFLT valuemax, 00471 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00472 // PLPointer pltr_data); 00473 // 00474 void ml_plimagefr( const PLFLT **idata, PLINT nx, PLINT ny, 00475 PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, 00476 PLFLT zmin, PLFLT zmax, 00477 PLFLT valuemin, PLFLT valuemax ) 00478 { 00479 c_plimagefr( idata, nx, ny, 00480 xmin, xmax, ymin, ymax, 00481 zmin, zmax, 00482 valuemin, valuemax, 00483 get_ml_plotter_func(), 00484 (void *) 1 ); 00485 } 00486 00487 // 00488 // void 00489 // c_plvect(PLFLT **u, PLFLT **v, PLINT nx, PLINT ny, PLFLT scale, 00490 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00491 // PLPointer pltr_data); 00492 // 00493 void ml_plvect( const PLFLT **u, const PLFLT **v, PLINT nx, PLINT ny, PLFLT scale ) 00494 { 00495 c_plvect( u, v, nx, ny, scale, 00496 get_ml_plotter_func(), 00497 (void *) 1 ); 00498 } 00499 00500 // 00501 // Wrapper to reset vector rendering 00502 // 00503 void ml_plsvect_reset() 00504 { 00505 c_plsvect( NULL, NULL, 0, 0 ); 00506 } 00507 00508 // 00509 // void 00510 // c_plmap( void (*mapform)(PLINT, PLFLT *, PLFLT *), const char *type, 00511 // PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat ); 00512 // 00513 void ml_plmap( const char *type, 00514 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat ) 00515 { 00516 c_plmap( get_ml_mapform_func(), 00517 type, minlong, maxlong, minlat, maxlat ); 00518 } 00519 00520 // 00521 // void 00522 // c_plmeridians( void (*mapform)(PLINT, PLFLT *, PLFLT *), 00523 // PLFLT dlong, PLFLT dlat, 00524 // PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat ); 00525 // 00526 void ml_plmeridians( PLFLT dlong, PLFLT dlat, 00527 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat ) 00528 { 00529 c_plmeridians( get_ml_mapform_func(), 00530 dlong, dlat, minlong, maxlong, minlat, maxlat ); 00531 } 00532 00533 // 00534 // void 00535 // c_plgriddata(PLFLT *x, PLFLT *y, PLFLT *z, PLINT npts, 00536 // PLFLT *xg, PLINT nptsx, PLFLT *yg, PLINT nptsy, 00537 // PLFLT **zg, PLINT type, PLFLT data); 00538 // 00539 // This one is currently wrapped by hand, as I am not sure how to get camlidl 00540 // to allocate zg in a way that makes plgriddata happy and doesn't require the 00541 // user to pre-allocate the space. 00542 value ml_plgriddata( value x, value y, value z, 00543 value xg, value yg, 00544 value type, value data ) 00545 { 00546 CAMLparam5( x, y, z, xg, yg ); 00547 CAMLxparam2( type, data ); 00548 00549 // zg holds the OCaml float array array. 00550 // y_ml_array is a temporary structure which will be used to form each 00551 // float array making up zg. 00552 CAMLlocal2( zg, y_ml_array ); 00553 00554 PLFLT **zg_local; 00555 00556 int npts, nptsx, nptsy; 00557 int i, j; 00558 00559 // Check to make sure x, y and z are all the same length. 00560 npts = Wosize_val( x ) / Double_wosize; 00561 if ( ( Wosize_val( y ) / Double_wosize != Wosize_val( z ) / Double_wosize ) || 00562 ( Wosize_val( y ) / Double_wosize != npts ) || 00563 ( Wosize_val( z ) / Double_wosize != npts ) 00564 ) 00565 { 00566 caml_failwith( "ml_plgriddata: x, y, z must all have the same dimensions" ); 00567 } 00568 00569 nptsx = Wosize_val( xg ) / Double_wosize; 00570 nptsy = Wosize_val( yg ) / Double_wosize; 00571 00572 // Allocate the 2D grid in a way that will make PLplot happy 00573 plAlloc2dGrid( &zg_local, nptsx, nptsy ); 00574 00575 // Using "type + 1" because "type" is passed in as a variant type, so 00576 // the indexing starts from 0 rather than 1. 00577 c_plgriddata( (double *) x, (double *) y, (double *) z, npts, (double *) xg, nptsx, 00578 (double *) yg, nptsy, zg_local, Int_val( type ) + 1, 00579 Double_val( data ) ); 00580 00581 // Allocate the X-dimension of the to-be-returned OCaml array 00582 zg = caml_alloc( nptsx, 0 ); 00583 00584 for ( i = 0; i < nptsx; i++ ) 00585 { 00586 // Allocate each Y-dimension array of the OCaml array 00587 y_ml_array = caml_alloc( nptsy * Double_wosize, Double_array_tag ); 00588 for ( j = 0; j < nptsy; j++ ) 00589 { 00590 Store_double_field( y_ml_array, j, zg_local[i][j] ); 00591 } 00592 caml_modify( &Field( zg, i ), y_ml_array ); 00593 } 00594 00595 // Free the memory used by the C array 00596 plFree2dGrid( zg_local, nptsx, nptsy ); 00597 00598 CAMLreturn( zg ); 00599 } 00600 00601 value ml_plgriddata_bytecode( value* argv, int argn ) 00602 { 00603 return ml_plgriddata( argv[0], argv[1], argv[2], argv[3], argv[4], 00604 argv[5], argv[6] ); 00605 } 00606 00607 // 00608 // void 00609 // c_plpoly3(PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLBOOL *draw, PLBOOL ifcc); 00610 // 00611 // plpoly3 is wrapped by hand because draw has a length of (n - 1) and camlidl 00612 // does not have a way to indicate this automatically. 00613 void ml_plpoly3( PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLINT ndraw, PLBOOL *draw, PLBOOL ifcc ) 00614 { 00615 plpoly3( n, x, y, z, draw, ifcc ); 00616 } 00617 00618 // Raise Invalid_argument if the given value is <> 0 00619 void plplot_check_nonzero_result( int result ) 00620 { 00621 if ( result != 0 ) 00622 { 00623 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH]; 00624 sprintf( exception_message, "Error, return code %d", result ); 00625 caml_invalid_argument( exception_message ); 00626 } 00627 return; 00628 } 00629 00630 // Translate the integer version of the OCaml variant to the appropriate 00631 // PLplot constant. 00632 int translate_parse_option( int parse_option ) 00633 { 00634 int translated_option; 00635 switch ( parse_option ) 00636 { 00637 case 0: translated_option = PL_PARSE_PARTIAL; break; 00638 case 1: translated_option = PL_PARSE_FULL; break; 00639 case 2: translated_option = PL_PARSE_QUIET; break; 00640 case 3: translated_option = PL_PARSE_NODELETE; break; 00641 case 4: translated_option = PL_PARSE_SHOWALL; break; 00642 case 5: translated_option = PL_PARSE_OVERRIDE; break; 00643 case 6: translated_option = PL_PARSE_NOPROGRAM; break; 00644 case 7: translated_option = PL_PARSE_NODASH; break; 00645 case 8: translated_option = PL_PARSE_SKIP; break; 00646 default: translated_option = -1; 00647 } 00648 return translated_option; 00649 } 00650 00651 // Copy a string array 00652 #define INIT_STRING_ARRAY( o ) \ 00653 int o ## _length; \ 00654 o ## _length = Wosize_val( o ); \ 00655 const char *c_ ## o[o ## _length]; \ 00656 for ( i = 0; i < o ## _length; i++ ) { c_ ## o[i] = String_val( Field( o, i ) ); } 00657 00658 // Copy an int array, o, of n element to the C array c 00659 #define INIT_INT_ARRAY( o ) \ 00660 int o ## _length; \ 00661 o ## _length = Wosize_val( o ); \ 00662 int c_ ## o[o ## _length]; \ 00663 for ( i = 0; i < ( o ## _length ); i++ ) { ( c_ ## o )[i] = Int_val( Field( ( o ), i ) ); } 00664 00665 // Copy an int array, o, of n element to the C array c 00666 #define INIT_INT_ARRAYS( o ) \ 00667 int o ## _length, o ## _inner; \ 00668 o ## _length = Wosize_val( o ); \ 00669 int *c_ ## o[o ## _length]; \ 00670 for ( i = 0; i < ( o ## _length ); i++ ) { \ 00671 INIT_INT_ARRAY( o ## _subarray ); \ 00672 ( c_ ## o )[i] = c_ ## o ## _subarray; \ 00673 } 00674 00675 int lor_ml_list( value list, ML_VARIANT_FUNC variant_f ) 00676 { 00677 CAMLparam1( list ); 00678 int result; 00679 00680 result = 0; 00681 while ( list != Val_emptylist ) 00682 { 00683 // Accumulate the elements of the list 00684 result = result | variant_f( Int_val( Field( list, 0 ) ) ); 00685 // Point to the tail of the list for the next loop 00686 list = Field( list, 1 ); 00687 } 00688 00689 CAMLreturn( result ); 00690 } 00691 00692 value ml_plparseopts( value argv, value parse_method ) 00693 { 00694 CAMLparam2( argv, parse_method ); 00695 int i; 00696 int result; 00697 int combined_parse_method; 00698 // Make a copy of the command line argument strings 00699 INIT_STRING_ARRAY( argv ) 00700 00701 // OR the elements of the parse_method list together 00702 combined_parse_method = lor_ml_list( parse_method, translate_parse_option ); 00703 00704 result = plparseopts( &argv_length, c_argv, combined_parse_method ); 00705 if ( result != 0 ) 00706 { 00707 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH]; 00708 sprintf( exception_message, "Invalid arguments in plparseopts, error %d", result ); 00709 caml_invalid_argument( exception_message ); 00710 } 00711 CAMLreturn( Val_unit ); 00712 } 00713 00714 value ml_plstripc( value xspec, value yspec, value xmin, value xmax, value xjump, 00715 value ymin, value ymax, value xlpos, value ylpos, value y_ascl, 00716 value acc, value colbox, value collab, value colline, value styline, 00717 value legline, value labx, value laby, value labtop ) 00718 { 00719 // Function parameters 00720 CAMLparam5( xspec, yspec, xmin, xmax, xjump ); 00721 CAMLxparam5( ymin, ymax, xlpos, ylpos, y_ascl ); 00722 CAMLxparam5( acc, colbox, collab, colline, styline ); 00723 CAMLxparam4( legline, labx, laby, labtop ); 00724 // Line attribute array copies 00725 int colline_copy[4]; 00726 int styline_copy[4]; 00727 const char* legend_copy[4]; 00728 int i; 00729 for ( i = 0; i < 4; i++ ) 00730 { 00731 colline_copy[i] = Int_val( Field( colline, i ) ); 00732 styline_copy[i] = Int_val( Field( styline, i ) ); 00733 legend_copy[i] = String_val( Field( legline, i ) ); 00734 } 00735 // The returned value 00736 int id; 00737 plstripc( &id, String_val( xspec ), String_val( yspec ), 00738 Double_val( xmin ), Double_val( xmax ), 00739 Double_val( xjump ), Double_val( ymin ), Double_val( ymax ), 00740 Double_val( xlpos ), Double_val( ylpos ), Bool_val( y_ascl ), 00741 Bool_val( acc ), Int_val( colbox ), Int_val( collab ), 00742 colline_copy, styline_copy, legend_copy, 00743 String_val( labx ), String_val( laby ), String_val( labtop ) ); 00744 // Make me do something! 00745 CAMLreturn( Val_int( id ) ); 00746 } 00747 00748 value ml_plstripc_byte( value* argv, int argn ) 00749 { 00750 return ml_plstripc( argv[0], argv[1], argv[2], argv[3], argv[4], 00751 argv[5], argv[6], argv[7], argv[8], argv[9], 00752 argv[10], argv[11], argv[12], argv[13], argv[14], 00753 argv[15], argv[16], argv[17], argv[18] ); 00754 } 00755 00756 int translate_legend_option( int legend_option ) 00757 { 00758 int translated_option; 00759 switch ( legend_option ) 00760 { 00761 case 0: translated_option = PL_LEGEND_NONE; break; 00762 case 1: translated_option = PL_LEGEND_COLOR_BOX; break; 00763 case 2: translated_option = PL_LEGEND_LINE; break; 00764 case 3: translated_option = PL_LEGEND_SYMBOL; break; 00765 case 4: translated_option = PL_LEGEND_TEXT_LEFT; break; 00766 case 5: translated_option = PL_LEGEND_BACKGROUND; break; 00767 case 6: translated_option = PL_LEGEND_BOUNDING_BOX; break; 00768 case 7: translated_option = PL_LEGEND_ROW_MAJOR; break; 00769 default: translated_option = -1; 00770 } 00771 return translated_option; 00772 } 00773 00774 int translate_colorbar_option( int colorbar_option ) 00775 { 00776 int translated_option; 00777 switch ( colorbar_option ) 00778 { 00779 case 0: translated_option = PL_COLORBAR_LABEL_LEFT; break; 00780 case 1: translated_option = PL_COLORBAR_LABEL_RIGHT; break; 00781 case 2: translated_option = PL_COLORBAR_LABEL_TOP; break; 00782 case 3: translated_option = PL_COLORBAR_LABEL_BOTTOM; break; 00783 case 4: translated_option = PL_COLORBAR_IMAGE; break; 00784 case 5: translated_option = PL_COLORBAR_SHADE; break; 00785 case 6: translated_option = PL_COLORBAR_GRADIENT; break; 00786 case 7: translated_option = PL_COLORBAR_CAP_NONE; break; 00787 case 8: translated_option = PL_COLORBAR_CAP_LOW; break; 00788 case 9: translated_option = PL_COLORBAR_CAP_HIGH; break; 00789 case 10: translated_option = PL_COLORBAR_SHADE_LABEL; break; 00790 case 11: translated_option = PL_COLORBAR_ORIENT_RIGHT; break; 00791 case 12: translated_option = PL_COLORBAR_ORIENT_TOP; break; 00792 case 13: translated_option = PL_COLORBAR_ORIENT_LEFT; break; 00793 case 14: translated_option = PL_COLORBAR_ORIENT_BOTTOM; break; 00794 case 15: translated_option = PL_COLORBAR_BACKGROUND; break; 00795 case 16: translated_option = PL_COLORBAR_BOUNDING_BOX; break; 00796 default: translated_option = -1; 00797 } 00798 return translated_option; 00799 } 00800 00801 int translate_position_option( int position_option ) 00802 { 00803 int translated_option; 00804 switch ( position_option ) 00805 { 00806 case 0: translated_option = PL_POSITION_LEFT; break; 00807 case 1: translated_option = PL_POSITION_RIGHT; break; 00808 case 2: translated_option = PL_POSITION_TOP; break; 00809 case 3: translated_option = PL_POSITION_BOTTOM; break; 00810 case 4: translated_option = PL_POSITION_INSIDE; break; 00811 case 5: translated_option = PL_POSITION_OUTSIDE; break; 00812 case 6: translated_option = PL_POSITION_VIEWPORT; break; 00813 case 7: translated_option = PL_POSITION_SUBPAGE; break; 00814 default: translated_option = -1; 00815 } 00816 return translated_option; 00817 } 00818 00819 value ml_pllegend( value opt, value position, value x, value y, value plot_width, 00820 value bg_color, 00821 value bb_color, value bb_style, 00822 value nrow, value ncolumn, 00823 value opt_array, 00824 value text_offset, value text_scale, value text_spacing, 00825 value text_justification, value text_colors, value text, 00826 value box_colors, value box_patterns, value box_scales, 00827 value box_line_widths, 00828 value line_colors, value line_styles, value line_widths, 00829 value symbol_colors, value symbol_scales, 00830 value symbol_numbers, value symbols ) 00831 { 00832 CAMLparam5( position, opt, x, y, plot_width ); 00833 CAMLxparam5( bg_color, bb_color, bb_style, nrow, ncolumn ); 00834 CAMLxparam5( opt_array, text_offset, text_scale, text_spacing, text_justification ); 00835 CAMLxparam5( text_colors, text, box_colors, box_patterns, box_scales ); 00836 CAMLxparam5( box_line_widths, line_colors, line_styles, line_widths, symbol_colors ); 00837 CAMLxparam3( symbol_scales, symbol_numbers, symbols ); 00838 CAMLlocal1( result ); 00839 result = caml_alloc( 2, 0 ); 00840 00841 // Counter 00842 int i; 00843 // General legend options 00844 int c_position, c_opt; 00845 // Number of legend entries 00846 int n_legend; 00847 n_legend = Wosize_val( opt_array ); 00848 // Options for each legend entry 00849 int c_opt_array[n_legend]; 00850 00851 // Assume that the dimensions all line up on the OCaml side, so we don't 00852 // need to do any further dimension checks. 00853 00854 // Define and initialize all of the C arrays to pass in to pllegend 00855 INIT_STRING_ARRAY( text ) 00856 INIT_INT_ARRAY( text_colors ) 00857 INIT_INT_ARRAY( box_colors ) 00858 INIT_INT_ARRAY( box_patterns ) 00859 INIT_INT_ARRAY( line_colors ) 00860 INIT_INT_ARRAY( line_styles ) 00861 INIT_INT_ARRAY( symbol_colors ) 00862 INIT_INT_ARRAY( symbol_numbers ) 00863 INIT_STRING_ARRAY( symbols ) 00864 00865 // Translate the legend configuration options 00866 c_opt = lor_ml_list( opt, translate_legend_option ); 00867 c_position = lor_ml_list( position, translate_position_option ); 00868 00869 for ( i = 0; i < n_legend; i++ ) 00870 { 00871 c_opt_array[i] = 00872 lor_ml_list( Field( opt_array, i ), translate_legend_option ); 00873 } 00874 00875 // The returned width and height of the legend 00876 PLFLT width, height; 00877 00878 pllegend( &width, &height, c_opt, c_position, Double_val( x ), Double_val( y ), 00879 Double_val( plot_width ), Int_val( bg_color ), 00880 Int_val( bb_color ), Int_val( bb_style ), 00881 Int_val( nrow ), Int_val( ncolumn ), 00882 n_legend, c_opt_array, 00883 Double_val( text_offset ), Double_val( text_scale ), 00884 Double_val( text_spacing ), 00885 Double_val( text_justification ), 00886 c_text_colors, c_text, 00887 c_box_colors, c_box_patterns, (double *) box_scales, 00888 (double *) box_line_widths, 00889 c_line_colors, c_line_styles, (double *) line_widths, 00890 c_symbol_colors, (double *) symbol_scales, c_symbol_numbers, 00891 c_symbols ); 00892 00893 // Return a tuple with the legend's size 00894 Store_field( result, 0, caml_copy_double( width ) ); 00895 Store_field( result, 1, caml_copy_double( height ) ); 00896 00897 CAMLreturn( result ); 00898 } 00899 00900 value ml_pllegend_byte( value* argv, int argn ) 00901 { 00902 return ml_pllegend( argv[0], argv[1], argv[2], argv[3], argv[4], 00903 argv[5], argv[6], argv[7], argv[8], argv[9], 00904 argv[10], argv[11], argv[12], argv[13], argv[14], 00905 argv[15], argv[16], argv[17], argv[18], argv[19], 00906 argv[20], argv[21], argv[22], argv[23], argv[24], 00907 argv[25], argv[26], argv[27] ); 00908 } 00909 00910 value ml_plcolorbar( value opt, value position, value x, value y, 00911 value x_length, value y_length, 00912 value bg_color, value bb_color, value bb_style, 00913 value low_cap_color, value high_cap_color, 00914 value cont_color, value cont_width, 00915 value label_opts, value label, 00916 value axis_opts, 00917 value ticks, value sub_ticks, 00918 value values ) 00919 { 00920 CAMLparam5( opt, position, x, y, x_length ); 00921 CAMLxparam5( y_length, bg_color, bb_color, bb_style, low_cap_color ); 00922 CAMLxparam5( high_cap_color, cont_color, cont_width, label_opts, label ); 00923 CAMLxparam4( axis_opts, ticks, sub_ticks, values ); 00924 CAMLlocal1( result ); 00925 result = caml_alloc( 2, 0 ); 00926 00927 // Counter 00928 int i; 00929 // General colorbar options 00930 int c_opt, c_position; 00931 // Number of labels 00932 int n_labels; 00933 n_labels = Wosize_val( label_opts ); 00934 // Number of axes and value ranges 00935 int n_axes; 00936 n_axes = Wosize_val( axis_opts ); 00937 00938 // Translate configuration options 00939 c_opt = lor_ml_list( opt, translate_colorbar_option ); 00940 c_position = lor_ml_list( position, translate_position_option ); 00941 00942 // Assume that the dimensions all line up on the OCaml side, so we don't 00943 // need to do any further dimension checks. 00944 00945 // Define and initialize all of the C arrays to pass into plcolorbar 00946 INIT_STRING_ARRAY( label ) 00947 INIT_STRING_ARRAY( axis_opts ) 00948 INIT_INT_ARRAY( sub_ticks ); 00949 00950 // Label options 00951 int c_label_opts[ n_labels ]; 00952 for ( i = 0; i < n_labels; i++ ) 00953 { 00954 c_label_opts[i] = lor_ml_list( Field( label_opts, i ), translate_colorbar_option ); 00955 } 00956 00957 // Copy the axis/range values 00958 double **c_values; 00959 int n_values[ n_axes ]; 00960 c_values = malloc( n_axes * sizeof ( double * ) ); 00961 // TODO: Add allocation failure check 00962 for ( i = 0; i < n_axes; i++ ) 00963 { 00964 c_values[i] = (double *) Field( values, i ); 00965 n_values[i] = Wosize_val( Field( values, i ) ) / Double_wosize; 00966 } 00967 00968 // Return values 00969 PLFLT width, height; 00970 00971 plcolorbar( &width, &height, 00972 c_opt, c_position, Double_val( x ), Double_val( y ), 00973 Double_val( x_length ), Double_val( y_length ), 00974 Int_val( bg_color ), Int_val( bb_color ), Int_val( bb_style ), 00975 Double_val( low_cap_color ), Double_val( high_cap_color ), 00976 Int_val( cont_color ), Double_val( cont_width ), 00977 n_labels, c_label_opts, c_label, 00978 n_axes, c_axis_opts, 00979 (double *) ticks, c_sub_ticks, 00980 n_values, (const PLFLT * const *) c_values ); 00981 00982 // Return a tuple with the colorbar's size 00983 Store_field( result, 0, caml_copy_double( width ) ); 00984 Store_field( result, 1, caml_copy_double( height ) ); 00985 00986 CAMLreturn( result ); 00987 } 00988 00989 value ml_plcolorbar_byte( value *argv, int argn ) 00990 { 00991 return ml_plcolorbar( argv[0], argv[1], argv[2], argv[3], argv[4], 00992 argv[5], argv[6], argv[7], argv[8], argv[9], 00993 argv[10], argv[11], argv[12], argv[13], argv[14], 00994 argv[15], argv[16], argv[17], argv[18] ); 00995 } 00996 00997 // pltr* function implementations 00998 void ml_pltr0( double x, double y, double* tx, double* ty ) 00999 { 01000 pltr0( x, y, tx, ty, NULL ); 01001 } 01002 01003 value ml_pltr1( value xg, value yg, value x, value y ) 01004 { 01005 CAMLparam4( xg, yg, x, y ); 01006 CAMLlocal1( tx_ty ); 01007 tx_ty = caml_alloc( 2, 0 ); 01008 double tx; 01009 double ty; 01010 PLcGrid grid; 01011 grid.xg = (double *) xg; 01012 grid.yg = (double *) yg; 01013 grid.nx = Wosize_val( xg ) / Double_wosize; 01014 grid.ny = Wosize_val( yg ) / Double_wosize; 01015 pltr1( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid ); 01016 01017 // Allocate a tuple and return it with the results 01018 Store_field( tx_ty, 0, caml_copy_double( tx ) ); 01019 Store_field( tx_ty, 1, caml_copy_double( ty ) ); 01020 CAMLreturn( tx_ty ); 01021 } 01022 01023 value ml_pltr2( value xg, value yg, value x, value y ) 01024 { 01025 CAMLparam4( xg, yg, x, y ); 01026 CAMLlocal1( tx_ty ); 01027 tx_ty = caml_alloc( 2, 0 ); 01028 double ** c_xg; 01029 double ** c_yg; 01030 int i; 01031 int length1; 01032 int length2; 01033 PLcGrid2 grid; 01034 double tx; 01035 double ty; 01036 01037 // TODO: As of now, you will probably get a segfault of the xg and yg 01038 // dimensions don't match up properly. 01039 // Build the grid. 01040 // Length of "outer" array 01041 length1 = Wosize_val( xg ); 01042 // Length of the "inner" arrays 01043 length2 = Wosize_val( Field( xg, 0 ) ) / Double_wosize; 01044 c_xg = malloc( length1 * sizeof ( double* ) ); 01045 for ( i = 0; i < length1; i++ ) 01046 { 01047 c_xg[i] = (double *) Field( xg, i ); 01048 } 01049 c_yg = malloc( length1 * sizeof ( double* ) ); 01050 for ( i = 0; i < length1; i++ ) 01051 { 01052 c_yg[i] = (double *) Field( yg, i ); 01053 } 01054 grid.xg = c_xg; 01055 grid.yg = c_yg; 01056 grid.nx = length1; 01057 grid.ny = length2; 01058 01059 pltr2( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid ); 01060 01061 // Clean up 01062 free( c_xg ); 01063 free( c_yg ); 01064 01065 // Allocate a tuple and return it with the results 01066 Store_field( tx_ty, 0, caml_copy_double( tx ) ); 01067 Store_field( tx_ty, 1, caml_copy_double( ty ) ); 01068 CAMLreturn( tx_ty ); 01069 } 01070 01071 // XXX Non-core functions follow XXX 01072 //* 01073 // The following functions are here for (my?) convenience. As far as I can 01074 // tell, they are not defined in the core PLplot library. 01075 // 01076 01077 // Get the current color map 0 color index 01078 int plg_current_col0( void ) 01079 { 01080 return plsc->icol0; 01081 } 01082 01083 // Get the current color map 1 color index 01084 PLFLT plg_current_col1( void ) 01085 { 01086 return plsc->icol1; 01087 } 01088 01089 // Get the current pen width. TODO: Remove this, as I think this information 01090 // can be retrieved from another proper PLplot function. 01091 PLFLT plgwidth( void ) 01092 { 01093 return plsc->width; 01094 } 01095 01096 // Get the current character (text) height in mm. TODO: Remove this, as I 01097 // think this information can be retrieved from another proper PLplot 01098 // function 01099 PLFLT plgchrht( void ) 01100 { 01101 return plsc->chrht; 01102 }