00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
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
00054
00055
00056
00057
00058
00059
00060 void ml_plotter( PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, PLPointer pltr_data )
00061 {
00062 CAMLparam0();
00063 CAMLlocal1( result );
00064
00065
00066 static value * pltr = NULL;
00067 if ( pltr == NULL )
00068 pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME );
00069
00070
00071
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
00085
00086
00087
00088
00089 PLINT ml_defined( PLFLT x, PLFLT y )
00090 {
00091 CAMLparam0();
00092 CAMLlocal1( result );
00093
00094
00095 PLINT is_it_defined;
00096
00097
00098 static value * defined = NULL;
00099 if ( defined == NULL )
00100 defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME );
00101
00102
00103
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
00112
00113
00114 void ml_mapform( PLINT n, PLFLT *x, PLFLT *y )
00115 {
00116 CAMLparam0();
00117 CAMLlocal1( result );
00118
00119
00120 static value * mapform = NULL;
00121 if ( mapform == NULL )
00122 mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME );
00123
00124
00125
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
00145
00146 void ml_labelfunc( PLINT axis, PLFLT n, char *label, PLINT length, PLPointer d )
00147 {
00148 CAMLparam0();
00149 CAMLlocal1( result );
00150
00151
00152 static value * callback = NULL;
00153 if ( callback == NULL )
00154 callback = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME );
00155
00156
00157
00158 result =
00159 caml_callback2( *callback, Val_int( axis - 1 ), caml_copy_double( n ) );
00160
00161
00162 snprintf( label, length, "%s", String_val( result ) );
00163
00164 CAMLreturn0;
00165 }
00166
00167
00168 void ml_abort( const char* message )
00169 {
00170 CAMLparam0();
00171 CAMLlocal1( result );
00172
00173
00174 static value * handler = NULL;
00175 if ( handler == NULL )
00176 handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME );
00177
00178
00179
00180 result =
00181 caml_callback( *handler, caml_copy_string( message ) );
00182
00183 CAMLreturn0;
00184 }
00185
00186
00187 int ml_exit( const char* message )
00188 {
00189 CAMLparam0();
00190 CAMLlocal1( result );
00191
00192
00193 static value * handler = NULL;
00194 if ( handler == NULL )
00195 handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME );
00196
00197
00198
00199 result =
00200 caml_callback( *handler, caml_copy_string( message ) );
00201
00202 CAMLreturn( Int_val( result ) );
00203 }
00204
00205
00206
00207
00208 void ml_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data )
00209 {
00210 CAMLparam0();
00211 CAMLlocal1( result );
00212
00213
00214 static value * transform = NULL;
00215 if ( transform == NULL )
00216 transform = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME );
00217
00218
00219
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
00230
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
00240 return NULL;
00241 }
00242 else
00243 {
00244
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
00257 return NULL;
00258 }
00259 else
00260 {
00261
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
00274 return NULL;
00275 }
00276 else
00277 {
00278
00279 return ml_mapform;
00280 }
00281 }
00282
00283
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
00294 plslabelfunc( NULL, NULL );
00295 }
00296 else
00297 {
00298
00299 plslabelfunc( ml_labelfunc, NULL );
00300 }
00301
00302 CAMLreturn( Val_unit );
00303 }
00304
00305
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
00316 plsabort( NULL );
00317 }
00318 else
00319 {
00320
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
00335 plsexit( NULL );
00336 }
00337 else
00338 {
00339
00340 plsexit( ml_exit );
00341 }
00342 CAMLreturn( Val_unit );
00343 }
00344
00345
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
00356 plstransform( NULL, NULL );
00357 }
00358 else
00359 {
00360
00361 plstransform( ml_transform, NULL );
00362 }
00363 CAMLreturn( Val_unit );
00364 }
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
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
00386
00387
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
00400
00401
00402
00403
00404
00405
00406
00407
00408
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, PLINT sh_width,
00414 PLINT min_color, PLINT min_width,
00415 PLINT max_color, PLINT 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
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
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, PLINT fill_width,
00453 PLINT cont_color, PLINT 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
00468
00469
00470
00471
00472
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
00489
00490
00491
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
00502
00503
00504
00505 void ml_plmap( const char *type,
00506 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00507 {
00508 c_plmap( get_ml_mapform_func(),
00509 type, minlong, maxlong, minlat, maxlat );
00510 }
00511
00512
00513
00514
00515
00516
00517
00518 void ml_plmeridians( PLFLT dlong, PLFLT dlat,
00519 PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00520 {
00521 c_plmeridians( get_ml_mapform_func(),
00522 dlong, dlat, minlong, maxlong, minlat, maxlat );
00523 }
00524
00525
00526
00527
00528
00529
00530
00531
00532
00533
00534 value ml_plgriddata( value x, value y, value z,
00535 value xg, value yg,
00536 value type, value data )
00537 {
00538 CAMLparam5( x, y, z, xg, yg );
00539 CAMLxparam2( type, data );
00540
00541
00542
00543
00544 CAMLlocal2( zg, y_ml_array );
00545
00546 PLFLT **zg_local;
00547
00548 int npts, nptsx, nptsy;
00549 int i, j;
00550
00551
00552 npts = Wosize_val( x ) / Double_wosize;
00553 if ( ( Wosize_val( y ) / Double_wosize != Wosize_val( z ) / Double_wosize ) ||
00554 ( Wosize_val( y ) / Double_wosize != npts ) ||
00555 ( Wosize_val( z ) / Double_wosize != npts )
00556 )
00557 {
00558 caml_failwith( "ml_plgriddata: x, y, z must all have the same dimensions" );
00559 }
00560
00561 nptsx = Wosize_val( xg ) / Double_wosize;
00562 nptsy = Wosize_val( yg ) / Double_wosize;
00563
00564
00565 plAlloc2dGrid( &zg_local, nptsx, nptsy );
00566
00567
00568
00569 c_plgriddata( (double *) x, (double *) y, (double *) z, npts, (double *) xg, nptsx,
00570 (double *) yg, nptsy, zg_local, Int_val( type ) + 1,
00571 Double_val( data ) );
00572
00573
00574 zg = caml_alloc( nptsx, 0 );
00575
00576 for ( i = 0; i < nptsx; i++ )
00577 {
00578
00579 y_ml_array = caml_alloc( nptsy * Double_wosize, Double_array_tag );
00580 for ( j = 0; j < nptsy; j++ )
00581 {
00582 Store_double_field( y_ml_array, j, zg_local[i][j] );
00583 }
00584 caml_modify( &Field( zg, i ), y_ml_array );
00585 }
00586
00587
00588 plFree2dGrid( zg_local, nptsx, nptsy );
00589
00590 CAMLreturn( zg );
00591 }
00592
00593 value ml_plgriddata_bytecode( value* argv, int argn )
00594 {
00595 return ml_plgriddata( argv[0], argv[1], argv[2], argv[3], argv[4],
00596 argv[5], argv[6] );
00597 }
00598
00599
00600
00601
00602
00603
00604
00605 void ml_plpoly3( PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLINT ndraw, PLBOOL *draw, PLBOOL ifcc )
00606 {
00607 plpoly3( n, x, y, z, draw, ifcc );
00608 }
00609
00610
00611 void plplot_check_nonzero_result( int result )
00612 {
00613 if ( result != 0 )
00614 {
00615 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00616 sprintf( exception_message, "Error, return code %d", result );
00617 caml_invalid_argument( exception_message );
00618 }
00619 return;
00620 }
00621
00622
00623
00624 int translate_parse_option( int parse_option )
00625 {
00626 int translated_option;
00627 switch ( parse_option )
00628 {
00629 case 0: translated_option = PL_PARSE_PARTIAL; break;
00630 case 1: translated_option = PL_PARSE_FULL; break;
00631 case 2: translated_option = PL_PARSE_QUIET; break;
00632 case 3: translated_option = PL_PARSE_NODELETE; break;
00633 case 4: translated_option = PL_PARSE_SHOWALL; break;
00634 case 5: translated_option = PL_PARSE_OVERRIDE; break;
00635 case 6: translated_option = PL_PARSE_NOPROGRAM; break;
00636 case 7: translated_option = PL_PARSE_NODASH; break;
00637 case 8: translated_option = PL_PARSE_SKIP; break;
00638 default: translated_option = -1;
00639 }
00640 return translated_option;
00641 }
00642
00643
00644 #define INIT_STRING_ARRAY( o ) \
00645 int o ## _length; \
00646 o ## _length = Wosize_val( o ); \
00647 const char *c_ ## o[o ## _length]; \
00648 for ( i = 0; i < o ## _length; i++ ) { c_ ## o[i] = String_val( Field( o, i ) ); }
00649
00650
00651 #define INIT_INT_ARRAY( o ) \
00652 int o ## _length; \
00653 o ## _length = Wosize_val( o ); \
00654 int c_ ## o[o ## _length]; \
00655 for ( i = 0; i < ( o ## _length ); i++ ) { ( c_ ## o )[i] = Int_val( Field( ( o ), i ) ); }
00656
00657 int lor_ml_list( value list, ML_VARIANT_FUNC variant_f )
00658 {
00659 CAMLparam1( list );
00660 int result;
00661
00662 result = 0;
00663 while ( list != Val_emptylist )
00664 {
00665
00666 result = result | variant_f( Int_val( Field( list, 0 ) ) );
00667
00668 list = Field( list, 1 );
00669 }
00670
00671 CAMLreturn( result );
00672 }
00673
00674 value ml_plparseopts( value argv, value parse_method )
00675 {
00676 CAMLparam2( argv, parse_method );
00677 int i;
00678 int result;
00679 int combined_parse_method;
00680
00681 INIT_STRING_ARRAY( argv )
00682
00683
00684 combined_parse_method = lor_ml_list( parse_method, translate_parse_option );
00685
00686 result = plparseopts( &argv_length, c_argv, combined_parse_method );
00687 if ( result != 0 )
00688 {
00689 char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00690 sprintf( exception_message, "Invalid arguments in plparseopts, error %d", result );
00691 caml_invalid_argument( exception_message );
00692 }
00693 CAMLreturn( Val_unit );
00694 }
00695
00696 value ml_plstripc( value xspec, value yspec, value xmin, value xmax, value xjump,
00697 value ymin, value ymax, value xlpos, value ylpos, value y_ascl,
00698 value acc, value colbox, value collab, value colline, value styline,
00699 value legline, value labx, value laby, value labtop )
00700 {
00701
00702 CAMLparam5( xspec, yspec, xmin, xmax, xjump );
00703 CAMLxparam5( ymin, ymax, xlpos, ylpos, y_ascl );
00704 CAMLxparam5( acc, colbox, collab, colline, styline );
00705 CAMLxparam4( legline, labx, laby, labtop );
00706
00707 int colline_copy[4];
00708 int styline_copy[4];
00709 const char* legend_copy[4];
00710 int i;
00711 for ( i = 0; i < 4; i++ )
00712 {
00713 colline_copy[i] = Int_val( Field( colline, i ) );
00714 styline_copy[i] = Int_val( Field( styline, i ) );
00715 legend_copy[i] = String_val( Field( legline, i ) );
00716 }
00717
00718 int id;
00719 plstripc( &id, String_val( xspec ), String_val( yspec ),
00720 Double_val( xmin ), Double_val( xmax ),
00721 Double_val( xjump ), Double_val( ymin ), Double_val( ymax ),
00722 Double_val( xlpos ), Double_val( ylpos ), Bool_val( y_ascl ),
00723 Bool_val( acc ), Int_val( colbox ), Int_val( collab ),
00724 colline_copy, styline_copy, legend_copy,
00725 String_val( labx ), String_val( laby ), String_val( labtop ) );
00726
00727 CAMLreturn( Val_int( id ) );
00728 }
00729
00730 value ml_plstripc_byte( value* argv, int argn )
00731 {
00732 return ml_plstripc( argv[0], argv[1], argv[2], argv[3], argv[4],
00733 argv[5], argv[6], argv[7], argv[8], argv[9],
00734 argv[10], argv[11], argv[12], argv[13], argv[14],
00735 argv[15], argv[16], argv[17], argv[18] );
00736 }
00737
00738 int translate_legend_option( int legend_option )
00739 {
00740 int translated_option;
00741 switch ( legend_option )
00742 {
00743 case 0: translated_option = PL_LEGEND_NONE; break;
00744 case 1: translated_option = PL_LEGEND_COLOR_BOX; break;
00745 case 2: translated_option = PL_LEGEND_LINE; break;
00746 case 3: translated_option = PL_LEGEND_SYMBOL; break;
00747 case 4: translated_option = PL_LEGEND_TEXT_LEFT; break;
00748 case 5: translated_option = PL_LEGEND_BACKGROUND; break;
00749 case 6: translated_option = PL_LEGEND_BOUNDING_BOX; break;
00750 case 7: translated_option = PL_LEGEND_ROW_MAJOR; break;
00751 default: translated_option = -1;
00752 }
00753 return translated_option;
00754 }
00755
00756 int translate_position_option( int position_option )
00757 {
00758 int translated_option;
00759 switch ( position_option )
00760 {
00761 case 0: translated_option = PL_POSITION_LEFT; break;
00762 case 1: translated_option = PL_POSITION_RIGHT; break;
00763 case 2: translated_option = PL_POSITION_TOP; break;
00764 case 3: translated_option = PL_POSITION_BOTTOM; break;
00765 case 4: translated_option = PL_POSITION_INSIDE; break;
00766 case 5: translated_option = PL_POSITION_OUTSIDE; break;
00767 case 6: translated_option = PL_POSITION_VIEWPORT; break;
00768 case 7: translated_option = PL_POSITION_SUBPAGE; break;
00769 default: translated_option = -1;
00770 }
00771 return translated_option;
00772 }
00773
00774 value ml_pllegend( value opt, value position, value x, value y, value plot_width,
00775 value bg_color,
00776 value bb_color, value bb_style,
00777 value nrow, value ncolumn,
00778 value opt_array,
00779 value text_offset, value text_scale, value text_spacing,
00780 value text_justification, value text_colors, value text,
00781 value box_colors, value box_patterns, value box_scales,
00782 value box_line_widths,
00783 value line_colors, value line_styles, value line_widths,
00784 value symbol_colors, value symbol_scales,
00785 value symbol_numbers, value symbols )
00786 {
00787 CAMLparam5( position, opt, x, y, plot_width );
00788 CAMLxparam5( bg_color, bb_color, bb_style, nrow, ncolumn );
00789 CAMLxparam5( opt_array, text_offset, text_scale, text_spacing, text_justification );
00790 CAMLxparam5( text_colors, text, box_colors, box_patterns, box_scales );
00791 CAMLxparam5( box_line_widths, line_colors, line_styles, line_widths, symbol_colors );
00792 CAMLxparam3( symbol_scales, symbol_numbers, symbols );
00793 CAMLlocal1( result );
00794 result = caml_alloc( 2, 0 );
00795
00796
00797 int i;
00798
00799 int c_position, c_opt;
00800
00801 int n_legend;
00802 n_legend = Wosize_val( opt_array );
00803
00804 int c_opt_array[n_legend];
00805
00806
00807
00808
00809
00810 INIT_STRING_ARRAY( text )
00811 INIT_INT_ARRAY( text_colors )
00812 INIT_INT_ARRAY( box_colors )
00813 INIT_INT_ARRAY( box_patterns )
00814 INIT_INT_ARRAY( box_line_widths )
00815 INIT_INT_ARRAY( line_colors )
00816 INIT_INT_ARRAY( line_styles )
00817 INIT_INT_ARRAY( line_widths )
00818 INIT_INT_ARRAY( symbol_colors )
00819 INIT_INT_ARRAY( symbol_numbers )
00820 INIT_STRING_ARRAY( symbols )
00821
00822
00823 c_opt = lor_ml_list( opt, translate_legend_option );
00824 c_position = lor_ml_list( position, translate_position_option );
00825
00826 for ( i = 0; i < n_legend; i++ )
00827 {
00828 c_opt_array[i] =
00829 lor_ml_list( Field( opt_array, i ), translate_legend_option );
00830 }
00831
00832
00833 PLFLT width, height;
00834
00835 pllegend( &width, &height, c_opt, c_position, Double_val( x ), Double_val( y ),
00836 Double_val( plot_width ), Int_val( bg_color ),
00837 Int_val( bb_color ), Int_val( bb_style ),
00838 Int_val( nrow ), Int_val( ncolumn ),
00839 n_legend, c_opt_array,
00840 Double_val( text_offset ), Double_val( text_scale ),
00841 Double_val( text_spacing ),
00842 Double_val( text_justification ),
00843 c_text_colors, c_text,
00844 c_box_colors, c_box_patterns, (double *) box_scales,
00845 c_box_line_widths,
00846 c_line_colors, c_line_styles, c_line_widths,
00847 c_symbol_colors, (double *) symbol_scales, c_symbol_numbers,
00848 c_symbols );
00849
00850
00851 Store_field( result, 0, caml_copy_double( width ) );
00852 Store_field( result, 1, caml_copy_double( height ) );
00853
00854 CAMLreturn( result );
00855 }
00856
00857 value ml_pllegend_byte( value* argv, int argn )
00858 {
00859 return ml_pllegend( argv[0], argv[1], argv[2], argv[3], argv[4],
00860 argv[5], argv[6], argv[7], argv[8], argv[9],
00861 argv[10], argv[11], argv[12], argv[13], argv[14],
00862 argv[15], argv[16], argv[17], argv[18], argv[19],
00863 argv[20], argv[21], argv[22], argv[23], argv[24],
00864 argv[25], argv[26], argv[27] );
00865 }
00866
00867
00868 void ml_pltr0( double x, double y, double* tx, double* ty )
00869 {
00870 pltr0( x, y, tx, ty, NULL );
00871 }
00872
00873 value ml_pltr1( value xg, value yg, value x, value y )
00874 {
00875 CAMLparam4( xg, yg, x, y );
00876 CAMLlocal1( tx_ty );
00877 tx_ty = caml_alloc( 2, 0 );
00878 double tx;
00879 double ty;
00880 PLcGrid grid;
00881 grid.xg = (double *) xg;
00882 grid.yg = (double *) yg;
00883 grid.nx = Wosize_val( xg ) / Double_wosize;
00884 grid.ny = Wosize_val( yg ) / Double_wosize;
00885 pltr1( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
00886
00887
00888 Store_field( tx_ty, 0, caml_copy_double( tx ) );
00889 Store_field( tx_ty, 1, caml_copy_double( ty ) );
00890 CAMLreturn( tx_ty );
00891 }
00892
00893 value ml_pltr2( value xg, value yg, value x, value y )
00894 {
00895 CAMLparam4( xg, yg, x, y );
00896 CAMLlocal1( tx_ty );
00897 tx_ty = caml_alloc( 2, 0 );
00898 double ** c_xg;
00899 double ** c_yg;
00900 int i;
00901 int length1;
00902 int length2;
00903 PLcGrid2 grid;
00904 double tx;
00905 double ty;
00906
00907
00908
00909
00910
00911 length1 = Wosize_val( xg );
00912
00913 length2 = Wosize_val( Field( xg, 0 ) ) / Double_wosize;
00914 c_xg = malloc( length1 * sizeof ( double* ) );
00915 for ( i = 0; i < length1; i++ )
00916 {
00917 c_xg[i] = (double *) Field( xg, i );
00918 }
00919 c_yg = malloc( length1 * sizeof ( double* ) );
00920 for ( i = 0; i < length1; i++ )
00921 {
00922 c_yg[i] = (double *) Field( yg, i );
00923 }
00924 grid.xg = c_xg;
00925 grid.yg = c_yg;
00926 grid.nx = length1;
00927 grid.ny = length2;
00928
00929 pltr2( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
00930
00931
00932 free( c_xg );
00933 free( c_yg );
00934
00935
00936 Store_field( tx_ty, 0, caml_copy_double( tx ) );
00937 Store_field( tx_ty, 1, caml_copy_double( ty ) );
00938 CAMLreturn( tx_ty );
00939 }
00940
00941
00942
00943
00944
00945
00946
00947
00948 int plg_current_col0( void )
00949 {
00950 return plsc->icol0;
00951 }
00952
00953
00954 float plg_current_col1( void )
00955 {
00956 return plsc->icol1;
00957 }
00958
00959
00960
00961 int plgwid( void )
00962 {
00963 return plsc->width;
00964 }
00965
00966
00967
00968
00969 float plgchrht( void )
00970 {
00971 return plsc->chrht;
00972 }