From: <ai...@us...> - 2008-07-19 17:03:16
|
Revision: 8532 http://plplot.svn.sourceforge.net/plplot/?rev=8532&view=rev Author: airwin Date: 2008-07-19 17:01:30 +0000 (Sat, 19 Jul 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Add/fix support for plhlsrgb and plmkstrm. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-07-19 00:39:26 UTC (rev 8531) +++ trunk/bindings/ocaml/plplot_h.inc 2008-07-19 17:01:30 UTC (rev 8532) @@ -51,7 +51,7 @@ [mlname(plgzax)] void c_plgzax ( [out] int * p_digmax, [out] int * p_digits ); [mlname(plhist)] void c_plhist ( int n, [in, size_is(n), size_is(n)] double * data, double datmin, double datmax, int nbin, int opt ); [mlname(plhls)] void c_plhls ( double h, double l, double s ); -[mlname(plhlsrgb)] void c_plhlsrgb ( double h, double l, double s, double * p_r, double * p_g, double * p_b ); +[mlname(plhlsrgb)] void c_plhlsrgb ( double h, double l, double s, [out] double * p_r, [out] double * p_g, [out] double * p_b ); [mlname(plinit)] void c_plinit ( void ); [mlname(pljoin)] void c_pljoin ( double x1, double y1, double x2, double y2 ); [mlname(pllab)] void c_pllab ( [string] const char * xlabel, [string] const char * ylabel, [string] const char * tlabel ); @@ -61,7 +61,7 @@ [mlname(pllsty)] void c_pllsty ( int lin ); [mlname(plmesh)] void c_plmesh ( [size_is(nx), in] double * x, [size_is(ny), in] double * y, [size_is(nx, ny), in] double ** z, int nx, int ny, int opt ); [mlname(plmeshc)] void c_plmeshc ( [size_is(nx), in] double * x, [size_is(ny), in] double * y, [size_is(nx, ny), in] double ** z, int nx, int ny, int opt, [size_is(nlevel), in] double * clevel, int nlevel ); -[mlname(plmkstrm)] void c_plmkstrm ( int * p_strm ); +[mlname(plmkstrm)] void c_plmkstrm ( [out] int * p_strm ); [mlname(plmtex)] void c_plmtex ( [string] const char * side, double disp, double pos, double just, [string] const char * text ); [mlname(plmtex3)] void c_plmtex3 ( [string] const char * side, double disp, double pos, double just, [string] const char * text ); [mlname(plot3d)] void c_plot3d ( [size_is(nx), in] double * x, [size_is(ny), in] double * y, [size_is(nx, ny), in] double ** z, int nx, int ny, int opt, int side ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2008-07-19 00:39:26 UTC (rev 8531) +++ trunk/bindings/ocaml/touchup.ml 2008-07-19 17:01:30 UTC (rev 8532) @@ -48,8 +48,18 @@ { function_name = "c_plrgbhls"; function_attrs = None; - parameter_attrs = Some ["p_h", ["out"]; "p_l", ["out"]; "p_s", ["out"]] + parameter_attrs = Some ["p_h", ["out"]; "p_l", ["out"]; "p_s", ["out"]]; }; + { + function_name = "c_plhlsrgb"; + function_attrs = None; + parameter_attrs = Some ["p_r", ["out"]; "p_g", ["out"]; "p_b", ["out"]]; + }; + { + function_name = "c_plmkstrm"; + function_attrs = None; + parameter_attrs = Some ["p_strm", ["out"]]; + }; (* For now, this will be wrapped by hand... { function_name = "c_plgriddata"; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-07-19 18:16:29
|
Revision: 8537 http://plplot.svn.sourceforge.net/plplot/?rev=8537&view=rev Author: airwin Date: 2008-07-19 18:13:39 +0000 (Sat, 19 Jul 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Add support for the new PLplot random number generator functions. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2008-07-19 18:05:17 UTC (rev 8536) +++ trunk/bindings/ocaml/plplot_h 2008-07-19 18:13:39 UTC (rev 8537) @@ -581,6 +581,15 @@ void c_plxormod(PLBOOL mode, PLBOOL *status); + void +c_plseed(unsigned int s); + + unsigned long +c_plrandi(void); + + PLFLT +c_plrandd(void); + /* void plgFileDevs(const char ***p_menustr, const char ***p_devname, int *p_ndev); Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-07-19 18:05:17 UTC (rev 8536) +++ trunk/bindings/ocaml/plplot_h.inc 2008-07-19 18:13:39 UTC (rev 8537) @@ -134,6 +134,9 @@ [mlname(plwid)] void c_plwid ( int width ); [mlname(plwind)] void c_plwind ( double xmin, double xmax, double ymin, double ymax ); [mlname(plxormod)] void c_plxormod ( int mode, [out] int * status ); +[mlname(plseed)] void c_plseed(unsigned int s); +[mlname(plrandi)] unsigned long c_plrandi(void); +[mlname(plrandd)] double c_plrandd(void); [mlname(plsetopt)] int c_plsetopt ( [string] const char * opt, [string] const char * optarg ); void plMinMax2dGrid ( [size_is(nx, ny)] double ** f, int nx, int ny, [out] double * fmax, [out] double * fmin ); void plHLS_RGB ( double h, double l, double s, double * p_r, double * p_g, double * p_b ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-07-19 20:20:53
|
Revision: 8542 http://plplot.svn.sourceforge.net/plplot/?rev=8542&view=rev Author: airwin Date: 2008-07-19 20:17:57 +0000 (Sat, 19 Jul 2008) Log Message: ----------- Delete extras.ml at the request of Hezekiah M. Carty who want to use a different approach in the future for supplementing the API that is available to the ocaml users of PLplot. This removal affects none of the standard examples. Modified Paths: -------------- trunk/bindings/ocaml/CMakeLists.txt Removed Paths: ------------- trunk/bindings/ocaml/extras.ml Modified: trunk/bindings/ocaml/CMakeLists.txt =================================================================== --- trunk/bindings/ocaml/CMakeLists.txt 2008-07-19 20:03:20 UTC (rev 8541) +++ trunk/bindings/ocaml/CMakeLists.txt 2008-07-19 20:17:57 UTC (rev 8542) @@ -23,7 +23,6 @@ if(ENABLE_ocaml) set(SOURCE_LIST - extras.ml libplplot_stubs.clib plplot_h plplot_h.inc Deleted: trunk/bindings/ocaml/extras.ml =================================================================== --- trunk/bindings/ocaml/extras.ml 2008-07-19 20:03:20 UTC (rev 8541) +++ trunk/bindings/ocaml/extras.ml 2008-07-19 20:17:57 UTC (rev 8542) @@ -1,197 +0,0 @@ -open Plplot - -let draw_legend x y names colors = - (* - let () = - if x < 0.0 || x > 1.0 || y < 0.0 || y > 1.0 then - failwith "Legend location must be between 0.0 and 1.0" - in - *) - - let character_width = 0.2 in - let character_height = 0.2 in - let x_buffer = 0.1 in - let y_buffer = 0.1 in - - let max_name_length = - List.fold_left ( - fun l n2 -> - max l (String.length n2) - ) 0 names - in - let width = - float_of_int max_name_length *. character_width +. 2.0 *. x_buffer - in - let height = - character_height *. float_of_int (List.length names) - in - - let tx = x +. 0.6 in - let ty = ref (y +. 0.2) in - - List.iter2 ( - fun n c -> - plcol0 c; - plline [|tx -. 0.4; tx -. 0.1|] [|!ty; !ty|]; - plptex tx !ty 0.0 0.0 0.0 n; - ty := !ty -. character_height -. 0.2; - () - ) names colors; - () - -(** [plshades0 a xmin xmax ymin ymax clevels base_color] acts in the same - manner as plshades, but uses color map 0 rather than color map 1. - [base_color] is the index of the color to use for the first shaded - interval. The next interval uses color index [base_color] + 1 and so on. - A separate call to {plcont} is -*) -let plshades0 a xmin xmax ymin ymax clevels base_color color_step = - (* Save the current color and pencil width values *) - let initial_color = plg_current_col0 () in - let initial_width = plgwid () in - - (* Use color map 0, and iterate through colors from base_color in increments - of 1. *) - let color_map = 0 in - Array.iteri ( - fun i c0 -> - let c1 = clevels.(i + 1) in - let color = float_of_int (base_color + i * color_step) in - plshade a xmin xmax ymin ymax c0 c1 color_map color 0 0 0 0 0 0; - ) (Array.sub clevels 0 (Array.length clevels - 1)); - - (* Restore the initial color and width values *) - plcol0 initial_color; - plwid initial_width; - () - -(** [color_bar ?tick_interval ?step contours] draws a vertical color bar on the - right side end of the plot canvas, using the information in [contours] to - decide which colors to draw. - If [step] is provided, then every [step] units there will - be a new color. If [step] is omitted, then the smallest difference - between two consecutive values in [contours] is used. - [tick_level] can be used to set the interval between axis numbers if - something other than [step] is desired. -*) -let color_bar ?(tick_interval) ?(step) contours = - (* Get the current character size to restore later *) - let (old_default, old_scale) = plgchr () in - - (* A wee, tiny little font for the color scale *) - plschr 0.0 0.50; - - (* Vertical bar on the right side of the plot canvas *) - plvpor 0.93 0.96 0.15 0.85; - - (* Minimum and maximum values *) - let cmin = Array.fold_left min infinity contours in - let cmax = Array.fold_left max neg_infinity contours in - - (* Find the smallest step between contours, if none is provided *) - let step = - match step with - Some s -> s - | None -> - let accum = ref 0.0 in - for i = 1 to Array.length contours - 1 do - let delta = contours.(i) -. contours.(i - 1) in - if delta > !accum then - accum := delta - else - () - done; - !accum - in - let tick_interval = - match tick_interval with - Some t -> t - | None -> step - in - - (* Setup the color bar shades according to the given step size *) - let shades = - Array.init - (int_of_float ((cmax -. cmin) /. step) + 1) - (fun i -> float_of_int i *. step) - in - (* Unit x-axis, y-axis scaled to contour values *) - plwind 0.0 1.0 cmin cmax; - (* Small ticks on the vertical axis *) - plsmaj 1.0 1.0; - (* Show each contour *) - plshades [| shades; shades |] 0.0 1.0 cmin cmax shades 0 0 0 0; - plcol0 15; - plbox "bc" 0.0 0 "bcmtv" tick_interval 0; - - (* Set the character size to the old values *) - plschr old_default old_scale; - () - -(** [color_bar0 ?tick_interval ?step contours base_color color_step] -- - See [color_bar]. This does the same thing, except that it uses color map 0 - for the colors. [base_color] is the first map 0 index to use, and - [color_step] is the index increment. So the colors used are: - cmap0.(base_color + n * color_step) for n in 0 .. (Array.length contours) -*) -let color_bar0 ?(tick_interval) ?(step) contours base_color color_step = - (* Save some plot parameters to restore at the end of the function *) - let (old_default, old_scaled) = plgchr () in - let old_col0 = plg_current_col0 () in - let (old_vxmin, old_vxmax, old_vymin, old_vymax) = plgvpd () in - let (old_wxmin, old_wxmax, old_wymin, old_wymax) = plgvpw () in - - (* A wee, tiny little font for the color scale *) - plschr 0.0 0.50; - - (* Vertical bar on the right side of the plot canvas *) - plvpor 0.93 0.96 0.15 0.85; - - (* Minimum and maximum values *) - let cmin = Array.fold_left min infinity contours in - let cmax = Array.fold_left max neg_infinity contours in - - (* Find the smallest step between contours, if none is provided *) - let step = - match step with - Some s -> s - | None -> - let accum = ref 0.0 in - for i = 1 to Array.length contours - 1 do - let delta = contours.(i) -. contours.(i - 1) in - if delta > !accum then - accum := delta - else - () - done; - !accum - in - let tick_interval = - match tick_interval with - Some t -> t - | None -> step - in - - (* Setup the color bar shades according to the given step size *) - let shades = - Array.init - ((int_of_float (cmax -. cmin) + 1) * int_of_float step) - (fun i -> float_of_int i *. step) - in - (* Unit x-axis, y-axis scaled to contour values *) - plwind 0.0 1.0 cmin cmax; - (* Small ticks on the vertical axis *) - plsmaj 0.0 0.5; - (* Show each contour *) - plshades0 [| contours; contours |] 0.0 1.0 cmin cmax contours base_color color_step; - plcol0 15; - plbox "bc" 0.0 0 "bcmtv" tick_interval 0; - - (* Set things back to their old/default values *) - plschr old_scaled 1.0; - plcol0 old_col0; - plsmaj 0.0 1.0; - plvpor old_vxmin old_vxmax old_vymin old_vymax; - plwind old_wxmin old_wxmax old_wymin old_wymax; - () - This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-07-19 23:23:12
|
Revision: 8544 http://plplot.svn.sourceforge.net/plplot/?rev=8544&view=rev Author: airwin Date: 2008-07-19 23:22:25 +0000 (Sat, 19 Jul 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Change so the OCaml bindings will build with the changed plimagefr API. Modified Paths: -------------- trunk/bindings/ocaml/plplot.idl trunk/bindings/ocaml/plplot_impl.c Modified: trunk/bindings/ocaml/plplot.idl =================================================================== --- trunk/bindings/ocaml/plplot.idl 2008-07-19 21:56:21 UTC (rev 8543) +++ trunk/bindings/ocaml/plplot.idl 2008-07-19 23:22:25 UTC (rev 8544) @@ -51,7 +51,6 @@ [size_is(nx, ny)] PLFLT **idata, PLINT nx, PLINT ny, PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax, - PLFLT Dxmin, PLFLT Dxmax, PLFLT Dymin, PLFLT Dymax, PLFLT valuemin, PLFLT valuemax); [mlname(plvect)] void ml_plvect( Modified: trunk/bindings/ocaml/plplot_impl.c =================================================================== --- trunk/bindings/ocaml/plplot_impl.c 2008-07-19 21:56:21 UTC (rev 8543) +++ trunk/bindings/ocaml/plplot_impl.c 2008-07-19 23:22:25 UTC (rev 8544) @@ -275,19 +275,20 @@ void c_plimagefr(PLFLT **idata, PLINT nx, PLINT ny, PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax, - PLFLT Dxmin, PLFLT Dxmax, PLFLT Dymin, PLFLT Dymax, - PLFLT valuemin, PLFLT valuemax); + PLFLT valuemin, PLFLT valuemax, + void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), + PLPointer pltr_data); */ void ml_plimagefr(PLFLT **idata, PLINT nx, PLINT ny, PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax, - PLFLT Dxmin, PLFLT Dxmax, PLFLT Dymin, PLFLT Dymax, PLFLT valuemin, PLFLT valuemax) { c_plimagefr(idata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, - Dxmin, Dxmax, Dymin, Dymax, - valuemin, valuemax); + valuemin, valuemax, + get_ml_plotter_func(), + (void*)1); } /* This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-07-22 06:45:07
|
Revision: 8549 http://plplot.svn.sourceforge.net/plplot/?rev=8549&view=rev Author: airwin Date: 2008-07-22 06:45:16 +0000 (Tue, 22 Jul 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Fix OCaml interfaces for plpat and plbin. Remove deprecated plHLS_RGB and plRGB_HLS. Clean up the touchup.ml script related to the above changes and a better handling of the random number generator functions. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2008-07-21 12:09:13 UTC (rev 8548) +++ trunk/bindings/ocaml/plplot_h 2008-07-22 06:45:16 UTC (rev 8549) @@ -719,10 +719,10 @@ int plParseOpts(int *p_argc, const char **argv, PLINT mode); -*/ void plHLS_RGB(PLFLT h, PLFLT l, PLFLT s, PLFLT *p_r, PLFLT *p_g, PLFLT *p_b); void plRGB_HLS(PLFLT r, PLFLT g, PLFLT b, PLFLT *p_h, PLFLT *p_l, PLFLT *p_s); +*/ Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-07-21 12:09:13 UTC (rev 8548) +++ trunk/bindings/ocaml/plplot_h.inc 2008-07-22 06:45:16 UTC (rev 8549) @@ -3,7 +3,7 @@ [mlname(pladv)] void c_pladv ( int page ); [mlname(plsvect)] void c_plsvect ( [in, size_is(npts)] double * arrowx, [in, size_is(npts)] double * arrowy, int npts, int fill ); [mlname(plaxes)] void c_plaxes ( double x0, double y0, [string] const char * xopt, double xtick, int nxsub, [string] const char * yopt, double ytick, int nysub ); -[mlname(plbin)] void c_plbin ( int nbin, double * x, double * y, int opt ); +[mlname(plbin)] void c_plbin ( int nbin, [in, size_is(nbin)] double * x, [in, size_is(nbin)] double * y, int opt ); [mlname(plbop)] void c_plbop ( void ); [mlname(plbox)] void c_plbox ( [string] const char * xopt, double xtick, int nxsub, [string] const char * yopt, double ytick, int nysub ); [mlname(plbox3)] void c_plbox3 ( [string] const char * xopt, [string] const char * xlabel, double xtick, int nsubx, [string] const char * yopt, [string] const char * ylabel, double ytick, int nsuby, [string] const char * zopt, [string] const char * zlabel, double ztick, int nsubz ); @@ -66,7 +66,7 @@ [mlname(plmtex3)] void c_plmtex3 ( [string] const char * side, double disp, double pos, double just, [string] const char * text ); [mlname(plot3d)] void c_plot3d ( [size_is(nx), in] double * x, [size_is(ny), in] double * y, [size_is(nx, ny), in] double ** z, int nx, int ny, int opt, int side ); [mlname(plot3dc)] void c_plot3dc ( [size_is(nx), in] double * x, [size_is(ny), in] double * y, [size_is(nx, ny), in] double ** z, int nx, int ny, int opt, [size_is(nlevel), in] double * clevel, int nlevel ); -[mlname(plpat)] void c_plpat ( int nlin, int * inc, int * del ); +[mlname(plpat)] void c_plpat ( int nlin, [in, size_is(nlin)] int * inc, [in, size_is(nlin)] int * del ); [mlname(plpoin)] void c_plpoin ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y, int code ); [mlname(plpoin3)] void c_plpoin3 ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y, [in, size_is(n)] double * z, int code ); [mlname(plpoly3)] void c_plpoly3 ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y, [in, size_is(n)] double * z, [in, size_is(n)] int * draw, int ifcc ); @@ -134,10 +134,8 @@ [mlname(plwid)] void c_plwid ( int width ); [mlname(plwind)] void c_plwind ( double xmin, double xmax, double ymin, double ymax ); [mlname(plxormod)] void c_plxormod ( int mode, [out] int * status ); -[mlname(plseed)] void c_plseed(unsigned int s); -[mlname(plrandi)] unsigned long c_plrandi(void); -[mlname(plrandd)] double c_plrandd(void); +[mlname(plseed)] void c_plseed ( unsigned int s ); +[mlname(plrandi)] unsigned long c_plrandi ( void ); +[mlname(plrandd)] double c_plrandd ( void ); [mlname(plsetopt)] int c_plsetopt ( [string] const char * opt, [string] const char * optarg ); void plMinMax2dGrid ( [size_is(nx, ny)] double ** f, int nx, int ny, [out] double * fmax, [out] double * fmin ); -void plHLS_RGB ( double h, double l, double s, double * p_r, double * p_g, double * p_b ); -void plRGB_HLS ( double r, double g, double b, double * p_h, double * p_l, double * p_s ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2008-07-21 12:09:13 UTC (rev 8548) +++ trunk/bindings/ocaml/touchup.ml 2008-07-22 06:45:16 UTC (rev 8549) @@ -60,6 +60,18 @@ function_attrs = None; parameter_attrs = Some ["p_strm", ["out"]]; }; + { + function_name = "c_plbin"; + function_attrs = None; + parameter_attrs = Some ["x", ["in"; "size_is(nbin)"]; + "y", ["in"; "size_is(nbin)"]]; + }; + { + function_name = "c_plpat"; + function_attrs = None; + parameter_attrs = Some ["inc", ["in"; "size_is(nlin)"]; + "del", ["in"; "size_is(nlin)"]]; + }; (* For now, this will be wrapped by hand... { function_name = "c_plgriddata"; @@ -163,7 +175,6 @@ | 2 -> String.lowercase a.(0) ^ "_" ^ a.(1) | _ -> raise (Failure "Bad result in function caps check") - ) ^ ")"] ); (* Plplot names many of their functions c_* to avoid clashes with certain @@ -319,7 +330,6 @@ ) |> List.iter (fun (_,_,_,_,attrs) -> Hashtbl.add attr_hash param_name attrs) in - List.iter2 perform_check types names; attr_hash @@ -332,7 +342,7 @@ let process_prototype line = let pieces = line - |> Pcre.extract ~pat:"^((?:const )?\\w+ (?:\\*\\s*)?)(\\w+)\\s*\\(([\\w\\s\\*\\[\\],]*)\\)" ~full_match:false + |> Pcre.extract ~pat:"^((?:(?:const|unsigned) )?\\w+ (?:\\*\\s*)?)(\\w+)\\s*\\(([\\w\\s\\*\\[\\],]*)\\)" ~full_match:false |> Array.map minimize_whitespace in (* Get the return type, name and arg list separately *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <and...@us...> - 2008-08-15 19:32:59
|
Revision: 8663 http://plplot.svn.sourceforge.net/plplot/?rev=8663&view=rev Author: andrewross Date: 2008-08-15 19:33:06 +0000 (Fri, 15 Aug 2008) Log Message: ----------- Add pltr? functions to ocaml bindings. N.B. Currently untested. Modified Paths: -------------- trunk/bindings/ocaml/plplot.idl trunk/bindings/ocaml/plplot_impl.c Modified: trunk/bindings/ocaml/plplot.idl =================================================================== --- trunk/bindings/ocaml/plplot.idl 2008-08-15 02:58:19 UTC (rev 8662) +++ trunk/bindings/ocaml/plplot.idl 2008-08-15 19:33:06 UTC (rev 8663) @@ -65,6 +65,20 @@ PLFLT dlong, PLFLT dlat, PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat); +// The following are for the pltr functions +[mlname(pltr0)] void ml_pltr0( + PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty); + +[mlname(pltr1)] void ml_pltr1( + PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty, + PLINT nxg, PLINT nyg, + [in, size_is(nxg)] PLFLT *xg, [in, size_is(nyg)] PLFLT *yg); + +[mlname(pltr2)] void ml_pltr2( + PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty, + PLINT nxg, PLINT nyg, + [in, size_is(nxg, nyg)] PLFLT **xg, [in, size_is(nxg, nyg)] PLFLT **yg); + // XXX The following are non-standard functions which help retrieve some extra // information from PLplot. int plg_current_col0(void); Modified: trunk/bindings/ocaml/plplot_impl.c =================================================================== --- trunk/bindings/ocaml/plplot_impl.c 2008-08-15 02:58:19 UTC (rev 8662) +++ trunk/bindings/ocaml/plplot_impl.c 2008-08-15 19:33:06 UTC (rev 8663) @@ -439,8 +439,31 @@ CAMLreturn( Val_int(result) ); } +/* pltr* function implementations */ +void ml_pltr0(double x, double y, double* tx, double* ty) { + pltr0(x, y, tx, ty, NULL); +} +void ml_pltr1(double x, double y, double* tx, double* ty, + double nxg, double nyg, double* xg, double* yg) { + PLcGrid grid; + grid.xg = xg; + grid.yg = yg; + grid.nx = nxg; + grid.ny = nyg; + pltr1(x, y, tx, ty, (PLPointer)&grid); +} +void ml_pltr2(double x, double y, double* tx, double* ty, + double nxg, double nyg, double** xg, double** yg) { + PLcGrid2 grid; + grid.xg = xg; + grid.yg = yg; + grid.nx = nxg; + grid.ny = nyg; + pltr2(x, y, tx, ty, (PLPointer)&grid); +} + /* XXX Non-core functions follow XXX */ /** * The following functions are here for (my?) convenience. As far as I can This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-09-01 00:56:36
|
Revision: 8735 http://plplot.svn.sourceforge.net/plplot/?rev=8735&view=rev Author: airwin Date: 2008-09-01 00:56:41 +0000 (Mon, 01 Sep 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Force the use of 64bit integers for any function parameter which takes an unsigned integer value. In this case, the fci function arguments and plseed. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-08-31 21:02:59 UTC (rev 8734) +++ trunk/bindings/ocaml/plplot_h.inc 2008-09-01 00:56:41 UTC (rev 8735) @@ -35,7 +35,7 @@ [mlname(plgdidev)] void c_plgdidev ( [out] double * p_mar, [out] double * p_aspect, [out] double * p_jx, [out] double * p_jy ); [mlname(plgdiori)] void c_plgdiori ( [out] double * p_rot ); [mlname(plgdiplt)] void c_plgdiplt ( [out] double * p_xmin, [out] double * p_ymin, [out] double * p_xmax, [out] double * p_ymax ); -[mlname(plgfci)] void c_plgfci ( [out] unsigned int * pfci ); +[mlname(plgfci)] void c_plgfci ( [out, int64] unsigned int * pfci ); [mlname(plgfam)] void c_plgfam ( [out] int * p_fam, [out] int * p_num, [out] int * p_bmax ); [mlname(plgfnam)] void c_plgfnam ( [string, out, length_is(1024)] char * fnam ); [mlname(plgfont)] void c_plgfont ( [out] int * p_family, [out] int * p_style, [out] int * p_weight ); @@ -101,7 +101,7 @@ [mlname(plsdiplz)] void c_plsdiplz ( double xmin, double ymin, double xmax, double ymax ); [mlname(plsesc)] void c_plsesc ( char esc ); [mlname(plsfam)] void c_plsfam ( int fam, int num, int bmax ); -[mlname(plsfci)] void c_plsfci ( unsigned int fci ); +[mlname(plsfci)] void c_plsfci ( [int64] unsigned int fci ); [mlname(plsfnam)] void c_plsfnam ( [string] const char * fnam ); [mlname(plsfont)] void c_plsfont ( int family, int style, int weight ); [mlname(plsmaj)] void c_plsmaj ( double def, double scale ); @@ -135,7 +135,7 @@ [mlname(plwid)] void c_plwid ( int width ); [mlname(plwind)] void c_plwind ( double xmin, double xmax, double ymin, double ymax ); [mlname(plxormod)] void c_plxormod ( int mode, [out] int * status ); -[mlname(plseed)] void c_plseed ( unsigned int s ); +[mlname(plseed)] void c_plseed ( [int64] unsigned int s ); [mlname(plrandd)] double c_plrandd ( void ); [mlname(plsetopt)] int c_plsetopt ( [string] const char * opt, [string] const char * optarg ); void plMinMax2dGrid ( [size_is(nx, ny)] double ** f, int nx, int ny, [out] double * fmax, [out] double * fmin ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2008-08-31 21:02:59 UTC (rev 8734) +++ trunk/bindings/ocaml/touchup.ml 2008-09-01 00:56:41 UTC (rev 8735) @@ -234,6 +234,13 @@ misc. check (anything, as long as it's a bool) attributes, if all of the above are true *) + (* "PLUNICODE" parameters need at least unsigned int32 width ints, + so use Int64.t values to be safe. *) + true, + pmatch "unsigned int" p_type, + true, + true, + ["int64"]; (* "get" functions *) pmatch "^c_plg" function_name, pmatch "\\*" p_type, This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-09-01 05:02:14
|
Revision: 8738 http://plplot.svn.sourceforge.net/plplot/?rev=8738&view=rev Author: airwin Date: 2008-09-01 05:02:19 +0000 (Mon, 01 Sep 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Substantial (at least factor of 4) speedups to pltr1 and pltr2. Renames some of the OCaml-specific API functions to have a "pl" prefix for consistency and to help avoid namespace collisions when the Plplot module is opened in OCaml. Force pl_setcontlabelformat to have the correct name (no "c_" prefix) under OCaml. Modified Paths: -------------- trunk/bindings/ocaml/plplot.idl trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/plplot_impl.c Modified: trunk/bindings/ocaml/plplot.idl =================================================================== --- trunk/bindings/ocaml/plplot.idl 2008-09-01 01:04:12 UTC (rev 8737) +++ trunk/bindings/ocaml/plplot.idl 2008-09-01 05:02:19 UTC (rev 8738) @@ -1,5 +1,5 @@ /* -Copyright 2007 Hezekiah M. Carty +Copyright 2007, 2008 Hezekiah M. Carty This file is part of ocaml-plplot. @@ -73,16 +73,6 @@ [mlname(pltr0)] void ml_pltr0( PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty); -[mlname(pltr1)] void ml_pltr1( - PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty, - PLINT nxg, PLINT nyg, - [in, size_is(nxg)] PLFLT *xg, [in, size_is(nyg)] PLFLT *yg); - -[mlname(pltr2)] void ml_pltr2( - PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty, - PLINT nxg, PLINT nyg, - [in, size_is(nxg, nyg)] PLFLT **xg, [in, size_is(nxg, nyg)] PLFLT **yg); - // XXX The following are non-standard functions which help retrieve some extra // information from PLplot. int plg_current_col0(void); @@ -93,31 +83,39 @@ #define QUOTEME(x) #x #define RAW_ML(x) quote(mlmli, QUOTEME(x)); +// pltr callback functions, hand-wrapped +quote(mlmli, + "external pltr1 : float -> float -> float array -> float array -> float * float \ + = \"ml_pltr1\""); +quote(mlmli, + "external pltr2 : float -> float -> float array array -> float array array -> float * float \ + = \"ml_pltr2\""); + // Setting the translation function for the contouring and plotting functions quote(ml, - "let set_pltr (f : float -> float -> (float * float)) =\ + "let plset_pltr (f : float -> float -> (float * float)) =\ Callback.register \"caml_plplot_plotter\" f"); -quote(mli, "val set_pltr : (float -> float -> (float * float)) -> unit"); -quote(ml, "let unset_pltr () = Callback.register \"caml_plplot_plotter\" 0"); -quote(mli, "val unset_pltr : unit -> unit"); +quote(mli, "val plset_pltr : (float -> float -> (float * float)) -> unit"); +quote(ml, "let plunset_pltr () = Callback.register \"caml_plplot_plotter\" 0"); +quote(mli, "val plunset_pltr : unit -> unit"); // Setting the translation function for the map drawing functions quote(ml, - "let set_mapform (f : float -> float -> (float * float)) =\ + "let plset_mapform (f : float -> float -> (float * float)) =\ Callback.register \"caml_plplot_mapform\" f"); -quote(mli, "val set_mapform : (float -> float -> (float * float)) -> unit"); +quote(mli, "val plset_mapform : (float -> float -> (float * float)) -> unit"); quote(ml, - "let unset_mapform () = Callback.register \"caml_plplot_mapform\" 0"); -quote(mli, "val unset_mapform : unit -> unit"); + "let plunset_mapform () = Callback.register \"caml_plplot_mapform\" 0"); +quote(mli, "val plunset_mapform : unit -> unit"); // Setting the "defined" function for the shading functions quote(ml, -"let set_defined (f : float -> float -> int) =\ +"let plset_defined (f : float -> float -> int) =\ Callback.register \"caml_plplot_defined\" f"); -quote(mli, "val set_defined : (float -> float -> int) -> unit"); +quote(mli, "val plset_defined : (float -> float -> int) -> unit"); quote(ml, - "let unset_defined () = Callback.register \"caml_plplot_defined\" 0"); -quote(mli, "val unset_defined : unit -> unit"); + "let plunset_defined () = Callback.register \"caml_plplot_defined\" 0"); +quote(mli, "val plunset_defined : unit -> unit"); // Hand-translated GRID_* flags for use with plgriddata quote(mlmli, "type plplot_grid_method_type = \ Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-09-01 01:04:12 UTC (rev 8737) +++ trunk/bindings/ocaml/plplot_h.inc 2008-09-01 05:02:19 UTC (rev 8738) @@ -1,4 +1,4 @@ -void c_pl_setcontlabelformat(int lexp, int sigdig); +[mlname(pl_setcontlabelformat)] void c_pl_setcontlabelformat(int lexp, int sigdig); [mlname(pl_setcontlabelparam)] void c_pl_setcontlabelparam ( double offset, double size, double spacing, int active ); [mlname(pladv)] void c_pladv ( int page ); [mlname(plsvect)] void c_plsvect ( [in, size_is(npts)] double * arrowx, [in, size_is(npts)] double * arrowy, int npts, int fill ); Modified: trunk/bindings/ocaml/plplot_impl.c =================================================================== --- trunk/bindings/ocaml/plplot_impl.c 2008-09-01 01:04:12 UTC (rev 8737) +++ trunk/bindings/ocaml/plplot_impl.c 2008-09-01 05:02:19 UTC (rev 8738) @@ -454,24 +454,68 @@ pltr0(x, y, tx, ty, NULL); } -void ml_pltr1(double x, double y, double* tx, double* ty, - int nxg, int nyg, double* xg, double* yg) { +value ml_pltr1(value x, value y, value xg, value yg) { + CAMLparam4(x, y, xg, yg); + CAMLlocal1(tx_ty); + tx_ty = caml_alloc(2, 0); + double tx; + double ty; PLcGrid grid; - grid.xg = xg; - grid.yg = yg; - grid.nx = nxg; - grid.ny = nyg; - pltr1(x, y, tx, ty, (PLPointer)&grid); + grid.xg = (double*)xg; + grid.yg = (double*)yg; + grid.nx = Wosize_val(xg) / Double_wosize; + grid.ny = Wosize_val(yg) / Double_wosize; + pltr1(Double_val(x), Double_val(y), &tx, &ty, (PLPointer)&grid); + + // Allocate a tuple and return it with the results + Store_field(tx_ty, 0, caml_copy_double(tx)); + Store_field(tx_ty, 1, caml_copy_double(ty)); + CAMLreturn(tx_ty); } -void ml_pltr2(double x, double y, double* tx, double* ty, - int nxg, int nyg, double** xg, double** yg) { +value ml_pltr2(value x, value y, value xg, value yg) { + CAMLparam4(x, y, xg, yg); + CAMLlocal1(tx_ty); + tx_ty = caml_alloc(2, 0); + double** c_xg; + double** c_yg; + int i; + int length1; + int length2; PLcGrid2 grid; - grid.xg = xg; - grid.yg = yg; - grid.nx = nxg; - grid.ny = nyg; - pltr2(x, y, tx, ty, (PLPointer)&grid); + double tx; + double ty; + + /* TODO: As of now, you will probably get a segfault of the xg and yg + dimensions don't match up properly. */ + // Build the grid. + // Length of "outer" array + length1 = Wosize_val(xg); + // Length of the "inner" arrays + length2 = Wosize_val(Field(xg, 0)) / Double_wosize; + c_xg = malloc(length1 * sizeof(double*)); + for (i = 0; i < length1; i++) { + c_xg[i] = (double*)Field(xg, i); + } + c_yg = malloc(length1 * sizeof(double*)); + for (i = 0; i < length1; i++) { + c_yg[i] = (double*)Field(yg, i); + } + grid.xg = c_xg; + grid.yg = c_yg; + grid.nx = length1; + grid.ny = length2; + + pltr2(Double_val(x), Double_val(y), &tx, &ty, (PLPointer)&grid); + + // Clean up + free(c_xg); + free(c_yg); + + // Allocate a tuple and return it with the results + Store_field(tx_ty, 0, caml_copy_double(tx)); + Store_field(tx_ty, 1, caml_copy_double(ty)); + CAMLreturn(tx_ty); } /* XXX Non-core functions follow XXX */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-08 03:58:42
|
Revision: 10384 http://plplot.svn.sourceforge.net/plplot/?rev=10384&view=rev Author: hezekiahcarty Date: 2009-09-08 03:58:32 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Add Plplot.Plot and Plplot.Quick_plot modules to the OCaml interface This is a rather large commit, including two new modules as well as ocamldoc-ready documentation in the bindings/ocaml/plplot.mli file. These are two relatively high-level modules for the OCaml PLplot interface. They should both be considered usable but alpha as their interfaces may change. Plot is a module based largely around plot streams, making it easy to have multiple plots going at one time and to pass individual plot streams between functions. Quick_plot is a module for quick plots, intended mainly for short scripts and for use from the OCaml toplevel. Modified Paths: -------------- trunk/bindings/ocaml/CMakeLists.txt trunk/bindings/ocaml/libplplot_stubs.clib Added Paths: ----------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli trunk/bindings/ocaml/plplot_core.idl Removed Paths: ------------- trunk/bindings/ocaml/plplot.idl Modified: trunk/bindings/ocaml/CMakeLists.txt =================================================================== --- trunk/bindings/ocaml/CMakeLists.txt 2009-09-08 03:08:07 UTC (rev 10383) +++ trunk/bindings/ocaml/CMakeLists.txt 2009-09-08 03:58:32 UTC (rev 10384) @@ -26,8 +26,10 @@ libplplot_stubs.clib plplot_h plplot_h.inc - plplot.idl + plplot_core.idl plplot_impl.c + plplot.ml + plplot.mli touchup.ml ) set(GEN_SOURCE_LIST @@ -40,6 +42,7 @@ plplot.a plplot.cmi libplplot_stubs.a + plplot.mli ) set(OCAML_FULL_INSTALL_FILES) Modified: trunk/bindings/ocaml/libplplot_stubs.clib =================================================================== --- trunk/bindings/ocaml/libplplot_stubs.clib 2009-09-08 03:08:07 UTC (rev 10383) +++ trunk/bindings/ocaml/libplplot_stubs.clib 2009-09-08 03:58:32 UTC (rev 10384) @@ -1 +1 @@ -plplot_impl.o plplot_stubs.o +plplot_impl.o plplot_core_stubs.o Deleted: trunk/bindings/ocaml/plplot.idl =================================================================== --- trunk/bindings/ocaml/plplot.idl 2009-09-08 03:08:07 UTC (rev 10383) +++ trunk/bindings/ocaml/plplot.idl 2009-09-08 03:58:32 UTC (rev 10384) @@ -1,202 +0,0 @@ -/* -Copyright 2007, 2008 Hezekiah M. Carty - -This file is part of ocaml-plplot. - -ocaml-plplot is free software: you can redistribute it and/or modify -it under the terms of the GNU Lesser General Public License as published by -the Free Software Foundation, either version 2 of the License, or -(at your option) any later version. - -Foobar is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public License -along with ocaml-plplot. If not, see <http://www.gnu.org/licenses/>. -*/ - -// Taken from the plplot.h 3D plot style definitions -enum plplot3d_style_enum { - PL_DIFFUSE = 0, - PL_DRAW_LINEX = 1, - PL_DRAW_LINEY = 2, - PL_DRAW_LINEXY = 3, - PL_MAG_COLOR = 4, - PL_BASE_CONT = 8, - PL_TOP_CONT = 16, - PL_SURF_CONT = 32, - PL_DRAW_SIDES = 64, - PL_FACETED = 128, - PL_MESH = 256 -}; -typedef [set] enum plplot3d_style_enum plplot3d_style; - -enum plplot_bin_enum { - PL_BIN_DEFAULT = 0, - PL_BIN_CENTRED = 1, - PL_BIN_NOEXPAND = 2, - PL_BIN_NOEMPTY = 4, -}; -typedef [set] enum plplot_bin_enum plplot_bin_style; - -enum plplot_hist_enum { - PL_HIST_DEFAULT = 0, - PL_HIST_NOSCALING = 1, - PL_HIST_IGNORE_OUTLIERS = 2, - PL_HIST_NOEXPAND = 8, - PL_HIST_NOEMPTY = 16, -}; -typedef [set] enum plplot_hist_enum plplot_hist_style; - -// This is a simplified and modified version of the plplot.h file. -#include "plplot_h.inc" - -// These functions require(d) some manual assistance to get them to work -// properly -#define PLINT int -#define PLFLT double -#define PLBOOL int - -[mlname(plcont)] void ml_plcont( - [size_is(nx,ny)] PLFLT **f, PLINT nx, PLINT ny, - PLINT kx, PLINT lx, PLINT ky, PLINT ly, - [size_is(nlevel)] PLFLT *clevel, PLINT nlevel); - -[mlname(plshade)] void ml_plshade( - [size_is(nx,ny)] PLFLT **a, PLINT nx, PLINT ny, - PLFLT left, PLFLT right, PLFLT bottom, PLFLT top, - PLFLT shade_min, PLFLT shade_max, - PLINT sh_cmap, PLFLT sh_color, PLINT sh_width, - PLINT min_color, PLINT min_width, - PLINT max_color, PLINT max_width, - PLBOOL rectangular); - -[mlname(plshades)] void ml_plshades( - [size_is(nx,ny)] PLFLT **a, PLINT nx, PLINT ny, - PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, - [size_is(nlevel)] PLFLT *clevel, PLINT nlevel, PLINT fill_width, - PLINT cont_color, PLINT cont_width, - PLBOOL rectangular); - -[mlname(plimagefr)] void ml_plimagefr( - [size_is(nx, ny)] PLFLT **idata, PLINT nx, PLINT ny, - PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, - PLFLT zmin, PLFLT zmax, - PLFLT valuemin, PLFLT valuemax); - -[mlname(plvect)] void ml_plvect( - [size_is(nx,ny)] PLFLT **u, [size_is(nx,ny)] PLFLT **v, - PLINT nx, PLINT ny, PLFLT scale); - -[mlname(plmap)] void ml_plmap( - [string] const char *type, - PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat); - -[mlname(plmeridians)] void ml_plmeridians( - PLFLT dlong, PLFLT dlat, - PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat); - -[mlname(plpoly3)] void ml_plpoly3( - PLINT n, [size_is(n)] PLFLT *x, [size_is(n)] PLFLT *y, [size_is(n)] PLFLT *z, - PLINT ndraw, [size_is(ndraw)] PLBOOL *draw, PLBOOL ifcc); - -// The following are for the pltr functions -[mlname(pltr0)] void ml_pltr0( - PLFLT x, PLFLT y, [out] PLFLT *tx, [out] PLFLT *ty); - -// XXX The following are non-standard functions which help retrieve some extra -// information from PLplot. -int plg_current_col0(void); -float plg_current_col1(void); -int plgwid(void); -float plgchrht(void); - -#define QUOTEME(x) #x -#define RAW_ML(x) quote(mlmli, QUOTEME(x)); - -// plstripc function -quote(mlmli, - "external plstripc : string -> string -> float -> float -> float -> float -> \ - float -> float -> float -> bool -> bool -> int -> int -> \ - int array -> int array -> string array -> string -> \ - string -> string -> int = \"ml_plstripc_byte\" \"ml_plstripc\""); - -// pltr callback functions, hand-wrapped -quote(mlmli, - "external pltr1 : float -> float -> float array -> float array -> float * float \ - = \"ml_pltr1\""); -quote(mlmli, - "external pltr2 : float -> float -> float array array -> float array array -> float * float \ - = \"ml_pltr2\""); - -// Setting the translation function for the contouring and plotting functions -quote(ml, - "let plset_pltr (f : float -> float -> (float * float)) =\ - Callback.register \"caml_plplot_plotter\" f"); -quote(mli, "val plset_pltr : (float -> float -> (float * float)) -> unit"); -quote(ml, "let plunset_pltr () = Callback.register \"caml_plplot_plotter\" 0"); -quote(mli, "val plunset_pltr : unit -> unit"); - -// Setting the translation function for the map drawing functions -quote(ml, - "let plset_mapform (f : float -> float -> (float * float)) =\ - Callback.register \"caml_plplot_mapform\" f"); -quote(mli, "val plset_mapform : (float -> float -> (float * float)) -> unit"); -quote(ml, - "let plunset_mapform () = Callback.register \"caml_plplot_mapform\" 0"); -quote(mli, "val plunset_mapform : unit -> unit"); - -// Setting the "defined" function for the shading functions -quote(ml, -"let plset_defined (f : float -> float -> int) =\ - Callback.register \"caml_plplot_defined\" f"); -quote(mli, "val plset_defined : (float -> float -> int) -> unit"); -quote(ml, - "let plunset_defined () = Callback.register \"caml_plplot_defined\" 0"); -quote(mli, "val plunset_defined : unit -> unit"); - -// Hand-translated PL_GRID_* flags for use with plgriddata -quote(mlmli, "type plplot_grid_method_type = \ - PL_GRID_CSA | \ - PL_GRID_DTLI | \ - PL_GRID_NNI | \ - PL_GRID_NNIDW | \ - PL_GRID_NNLI | \ - PL_GRID_NNAIDW"); - -// Hand-translated PL_PARSE_* flags for use with plparseopts -quote(mlmli, "type plplot_parse_method_type = \ - PL_PARSE_PARTIAL | \ - PL_PARSE_FULL | \ - PL_PARSE_QUIET | \ - PL_PARSE_NODELETE | \ - PL_PARSE_SHOWALL | \ - PL_PARSE_OVERRIDE | \ - PL_PARSE_NOPROGRAM | \ - PL_PARSE_NODASH | \ - PL_PARSE_SKIP"); - -// Data type to reference axes -quote(mlmli, "type plplot_axis_type = \ - PL_X_AXIS | \ - PL_Y_AXIS | \ - PL_Z_AXIS"); - -// Custom axis labeling -quote(ml, "external ml_plslabelfunc : unit -> unit = \"ml_plslabelfunc\""); -quote(ml, -"let plslabelfunc (f : plplot_axis_type -> float -> string) =\ - Callback.register \"caml_plplot_customlabel\" f;\ - ml_plslabelfunc ()"); -quote(mli, "val plslabelfunc : (plplot_axis_type -> float -> string) -> unit"); -quote(ml, -"let plunset_labelfunc () =\ - Callback.register \"caml_plplot_customlabel\" 0;\ - ml_plslabelfunc ()"); -quote(mli, "val plunset_labelfunc : unit -> unit"); - -RAW_ML(external plgriddata : float array -> float array -> float array -> float array -> float array -> plplot_grid_method_type -> float -> float array array = "ml_plgriddata_bytecode" "ml_plgriddata") -RAW_ML(external plparseopts : string array -> plplot_parse_method_type list -> int = "ml_plparseopts") - Added: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml (rev 0) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 03:58:32 UTC (rev 10384) @@ -0,0 +1,956 @@ +include Plplot_core +open Printf + +(** [plcalc_device x y] will give the device position, in normalized device + coordinates, of the world coordinates (x, y). *) +let plcalc_device x y = + let xmin, xmax, ymin, ymax = plgvpw () in + let dev_xmin, dev_xmax, dev_ymin, dev_ymax = plgvpd () in + let width = xmax -. xmin in + let height = ymax -. ymin in + let dev_width = dev_xmax -. dev_xmin in + let dev_height = dev_ymax -. dev_ymin in + ((x -. xmin) /. width) *. dev_width +. dev_xmin, + ((y -. ymin) /. height) *. dev_height +. dev_ymin + +(** [plfullcanvas ()] maximizes the plot viewport and window. Dimensions are + set to (0.0, 0.0) to (1.0, 1.0). *) +let plfullcanvas () = + plvpor 0.0 1.0 0.0 1.0; + plwind 0.0 1.0 0.0 1.0; + () + +(** Draw an unfilled polygon. The only functional difference between this and + {plline} is that this function will close the given polygon, so there is no + need to duplicate points to have a closed figure. *) +let plpolyline xs ys = + plline xs ys; + (* Close off the polygon. *) + pljoin xs.(0) ys.(0) xs.(Array.length xs - 1) ys.(Array.length ys - 1) + +(** Support modules for Plot and Quick_plot *) + +module Option = struct + let may f o = + match o with + | Some x -> f x + | None -> () + + let default x_default o = + match o with + | Some x -> x + | None -> x_default + + let map_default f x_default o = + match o with + | Some x -> f x + | None -> x_default +end + +module Array_ext = struct + let matrix_dims m = + let ni = Array.length m in + if ni = 0 then 0, 0 else ( + let nj = Array.length (Array.unsafe_get m 0) in + for i = 1 to ni - 1 do + if Array.length (Array.unsafe_get m i) <> nj + then invalid_arg "Non-rectangular array" + done; + ni, nj + ) + + (** [range ~n a b] returns an array with elements ranging from [a] to [b] + in [n] total elements. *) + let range ~n a b = + let step = (b -. a) /. (float n -. 1.0) in + Array.init n ( + fun i -> + a +. float i *. step + ) + + (** [reduce f a] performs a fold of [f] over [a], using only the elements of + [a]. *) + let reduce f a = + if Array.length a = 0 then + invalid_arg "reduce: empty array" + else ( + let acc = ref a.(0) in + for i = 1 to Array.length a - 1 do acc := f !acc a.(i) done; + !acc + ) +end + +(** Work-in-progress easy plotting library for PLplot. The intention is to + provide a PLplot interface which is closer in style to other OCaml + libraries. *) +module Plot = struct + let ( |? ) o x_default = Option.default x_default o + + (** [verify_arg x s] will raise [Invalid_arg s] if [x] is false. Otherwise, + it does nothing. *) + let verify_arg x s = if x then () else (invalid_arg s) + + type 'a plot_side_t = + | Top of 'a | Bottom of 'a + | Left of 'a | Right of 'a + + type axis_options_t = + | Axis + | Frame0 | Frame1 + | Time + | Fixed_point + | Major_grid | Minor_grid + | Invert_ticks + | Log + | Unconventional_label + | Label + | Custom_label + | Minor_ticks | Major_ticks + | Vertical_label + + type stream_t = { + stream : int; + x_axis : axis_options_t list; + y_axis : axis_options_t list; + } + + type color_t = + | White + | Red + | Yellow + | Green + | Grey + | Blue + | Light_blue + | Purple + | Pink + | Black + | Brown + | Index_color of int + + type map_t = + | Globe_outline + | USA_outline + | Countries_outline + | All_outline + + type pltr_t = float -> float -> float * float + + type plot_t = + (* Standard plot elements *) + | Arc of (color_t * float * float * float * float * float * float * bool) + | Contours of (color_t * pltr_t * float array * float array array) + | Image of image_t + | Image_fr of (image_t * (float * float)) + | Join of (color_t * float * float * float * float) + | Lines of (string option * color_t * float array * float array) + | Map of (color_t * map_t * float * float * float * float) + | Points of + (string option * color_t * float array * float array * int * float) + | Polygon of (color_t * float array * float array * bool) + | Text of (color_t * string * float * float * float * float * float) + | Text_outside of (color_t * string * float plot_side_t * float * float * bool) + (* Set/clear coordinate transforms *) + | Set_transform of pltr_t + | Clear_transform + (* Custom functions *) + | Custom of (unit -> unit) + (* Embedded list of plottable elements *) + | List of plot_t list + and image_t = (float * float) option * float * float * float * float * float array array + + type plot_device_family_t = + | Cairo + | Qt + | Core + | Wx + type plot_device_t = + | Pdf of plot_device_family_t + | Png of plot_device_family_t + | Ps of plot_device_family_t + | Svg of plot_device_family_t + | Window of plot_device_family_t + | External of int + | Other_device of string + type plot_scaling_t = Preset | Greedy | Equal | Equal_square + + type color_palette_t = + | Indexed of string + | Continuous of (string * bool) + + let default_axis_options = + [Frame0; Frame1; Major_ticks; Minor_ticks; Invert_ticks; Label] + + (** Convert a color to a (red, green, blue) triple *) + let rgb_of_color = function + | White -> 255, 255, 255 + | Red -> 255, 0, 0 + | Yellow -> 255, 255, 0 + | Green -> 0, 255, 0 + | Grey -> 200, 200, 200 + | Blue -> 0, 0, 255 + | Light_blue -> 0, 255, 255 + | Purple -> 160, 0, 213 + | Pink -> 255, 0, 255 + | Black -> 0, 0, 0 + | Brown -> 165, 42, 42 + | Index_color i -> plgcol0 i + + let string_of_map_t = function + | Globe_outline -> "globe" + | USA_outline -> "usa" + | Countries_outline -> "cglobe" + | All_outline -> "usaglobe" + + (** An internal function for converting a scaling variant value to the + associated PLplot integer value. *) + let int_of_scaling = function + | Preset -> -1 (* Scaling must be set beforehand *) + | Greedy -> 0 (* Use as much of the plot space as possible *) + | Equal -> 1 (* Square aspect ratio *) + | Equal_square -> 2 (* Square aspect ratio and square plot area *) + + + (** Get the suffix string which matches the given device family *) + let string_of_device_family = function + | Cairo -> "cairo" + | Qt -> "qt" + | Core -> "" + | Wx -> "" + + (** Returns the string to pass to plsdev and a boolean value indicating if + the device is interactive or not. *) + let devstring_of_plot_device = function + | External _ -> "N/A", false + | Other_device s -> s, false + | Pdf family -> "pdf" ^ string_of_device_family family, false + | Png family -> "png" ^ string_of_device_family family , false + | Ps family -> "ps" ^ string_of_device_family family, false + | Svg family -> "svg" ^ string_of_device_family family, false + | Window family -> ( + match family with + | Cairo -> "xcairo" + | Qt -> "qtwidget" + | Core -> "xwin" + | Wx -> "wxwidgets" + ), true + + let recommended_extension = function + | Png _ -> ".png" + | Ps _ -> ".ps" + | Pdf _ -> ".pdf" + | Svg _ -> ".svg" + | Window _ -> invalid_arg "interactive plot device" + | External _ -> invalid_arg "external plot device" + | Other_device _ -> invalid_arg "other device, unknown extension" + + (** Make a new stream, without disturbing the current plot state. *) + let make_stream ?stream () = + let this_stream = + match stream with + | None -> + let old_stream = plgstrm () in + let new_stream = plmkstrm () in + plsstrm old_stream; + new_stream + | Some s -> s + in + { stream = this_stream; + x_axis = default_axis_options; y_axis = default_axis_options; } + + (** [with_stream ?stream f] calls [f ()] with [stream] as the active + plotting stream if [stream] is present. Otherwise it just calls + [f ()]. *) + let with_stream ?stream f = + match stream with + | None -> f () + | Some s -> + let old_stream = plgstrm () in + plsstrm s.stream; + let result = f () in + plsstrm old_stream; + result + + (** Set the plotting color (color scale 0). NOTE that these are for the + ALTERNATE color palette, not the DEFAULT color palette. *) + let set_color ?stream c = + let n = + match c with + | White -> 0 + | Red -> 3 + | Yellow -> 13 + | Green -> 12 + | Grey -> 10 + | Blue -> 2 + | Light_blue -> 11 + | Purple -> 15 + | Pink -> 14 + | Black -> 1 + | Brown -> 4 + | Index_color i -> i + in + with_stream ?stream (fun () -> plcol0 n) + + (** [set_color_scale ?stream rev colors] sets the color scale 1 (images and + shade plots) using a linear interpolation between the given list of + colors. If [rev] is true then the scale goes in the reverse order. *) + let set_color_scale ?stream rev colors = + let cs = Array.map rgb_of_color colors in + let r, g, b = + Array.map (fun (r, _, _) -> float_of_int r /. 255.0) cs, + Array.map (fun (_, g, _) -> float_of_int g /. 255.0) cs, + Array.map (fun (_, _, b) -> float_of_int b /. 255.0) cs + in + let positions = Array_ext.range ~n:(Array.length cs) 0.0 1.0 in + let rev = + if rev then Some (Array.map (fun _ -> true) cs) else None + in + with_stream ?stream (fun () -> plscmap1l true positions r g b rev); + () + + (** Start a new page *) + let start_page ?stream x0 x1 y0 y1 axis_scaling = + with_stream ?stream ( + fun () -> + (* Start with a black plotting color. *) + set_color Black; + plenv x0 x1 y0 y1 (int_of_scaling axis_scaling) (-2); + ) + + (** Load a color palette from a file on disk *) + let load_palette ?stream which = + with_stream ?stream ( + fun () -> + match which with + | Indexed file -> plspal0 file + | Continuous (file, segmented) -> plspal1 file segmented + ) + + (** [init ?filename ?size ?pages x0 x1 y0 y1 axis_scaling device] creates a + new plot instance. [size] is the size of the plot device. If a [filename] + is provided then an appropriate file extension will be added, based on the + given [device]. [pages] determines how many plots will be on a single + device page. *) + let init ?filename ?size ?pages ?pre x0 x1 y0 y1 axis_scaling device = + (* Make a new plot stream. *) + let stream, init = + match device with + | External stream -> make_stream ~stream (), false + | _ -> make_stream (), true + in + (* If an external stream is provided, assume all initialization has been + performed before we get here. *) + if init then with_stream ~stream ( + fun () -> + (* Set the output file name *) + let dev, is_interactive = devstring_of_plot_device device in + Option.may ( + fun name_base -> + plsfnam ( + name_base ^ ( + if is_interactive then "" + else ( + (* Only append an extension if the filename does not have + one already. *) + let extension = recommended_extension device in + if Filename.check_suffix name_base extension then "" + else extension + ) + ) + ); + ) filename; + + (* Set the physical page dimensions for the plot *) + Option.may ( + fun (x, y) -> + let dim_string = sprintf "%dx%d" x y in + ignore (plsetopt "geometry" dim_string) + ) size; + plsdev dev; + + (* Run the requested pre-plot-initialization function and then + initialize the new plot. *) + Option.may (fun f -> f ()) pre; + plinit (); + ); + (* If requested, set up multiple sub-pages. *) + Option.may (fun (x, y) -> with_stream ~stream (fun () -> plssub x y)) pages; + start_page ~stream x0 x1 y0 y1 axis_scaling; + stream + + (** [make_stream_active stream] makes [stream] the active plot stream. If + there is another active plot stream its identity is not saved. *) + let make_stream_active stream = plsstrm stream.stream + + (** {3 Simplified plotting interface} *) + + (** [arc ?fill color x y a b angle1 angle2 rotation] *) + let arc ?(fill = false) color x y a b angle1 angle2 = + Arc (color, x, y, a, b, angle1, angle2, fill) + + (** [circle ?fill color x y r] - A special case of [arc]. *) + let circle ?fill color x y r = arc ?fill color x y r r 0.0 360.0 + + (** [contours color pltr contours data] *) + let contours color pltr contours data = + Contours (color, pltr, contours, data) + + (** [image ?range sw ne image] *) + let image ?range (x0, y0) (x1, y1) data = Image (range, x0, y0, x1, y1, data) + + (** [imagefr ?range ~scale sw ne image] *) + let imagefr ?range ~scale (x0, y0) (x1, y1) data = + Image_fr ((range, x0, y0, x1, y1, data), scale) + + (** [join color x0 y0 x1 y1] *) + let join color x0 y0 x1 y1 = Join (color, x0, y0, x1, y1) + + (** [lines ?label color xs ys] *) + let lines ?label color xs ys = Lines (label, color, xs, ys) + + (** [map ?sw ?ne color outline] *) + let map ?sw ?ne color outline = + let x0, y0 = sw |? (-180.0, -90.0) in + let x1, y1 = ne |? (180.0, 90.0) in + Map (color, outline, x0, y0, x1, y1) + + (** [points ?label ?scale color xs ys symbol] *) + let points ?label ?scale color xs ys symbol = + Points (label, color, xs, ys, symbol, scale |? 1.0) + + (** [polygon color xs ys fill] *) + let polygon ?(fill = false) color xs ys = Polygon (color, xs, ys, fill) + + (** [text ?dx ?dy ?just ?color s x y] *) + let text ?(dx = 0.0) ?(dy = 0.0) ?(just = 0.5) ?(color = Black) s x y = + Text (color, s, x, y, dx, dy, just) + + (** [text_outside ?just side displacement s] *) + let text_outside ?(just = 0.5) ?(perp = false) ?(color = Black) side displacement s = + Text_outside (color, s, side, displacement, just, perp) + + (** [transform f] *) + let transform f = Set_transform f + + (** [clear_transform] *) + let clear_transform = Clear_transform + + (** [custom f] *) + let custom f = Custom f + + (** [list l] *) + let list l = List l + + (** Get the font character height in plot world coordinates *) + let character_height ?stream () = + with_stream ?stream ( + fun () -> + let (_, char_height_mm) = plgchr () in + (* Normalized viewport dims * dimensions in mm = world size in mm *) + let (_, _, vymin, vymax) = plgvpd () in + let vy = vymax -. vymin in + let (_, _, mymin, mymax) = plgspa () in + let mm_y = mymax -. mymin in + let world_height_mm = (mm_y *. vy) in + (* Character height (mm) / World height (mm) = Normalized char height *) + let char_height_norm = char_height_mm /. world_height_mm in + (* Normalized character height * World height (world) = + Character height (world) *) + let (_, _, wymin, wymax) = plgvpw () in + let world_y = wymax -. wymin in + char_height_norm *. world_y + ) + + (** Draw a legend with the upper-left corner at (x,y) *) + let draw_legend ?stream ?line_length ?x ?y names colors = + with_stream ?stream ( + fun () -> + (* Save the current color to restore at the end *) + let old_col0 = plg_current_col0 () in + + (* Get viewport world-coordinate limits *) + let xmin, xmax, ymin, ymax = plgvpw () in + let normalized_to_world nx ny = + xmin +. nx *. (xmax -. xmin), + ymin +. ny *. (ymax -. ymin) + in + + (* Get world-coordinate positions of the start of the legend text *) + let line_x = x |? 0.6 in + let line_y = y |? 0.95 in + let line_x_end = line_x +. 0.1 in + let line_x_world, line_y_world = normalized_to_world line_x line_y in + let line_x_end_world, _ = normalized_to_world line_x_end line_y in + let text_x = line_x_end +. 0.01 in + let text_y = line_y in + let text_x_world, text_y_world = normalized_to_world text_x text_y in + + let character_height = character_height () in + let ty = ref (text_y_world -. character_height) in + + (* Draw each line type with the appropriate label *) + List.iter2 ( + fun n c -> + set_color c; + plline [|line_x_world; line_x_end_world|] [|!ty; !ty|]; + set_color Black; + plptex text_x_world !ty 0.0 0.0 0.0 n; + ty := !ty -. (1.5 *. character_height); + () + ) names colors; + + (* Restore old color *) + plcol0 old_col0; + () + ) + + (** [plot stream l] plots the data in [l] to the plot [stream]. *) + let rec plot ?stream plottable_list = + (* TODO: Add legend support. *) + (* + let dims ?(expand = true) l = + let coef = 5.0e-5 in + let one_dims = function + | Pts (xs, ys, _) + | Lines (xs, ys) -> + (Array.reduce min xs, Array.reduce min ys), + (Array.reduce max xs, Array.reduce max ys) + in + let all_dims = List.map one_dims l in + let min_dims, max_dims = List.split all_dims in + let xmins, ymins = List.split min_dims in + let xmaxs, ymaxs = List.split max_dims in + let (xmin, ymin), (xmax, ymax) = + (List.reduce min xmins, List.reduce min ymins), + (List.reduce max xmaxs, List.reduce max ymaxs) + in + let diminish n = n -. n *. coef in + let extend n = n +. n *. coef in + if expand then + (diminish xmin, diminish ymin), + (extend xmax, extend ymax) + else + (xmin, ymin), (xmax, ymax) + in + *) + let set_color_in c f = + let old_color = plg_current_col0 () in + set_color c; + f (); + plcol0 old_color; + () + in + let plot_arc (color, x, y, a, b, angle1, angle2, fill) = + set_color_in color ( + fun () -> plarc x y a b angle1 angle2 fill; + ) + in + let plot_contours (color, pltr, contours, data) = + set_color_in color ( + fun () -> + plset_pltr pltr; + let ixmax, iymax = Array_ext.matrix_dims data in + plcont data 1 ixmax 1 iymax contours; + plunset_pltr (); + ) + in + let plot_image (range, x0, y0, x1, y1, image) = + let range_min, range_max = range |? (0.0, 0.0) in + plimage image + x0 x1 y0 y1 range_min range_max x0 x1 y0 y1; + () + in + let plot_imagefr (range, x0, y0, x1, y1, image) scale = + let range_min, range_max = range |? (0.0, 0.0) in + let scale_min, scale_max = scale in + plimagefr image + x0 x1 y0 y1 range_min range_max scale_min scale_max; + () + in + let plot_join (color, x0, y0, x1, y1) = + set_color_in color (fun () -> pljoin x0 y0 x1 y1) + in + let plot_lines (label, color, xs, ys) = + set_color_in color (fun () -> plline xs ys) + in + let plot_map (color, outline, x0, y0, x1, y1) = + set_color_in color ( + fun () -> + plmap (string_of_map_t outline) x0 x1 y0 y1; + ) + in + let plot_points (label, color, xs, ys, symbol, scale) = + set_color_in color ( + fun () -> + plssym 0.0 scale; + plpoin xs ys symbol; + plssym 0.0 1.0; + ) + in + let plot_polygon (color, xs, ys, fill) = + let x_len = Array.length xs in + let y_len = Array.length ys in + verify_arg (x_len = y_len) + "plot_polygon: must provide same number of X and Y coordinates"; + set_color_in color ( + fun () -> + if fill then ( + plfill xs ys; + ) + else ( + (* Make sure the polygon is closed *) + let xs' = + Array.init (x_len + 1) + (fun i -> if i < x_len - 1 then xs.(i) else xs.(0)) + in + let ys' = + Array.init (y_len + 1) + (fun i -> if i < y_len - 1 then ys.(i) else ys.(0)) + in + plline xs' ys'; + ) + ) + in + let plot_text (color, s, x, y, dx, dy, just) = + set_color_in color (fun () -> plptex x y dx dy just s) + in + let plot_text_outside (color, s, side, displacement, just, perp) = + let side_string, position = + match side with + | Right p -> "r", p + | Left p -> "l", p + | Top p -> "t", p + | Bottom p -> "b", p + in + let side_string = side_string ^ if perp then "v" else "" in + set_color_in color + (fun () -> plmtex side_string displacement position just s) + in + + let one_plot p = + match p with + | Arc a -> plot_arc a + | Contours c -> plot_contours c + | Image i -> plot_image i + | Image_fr (i, scale) -> plot_imagefr i scale + | Join j -> plot_join j + | Lines l -> plot_lines l + | Map m -> plot_map m + | Points p -> plot_points p + | Polygon poly -> plot_polygon poly + | Text t -> plot_text t + | Text_outside t_o -> plot_text_outside t_o + | Set_transform pltr -> plset_pltr pltr + | Clear_transform -> plunset_pltr () + | Custom f -> f () + | List l -> plot l + in + List.iter ( + fun plottable -> with_stream ?stream (fun () -> one_plot plottable) + ) plottable_list + + (** Label the axes and plot title *) + let label ?stream x y title = + with_stream ?stream (fun () -> pllab x y title) + + (** [colorbar ?label ?log ?pos values] draws a colorbar, using the given + values for the color range. [label] gives the position and text of the + colorbar label; if [log] is true then the scale is taken to be log rather + than linear ; [pos] sets the position of the colorbar itself, both the + side of the plot to put it on and the distance from the edge + (normalized device units); [width] is the width of the colorbar (again in + normalized device units). + NOTE: This potentially wrecks the current viewport and + window settings, among others, so it should be called AFTER the current + plot page is otherwise complete. *) + let colorbar ?label ?log ?(pos = Right 0.07) ?(width = 0.03) values = + (* Save the state of the current plot window. *) + let dxmin, dxmax, dymin, dymax = plgvpd () in + let wxmin, wxmax, wymin, wymax = plgvpw () in + (*let old_default, old_scale = plgchr () in*) + + let old_color = plg_current_col0 () in + + (* Small font *) + plschr 0.0 0.75; + (* Small ticks on the vertical axis *) + plsmaj 0.0 0.5; + plsmin 0.0 0.5; + + (* "Rotate" the image if we have a horizontal (Top or Bottom) colorbar. If + the colorbar is to the Right or Bottom of the image then count the + distance as distance from that edge. *) + let image, offset = + match pos with + | Right off -> [|values|], 1.0 -. off + | Left off -> [|values|], off -. width + | Top off -> + Array.map (fun x -> [|x|]) values, 1.0 -. off + | Bottom off -> + Array.map (fun x -> [|x|]) values, off -. width + in + + (* Find the min and max in the range of values, ignoring nan, infinity and + neg_infinity values. *) + let max_value, min_value = plMinMax2dGrid image in + + (* Put the bar on the proper side, with the proper offsets. *) + (* Unit major-axis, minor-axis scaled to contour values. *) + (* Draw the color bar as an image. *) + let width_start = offset in + let width_end = offset +. width in + let () = + match pos with + | Right _ + | Left _ -> + plvpor width_start width_end 0.15 0.85; + plwind 0.0 1.0 min_value max_value; + plimage + image 0.0 1.0 min_value max_value 0.0 0.0 + 0.0 1.0 min_value max_value; + | Top _ + | Bottom _ -> + plvpor 0.15 0.85 width_start width_end; + plwind min_value max_value 0.0 1.0; + plimage + image min_value max_value 0.0 1.0 0.0 0.0 + min_value max_value 0.0 1.0; + in + + (* Draw a box and tick marks around the color bar. *) + set_color Black; + (* Draw ticks and labels on the major axis. Add other options as + appropriate. *) + let major_axis_opt = + String.concat "" [ + "bct"; + (* Log? *) + (match log with + | None -> "" + | Some b -> if b then "sl" else ""); + (* Which side gets the label *) + (match pos with + | Right _ + | Top _ -> "m" + | Left _ + | Bottom _ -> "n"); + (* Perpendicular labeling? *) + (match pos with + | Right _ + | Left _ -> "v" + | Top _ + | Bottom _ -> ""); + ] + in + (* Just draw the minor axis sides, no labels or ticks. *) + let minor_axis_opt = "bc" in + let x_opt, y_opt = + match pos with + | Top _ + | Bottom _ -> major_axis_opt, minor_axis_opt + | Left _ + | Right _ -> minor_axis_opt, major_axis_opt + in + plbox x_opt 0.0 0 y_opt 0.0 0; + + (* Draw the label *) + Option.may ( + fun l -> + (* Which side to draw the label on and the offset from that side in units + of character height. *) + let label_string, label_pos_string, label_offset = + match l with + | Right s -> s, "r", 4.0 + | Left s -> s, "l", 4.0 + | Top s -> s, "t", 1.5 + | Bottom s -> s, "b", 1.5 + in + plmtex label_pos_string label_offset 0.5 0.5 label_string + ) label; + + (* TODO XXX FIXME - Make sure setting are all properly restored... *) + (* Restore the old plot window settings. *) + plvpor dxmin dxmax dymin dymax; + plwind wxmin wxmax wymin wymax; + plschr 0.0 1.0; + plsmaj 0.0 1.0; + plsmin 0.0 1.0; + plcol0 old_color; + () + + (** Draw a colorbar, optionally log scaled and labeled. *) + let colorbar ?stream ?label ?log ?pos ?width values = + with_stream ?stream (fun () -> colorbar ?label ?log ?pos ?width values) + + (** An easier to deduce alternative to {Plplot.plbox} *) + let plot_axes ~xtick ~xsub ~ytick ~ysub ~xoptions ~yoptions = + let map_axis_options ol = + List.map ( + function + | Axis -> "a" + | Frame0 -> "b" + | Frame1 -> "c" + | Time -> "d" + | Fixed_point -> "f" + | Major_grid -> "g" + | Minor_grid -> "h" + | Invert_ticks -> "i" + | Log -> "l" + | Unconventional_label -> "m" + | Label -> "n" + | Custom_label -> "o" + | Minor_ticks -> "s" + | Major_ticks -> "t" + | Vertical_label -> "v" + ) ol + in + let xopt = String.concat "" (map_axis_options xoptions) in + let yopt = String.concat "" (map_axis_options yoptions) ^ "v" in + plbox xopt xtick xsub yopt ytick ysub + + (** Default page ending steps *) + let default_finish ?stream xstep ystep () = + let xopt, yopt = + match stream with + | None -> default_axis_options, default_axis_options + | Some s -> s.x_axis, s.y_axis + in + with_stream ?stream ( + fun () -> + set_color Black; + plot_axes + ~xtick:xstep ~xsub:0 ~xoptions:xopt + ~ytick:ystep ~ysub:0 ~yoptions:yopt; + ) + + (** Plot axes, but don't advance the page or end the session. This is used + internally by [finish]. *) + let finish_page ?stream ?f ?post xstep ystep = + with_stream ?stream ( + fun () -> + let actual_finish = + match f with + | Some custom_finish -> custom_finish + | None -> default_finish ?stream xstep ystep + in + actual_finish (); + Option.may (fun f -> f ()) post; + ) + + (** Finish the current page, start a new one. *) + let next_page ?stream ?f ?post x0 x1 y0 y1 axis_scaling = + finish_page ?stream ?f ?post 0.0 0.0; + start_page ?stream x0 x1 y0 y1 axis_scaling; + () + + (** Finish up the plot by plotting axes and ending the session. This must + be called after plotting is complete. *) + let finish ?stream ?f ?post xstep ystep = + finish_page ?stream ?f ?post xstep ystep; + with_stream ?stream plend1 +end + +(** The [Quick_plot] module is intended to be used for quick, "throw-away" + plots. It's is likely to be most useful from the toplevel. *) +module Quick_plot = struct + open Plot + + let special_float x = + match classify_float x with + | FP_normal + | FP_subnormal + | FP_zero -> false + | FP_infinite + | FP_nan -> true + + let safe_array_reduce f a = + let n = + Array_ext.reduce ( + fun accu x -> + if special_float x then + accu + else if special_float accu then + x + else + f accu x + ) a + in + verify_arg (not (special_float n)) "No non-special values"; + n + + let extents xs_list ys_list = + List.fold_left min infinity (List.map (safe_array_reduce min) xs_list), + List.fold_left max neg_infinity (List.map (safe_array_reduce max) xs_list), + List.fold_left min infinity (List.map (safe_array_reduce min) ys_list), + List.fold_left max neg_infinity (List.map (safe_array_reduce max) ys_list) + + let maybe_log log p = + Option.map_default ( + fun (x_log, y_log) -> + { + p with + x_axis = if x_log then Log :: p.x_axis else p.x_axis; + y_axis = if y_log then Log :: p.y_axis else p.y_axis; + } + ) p log + + (** [points xs ys] plots the points described by the coordinates [xs] + and [ys]. *) + let points ?filename ?(device = Window Cairo) ?labels ?log xs_list ys_list = + let xmin, xmax, ymin, ymax = extents xs_list ys_list in + let ys_array = Array.of_list ys_list in + let p = init ?filename xmin xmax ymin ymax Greedy device in + let plottable_points = + Array.to_list ( + Array.mapi ( + fun i xs -> points (Index_color (i + 1)) xs ys_array.(i) i + ) (Array.of_list xs_list) + ) + in + plot ~stream:p plottable_points; + Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; + finish ~stream:(maybe_log log p) 0.0 0.0; + () + + (** [lines xs ys] plots the line segments described by the coordinates + [xs] and [ys]. *) + let lines + ?filename ?(device = Window Cairo) ?labels ?names ?log + xs_list ys_list = + let xmin, xmax, ymin, ymax = extents xs_list ys_list in + let ys_array = Array.of_list ys_list in + let p = init ?filename xmin xmax ymin ymax Greedy device in + let colors = Array.mapi (fun i _ -> Index_color (i + 1)) ys_array in + let plottable_lines = + Array.to_list ( + Array.mapi ( + fun i xs -> lines colors.(i) xs ys_array.(i) + ) (Array.of_list xs_list) + ) + in + plot ~stream:p plottable_lines; + Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; + Option.may (fun n -> draw_legend ~stream:p n (Array.to_list colors)) names; + finish ~stream:(maybe_log log p) 0.0 0.0; + () + + (** [image ?log m] plots the image [m] with a matching colorbar. If [log] is + true then the data in [m] are assumed to be log10(x) values. *) + let image ?filename ?(device = Window Cairo) ?labels ?log ?palette m = + let m_max, m_min = plMinMax2dGrid m in + let xmin, ymin = 0.0, 0.0 in + let xmax, ymax = Array_ext.matrix_dims m in + let xmax, ymax = float_of_int xmax, float_of_int ymax in + let p = init ?filename xmin xmax ymin ymax Equal_square device in + Option.may ( + fun palette_file -> + with_stream ~stream:p (fun () -> plspal1 palette_file false); + ) palette; + plot ~stream:p [image (xmin, ymin) (xmax, ymax) m]; + Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; + colorbar ~stream:p ?log ~pos:(Right 0.12) + (Array_ext.range ~n:100 m_min m_max); + finish ~stream:p 0.0 0.0; + () +end + Added: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli (rev 0) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 03:58:32 UTC (rev 10384) @@ -0,0 +1,757 @@ +(** {1 PLplot - A library for creating scientific plots} *) + +(** {e Note:} The API for the {!Plot} and {!Quick_plot} modules is not yet + fixed and may change. + + {!core} is {b not} expected to change. *) + +(** {3 A higher-level OCaml interface to PLplot} *) +module Plot : + sig + + (** {b THIS API IS NOT FIXED AND MAY CHANGE} *) + + (** The different sides of a (2D) plot. These values are used to + represent, e.g., offsets along axes and text placement. *) + type 'a plot_side_t = + | Top of 'a + | Bottom of 'a + | Left of 'a + | Right of 'a + + (** These are the available options for drawing plot axes. These values + map to individual letters provided to {!Plplot.plbox} and similar + functions. *) + type axis_options_t = + | Axis + | Frame0 + | Frame1 + | Time + | Fixed_point + | Major_grid + | Minor_grid + | Invert_ticks + | Log + | Unconventional_label + | Label + | Custom_label + | Minor_ticks + | Major_ticks + | Vertical_label + + (** A plot stream. *) + type stream_t = { + stream : int; (** The plot stream index as used by PLplot *) + x_axis : axis_options_t list; (** Axis drawing options for the X-axis *) + y_axis : axis_options_t list; (** Axis drawing options for the Y-axis *) + } + + (** Colors from the indexed color map (color map 0), from the + [cmapo_alternate.pal] file! Note that these will NOT match up with + colors from the default color palette! *) + type color_t = + | White + | Red + | Yellow + | Green + | Grey + | Blue + | Light_blue + | Purple + | Pink + | Black + | Brown + | Index_color of int + + (** Different map outlines available for {!map} *) + type map_t = + | Globe_outline + | USA_outline + | Countries_outline + | All_outline + + (** Type signature for coordinate transform functions *) + type pltr_t = float -> float -> float * float + + (** A plottable element, usable by the function {!plot}. *) + type plot_t + + (** The different available plot device families. This is not a complete + representation of all of the available devices provided by PLplot. *) + type plot_device_family_t = + | Cairo + | Qt + | Core + | Wx + + (** Plot devices. The constructor argument allows one to define which + device family is used. *) + type plot_device_t = + | Pdf of plot_device_family_t + | Png of plot_device_family_t + | Ps of plot_device_family_t + | Svg of plot_device_family_t + | Window of plot_device_family_t + | External of int (** Pre-defined plot streams *) + | Other_device of string (** PLplot plotting devices otherwise not + available from this list *) + + (** Type of scaling to use for plot axes, as in {!Plplot.plenv}. *) + type plot_scaling_t = Preset | Greedy | Equal | Equal_square + + (** PLplot has two color palettes - indexed (color map 0) and + continuous (color map 1). *) + type color_palette_t = + | Indexed of string + | Continuous of (string * bool) + + (** The default list of axis rendering options, used for all plots generated + with {!init} if no custom options are provided. *) + val default_axis_options : axis_options_t list + + (** Convert {!color_t} values to [r, g, b] integer values, each ranging in + value from [0 - 255].*) + val rgb_of_color : color_t -> int * int * int + + (** A recommended/standard file name extension, given a particular plot + device. *) + val recommended_extension : plot_device_t -> string + + (** Make a new {!stream_t}, possibly using an existing plot stream index. *) + val make_stream : ?stream:int -> unit -> stream_t + + (** [with_stream ?stream f] performs [f] with [stream] as the active plot + stream. If [stream] is not provided then the currently active plot + stream is left active. Once [f] is complete, the previously active plot + stream is restored. *) + val with_stream : ?stream:stream_t -> (unit -> 'a) -> 'a + + (** [set_color ?stream color] sets the current active plot color to + [color]. *) + val set_color : ?stream:stream_t -> color_t -> unit + + (** [set_color_scale ?stream reverse colors] sets the continuous color map + (color map 1) to a scale determined by interpolating between [colors]. + {!Plplot.plscmap1l} is used internally to set the color scale. *) + val set_color_scale : ?stream:stream_t -> bool -> color_t array -> unit + + (** [start_page ?stream x0 y0 x1 y1 scaling] starts a new plot page with the + given dimensions and scaling. *) + val start_page : + ?stream:stream_t -> + float -> float -> float -> float -> plot_scaling_t -> unit + + (** [load_palette ?stream palette] loads either indexed or continuous + color palette information from a file on disk. *) + val load_palette : ?stream:stream_t -> color_palette_t -> unit + + (** [init ?filename ?size ?pages x0 x1 y0 y1 scale device] - Start a new + plot stream for a 2D plot with plot axis extents given by [(x0, y0)] to + [(x1, y1)]. + @param filename Plot output filename. A suitable file extension + will be added if it does not already exist. + @param size Dimension of the plot in physical units (e.g., pixels + for bitmap outputs (PNG, X) and 1/72 inch for vector + outputs (PS, PDF, SVG) + @param pages Layout of multiple plots on a single page + @param pre This function, if provided, is called just before the plot + instance is initialized. It can be used to, for example, + load custom color palettes. *) + val init : + ?filename:string -> + ?size:int * int -> + ?pages:int * int -> + ?pre:(unit -> unit) -> + float -> + float -> float -> float -> plot_scaling_t -> plot_device_t -> stream_t + + (** [make_stream_active stream] makes [stream] in to the currently active + plot stream. *) + val make_stream_active : stream_t -> unit + + (** {4 Plot elements} *) + + (** [arc ?fill color x y a b angle0 angle1] *) + val arc : + ?fill:bool -> + color_t -> float -> float -> float -> float -> float -> float -> plot_t + + (** [circle ?fill color x y r] *) + val circle : ?fill:bool -> color_t -> float -> float -> float -> plot_t + + (** [contours color tranform_func contours data] *) + val contours : + color_t -> pltr_t -> float array -> float array array -> plot_t + + (** [image ?range (x0, y0) (x1, y1) data] *) + val image : + ?range:float * float -> + float * float -> float * float -> float array array -> plot_t + + (** [imagefr ?range ~scale (x0, y0) (x1, y1) data] *) + val imagefr : + ?range:float * float -> + scale:float * float -> + float * float -> float * float -> float array array -> plot_t + + (** [join color x0 y1 x1 y1] *) + val join : color_t -> float -> float -> float -> float -> plot_t + + (** [lines ?label color xs ys] *) + val lines : + ?label:string -> color_t -> float array -> float array -> plot_t + + (** [map ?sw ?ne color outline_type] *) + val map : + ?sw:float * float -> ?ne:float * float -> color_t -> map_t -> plot_t + + (** [points ?label ?scale color xs ys symbol] *) + val points : + ?label:string -> + ?scale:float -> color_t -> float array -> float array -> int -> plot_t + + (** [polygon ?fill color xs ys] *) + val polygon : + ?fill:bool -> color_t -> float array -> float array -> plot_t + + (** [text ?dx ?dy ?just ?color string x y] writes the text [string] inside + the plot window, at an optional angle defined by the offsets [dx] and + [dy]. *) + val text : + ?dx:float -> + ?dy:float -> + ?just:float -> ?color:color_t -> string -> float -> float -> plot_t + + (** [text_outside ?just ?perp ?color side offset string] writes text + outside of the plot window, along [side], displaced from the axis by + [offset] * character height. *) + val text_outside : + ?just:float -> + ?perp:bool -> + ?color:color_t -> float plot_side_t -> float -> string -> plot_t + + (** [transform f] Set the coordinate transformation function used by + {!imagefr} and other functions affected by {!Plplot.plset_pltr}. *) + val transform : pltr_t -> plot_t + + (** [clear_transform] clears any currently defined plot transform + function. *) + val clear_transform : plot_t + + (** [custom f] will call [f ()] when the plot element is used. This + function can be used to create customized plot elements for use with + {!plot}. *) + val custom : (unit -> unit) -> plot_t + + (** [list l] makes a plot element from a list of plot elements, allowing, + for example, a plot to be created piece-by-piece before being + rendered. *) + val list : plot_t list -> plot_t + + (** Plot a list of plottable elements *) + val plot : ?stream:stream_t -> plot_t list -> unit + + (** {4 Support functions} *) + + (** Character height in world coordinate units *) + val character_height : ?stream:stream_t -> unit -> float + + (** Draw a legend, given a list of titles and colors *) + val draw_legend : + ?stream:stream_t -> + ?line_length:'a -> + ?x:float -> ?y:float -> string list -> color_t list -> unit + + (** [label x_label y_label title] adds axis labels and a title to the given + plot [stream]. *) + val label : ?stream:stream_t -> string -> string -> string -> unit + + (** [colorbar ?stream ?label ?log ?pos ?width values] addd a color bar to a + plot using the current color scale. This function should be called + after the rest of the plot is complete. *) + val colorbar : + ?stream:stream_t -> + ?label:string plot_side_t -> + ?log:bool -> + ?pos:float plot_side_t -> ?width:float -> float array -> unit + + (** Draw the plot axes on the current plot page *) + val plot_axes : + xtick:float -> + xsub:int -> + ytick:float -> + ysub:int -> + xoptions:axis_options_t list -> yoptions:axis_options_t list -> unit + + (** {4 Finishing up a plot page} *) + + val default_finish : ?stream:stream_t -> float -> float -> unit -> unit + val finish_page : + ?stream:stream_t -> + ?f:(unit -> unit) -> ?post:(unit -> unit) -> float -> float -> unit + val next_page : + ?stream:stream_t -> + ?f:(unit -> unit) -> + ?post:(unit -> unit) -> + float -> float -> float -> float -> plot_scaling_t -> unit + + (** [finish ?stream xstep ystep] finishes up the plot [stream], using + [xstep] and [ystep] for the axis tick. *) + val finish : + ?stream:stream_t -> + ?f:(unit -> unit) -> ?post:(unit -> unit) -> float -> float -> unit + end + +(** {3 A module for quick, "throw-away" plots} *) +module Quick_plot : + sig + + (** {b THIS API IS NOT FIXED AND MAY CHANGE} *) + + (** [points xs ys] plots the points described by the coordinates [xs] + and [ys]. *) + val points : + ?filename:string -> + ?device:Plot.plot_device_t -> + ?labels:string * string * string -> + ?log:bool * bool -> float array list -> float array list -> unit + + (** [lines xs ys] plots the line segments described by the coordinates + [xs] and [ys]. *) + val lines : + ?filename:string -> + ?device:Plot.plot_device_t -> + ?labels:string * string * string -> + ?names:string list -> + ?log:bool * bool -> float array list -> float array list -> unit + + (** [image ?log m] plots the image [m] with a matching colorbar. If [log] + is true then the data in [m] are assumed to be [log10(x)] values. *) + val image : + ?filename:string -> + ?device:Plot.plot_device_t -> + ?labels:string * string * string -> + ?log:bool -> ?palette:string -> float array array -> unit + end + +(** {3:core The standard PLplot API} *) + +(** See the main PLplot documentation for the description and documentation of + these functions. *) + +type plplot3d_style_enum = + PL_DIFFUSE + | PL_DRAW_LINEX + | PL_DRAW_LINEY + | PL_DRAW_LINEXY + | PL_MAG_COLOR + | PL_BASE_CONT + | PL_TOP_CONT + | PL_SURF_CONT + | PL_DRAW_SIDES + | PL_FACETED + | PL_MESH +and plplot3d_style = plplot3d_style_enum list +and plplot_bin_enum = + PL_BIN_DEFAULT + | PL_BIN_CENTRED + | PL_BIN_NOEXPAND + | PL_BIN_NOEMPTY +and plplot_bin_style = plplot_bin_enum list +and plplot_hist_enum = + PL_HIST_DEFAULT + | PL_HIST_NOSCALING + | PL_HIST_IGNORE_OUTLIERS + | PL_HIST_NOEXPAND + | PL_HIST_NOEMPTY +and plplot_hist_style = plplot_hist_enum list +external pl_setcontlabelformat : int -> int -> unit + = "camlidl_plplot_core_c_pl_setcontlabelformat" +external pl_setcontlabelparam : float -> float -> float -> int -> unit + = "camlidl_plplot_core_c_pl_setcontlabelparam" +external pladv : int -> unit = "camlidl_plplot_core_c_pladv" +external plarc : + float -> float -> float -> float -> float -> float -> bool -> unit + = "camlidl_plplot_core_c_plarc_bytecode" "camlidl_plplot_core_c_plarc" +external plaxes : + float -> float -> string -> float -> int -> string -> float -> int -> unit + = "camlidl_plplot_core_c_plaxes_bytecode" "camlidl_plplot_core_c_plaxes" +external plbin : float array -> float array -> plplot_bin_style -> unit + = "camlidl_plplot_core_c_plbin" +external plbtime : float -> int * int * int * int * int * float + = "camlidl_plplot_core_c_plbtime" +external plbop : unit -> unit = "camlidl_plplot_core_c_plbop" +external plbox : string -> float -> int -> string -> float -> int -> unit + = "camlidl_plplot_core_c_plbox_bytecode" "camlidl_plplot_core_c_plbox" +external plbox3 : + string -> + string -> + float -> + int -> + string -> + string -> float -> int -> string -> string -> float -> int -> unit + = "camlidl_plplot_core_c_plbox3_bytecode" "camlidl_plplot_core_c_plbox3" +external plcalc_world : float -> float -> float * float * int + = "camlidl_plplot_core_c_plcalc_world" +external plclear : unit -> unit = "camlidl_plplot_core_c_plclear" +external plcol0 : int -> unit = "camlidl_plplot_core_c_plcol0" +external plcol1 : float -> unit = "camlidl_plplot_core_c_plcol1" +external plconfigtime : + float -> + float -> + float -> int -> bool -> int -> int -> int -> int -> int -> float -> unit + = "camlidl_plplot_core_c_plconfigtime_bytecode" + "camlidl_plplot_core_c_plconfigtime" +external plcpstrm : int -> bool -> unit = "camlidl_plplot_core_c_plcpstrm" +external plctime : int -> int -> int -> int -> int -> float -> float + = "camlidl_plplot_core_c_plctime_bytecode" "camlidl_plplot_core_c_plctime" +external plend : unit -> unit = "camlidl_plplot_core_c_plend" +external plend1 : unit -> unit = "camlidl_plplot_core_c_plend1" +external plenv : float -> float -> float -> float -> int -> int -> unit + = "camlidl_plplot_core_c_plenv_bytecode" "camlidl_plplot_core_c_plenv" +external plenv0 : float -> float -> float -> float -> int -> int -> unit + = "camlidl_plplot_core_c_plenv0_bytecode" "camlidl_plplot_core_c_plenv0" +external pleop : unit -> unit = "camlidl_plplot_core_c_pleop" +external plerrx : float array -> float array -> float array -> unit + = "camlidl_plplot_core_c_plerrx" +external plerry : float array -> float array -> float array -> unit + = "camlidl_plplot_core_c_plerry" +external plfamadv : unit -> unit = "camlidl_plplot_core_c_plfamadv" +external plfill : float array -> float array -> unit + = "camlidl_plplot_core_c_plfill" +external plfill3 : float array -> float array -> float array -> unit + = "camlidl_plplot_core_c_plfill3" +external plflush : unit -> unit = "camlidl_plplot_core_c_plflush" +external plfont : int -> unit = "camlidl_plplot_core_c_plfont" +external plfontld : int -> unit = "camlidl_plplot_core_c_plfontld" +external plgchr : unit -> float * float = "camlidl_plplot_core_c_plgchr" +external plgcol0 : int -> int * int * int = "camlidl_plplot_core_c_plgcol0" +external plgcol0a : int -> int * int * int * float + = "camlidl_plplot_core_c_plgcol0a" +external plgcolbg : unit -> int * int * int + = "camlidl_plplot_core_c_plgcolbg" +external plgcolbga : unit -> int * int * int * float + = "camlidl_plplot_core_c_plgcolbga" +external plgcompression : unit -> int + = "camlidl_plplot_core_c_plgcompression" +external plgdev : unit -> string = "camlidl_plplot_core_c_plgdev" +external plgdidev : unit -> float * float * float * float + = "camlidl_plplot_core_c_plgdidev" +external plgdiori : unit -> float = "camlidl_plplot_core_c_plgdiori" +external plgdiplt : unit -> float * float * float * float + = "camlidl_plplot_core_c_plgdiplt" +external plgfci : unit -> int64 = "camlidl_plplot_core_c_plgfci" +external plgfam : unit -> int * int * int = "camlidl_plplot_core_c_plgfam" +external plgfnam : unit -> string = "camlidl_plplot_core_c_plgfnam" +external plgfont : unit -> int * int * int = "camlidl_plplot_core_c_plgfont" +external plglevel : unit -> int = "camlidl_plplot_core_c_plglevel" +external plgpage : unit -> float * float * int * int * int * int + = "camlidl_plplot_core_c_plgpage" +external plgra : unit -> unit = "camlidl_plplot_core_c_plgra" +external plgspa : unit -> float * float * float * float + = "camlidl_plplot_core_c_plgspa" +external plgstrm : unit -> int = "camlidl_plplot_core_c_plgstrm" +external plgver : unit -> string = "camlidl_plplot_core_c_plgver" +external plgvpd : unit -> float * float * float * float + = "camlidl_plplot_core_c_plgvpd" +external plgvpw : unit -> float * float * float * float + = "camlidl_plplot_core_c_plgvpw" +external plgxax : unit -> int * int = "camlidl_p... [truncated message content] |
From: <hez...@us...> - 2009-09-08 04:14:56
|
Revision: 10385 http://plplot.svn.sourceforge.net/plplot/?rev=10385&view=rev Author: hezekiahcarty Date: 2009-09-08 04:14:46 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Add/update some license headers in the OCaml bindings Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli trunk/bindings/ocaml/plplot_impl.c Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-09-08 03:58:32 UTC (rev 10384) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 04:14:46 UTC (rev 10385) @@ -1,3 +1,22 @@ +(* +Copyright 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + include Plplot_core open Printf Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-09-08 03:58:32 UTC (rev 10384) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 04:14:46 UTC (rev 10385) @@ -1,3 +1,22 @@ +(* +Copyright 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + (** {1 PLplot - A library for creating scientific plots} *) (** {e Note:} The API for the {!Plot} and {!Quick_plot} modules is not yet Modified: trunk/bindings/ocaml/plplot_impl.c =================================================================== --- trunk/bindings/ocaml/plplot_impl.c 2009-09-08 03:58:32 UTC (rev 10384) +++ trunk/bindings/ocaml/plplot_impl.c 2009-09-08 04:14:46 UTC (rev 10385) @@ -1,5 +1,5 @@ /* -Copyright 2007, 2008 Hezekiah M. Carty +Copyright 2007, 2008, 2009 Hezekiah M. Carty This file is part of PLplot. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-10-11 23:08:27
|
Revision: 10525 http://plplot.svn.sourceforge.net/plplot/?rev=10525&view=rev Author: hezekiahcarty Date: 2009-10-11 23:08:14 +0000 (Sun, 11 Oct 2009) Log Message: ----------- Add high-level plshades wrapper to Plplot.Plot and Plplot.Quick_plot This includes a new colorbar function, shadebar, which can be used to draw a colorbar for unevenly spaced shading contours. Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-10-11 23:07:19 UTC (rev 10524) +++ trunk/bindings/ocaml/plplot.ml 2009-10-11 23:08:14 UTC (rev 10525) @@ -189,6 +189,10 @@ | Points of (string option * color_t * float array * float array * symbol_t * float) | Polygon of (color_t * float array * float array * bool) + | Shades of ( + int * color_t * int * bool * float * float * float * float * float array + array * float array + ) | Text of (color_t * string * float * float * float * float * float) | Text_outside of (color_t * string * float plot_side_t * float * float * bool) @@ -361,25 +365,26 @@ | Open_dot_symbol -> 20 | Index_symbol i -> i + (** NOTE that these are for the ALTERNATE color palette, not the DEFAULT + color palette. *) + let int_of_color = function + | White -> 0 + | Red -> 3 + | Yellow -> 13 + | Green -> 12 + | Gray -> 10 + | Blue -> 2 + | Light_blue -> 11 + | Purple -> 15 + | Pink -> 14 + | Black -> 1 + | Brown -> 4 + | Index_color i -> i + (** Set the plotting color (color scale 0). NOTE that these are for the ALTERNATE color palette, not the DEFAULT color palette. *) let set_color ?stream c = - let n = - match c with - | White -> 0 - | Red -> 3 - | Yellow -> 13 - | Green -> 12 - | Gray -> 10 - | Blue -> 2 - | Light_blue -> 11 - | Purple -> 15 - | Pink -> 14 - | Black -> 1 - | Brown -> 4 - | Index_color i -> i - in - with_stream ?stream (fun () -> plcol0 n) + with_stream ?stream (fun () -> plcol0 (int_of_color c)) (** [set_color_scale ?stream rev colors] sets the color scale 1 (images and shade plots) using a linear interpolation between the given list of @@ -519,6 +524,17 @@ let rectangle ?(fill = false) color (x0, y0) (x1, y1) = polygon ~fill color [|x0; x1; x1; x0; x0|] [|y0; y0; y1; y1; y0|] + (** [shades ?fill_width ?contour ?rect (x0, y0) (x1, y1) data] *) + let shades ?fill_width ?contour ?(rect = true) + (x0, y0) (x1, y1) contours data = + let cont_color, cont_width = + contour |? (Index_color 0, 0) + in + Shades ( + fill_width |? 1, cont_color, cont_width, rect, x0, y0, x1, y1, + data, contours + ) + (** [text ?dx ?dy ?just ?color s x y] *) let text ?(dx = 0.0) ?(dy = 0.0) ?(just = 0.5) color x y s = Text (color, s, x, y, dx, dy, just) @@ -747,6 +763,25 @@ ) ) in + (* + let plot_shade + (x0, y0, x1, y1, + shade_min, shade_max, shade_color, shade_width, + min_color, min_width, + max_color, max_width, + rect, + data) + = + plshade data x0 x1 y0 y1 shade_min shade_max cmap color width + min_color min_width max_color max_width rect + in + *) + let plot_shades + (fill_width, cont_color, cont_width, rect, x0, y0, x1, y1, data, contours) + = + let cont_color = int_of_color cont_color in + plshades data x0 x1 y0 y1 contours fill_width cont_color cont_width rect + in let plot_text (color, s, x, y, dx, dy, just) = set_color_in color (fun () -> plptex x y dx dy just s) in @@ -774,6 +809,7 @@ | Map m -> plot_map m | Points p -> plot_points p | Polygon poly -> plot_polygon poly + | Shades s -> plot_shades s | Text t -> plot_text t | Text_outside t_o -> plot_text_outside t_o | Set_transform pltr -> plset_pltr pltr @@ -816,7 +852,7 @@ let yopt = String.concat "" (map_axis_options yoptions) ^ "v" in with_stream ?stream (fun () -> plbox xopt xtick xsub yopt ytick ysub) - (** [colorbar ?label ?log ?pos values] draws a colorbar, using the given + (** [colorbar_base ?label ?log ?pos values] draws a colorbar, using the given values for the color range. [label] gives the position and text of the colorbar label; if [log] is true then the scale is taken to be log rather than linear ; [pos] sets the position of the colorbar itself, both the @@ -826,8 +862,8 @@ NOTE: This potentially wrecks the current viewport and window settings, among others, so it should be called AFTER the current plot page is otherwise complete. *) - let colorbar ?custom_axis ?label ?log ?(pos = Right 0.07) ?(width = 0.03) - values = + let colorbar_base ?custom_axis ?label ?log ?(pos = Right 0.07) ?(width = 0.03) + data = (* Save the state of the current plot window. *) let dxmin, dxmax, dymin, dymax = plgvpd () in let wxmin, wxmax, wymin, wymax = plgvpw () in @@ -841,46 +877,80 @@ plsmaj 0.0 0.5; plsmin 0.0 0.5; - (* "Rotate" the image if we have a horizontal (Top or Bottom) colorbar. If - the colorbar is to the Right or Bottom of the image then count the - distance as distance from that edge. *) - let image, offset = + (* Offset from the edge of the plot surface in normalized device units *) + let offset = match pos with - | Right off -> [|values|], 1.0 -. off - | Left off -> [|values|], off -. width - | Top off -> - Array.map (fun x -> [|x|]) values, 1.0 -. off - | Bottom off -> - Array.map (fun x -> [|x|]) values, off -. width + | Right off + | Top off -> 1.0 -. off + | Left off + | Bottom off -> off -. width in - - (* Find the min and max in the range of values, ignoring nan, infinity and - neg_infinity values. *) - let max_value, min_value = plMinMax2dGrid image in - (* Put the bar on the proper side, with the proper offsets. *) (* Unit major-axis, minor-axis scaled to contour values. *) - (* Draw the color bar as an image. *) let width_start = offset in let width_end = offset +. width in - let () = + + (* Set the viewport and window *) + let init_window min_value max_value = match pos with | Right _ | Left _ -> plvpor width_start width_end 0.15 0.85; plwind 0.0 1.0 min_value max_value; - plimage - image 0.0 1.0 min_value max_value 0.0 0.0 - 0.0 1.0 min_value max_value; | Top _ | Bottom _ -> plvpor 0.15 0.85 width_start width_end; plwind min_value max_value 0.0 1.0; - plimage - image min_value max_value 0.0 1.0 0.0 0.0 - min_value max_value 0.0 1.0; in + (* "Rotate" the image if we have a horizontal (Top or Bottom) colorbar. *) + (* Also, double the amount of data because plshades won't work properly + otherwise. *) + let colorbar_data values = + match pos with + | Right off + | Left off -> [|values; values|] + | Top off + | Bottom off -> Array.map (fun x -> [|x; x|]) values + in + + (* Draw the image or shaded data, depending on what was requested *) + let () = + match data with + | `image (min_value, max_value) -> + (* Draw the color bar as an image. *) + (* TODO FIXME XXX: Change "100" to be the number of color palette 1 + colors once the attribute getting + setting functions are in + place. *) + let colorbar_steps = Array_ext.range ~n:100 min_value max_value in + let data = colorbar_data colorbar_steps in + init_window min_value max_value; + (match pos with + | Right _ + | Left _ -> plot [image (0.0, min_value) (1.0, max_value) data] + | Top _ + | Bottom _ -> plot [image (min_value, 0.0) (max_value, 1.0) data]) + | `shade contours -> + let shade_data = colorbar_data contours in + let max_value, min_value = plMinMax2dGrid [|contours|] in + init_window min_value max_value; + (match pos with + | Right _ + | Left _ -> + plot [ + transform (pltr1 [|0.0; 1.0|] contours); + shades (0.0, min_value) (1.0, max_value) contours shade_data; + clear_transform; + ] + | Top _ + | Bottom _ -> + plot [ + transform (pltr1 contours [|0.0; 1.0|]); + shades (min_value, 0.0) (max_value, 1.0) contours shade_data; + clear_transform; + ]) + in + (* Draw a box and tick marks around the color bar. *) set_color Black; (* Draw ticks and labels on the major axis. Add other options as @@ -943,7 +1013,7 @@ plschr 0.0 1.0; plsmaj 0.0 1.0; plsmin 0.0 1.0; - plcol0 old_color; + set_color (Index_color old_color); () (** [colorbar_labeler ?log ?min ?max axis n] can be used as a custom @@ -982,10 +1052,19 @@ | Some true -> log10_text n (** Draw a colorbar, optionally log scaled and labeled. *) - let colorbar ?stream ?custom_axis ?label ?log ?pos ?width values = - with_stream ?stream - (fun () -> colorbar ?custom_axis ?label ?log ?pos ?width values) + let colorbar ?stream ?custom_axis ?label ?log ?pos ?width (min, max) = + with_stream ?stream ( + fun () -> + colorbar_base ?custom_axis ?label ?log ?pos ?width (`image (min, max)) + ) + (** Draw a shaded colorbar, optionally log scaled and labeled. *) + let shadebar ?stream ?custom_axis ?label ?log ?pos ?width values = + with_stream ?stream ( + fun () -> + colorbar_base ?custom_axis ?label ?log ?pos ?width (`shade values) + ) + (** Default page ending steps. Just draw the plot axes. *) let default_finish ?stream ?axis ?xtick ?ytick () = let xopt, yopt = @@ -1126,8 +1205,7 @@ Option.may (load_palette ~stream:p) palette; plot ~stream:p [image (xmin, ymin) (xmax, ymax) m]; Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; - colorbar ~stream:p ?log ~pos:(Right 0.12) - (Array_ext.range ~n:100 m_min m_max); + colorbar ~stream:p ?log ~pos:(Right 0.12) (m_min, m_max); finish ~stream:p (); () @@ -1164,5 +1242,24 @@ Option.may (fun (x, y, t) -> label ~stream x y t) labels; finish ~stream (); () + + let shades ?filename ?(device = Window Cairo) ?labels ?log ?palette ?contours + m = + let xmin, ymin = 0.0, 0.0 in + let xmax, ymax = Array_ext.matrix_dims m in + let xmax, ymax = float_of_int xmax, float_of_int ymax in + let p = init ?filename (xmin, ymin) (xmax, ymax) Equal_square device in + Option.may (load_palette ~stream:p) palette; + let contours = + contours |? ( + let m_max, m_min = plMinMax2dGrid m in + Array_ext.range ~n:11 m_min m_max + ) + in + plot ~stream:p [shades (xmin, ymin) (xmax, ymax) contours m]; + Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; + shadebar ~stream:p ?log ~pos:(Right 0.12) contours; + finish ~stream:p (); + () end Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-10-11 23:07:19 UTC (rev 10524) +++ trunk/bindings/ocaml/plplot.mli 2009-10-11 23:08:14 UTC (rev 10525) @@ -296,6 +296,14 @@ val rectangle : ?fill:bool -> color_t -> float * float -> float * float -> plot_t + (** [shades ?fill_width ?contour ?rect (x0, y0) (x1, y1) contours data] *) + val shades : + ?fill_width:int -> + ?contour:color_t * int -> + ?rect:bool -> + float * float -> float * float -> + float array -> float array array -> plot_t + (** [text ?dx ?dy ?just color x y string ] writes the text [string] inside the plot window, at an optional angle defined by the offsets [dx] and [dy]. *) @@ -357,16 +365,31 @@ plot [stream]. *) val label : ?stream:stream_t -> string -> string -> string -> unit - (** [colorbar ?stream ?label ?log ?pos ?width values] addd a color bar to a - plot using the current color scale. This function should be called - after the rest of the plot is complete. *) + (** [colorbar ?stream ?label ?log ?pos ?width (min, max)] add a color bar + to a plot using the current color scale. This function should be + called after the rest of the plot is complete. *) val colorbar : ?stream:stream_t -> ?custom_axis:axis_options_t list -> ?label:string plot_side_t -> ?log:bool -> - ?pos:float plot_side_t -> ?width:float -> float array -> unit + ?pos:float plot_side_t -> + ?width:float -> + float * float -> unit + (** [shadebar ?stream ?label ?log ?pos ?width contours] add a shaded color + bar to a plot using the current color scale. This is similar to + {!colorbar} but takes contours as [values]. This function should be + called after the rest of the plot is complete. *) + val shadebar : + ?stream:stream_t -> + ?custom_axis:axis_options_t list -> + ?label:string plot_side_t -> + ?log:bool -> + ?pos:float plot_side_t -> + ?width:float -> + float array -> unit + (** [colorbar_labeler ?log ?min ?max axis n] can be used as a custom axis labeling function when a colorbar is meant to represent values beyond those which are represented. So if the colorbar labeling shows @@ -461,6 +484,17 @@ ?names:string list -> ?symbol:Plot.symbol_t -> ?step:float -> (float -> float) list -> float * float -> unit + + (** [shades ?log ?contours m] plots a filled contour/shaded [m] with a + matching colorbar. If [log] is true then the data in [m] are assumed + to be [log10(x)] values. *) + val shades : + ?filename:string -> + ?device:Plot.plot_device_t -> + ?labels:string * string * string -> + ?log:bool -> + ?palette:Plot.color_palette_t -> + ?contours:float array -> float array array -> unit end (** {3:core The standard PLplot API} *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2010-01-31 20:06:01
|
Revision: 10787 http://plplot.svn.sourceforge.net/plplot/?rev=10787&view=rev Author: hezekiahcarty Date: 2010-01-31 20:05:55 +0000 (Sun, 31 Jan 2010) Log Message: ----------- Add plgradient support to the OCaml bindings Modified Paths: -------------- trunk/bindings/ocaml/plplot.mli trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2010-01-31 20:05:35 UTC (rev 10786) +++ trunk/bindings/ocaml/plplot.mli 2010-01-31 20:05:55 UTC (rev 10787) @@ -617,6 +617,8 @@ external plgpage : unit -> float * float * int * int * int * int = "camlidl_plplot_core_c_plgpage" external plgra : unit -> unit = "camlidl_plplot_core_c_plgra" +external plgradient : float array -> float array -> float -> unit + = "camlidl_plplot_core_c_plgradient" external plgspa : unit -> float * float * float * float = "camlidl_plplot_core_c_plgspa" external plgstrm : unit -> int = "camlidl_plplot_core_c_plgstrm" Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2010-01-31 20:05:35 UTC (rev 10786) +++ trunk/bindings/ocaml/plplot_h 2010-01-31 20:05:55 UTC (rev 10787) @@ -182,6 +182,9 @@ void c_plgra(void); + void +c_plgradient( PLINT n, PLFLT *x, PLFLT *y, PLFLT angle ); + /* void c_plgriddata(PLFLT *x, PLFLT *y, PLFLT *z, PLINT npts, @@ -608,6 +611,14 @@ /* void +c_plget( enum PLAttributeName attrName, PLAttribute *attr ); + + void +c_plset( enum PLAttributeName attrName, PLAttribute attr ); +*/ + +/* + void plgFileDevs(const char ***p_menustr, const char ***p_devname, int *p_ndev); void Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2010-01-31 20:05:35 UTC (rev 10786) +++ trunk/bindings/ocaml/plplot_h.inc 2010-01-31 20:05:55 UTC (rev 10787) @@ -45,6 +45,7 @@ [mlname(plglevel)] void c_plglevel ( [out] plplot_run_level * p_level ); [mlname(plgpage)] void c_plgpage ( [out] double * p_xp, [out] double * p_yp, [out] int * p_xleng, [out] int * p_yleng, [out] int * p_xoff, [out] int * p_yoff ); [mlname(plgra)] void c_plgra ( void ); +[mlname(plgradient)] void c_plgradient ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y, double angle ); [mlname(plgspa)] void c_plgspa ( [out] double * xmin, [out] double * xmax, [out] double * ymin, [out] double * ymax ); [mlname(plgstrm)] void c_plgstrm ( [out] int * p_strm ); [mlname(plgver)] void c_plgver ( [string, out, length_is(1024)] char * p_ver ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2010-01-31 20:05:35 UTC (rev 10786) +++ trunk/bindings/ocaml/touchup.ml 2010-01-31 20:05:55 UTC (rev 10787) @@ -243,7 +243,7 @@ (** Generate attributes for function parameters *) let parameter_attributes function_name types names = let pmatch re str = Pcre.pmatch ~pat:re str in - let non_get_functions = ["c_plgriddata"; "c_plgra"] in + let non_get_functions = ["c_plgriddata"; "c_plgra"; "c_plgradient"] in (* If all of the pieces are true, then the attribute(s) is(are) appropriate for this parameter. This is basically a long list of special cases @@ -443,11 +443,15 @@ |> List.map minimize_whitespace |> List.map ( fun l -> - try - process_prototype l - with - | Not_found -> - failwith ("Unhandled or malformed prototype: \n" ^ l) + if Pcre.pmatch ~pat:"^enum" l then + l + else ( + try + process_prototype l + with + | Not_found -> + failwith ("Unhandled or malformed prototype: " ^ l) + ) ) |> List.map minimize_whitespace |> List.map (fun l -> l ^ "\n") This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2010-04-16 22:34:13
|
Revision: 10915 http://plplot.svn.sourceforge.net/plplot/?rev=10915&view=rev Author: hezekiahcarty Date: 2010-04-16 22:34:07 +0000 (Fri, 16 Apr 2010) Log Message: ----------- OCaml API change - clean up transform and label functions a bit The meaning of the Plplot.Plot.transform function has changed! The OCaml high-level API previously provided a "transform" function to specify which pltr-like function to pass to plimagefr, plshades and similar functions. This function is now used to set a global transform, using the plstransform function, rather than the function-specific pltr transform. pltr-like transforms are now set (cleared) with Plplot.Plot.pltr (Plplot.Plot.clear_pltr). This only affects the high-level Plplot.Plot module API, not the C-like Plplot.* functions. Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2010-04-16 20:18:47 UTC (rev 10914) +++ trunk/bindings/ocaml/plplot.ml 2010-04-16 22:34:07 UTC (rev 10915) @@ -201,9 +201,12 @@ | Text of (color_t * string * float * float * float * float * float) | Text_outside of (color_t * string * float plot_side_t * float * float * bool) - (* Set/clear coordinate transforms *) + (* Set/clear UNIVERSAL coordinate transforms *) | Set_transform of pltr_t | Clear_transform + (* Set/clear item-specific coordinate transforms (ex. plimagefr) *) + | Set_pltr of pltr_t + | Clear_pltr (* Custom functions *) | Custom of (unit -> unit) (* Embedded list of plottable elements *) @@ -578,6 +581,12 @@ (** [clear_transform] *) let clear_transform = Clear_transform + (** [pltr f] *) + let pltr f = Set_pltr f + + (** [clear_pltr] *) + let clear_pltr = Clear_pltr + (** [custom f] *) let custom f = Custom f @@ -868,8 +877,10 @@ | Shades s -> plot_shades s | Text t -> plot_text t | Text_outside t_o -> plot_text_outside t_o - | Set_transform pltr -> plset_pltr pltr - | Clear_transform -> plunset_pltr () + | Set_transform transform -> plstransform transform + | Clear_transform -> plunset_transform () + | Set_pltr pltr -> plset_pltr pltr + | Clear_pltr -> plunset_pltr () | Custom f -> f () | List l -> plot l in @@ -967,16 +978,16 @@ | Right _ | Left _ -> plot [ - transform (pltr1 [|0.0; 1.0|] contours); + pltr (pltr1 [|0.0; 1.0|] contours); shades (0.0, min_value) (1.0, max_value) contours shade_data; - clear_transform; + clear_pltr; ] | Top _ | Bottom _ -> plot [ - transform (pltr1 contours [|0.0; 1.0|]); + pltr (pltr1 contours [|0.0; 1.0|]); shades (min_value, 0.0) (max_value, 1.0) contours shade_data; - clear_transform; + clear_pltr; ]) in Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2010-04-16 20:18:47 UTC (rev 10914) +++ trunk/bindings/ocaml/plplot.mli 2010-04-16 22:34:07 UTC (rev 10915) @@ -347,14 +347,21 @@ ?step:float -> color_t -> (float -> float) -> float * float -> plot_t - (** [transform f] Set the coordinate transformation function used by - {!imagefr} and other functions affected by {!Plplot.plset_pltr}. *) + (** [transform f] sets the universal coordinate transformation function. *) val transform : pltr_t -> plot_t - (** [clear_transform] clears any currently defined plot transform - function. *) + (** [clear_transform] clears any currently defined universal coordinate + transform function. *) val clear_transform : plot_t + (** [pltr f] sets the coordinate transformation function used by + {!imagefr} and other functions affected by {!Plplot.plset_pltr}. *) + val pltr : pltr_t -> plot_t + + (** [clear_pltr] clears any currently defined function-specific pltr + transform function. *) + val clear_pltr : plot_t + (** [custom f] will call [f ()] when the plot element is used. This function can be used to create customized plot elements for use with {!plot}. *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2010-04-16 22:34:44
|
Revision: 10916 http://plplot.svn.sourceforge.net/plplot/?rev=10916&view=rev Author: hezekiahcarty Date: 2010-04-16 22:34:38 +0000 (Fri, 16 Apr 2010) Log Message: ----------- Add the ability to set custom axis tick label text to Plplot.Plot module This previously had to be done manually when using the OCaml Plplot.Plot module functions. Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2010-04-16 22:34:07 UTC (rev 10915) +++ trunk/bindings/ocaml/plplot.ml 2010-04-16 22:34:38 UTC (rev 10916) @@ -183,7 +183,8 @@ (* Standard plot elements *) | Arc of (color_t * float * float * float * float * float * float * bool) | Axes of - (color_t * axis_options_t list * axis_options_t list * int * line_style_t) + (color_t * axis_options_t list * axis_options_t list * int * + line_style_t * (plplot_axis_type -> float -> string) option) | Contours of (color_t * pltr_t * float array * float array array) | Image of image_t | Image_fr of (image_t * (float * float)) @@ -494,8 +495,8 @@ Arc (color, x, y, a, b, angle1, angle2, fill) (** [axes ?color ?style ?width xopt yopt] *) - let axes ?(color = Black) ?(style = Solid_line) ?(width = 1) xopt yopt = - Axes (color, xopt, yopt, width, style) + let axes ?(color = Black) ?(style = Solid_line) ?(width = 1) ?labelfunc xopt yopt = + Axes (color, xopt, yopt, width, style, labelfunc) (** Default axes *) let default_axes = axes default_axis_options default_axis_options @@ -734,13 +735,15 @@ fun () -> plarc x y a b angle1 angle2 fill; ) in - let plot_axes (color, xopt, yopt, width, style) = + let plot_axes (color, xopt, yopt, width, style, labelfunc) = set_color_in color ( fun () -> let old_width = plgwid () in plwid width; set_line_style style; + Option.may plslabelfunc labelfunc; plot_axes xopt yopt; + Option.may (fun _ -> plunset_labelfunc ()) labelfunc; set_line_style Solid_line; plwid old_width; ) Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2010-04-16 22:34:07 UTC (rev 10915) +++ trunk/bindings/ocaml/plplot.mli 2010-04-16 22:34:38 UTC (rev 10916) @@ -24,6 +24,11 @@ {!core} is {b not} expected to change. *) +type plplot_axis_type = + PL_X_AXIS + | PL_Y_AXIS + | PL_Z_AXIS + (** {3 A higher-level OCaml interface to PLplot} *) module Plot : sig @@ -258,6 +263,7 @@ ?color:color_t -> ?style:line_style_t -> ?width:int -> + ?labelfunc:(plplot_axis_type -> float -> string) -> axis_options_t list -> axis_options_t list -> plot_t (** [default_axes] is equivalent to @@ -896,10 +902,6 @@ | PL_PARSE_NOPROGRAM | PL_PARSE_NODASH | PL_PARSE_SKIP -type plplot_axis_type = - PL_X_AXIS - | PL_Y_AXIS - | PL_Z_AXIS val plslabelfunc : (plplot_axis_type -> float -> string) -> unit val plunset_labelfunc : unit -> unit val plsabort : (string -> unit) -> unit This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2010-05-23 15:14:02
|
Revision: 11020 http://plplot.svn.sourceforge.net/plplot/?rev=11020&view=rev Author: hezekiahcarty Date: 2010-05-23 15:13:55 +0000 (Sun, 23 May 2010) Log Message: ----------- Add size arguments to OCaml Quick_plot module functions These allow the user to set the dimensions of the generated plot surface. Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2010-05-22 19:55:27 UTC (rev 11019) +++ trunk/bindings/ocaml/plplot.ml 2010-05-23 15:13:55 UTC (rev 11020) @@ -1214,11 +1214,13 @@ (** [points [xs, ys; ...] plots the points described by the coordinates [xs] and [ys]. *) - let points ?filename ?(device = Window Cairo) ?labels ?log xs_ys_list = + let points ?filename ?size ?(device = Window Cairo) ?labels ?log xs_ys_list = let xs_list, ys_list = List.split xs_ys_list in let xmin, xmax, ymin, ymax = extents xs_list ys_list in let ys_array = Array.of_list ys_list in - let stream = init ?filename (xmin, ymin) (xmax, ymax) Greedy device in + let stream = + init ?filename ?size (xmin, ymin) (xmax, ymax) Greedy device + in let plottable_points = Array.to_list ( Array.mapi ( @@ -1239,11 +1241,13 @@ (** [lines [xs, ys; ...] plots the line segments described by the coordinates [xs] and [ys]. *) - let lines ?filename ?(device = Window Cairo) ?labels ?names ?log xs_ys_list = + let lines + ?filename ?size ?(device = Window Cairo) ?labels ?names ?log + xs_ys_list = let xs_list, ys_list = List.split xs_ys_list in let xmin, xmax, ymin, ymax = extents xs_list ys_list in let ys_array = Array.of_list ys_list in - let stream = init ?filename (xmin, ymin) (xmax, ymax) Greedy device in + let stream = init ?filename ?size (xmin, ymin) (xmax, ymax) Greedy device in let colors = Array.mapi (fun i _ -> Index_color (i + 1)) ys_array in let plottable_lines = Array.to_list ( @@ -1264,12 +1268,14 @@ (** [image ?log m] plots the image [m] with a matching colorbar. If [log] is true then the data in [m] are assumed to be log10(x) values. *) - let image ?filename ?(device = Window Cairo) ?labels ?log ?palette m = + let image ?filename ?size ?(device = Window Cairo) ?labels ?log ?palette m = let m_max, m_min = plMinMax2dGrid m in let xmin, ymin = 0.0, 0.0 in let xmax, ymax = Array_ext.matrix_dims m in let xmax, ymax = float_of_int xmax, float_of_int ymax in - let stream = init ?filename (xmin, ymin) (xmax, ymax) Equal_square device in + let stream = + init ?filename ?size (xmin, ymin) (xmax, ymax) Equal_square device + in Option.may (load_palette ~stream) palette; plot ~stream [ image (xmin, ymin) (xmax, ymax) m; @@ -1284,7 +1290,7 @@ to [x = max]. [step] can be used to tighten or coarsen the sampling of plot points. *) let func - ?filename ?(device = Window Cairo) ?labels ?names ?symbol ?step + ?filename ?size ?(device = Window Cairo) ?labels ?names ?symbol ?step fs (xmin, xmax) = let fs_array = Array.of_list fs in let colors = Array.mapi (fun i _ -> Index_color (i + 1)) fs_array in @@ -1307,7 +1313,9 @@ ) in let ymax, ymin = plMinMax2dGrid ys in - let stream = init ?filename (xmin, ymin) (xmax, ymax) Greedy device in + let stream = + init ?filename ?size (xmin, ymin) (xmax, ymax) Greedy device + in plot ~stream [ list plot_content; default_axes; @@ -1317,12 +1325,14 @@ end_stream ~stream (); () - let shades ?filename ?(device = Window Cairo) ?labels ?log ?palette ?contours - m = + let shades ?filename ?size ?(device = Window Cairo) ?labels ?log ?palette + ?contours m = let xmin, ymin = 0.0, 0.0 in let xmax, ymax = Array_ext.matrix_dims m in let xmax, ymax = float_of_int xmax, float_of_int ymax in - let stream = init ?filename (xmin, ymin) (xmax, ymax) Equal_square device in + let stream = + init ?filename ?size (xmin, ymin) (xmax, ymax) Equal_square device + in Option.may (load_palette ~stream) palette; let contours = contours |? ( Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2010-05-22 19:55:27 UTC (rev 11019) +++ trunk/bindings/ocaml/plplot.mli 2010-05-23 15:13:55 UTC (rev 11020) @@ -463,6 +463,7 @@ and [ys]. *) val points : ?filename:string -> + ?size:int * int -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?log:bool * bool -> (float array * float array) list -> unit @@ -471,6 +472,7 @@ [xs] and [ys]. *) val lines : ?filename:string -> + ?size:int * int -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?names:string list -> @@ -480,6 +482,7 @@ is true then the data in [m] are assumed to be [log10(x)] values. *) val image : ?filename:string -> + ?size:int * int -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?log:bool -> ?palette:Plot.color_palette_t -> float array array -> unit @@ -489,6 +492,7 @@ sampling of plot points. *) val func : ?filename:string -> + ?size:int * int -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?names:string list -> @@ -500,6 +504,7 @@ to be [log10(x)] values. *) val shades : ?filename:string -> + ?size:int * int -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?log:bool -> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2011-01-29 17:09:57
|
Revision: 11521 http://plplot.svn.sourceforge.net/plplot/?rev=11521&view=rev Author: hezekiahcarty Date: 2011-01-29 17:09:51 +0000 (Sat, 29 Jan 2011) Log Message: ----------- Update OCaml bindings to match C plcolorbar change (contours) Modified Paths: -------------- trunk/bindings/ocaml/plplot.mli trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2011-01-29 17:08:58 UTC (rev 11520) +++ trunk/bindings/ocaml/plplot.mli 2011-01-29 17:09:51 UTC (rev 11521) @@ -692,8 +692,8 @@ external pllab : string -> string -> string -> unit = "camlidl_plplot_core_c_pllab" external plcolorbar : plplot_colorbar_opt -> float -> float -> float -> - float -> float -> int -> string -> string -> float array -> float array -> - unit + float -> int -> int -> float -> int -> string -> string -> float array -> + float array -> unit = "camlidl_plplot_core_c_plcolorbar_bytecode" "camlidl_plplot_core_c_plcolorbar" external pllegend : plplot_legend_position -> plplot_legend_opt -> float -> float -> float -> int -> int -> int -> int -> int -> Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2011-01-29 17:08:58 UTC (rev 11520) +++ trunk/bindings/ocaml/plplot_h 2011-01-29 17:09:51 UTC (rev 11521) @@ -257,6 +257,7 @@ void c_plcolorbar( plplot_colorbar_opt opt, PLFLT x, PLFLT y, PLFLT length, PLFLT width, + PLINT cont_color, PLINT cont_width, PLFLT ticks, PLINT sub_ticks, const char *axis_opts, const char *label, PLINT n_colors, PLFLT *colors, PLFLT *values ); Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2011-01-29 17:08:58 UTC (rev 11520) +++ trunk/bindings/ocaml/plplot_h.inc 2011-01-29 17:09:51 UTC (rev 11521) @@ -59,7 +59,7 @@ [mlname(plinit)] void c_plinit ( void ); [mlname(pljoin)] void c_pljoin ( double x1, double y1, double x2, double y2 ); [mlname(pllab)] void c_pllab ( [string] const char * xlabel, [string] const char * ylabel, [string] const char * tlabel ); -[mlname(plcolorbar)] void c_plcolorbar ( plplot_colorbar_opt opt, double x, double y, double length, double width, double ticks, int sub_ticks, [string] const char * axis_opts, [string] const char * label, int n_colors, [in, size_is(n_colors)] double * colors, [in, size_is(n_colors)] double * values ); +[mlname(plcolorbar)] void c_plcolorbar ( plplot_colorbar_opt opt, double x, double y, double length, double width, int cont_color, int cont_width, double ticks, int sub_ticks, [string] const char * axis_opts, [string] const char * label, int n_colors, [in, size_is(n_colors)] double * colors, [in, size_is(n_colors)] double * values ); [mlname(pllightsource)] void c_pllightsource ( double x, double y, double z ); [mlname(plline)] void c_plline ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y ); [mlname(plline3)] void c_plline3 ( int n, [in, size_is(n)] double * x, [in, size_is(n)] double * y, [in, size_is(n)] double * z ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2011-08-06 14:58:24
|
Revision: 11862 http://plplot.svn.sourceforge.net/plplot/?rev=11862&view=rev Author: hezekiahcarty Date: 2011-08-06 14:58:18 +0000 (Sat, 06 Aug 2011) Log Message: ----------- Add plsdrawmode and plgdrawmode to the OCaml bindings Modified Paths: -------------- trunk/bindings/ocaml/plplot.mli trunk/bindings/ocaml/plplot_core.idl trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2011-08-06 14:58:04 UTC (rev 11861) +++ trunk/bindings/ocaml/plplot.mli 2011-08-06 14:58:18 UTC (rev 11862) @@ -644,6 +644,11 @@ | PL_FCI_WEIGHT_UNCHANGED | PL_FCI_MEDIUM | PL_FCI_BOLD +and plplot_draw_mode_enum = + | PL_DRAWMODE_UNKNOWN + | PL_DRAWMODE_DEFAULT + | PL_DRAWMODE_REPLACE + | PL_DRAWMODE_XOR external pl_setcontlabelformat : int -> int -> unit = "camlidl_plplot_core_c_pl_setcontlabelformat" external pl_setcontlabelparam : float -> float -> float -> int -> unit @@ -719,6 +724,8 @@ external plgdiori : unit -> float = "camlidl_plplot_core_c_plgdiori" external plgdiplt : unit -> float * float * float * float = "camlidl_plplot_core_c_plgdiplt" +external plgdrawmode : unit -> plplot_draw_mode_enum + = "camlidl_plplot_core_c_plgdrawmode" external plgfci : unit -> int64 = "camlidl_plplot_core_c_plgfci" external plgfam : unit -> int * int * int = "camlidl_plplot_core_c_plgfam" external plgfnam : unit -> string = "camlidl_plplot_core_c_plgfnam" @@ -869,6 +876,8 @@ = "camlidl_plplot_core_c_plsfont" external plsmaj : float -> float -> unit = "camlidl_plplot_core_c_plsmaj" external plsmin : float -> float -> unit = "camlidl_plplot_core_c_plsmin" +external plsdrawmode : plplot_draw_mode_enum -> unit + = "camlidl_plplot_core_c_plsdrawmode" external plsori : int -> unit = "camlidl_plplot_core_c_plsori" external plspage : float -> float -> int -> int -> int -> int -> unit = "camlidl_plplot_core_c_plspage_bytecode" "camlidl_plplot_core_c_plspage" Modified: trunk/bindings/ocaml/plplot_core.idl =================================================================== --- trunk/bindings/ocaml/plplot_core.idl 2011-08-06 14:58:04 UTC (rev 11861) +++ trunk/bindings/ocaml/plplot_core.idl 2011-08-06 14:58:18 UTC (rev 11862) @@ -119,6 +119,14 @@ PL_FCI_BOLD = 0x1 }; +enum plplot_draw_mode_enum { + // Flags for drawing mode + PL_DRAWMODE_UNKNOWN = 0x0, + PL_DRAWMODE_DEFAULT = 0x1, + PL_DRAWMODE_REPLACE = 0x2, + PL_DRAWMODE_XOR = 0x4 +}; + // Any function which has a nonzero_error_int return type will raise // an Invalid_argument error if the return value is <> 0. typedef [errorcheck(plplot_check_nonzero_result), errorcode] int nonzero_error_int; Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2011-08-06 14:58:04 UTC (rev 11861) +++ trunk/bindings/ocaml/plplot_h 2011-08-06 14:58:18 UTC (rev 11862) @@ -160,6 +160,9 @@ void c_plgdiplt(PLFLT *p_xmin, PLFLT *p_ymin, PLFLT *p_xmax, PLFLT *p_ymax); + enum plplot_draw_mode_enum +c_plgdrawmode(); + void c_plgfci(PLUNICODE *pfci); @@ -554,6 +557,9 @@ c_plsmin(PLFLT def, PLFLT scale); void +c_plsdrawmode(enum plplot_draw_mode_enum mode); + + void c_plsori(PLINT ori); void Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2011-08-06 14:58:04 UTC (rev 11861) +++ trunk/bindings/ocaml/plplot_h.inc 2011-08-06 14:58:18 UTC (rev 11862) @@ -38,6 +38,7 @@ [mlname(plgdidev)] void c_plgdidev ( [out] double * p_mar, [out] double * p_aspect, [out] double * p_jx, [out] double * p_jy ); [mlname(plgdiori)] void c_plgdiori ( [out] double * p_rot ); [mlname(plgdiplt)] void c_plgdiplt ( [out] double * p_xmin, [out] double * p_ymin, [out] double * p_xmax, [out] double * p_ymax ); +[mlname(plgdrawmode)] enum plplot_draw_mode_enum c_plgdrawmode ( ); [mlname(plgfci)] void c_plgfci ( [out] long long * pfci ); [mlname(plgfam)] void c_plgfam ( [out] int * p_fam, [out] int * p_num, [out] int * p_bmax ); [mlname(plgfnam)] void c_plgfnam ( [string, out, length_is(1024)] char * fnam ); @@ -111,6 +112,7 @@ [mlname(plsfont)] void c_plsfont ( enum plplot_fci_family_enum family, enum plplot_fci_style_enum style, enum plplot_fci_weight_enum weight ); [mlname(plsmaj)] void c_plsmaj ( double def, double scale ); [mlname(plsmin)] void c_plsmin ( double def, double scale ); +[mlname(plsdrawmode)] void c_plsdrawmode ( enum plplot_draw_mode_enum mode ); [mlname(plsori)] void c_plsori ( int ori ); [mlname(plspage)] void c_plspage ( double xp, double yp, int xleng, int yleng, int xoff, int yoff ); [mlname(plspal0)] void c_plspal0 ( [string] const char * filename ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2011-08-06 14:58:04 UTC (rev 11861) +++ trunk/bindings/ocaml/touchup.ml 2011-08-06 14:58:18 UTC (rev 11862) @@ -389,10 +389,12 @@ prototypes. *) let pieces = line - |> Pcre.extract ~pat:"^((?:(?:const|unsigned) )?\\w+ (?:\\*\\s*)?)(\\w+)\\s*\\(([\\w\\s\\*\\[\\],]*)\\)" ~full_match:false + |> Pcre.extract ~pat:"^((?:(?:const|unsigned|enum) )?\\w+ (?:\\*\\s*)?)(\\w+)\\s*\\(([\\w\\s\\*\\[\\],]*)\\)" ~full_match:false |> Array.map minimize_whitespace in (* Get the return type, name and arg list separately *) + Array.iter print_string pieces; + print_newline (); let return_type = pieces.(0) in let function_name = pieces.(1) in let params = @@ -449,15 +451,11 @@ |> List.map minimize_whitespace |> List.map ( fun l -> - if Pcre.pmatch ~pat:"^enum" l then - l - else ( - try - process_prototype l - with - | Not_found -> - failwith ("Unhandled or malformed prototype: " ^ l) - ) + try + process_prototype l + with + | Not_found -> + failwith ("Unhandled or malformed prototype: " ^ l) ) |> List.map minimize_whitespace |> List.map (fun l -> l ^ "\n") This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ai...@us...> - 2008-09-13 17:15:46
|
Revision: 8775 http://plplot.svn.sourceforge.net/plplot/?rev=8775&view=rev Author: airwin Date: 2008-09-13 17:15:56 +0000 (Sat, 13 Sep 2008) Log Message: ----------- AWI for Hezekiah M. Carty. Make plscmap1la consistent with plscmap1l in how the "rev" parameter is handled. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2008-09-13 17:13:50 UTC (rev 8774) +++ trunk/bindings/ocaml/plplot_h.inc 2008-09-13 17:15:56 UTC (rev 8775) @@ -85,7 +85,7 @@ [mlname(plscmap1)] void c_plscmap1 ( [size_is(ncol1), in] int * r, [size_is(ncol1), in] int * g, [size_is(ncol1), in] int * b, int ncol1 ); [mlname(plscmap1a)] void c_plscmap1a ( [size_is(ncol1), in] int * r, [size_is(ncol1), in] int * g, [size_is(ncol1), in] int * b, [size_is(ncol1), in] double * a, int ncol1 ); [mlname(plscmap1l)] void c_plscmap1l ( int itype, int npts, [size_is(npts), in, size_is(npts)] double * intensity, [size_is(npts), in, size_is(npts)] double * coord1, [size_is(npts), in, size_is(npts)] double * coord2, [size_is(npts), in, size_is(npts)] double * coord3, [in, size_is(npts), in, size_is(npts), unique] int * rev ); -[mlname(plscmap1la)] void c_plscmap1la ( int itype, int npts, [size_is(npts), in, size_is(npts)] double * intensity, [size_is(npts), in, size_is(npts)] double * coord1, [size_is(npts), in, size_is(npts)] double * coord2, [size_is(npts), in, size_is(npts)] double * coord3, [size_is(npts), in, size_is(npts)] double * a, [in, size_is(npts)] int * rev ); +[mlname(plscmap1la)] void c_plscmap1la ( int itype, int npts, [size_is(npts), in, size_is(npts)] double * intensity, [size_is(npts), in, size_is(npts)] double * coord1, [size_is(npts), in, size_is(npts)] double * coord2, [size_is(npts), in, size_is(npts)] double * coord3, [size_is(npts), in, size_is(npts)] double * a, [in, size_is(npts), in, size_is(npts), unique] int * rev ); [mlname(plscmap1n)] void c_plscmap1n ( int ncol1 ); [mlname(plscol0)] void c_plscol0 ( int icol0, int r, int g, int b ); [mlname(plscol0a)] void c_plscol0a ( int icol0, int r, int g, int b, double a ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2008-09-13 17:13:50 UTC (rev 8774) +++ trunk/bindings/ocaml/touchup.ml 2008-09-13 17:15:56 UTC (rev 8775) @@ -41,6 +41,11 @@ parameter_attrs = Some ["rev", ["in"; "size_is(npts)"; "unique"]]; }; { + function_name = "c_plscmap1la"; + function_attrs = None; + parameter_attrs = Some ["rev", ["in"; "size_is(npts)"; "unique"]]; + }; + { function_name = "c_plxormod"; function_attrs = None; parameter_attrs = Some ["status", ["out"]]; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-07-09 15:42:04
|
Revision: 10127 http://plplot.svn.sourceforge.net/plplot/?rev=10127&view=rev Author: hezekiahcarty Date: 2009-07-09 15:42:01 +0000 (Thu, 09 Jul 2009) Log Message: ----------- Add an experimental library to support the extcairo device under OCaml. This library should allow the use of the extcairo device under OCaml along the Cairo OCaml bindings. This also allows embedding plots generated by PLplot in a Gtk+ application with the lablgtk2 library. Added Paths: ----------- trunk/bindings/ocaml/plcairo/ trunk/bindings/ocaml/plcairo/META trunk/bindings/ocaml/plcairo/Makefile trunk/bindings/ocaml/plcairo/README.plcairo trunk/bindings/ocaml/plcairo/_tags trunk/bindings/ocaml/plcairo/libplcairo_stubs.clib trunk/bindings/ocaml/plcairo/myocamlbuild.ml trunk/bindings/ocaml/plcairo/plcairo.ml trunk/bindings/ocaml/plcairo/plcairo_impl.c trunk/bindings/ocaml/plcairo/tests/ trunk/bindings/ocaml/plcairo/tests/cairo_raster.ml trunk/bindings/ocaml/plcairo/tests/gtk_interface.ml trunk/bindings/ocaml/plcairo/tests/multiple_pages.ml Added: trunk/bindings/ocaml/plcairo/META =================================================================== --- trunk/bindings/ocaml/plcairo/META (rev 0) +++ trunk/bindings/ocaml/plcairo/META 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,9 @@ +# Specifications for PLplot Cairo library +requires = "plplot" +requires += "cairo" +description = "PLplot Cairo extras" +version = "0.1" +browse_interfaces = " Plcairo " +archive(byte) = "plcairo.cma" +archive(native) = "plcairo.cmxa" + Added: trunk/bindings/ocaml/plcairo/Makefile =================================================================== --- trunk/bindings/ocaml/plcairo/Makefile (rev 0) +++ trunk/bindings/ocaml/plcairo/Makefile 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,40 @@ +# The target library's name +LIBRARY = plcairo + +# Commands to use for ocamlbuild and ocamlfind (in case they are not in $PATH) +OCAMLBUILD = ocamlbuild -tag debug +OCAMLFIND = ocamlfind + +# Where ocamlbuild put the build files +BUILD_DIR = _build/ + +# Default to building bytecoode and native code libraries +all: byte opt + +byte: + $(OCAMLBUILD) $(LIBRARY).cma + +opt: + $(OCAMLBUILD) $(LIBRARY).cmxa + +mli: + $(OCAMLBUILD) $(LIBRARY).inferred.mli + +# (Un)Installation using ocamlfind +install: + $(OCAMLFIND) install $(LIBRARY) \ + META \ + $(BUILD_DIR)*plcairo.cmi \ + $(BUILD_DIR)*plcairo.cma \ + $(BUILD_DIR)*plcairo.cmxa \ + $(BUILD_DIR)*plcairo_stubs.so \ + $(BUILD_DIR)*plcairo_stubs.a \ + $(BUILD_DIR)*plcairo.a + +uninstall: + $(OCAMLFIND) remove $(LIBRARY) + +# Clean up the build process using ocamlbuild +clean: + $(OCAMLBUILD) -clean + Added: trunk/bindings/ocaml/plcairo/README.plcairo =================================================================== --- trunk/bindings/ocaml/plcairo/README.plcairo (rev 0) +++ trunk/bindings/ocaml/plcairo/README.plcairo 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,35 @@ +Description: + +THIS LIBRARY IS CURRENTLY EXPERIMENTAL + +This is an add-on library for the OCaml PLplot bindings which allows the user +to use the extcairo device with the OCaml Cairo library bindings. + +While the Plcairo module and related code should be relatively stable, the API +is subject to and likely to change. It should eventually be included in the +core PLplot OCaml bindings. + +Requirements: + +- OCaml 3.10.0 or a later version +- PLplot with Cairo (extcairo) and OCaml bindings support +- The Cairo OCaml bindings + - These bindings are available in binary form on Debian, Ubuntu, Fedora and + possibly other Linux distributions. If a binary version is not available + on your system, the code can be retrieved from here: + http://cgit.freedesktop.org/cairo-ocaml/ +- findlib must be setup to find both the PLplot and Cairo bindings +- Optionally, lablgtk2 for the examples + + +Installation: + +make +make install + +You may have to run "make install" with sudo or as root, depending on your +OCaml installation. + +Testing: + +There are some simple test applications in the "tests" directory. Added: trunk/bindings/ocaml/plcairo/_tags =================================================================== --- trunk/bindings/ocaml/plcairo/_tags (rev 0) +++ trunk/bindings/ocaml/plcairo/_tags 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,2 @@ +<**/*.{ml,mli}> : pkg_cairo, pkg_plplot +<plcairo.{cma,cmxa}> : pkg_cairo, pkg_plplot Added: trunk/bindings/ocaml/plcairo/libplcairo_stubs.clib =================================================================== --- trunk/bindings/ocaml/plcairo/libplcairo_stubs.clib (rev 0) +++ trunk/bindings/ocaml/plcairo/libplcairo_stubs.clib 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1 @@ +plcairo_impl.o Added: trunk/bindings/ocaml/plcairo/myocamlbuild.ml =================================================================== --- trunk/bindings/ocaml/plcairo/myocamlbuild.ml (rev 0) +++ trunk/bindings/ocaml/plcairo/myocamlbuild.ml 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,125 @@ +open Ocamlbuild_plugin +open Ocamlbuild_pack +open Command +open Ocaml_specific +open Outcome +open Printf + +(* These functions are not really officially exported *) +let run_and_read = Ocamlbuild_pack.My_unix.run_and_read +let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings + +(* This lists all supported packages *) +let find_packages () = + blank_sep_strings & + Lexing.from_string & + run_and_read "ocamlfind list | cut -d' ' -f1" + +(* ocamlfind command *) +let ocamlfind x = S[A"ocamlfind"; x] + +(* C stuff *) +let cflags = + try + let fl = Sys.getenv "CFLAGS" in + let flags = Lexers.comma_or_blank_sep_strings (Lexing.from_string fl) in + S(List.concat (List.map (fun fl -> [A"-ccopt"; A fl]) flags)) + with + | Not_found -> S[] + +let pkg_config ?(notag = false) flag library = + let flag, opt_or_lib = + match flag with + | `cflags -> "--cflags", `opt + | `libs -> "--libs", `none + | `libsl -> "--libs-only-l", `lib + | `libsL -> "--libs-only-L", `opt + in + let opt_or_lib = + if notag then + N + else + match opt_or_lib with + | `opt -> A "-ccopt" + | `lib -> A "-cclib" + | `none -> N + in + let cmd = "pkg-config " ^ flag ^ " " ^ library in + let config = + My_unix.run_and_open cmd (fun ic -> + Log.dprintf 5 "Getting flags from command %s" cmd; + input_line ic) + in + let flags = Lexers.comma_or_blank_sep_strings (Lexing.from_string config) in + S(List.concat (List.map (fun fl -> [opt_or_lib; A fl]) flags)) + +let cairo_conf ?notag x = pkg_config ?notag x "cairo" +let plplot_conf ?notag x = pkg_config ?notag x "plplotd" +;; + +let _ = dispatch begin function + | Before_options -> + (* by using Before_options one let command line options have an higher + priority; on the contrary using After_options will guarantee to have + the higher priority *) + + (* override default commands by ocamlfind ones *) + Options.ocamlc := ocamlfind & A"ocamlc"; + Options.ocamlopt := ocamlfind & A"ocamlopt"; + Options.ocamldep := ocamlfind & A"ocamldep"; + Options.ocamldoc := ocamlfind & A"ocamldoc"; + Options.ocamlmktop := ocamlfind & A"ocamlmktop" + | After_rules -> + (* When one link an OCaml library/binary/package, one should use + -linkpkg *) + flag ["ocaml"; "link"] & A"-linkpkg"; + + (* For each ocamlfind package one injects the -package option when + compiling, computing dependencies, generating documentation and + linking. *) + List.iter begin fun pkg -> + flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "byte"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; + end (find_packages ()); + + (* The default "thread" tag is not compatible with ocamlfind. + Indeed, the default rules add the "threads.cma" or "threads.cmxa" + options when using this tag. When using the "-linkpkg" option with + ocamlfind, this module will then be added twice on the command line. + + To solve this, one approach is to add the "-thread" option when using + the "threads" package using the previous plugin. + *) + flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); + flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); + + (* C-related rules *) + (* Custom tag for OCaml bytecode *) + flag ["ocaml"; "link"; "byte"] + (A"-custom"); + + (* Include compiler options for ocamlmklib *) + flag ["ocamlmklib"; "c"] + (S[plplot_conf `libs; cairo_conf `libs]); + + (* gcc needs to know where to find the needed #includes *) + flag ["c"; "compile"] (S[plplot_conf `cflags; cairo_conf `cflags]); + + (* Use the proper extras when compiling the OCaml library *) + flag ["ocaml"; "link"; "library"; "byte"] + (S[A"-dllib"; A"-lplcairo_stubs"; A"-cclib"; A"-lplcairo_stubs"; + plplot_conf `libsL; plplot_conf `libsl; + cairo_conf `libsL; cairo_conf `libsl]); + + flag ["ocaml"; "link"; "library"; "native"] + (S[A"-cclib"; A"-lplcairo_stubs"; + plplot_conf `libsL; plplot_conf `libsl; + cairo_conf `libsL; cairo_conf `libsl]); + + (* Make sure the C pieces are built... *) + dep ["ocaml"; "compile"] ["libplcairo_stubs.a"]; + | _ -> () +end Added: trunk/bindings/ocaml/plcairo/plcairo.ml =================================================================== --- trunk/bindings/ocaml/plcairo/plcairo.ml (rev 0) +++ trunk/bindings/ocaml/plcairo/plcairo.ml 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,283 @@ +(* +Copyright 2008, 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + +(** Support for the extcairo PLplot device from OCaml. *) + +open Plplot +open Printf + +(** A record to keep track of the Cairo surface and context information *) +type ('a, 'b) t = { + width : float; + height : float; + surface : 'a Cairo.surface; + context : Cairo.t; + file : 'b option; + (* Should each new page be cleared? *) + clear : bool; + (* What PLplot stream number is associated with this plot? *) + plstream : int; +} + +(** An alias for {t}. *) +type ('a, 'b) plplot_cairo_t = ('a, 'b) t + +(** Provide PLplot with a Cairo context to plot on. *) +external set_cairo_context : Cairo.t -> unit = "ml_set_plplot_cairo_context" + +(** Blit the contents of the given {plplot_cairo_t} to the given {Cairo.t}. + Scale according to [`Width w]. [`Height h] or [`Both (w, h)]. *) +let blit_to_cairo ~dest ~dim ~xoff ~yoff plcairo = + let sx, sy = + match dim with + | `Width w -> let scale = w /. plcairo.width in scale, scale + | `Height h -> let scale = h /. plcairo.height in scale, scale + | `Both (w, h) -> w /. plcairo.width, h /. plcairo.height + in + Cairo.save dest; + begin + Cairo.scale ~sx ~sy dest; + Cairo.set_source_surface dest plcairo.surface xoff yoff; + Cairo.paint dest; + end; + Cairo.restore dest; + () + +(** [rasterize ?alpha plot f] applies the plotting function [f ()] to [plot], + with the caveat that the output will be rasterized for all plot + output drivers, including vector-based output drivers such as PS, PDF and + SVG. + The [alpha] parameter may be provided to make the rasterized overlay + transparent, even if the current color palette is not. + Note that the plotting done by [f ()] will not be antialiased. *) +let rasterize ?alpha plot f = + (* Create a Cairo image surface and context to plot the rasterized image + on. This will be a duplicate in size and shape of the current plot's + surface. Leave the background transparent, so only the plotted image + is transfered over to the main plot surface. *) + let img_sfc = + Cairo.image_surface_create + Cairo.FORMAT_ARGB32 + ~width:(int_of_float plot.width) + ~height:(int_of_float plot.height) + in + let img_context = Cairo.create img_sfc in + (* Assign the transformation matrix from the main plot context to maintain + consistency. It will also have to be applied to the main plot context + again once back to it. *) + let plot_matrix = Cairo.get_matrix plot.context in + Cairo.set_matrix img_context plot_matrix; + set_cairo_context img_context; + (* Make sure antialiasing is turned OFF for the. The output looks bad + otherwise. *) + Cairo.set_antialias img_context Cairo.ANTIALIAS_NONE; + (* This will now be plotted on to the Cairo image surface. *) + f (); + (* Blit the raster image on to the main plot surface *) + Cairo.set_source_surface plot.context img_sfc 0.0 0.0; + let () = + match alpha with + | None -> Cairo.paint plot.context + | Some a -> Cairo.paint_with_alpha plot.context a + in + (* Now set PLplot back to using the proper plot context. *) + set_cairo_context plot.context; + Cairo.set_matrix plot.context plot_matrix; + (* Don't forget to do a [Cairo.surface_finish] when everything is done! + That isn't done here because the plot may not be finished yet. *) + () + +(** [rimage ?alpha plot] takes the same arguments as {Plplot.plimagefr} and + works in the same way, except that the output will be rasterized for all + plot output drivers, including vector-based output drivers such as PS, PDF + and SVG. {Plplot.plimagefr} is used internally, so image distortions and + transformations are possible in the same way as for that function. The + [alpha] parameter may be provided to make the raster image overlay + transparent even if the current color palette is not. + This is somewhat deprecated, as [plimage] and [plimagefr] now act this way + by default. *) +let rimage ?alpha plot m xmin xmax ymin ymax zmin zmax valuemin valuemax = + rasterize ?alpha plot + (fun () -> plimagefr m xmin xmax ymin ymax zmin zmax valuemin valuemax); + () + +(* +(** FIXME TODO XXX : I don't think this works properly yet. + [plxy_to_cairoxy ~x ~y context] will convert the plot world + coordinates [x, y] to Cairo device coordinates. *) +let plxy_to_cairoxy context ~x ~y = + (* Normalized device coordinates *) + let nxmin, nxmax, nymin, nymax = plgvpd () in + (* World (plot-space) coordinates *) + let wxmin, wxmax, wymin, wymax = plgvpw () in + (* Cairo device coordinates *) + let xmin = context.width *. nxmin in + let xmax = context.width *. nxmax in + let ymin = context.height *. nymin in + let ymax = context.height *. nymax in + (* World coordinates -> Cairo coordinates *) + xmin +. ((xmax -. xmin) *. (x /. (wxmax -. wxmin))), + ymin +. ((ymax -. ymin) *. (y /. (wymax -. wymin))) +*) + +(** [with_stream ?stream f] calls [f ()] with [stream] as the active + plotting stream if [stream] is present. Otherwise it just calls + [f ()]. *) +let with_stream ?stream f = + match stream with + | None -> f () + | Some s -> + let old_stream = plgstrm () in + plsstrm s.plstream; + let result = f () in + plsstrm old_stream; + result + +(** [new_page p] will advance the Cairo context associted with [p] to a + new page, for devices which support this. *) +let new_page p = + Cairo.show_page p.context; + if p.clear then with_stream ~stream:p (fun () -> pladv 0; plclear ()) else () + +(** The following 4 functions provide a relatively simple way to setup an + appropriate Cairo surface for use with this library and the extcairo + driver. They should be passed as the [init] argument to the + [plinit_cairo] function.*) +let pscairo ~width ~height filename = + let outfile = + match filename with + | Some f -> open_out f + | None -> raise (Invalid_argument "pscairo needs a filename") + in + Some outfile, + Cairo_ps.surface_create_for_channel outfile + ~width_in_points:(float_of_int width) + ~height_in_points:(float_of_int height) + +let pdfcairo ~width ~height filename = + let outfile = + match filename with + | Some f -> open_out f + | None -> raise (Invalid_argument "pdfcairo needs a filename") + in + Some outfile, + Cairo_pdf.surface_create_for_channel outfile + ~width_in_points:(float_of_int width) + ~height_in_points:(float_of_int height) + +let imagecairo ~width ~height (filename : string option) = + filename, + Cairo.image_surface_create Cairo.FORMAT_RGB24 ~width ~height + +let imagecairo_rgba ~width ~height (filename : string option) = + filename, + Cairo.image_surface_create Cairo.FORMAT_ARGB32 ~width ~height + +(** [init_cairo ?filename ~clear ~width ~height init] creates a Cairo context + and associates it with a PLplot stream. A new plot stream is created in the + process. The current plot stream is left active by this function. *) +let init_cairo ?filename ~clear ~width ~height init = + let file, sfc = init ~width ~height filename in + let context = Cairo.create sfc in + (* Associate the Cairo context with PLplot, then initialize PLplot *) + let old_stream = plgstrm () in + let new_stream = plmkstrm () in + plsdev "extcairo"; + ignore (plsetopt "geometry" (sprintf "%dx%d" width height)); + (* Make the plot have a white background. *) + plscol0 0 255 255 255; + plscol0 15 0 0 0; + plinit (); + (* Associate our new Cairo context with the PLplot stream. *) + set_cairo_context context; + if clear then (pladv 0; plclear ()) else (); + (* Return the Cairo information so that the plot surface can be manipulated + and/or saved late. *) + plsstrm old_stream; + { + width = float_of_int width; + height = float_of_int height; + surface = sfc; + context = context; + file = file; + clear = clear; + plstream = new_stream; + } + +(** [make_active plcairo] sets PLplot to using the [plcairo] context + and associated stream as its default plotting stream. *) +let make_active plcairo = plsstrm plcairo.plstream + +(** [finish plcairo] calls [Cairo.surface_finish] on the Cairo surface + associated with [plcairo]. *) +let finish plcairo = + Cairo.surface_finish plcairo.surface; + () + +(** [save_image plcairo] saves the plot surface in [plcairo] + as a png to its associated file. {Plplot.plend} should be called first or + the plotting may not be complete! *) +let save_image plcairo = + match plcairo.file with + | Some filename -> + Cairo_png.surface_write_to_file plcairo.surface filename; + () + | None -> raise (Invalid_argument "No filename is associated with this plot") + +(** [save_image_as plcairo filename] - Like [save_image], but save the plot to + the specified file rather than to a filename defined at plot creation. *) +let save_image_as plcairo filename = + Cairo_png.surface_write_to_file plcairo.surface filename; + () + +(** [save_to_file plcairo] saves the plot surface in [plcairo] to its + associated filename. + Raises [Invalid_argument] if [plcairo] does not have a filename associated + with it. *) +let save_to_file plcairo = + match plcairo.file with + | Some fout -> + finish plcairo; + close_out fout; + () + | None -> raise (Invalid_argument "No file is associated with this plot") + +(** NOTE XXX FIXME : This function will almost definitely change in a future + revision. + [copy_plot plcairo driver filename] copies the plot stream from + [plcairo] to a new output stream, using the plot driver [driver], saving the + output to [filename]. *) +let copy_plot plcairo driver filename = + (* Get the current stream so we can restore it when done. *) + let old_stream = plgstrm () in + (* Make a new plot stream *) + ignore (plmkstrm ()); + plsdev driver; + plsfnam filename; + let geometry = sprintf "%.0fx%.0f" plcairo.width plcairo.height in + ignore (plsetopt "geometry" geometry); + plscol0 0 255 255 255; + plscol0 15 0 0 0; + plinit (); + plcpstrm plcairo.plstream true; + plreplot (); + plend1 (); + plsstrm old_stream; + () + Added: trunk/bindings/ocaml/plcairo/plcairo_impl.c =================================================================== --- trunk/bindings/ocaml/plcairo/plcairo_impl.c (rev 0) +++ trunk/bindings/ocaml/plcairo/plcairo_impl.c 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,46 @@ +/* +Copyright 2008 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*/ + +#include <plplotP.h> + +/* The "usual" OCaml includes */ +#include <caml/alloc.h> +#include <caml/callback.h> +#include <caml/fail.h> +#include <caml/memory.h> +#include <caml/misc.h> +#include <caml/mlvalues.h> +#include <caml/bigarray.h> + +#include <plplot.h> + +#include <cairo.h> + +/** OCaml Cairo integration. */ +/* Get a Cairo context from OCaml. These #defines are from the + OCaml Cairo bindings. */ +#define wPointer_val(t, val) (* ((t **) Data_custom_val(val))) +#define cairo_t_val(v) wPointer_val(cairo_t, v) + +value ml_set_plplot_cairo_context(value context) { + CAMLparam1(context); + pl_cmd(PLESC_DEVINIT, cairo_t_val(context)); + CAMLreturn(Val_unit); +} + Added: trunk/bindings/ocaml/plcairo/tests/cairo_raster.ml =================================================================== --- trunk/bindings/ocaml/plcairo/tests/cairo_raster.ml (rev 0) +++ trunk/bindings/ocaml/plcairo/tests/cairo_raster.ml 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,49 @@ +(* +Copyright 2008, 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + +(* This is a Cairo-only example, meant as an illustration and test of the + technique used in the Plcairo.rasterize function. *) + +open Cairo + +let () = + let img = + Cairo.image_surface_create + Cairo.FORMAT_ARGB32 ~width:100 ~height:100 + in + let outfile = open_out "test.ps" in + let ps = + Cairo_ps.surface_create_for_channel outfile + ~width_in_points:1000.0 ~height_in_points:1000.0 + in + let ct_img = Cairo.create img in + let ct_ps = Cairo.create ps in + (* Draw something on the image *) + Cairo.rectangle ~x:10.0 ~y:10.0 ~width:80.0 ~height:80.0 ct_img; + Cairo.fill ct_img; + Cairo.stroke ct_img; + + (* Blit the image out to the Postscript. *) + Cairo.set_source_surface ct_ps img 0.0 0.0; + Cairo.paint ct_ps; + Cairo.surface_finish ps; + + (* Save the files *) + Cairo_png.surface_write_to_file img "test.png"; + close_out outfile; Added: trunk/bindings/ocaml/plcairo/tests/gtk_interface.ml =================================================================== --- trunk/bindings/ocaml/plcairo/tests/gtk_interface.ml (rev 0) +++ trunk/bindings/ocaml/plcairo/tests/gtk_interface.ml 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,95 @@ +(* +Copyright 2008, 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + +(* An example of using PLplot + Plcairo + Cairo + lablgtk to show a plot in a + Gtk+ application. This is meant to be run from the OCaml toplevel, after + running "make" in the plcairo/ directory. *) + +#use "topfind";; +#thread;; +#require "cairo.lablgtk2";; +#require "plplot";; +#directory "../_build/";; +#load "plcairo.cma";; + +open Plplot + +(* The plot surface size *) +let plot_width = 1600 +let plot_height = 1000 + +(* The size of the GUI view of the plot *) +let gui_width = plot_width / 2 +let gui_height = plot_height / 2 + +(** Get a Cairo context from the Gtk drawing area. *) +let get_cairo w = + Cairo_lablgtk.create w#misc#window + +(** Redraw the plot contents. *) +let redraw w plcairo _ = + let cr = get_cairo w in + let { Gtk.width = width ; Gtk.height = height } = + w#misc#allocation in + let width = float_of_int width in + let height = float_of_int height in + Plcairo.blit_to_cairo ~dest:cr ~dim:(`Both (width, height)) + ~xoff:0.0 ~yoff:0.0 plcairo; + true + +let () = + (* Make a simple plot. *) + let plcairo = + Plcairo.init_cairo ~width:plot_width ~height:plot_height + ~clear:true Plcairo.imagecairo + in + Plcairo.make_active plcairo; + plenv (-180.0) 180.0 (-90.0) 90.0 1 0; + plmap "globe" (-180.0) 180.0 (-90.0) 90.0; + pllab "Latitude" "Longitude" "It's Earth!"; + plend (); + + (* DO NOT call Plcairo.finish yet. The Cairo surface needs to remain active + in order to use it in the GUI. *) + + (* Create a window for the app. *) + let w = GWindow.window ~title:"PLplot + Gtk Integration Demo" () in + (* Quit cleanly when the close button is clicked. *) + ignore (w#connect#destroy GMain.quit); + + (* Put a box and frame around the plot. *) + let b = GPack.vbox ~spacing:6 ~border_width:12 ~packing:w#add () in + + let f = + GBin.frame ~shadow_type:`IN ~packing:(b#pack ~expand:true ~fill:true) () + in + + (* This drawing_area is where the plot will be displayed. *) + let area = + GMisc.drawing_area + ~width:gui_width ~height:gui_height ~packing:f#add () + in + + (* Be sure to update the plot display when required. *) + ignore (area#event#connect#expose (redraw area plcairo)); + + (* Show the window and enter the main Gtk+ application loop. *) + w#show (); + GMain.main () + Added: trunk/bindings/ocaml/plcairo/tests/multiple_pages.ml =================================================================== --- trunk/bindings/ocaml/plcairo/tests/multiple_pages.ml (rev 0) +++ trunk/bindings/ocaml/plcairo/tests/multiple_pages.ml 2009-07-09 15:42:01 UTC (rev 10127) @@ -0,0 +1,45 @@ +(* +Copyright 2008, 2009 Hezekiah M. Carty + +This file is part of PLplot. + +PLplot is free software: you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation, either version 2 of the License, or +(at your option) any later version. + +PLplot is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with PLplot. If not, see <http://www.gnu.org/licenses/>. +*) + +(* Test for multiple plot pages. *) + +open Plplot + +let () = + (* Initialize PLplot with the extcairo device and create a new plot stream. *) + let plcairo = + Plcairo.init_cairo ~clear:true ~width:400 ~height:400 ~filename:"test.pdf" + Plcairo.pdfcairo + in + (* Plcairo.init_cairo restores the current active plot stream, so we need to + make the plcairo stream active in order to plot on it. *) + Plcairo.make_active plcairo; + plenv 0.0 1.0 0.0 1.0 1 0; + pljoin 0.0 0.0 1.0 1.0; + (* The extcairo device does not automatically advance pages. This must be + done "by hand". The following function call is equivalent to: + Cairo.show_page plcairo.context; + *) + Plcairo.new_page plcairo; + plenv 0.0 1.0 0.0 1.0 1 0; + pljoin 0.0 1.0 1.0 0.0; + plend (); + (* Save the [plcairo] plot to its associated filename ("test.pdf"). *) + Plcairo.save_to_file plcairo; + () This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-08-18 16:19:26
|
Revision: 10283 http://plplot.svn.sourceforge.net/plplot/?rev=10283&view=rev Author: hezekiahcarty Date: 2009-08-18 16:19:11 +0000 (Tue, 18 Aug 2009) Log Message: ----------- Remove deprecated plrgb and plrgb1 functions from the OCaml bindings Modified Paths: -------------- trunk/bindings/ocaml/plplot_h trunk/bindings/ocaml/plplot_h.inc Modified: trunk/bindings/ocaml/plplot_h =================================================================== --- trunk/bindings/ocaml/plplot_h 2009-08-18 15:59:21 UTC (rev 10282) +++ trunk/bindings/ocaml/plplot_h 2009-08-18 16:19:11 UTC (rev 10283) @@ -326,12 +326,6 @@ c_plreplot(void); void -c_plrgb(PLFLT r, PLFLT g, PLFLT b); - - void -c_plrgb1(PLINT r, PLINT g, PLINT b); - - void c_plrgbhls(PLFLT r, PLFLT g, PLFLT b, PLFLT *p_h, PLFLT *p_l, PLFLT *p_s); void Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2009-08-18 15:59:21 UTC (rev 10282) +++ trunk/bindings/ocaml/plplot_h.inc 2009-08-18 16:19:11 UTC (rev 10283) @@ -76,8 +76,6 @@ [mlname(plptex)] void c_plptex ( double x, double y, double dx, double dy, double just, [string] const char * text ); [mlname(plptex3)] void c_plptex3 ( double wx, double wy, double wz, double dx, double dy, double dz, double sx, double sy, double sz, double just, [string] const char * text ); [mlname(plreplot)] void c_plreplot ( void ); -[mlname(plrgb)] void c_plrgb ( double r, double g, double b ); -[mlname(plrgb1)] void c_plrgb1 ( int r, int g, int b ); [mlname(plrgbhls)] void c_plrgbhls ( double r, double g, double b, [out] double * p_h, [out] double * p_l, [out] double * p_s ); [mlname(plschr)] void c_plschr ( double def, double scale ); [mlname(plscmap0)] void c_plscmap0 ( [size_is(ncol0), in] int * r, [size_is(ncol0), in] int * g, [size_is(ncol0), in] int * b, int ncol0 ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-08 20:37:58
|
Revision: 10390 http://plplot.svn.sourceforge.net/plplot/?rev=10390&view=rev Author: hezekiahcarty Date: 2009-09-08 20:37:50 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Fix custom palette loading for Quick_plot.image in the OCaml interface This is an interface change for this function. Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-09-08 20:35:46 UTC (rev 10389) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 20:37:50 UTC (rev 10390) @@ -961,10 +961,7 @@ let xmax, ymax = Array_ext.matrix_dims m in let xmax, ymax = float_of_int xmax, float_of_int ymax in let p = init ?filename xmin xmax ymin ymax Equal_square device in - Option.may ( - fun palette_file -> - with_stream ~stream:p (fun () -> plspal1 palette_file false); - ) palette; + Option.may (load_palette ~stream:p) palette; plot ~stream:p [image (xmin, ymin) (xmax, ymax) m]; Option.may (fun (x, y, t) -> label ~stream:p x y t) labels; colorbar ~stream:p ?log ~pos:(Right 0.12) Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-09-08 20:35:46 UTC (rev 10389) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 20:37:50 UTC (rev 10390) @@ -350,7 +350,7 @@ ?filename:string -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> - ?log:bool -> ?palette:string -> float array array -> unit + ?log:bool -> ?palette:Plot.color_palette_t -> float array array -> unit end (** {3:core The standard PLplot API} *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-08 20:38:46
|
Revision: 10391 http://plplot.svn.sourceforge.net/plplot/?rev=10391&view=rev Author: hezekiahcarty Date: 2009-09-08 20:38:38 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Change the spelling of some constant constructors Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-09-08 20:37:50 UTC (rev 10390) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 20:38:38 UTC (rev 10391) @@ -138,7 +138,7 @@ | Red | Yellow | Green - | Grey + | Gray | Blue | Light_blue | Purple @@ -206,7 +206,7 @@ | Red -> 255, 0, 0 | Yellow -> 255, 255, 0 | Green -> 0, 255, 0 - | Grey -> 200, 200, 200 + | Gray -> 200, 200, 200 | Blue -> 0, 0, 255 | Light_blue -> 0, 255, 255 | Purple -> 160, 0, 213 @@ -299,7 +299,7 @@ | Red -> 3 | Yellow -> 13 | Green -> 12 - | Grey -> 10 + | Gray -> 10 | Blue -> 2 | Light_blue -> 11 | Purple -> 15 Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-09-08 20:37:50 UTC (rev 10390) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 20:38:38 UTC (rev 10391) @@ -73,7 +73,7 @@ | Red | Yellow | Green - | Grey + | Gray | Blue | Light_blue | Purple This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-08 23:13:15
|
Revision: 10392 http://plplot.svn.sourceforge.net/plplot/?rev=10392&view=rev Author: hezekiahcarty Date: 2009-09-08 23:13:07 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Add rectangle and function plotting function to OCaml Plplot.Plot module Quick_plot also gets a function plotter Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-09-08 20:38:38 UTC (rev 10391) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 23:13:07 UTC (rev 10392) @@ -437,9 +437,13 @@ let points ?label ?scale color xs ys symbol = Points (label, color, xs, ys, symbol, scale |? 1.0) - (** [polygon color xs ys fill] *) + (** [polygon ?fill color xs ys fill] *) let polygon ?(fill = false) color xs ys = Polygon (color, xs, ys, fill) + (** [rectangle ?fill color (x0, y0) (x1, y1)] *) + let rectangle ?(fill = false) color (x0, y0) (x1, y1) = + polygon ~fill color [|x0; x1; x1; x0; x0|] [|y0; y0; y1; y1; y0|] + (** [text ?dx ?dy ?just ?color s x y] *) let text ?(dx = 0.0) ?(dy = 0.0) ?(just = 0.5) ?(color = Black) s x y = Text (color, s, x, y, dx, dy, just) @@ -448,6 +452,23 @@ let text_outside ?(just = 0.5) ?(perp = false) ?(color = Black) side displacement s = Text_outside (color, s, side, displacement, just, perp) + (** [func ?point ?step color f (min, max)] plots the function [f] from + [x = min] to [x = max]. [step] can be used to tighten or coarsen the + sampling of plot points. *) + let func ?point ?step color f (min, max) = + let step = + match step with + | None -> (max -. min) /. 100.0 + | Some s -> s + in + let xs = + Array_ext.range ~n:(int_of_float ((max -. min) /. step) + 1) min max + in + let ys = Array.map f xs in + match point with + | Some p -> points color xs ys p + | None -> lines color xs ys + (** [transform f] *) let transform f = Set_transform f @@ -968,5 +989,36 @@ (Array_ext.range ~n:100 m_min m_max); finish ~stream:p 0.0 0.0; () + + (** [func ?point ?step fs (min, max)] plots the functions [fs] from [x = min] + to [x = max]. [step] can be used to tighten or coarsen the sampling of + plot points. *) + let func + ?filename ?(device = Window Cairo) ?labels ?point ?step + fs (xmin, xmax) = + let plot_content = + Array.to_list ( + Array.mapi ( + fun i f -> + func ?point ?step (Index_color (i + 1)) f (xmin, xmax) + ) (Array.of_list fs) + ) + in + let ys = + Array.of_list ( + List.map ( + function + | Lines (_, _, _, y) + | Points (_, _, _, y, _, _) -> y + | _ -> invalid_arg "Invalid function output" + ) plot_content + ) + in + let ymax, ymin = plMinMax2dGrid ys in + let stream = init ?filename xmin xmax ymin ymax Greedy device in + plot ~stream plot_content; + Option.may (fun (x, y, t) -> label ~stream x y t) labels; + finish ~stream 0.0 0.0; + () end Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-09-08 20:38:38 UTC (rev 10391) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 23:13:07 UTC (rev 10392) @@ -233,6 +233,10 @@ val polygon : ?fill:bool -> color_t -> float array -> float array -> plot_t + (** [rectangle ?fill color (x0, y0) (x1, y1) *) + val rectangle : + ?fill:bool -> color_t -> float * float -> float * float -> plot_t + (** [text ?dx ?dy ?just ?color string x y] writes the text [string] inside the plot window, at an optional angle defined by the offsets [dx] and [dy]. *) @@ -249,6 +253,13 @@ ?perp:bool -> ?color:color_t -> float plot_side_t -> float -> string -> plot_t + (** [func ?point ?step color f (min, max)] plots the function [f] from + [x = min] to [x = max]. [step] can be used to tighten or coarsen the + sampling of plot points. *) + val func : + ?point:int -> + ?step:float -> color_t -> (float -> float) -> float * float -> plot_t + (** [transform f] Set the coordinate transformation function used by {!imagefr} and other functions affected by {!Plplot.plset_pltr}. *) val transform : pltr_t -> plot_t @@ -351,6 +362,16 @@ ?device:Plot.plot_device_t -> ?labels:string * string * string -> ?log:bool -> ?palette:Plot.color_palette_t -> float array array -> unit + + (** [func ?point ?step fs (min, max)] plots the functions [fs] from + [x = min] to [x = max]. [step] can be used to tighten or coarsen the + sampling of plot points. *) + val func : + ?filename:string -> + ?device:Plot.plot_device_t -> + ?labels:string * string * string -> + ?point:int -> + ?step:float -> (float -> float) list -> float * float -> unit end (** {3:core The standard PLplot API} *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-08 23:39:05
|
Revision: 10393 http://plplot.svn.sourceforge.net/plplot/?rev=10393&view=rev Author: hezekiahcarty Date: 2009-09-08 23:38:57 +0000 (Tue, 08 Sep 2009) Log Message: ----------- Add legend support to Quick_plot.func (OCaml) Modified Paths: -------------- trunk/bindings/ocaml/plplot.ml trunk/bindings/ocaml/plplot.mli Modified: trunk/bindings/ocaml/plplot.ml =================================================================== --- trunk/bindings/ocaml/plplot.ml 2009-09-08 23:13:07 UTC (rev 10392) +++ trunk/bindings/ocaml/plplot.ml 2009-09-08 23:38:57 UTC (rev 10393) @@ -994,14 +994,16 @@ to [x = max]. [step] can be used to tighten or coarsen the sampling of plot points. *) let func - ?filename ?(device = Window Cairo) ?labels ?point ?step + ?filename ?(device = Window Cairo) ?labels ?names ?point ?step fs (xmin, xmax) = + let fs_array = Array.of_list fs in + let colors = Array.mapi (fun i _ -> Index_color (i + 1)) fs_array in let plot_content = Array.to_list ( Array.mapi ( fun i f -> - func ?point ?step (Index_color (i + 1)) f (xmin, xmax) - ) (Array.of_list fs) + func ?point ?step colors.(i) f (xmin, xmax) + ) fs_array ) in let ys = @@ -1017,6 +1019,7 @@ let ymax, ymin = plMinMax2dGrid ys in let stream = init ?filename xmin xmax ymin ymax Greedy device in plot ~stream plot_content; + Option.may (fun n -> draw_legend ~stream n (Array.to_list colors)) names; Option.may (fun (x, y, t) -> label ~stream x y t) labels; finish ~stream 0.0 0.0; () Modified: trunk/bindings/ocaml/plplot.mli =================================================================== --- trunk/bindings/ocaml/plplot.mli 2009-09-08 23:13:07 UTC (rev 10392) +++ trunk/bindings/ocaml/plplot.mli 2009-09-08 23:38:57 UTC (rev 10393) @@ -213,7 +213,7 @@ scale:float * float -> float * float -> float * float -> float array array -> plot_t - (** [join color x0 y1 x1 y1] *) + (** [join color x0 y0 x1 y1] *) val join : color_t -> float -> float -> float -> float -> plot_t (** [lines ?label color xs ys] *) @@ -370,6 +370,7 @@ ?filename:string -> ?device:Plot.plot_device_t -> ?labels:string * string * string -> + ?names:string list -> ?point:int -> ?step:float -> (float -> float) list -> float * float -> unit end This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <hez...@us...> - 2009-09-21 01:42:15
|
Revision: 10443 http://plplot.svn.sourceforge.net/plplot/?rev=10443&view=rev Author: hezekiahcarty Date: 2009-09-21 01:42:07 +0000 (Mon, 21 Sep 2009) Log Message: ----------- Fix touchup.ml so that it generates a fully-working plplot_h.inc Previously, the output of this script (used with the OCaml bindings) required manual editing on the part of the OCaml bindings maintainer. Modified Paths: -------------- trunk/bindings/ocaml/plplot_h.inc trunk/bindings/ocaml/touchup.ml Modified: trunk/bindings/ocaml/plplot_h.inc =================================================================== --- trunk/bindings/ocaml/plplot_h.inc 2009-09-20 22:08:21 UTC (rev 10442) +++ trunk/bindings/ocaml/plplot_h.inc 2009-09-21 01:42:07 UTC (rev 10443) @@ -1,4 +1,4 @@ -[mlname(pl_setcontlabelformat)] void c_pl_setcontlabelformat(int lexp, int sigdig); +[mlname(pl_setcontlabelformat)] void c_pl_setcontlabelformat ( int lexp, int sigdig ); [mlname(pl_setcontlabelparam)] void c_pl_setcontlabelparam ( double offset, double size, double spacing, int active ); [mlname(pladv)] void c_pladv ( int page ); [mlname(plarc)] void c_plarc ( double x, double y, double a, double b, double angle1, double angle2, boolean fill ); Modified: trunk/bindings/ocaml/touchup.ml =================================================================== --- trunk/bindings/ocaml/touchup.ml 2009-09-20 22:08:21 UTC (rev 10442) +++ trunk/bindings/ocaml/touchup.ml 2009-09-21 01:42:07 UTC (rev 10443) @@ -8,6 +8,8 @@ parameter_attrs: (string * string list) list option; } +(* These functions all require special handling beyond the more general rules + below. *) let manual_function_attributes = [ { @@ -16,11 +18,6 @@ parameter_attrs = Some ["data", ["size_is(n)"]]; }; { - function_name = "c_plimagefr"; - function_attrs = None; - parameter_attrs = Some ["idata", ["in"; "size_is(nx, ny)"]]; - }; - { function_name = "c_plimage"; function_attrs = None; parameter_attrs = Some ["idata", ["in"; "size_is(nx, ny)"]]; @@ -96,6 +93,8 @@ (* Functions to read in everything on STDOUT from a given command. *) (* Many thanks to Richard M. Jones for the following two functions! *) + +(** Read in all of the lines from an input source *) let rec input_all_lines chan = try let line = input_line chan in @@ -103,6 +102,7 @@ with End_of_file -> [] +(** Read everything output on STDOUT from a given command-line *) let pget cmd = let chan = Unix.open_process_in cmd in let lines = input_all_lines chan in @@ -117,6 +117,8 @@ failwith ("command stopped by signal " ^ string_of_int i)); lines +(** Read in a file, pre-processed with cpp, and return the output as a list of + lines. *) let read_file filename = let preprocessed_text = pget ("cpp " ^ filename) in let l = List.map (fun l -> l ^ "\n") preprocessed_text in @@ -129,14 +131,17 @@ *) l +(** Utility functions *) let (|>) x f = f x let id x = x +(** Clean up the text a bit, minimizing whitespace and cutting out leftover + cruft from the preprocessor. *) let cleanup_lines l = (* Strip out #-started preprocessor lines, as well as lines with only whitespace. *) let blob = - let filtered = + let filtered = List.filter ( fun line -> if Pcre.pmatch ~pat:"^#|^\\s+$" line then @@ -148,23 +153,28 @@ List.fold_left (^) "" filtered in blob - (* Compress lengths of whitespace down to a single character *) - |> Pcre.replace ~pat:"\\s+" ~templ:" " - (* Put newlines back in after each ; *) - |> Pcre.replace ~pat:"; " ~templ:";\n" + (* Compress lengths of whitespace down to a single character *) + |> Pcre.replace ~pat:"\\s+" ~templ:" " + (* Put newlines back in after each ; *) + |> Pcre.replace ~pat:"; " ~templ:";\n" +(** Given a list of attributes, return a camlidl-ready string representing those + attributes. *) let make_attribute_string attributes = match attributes with [] -> "" | a -> "[" ^ String.concat ", " a ^"]" +(** Get rid of extraneous whitespace (leading, trailing, runs) *) let minimize_whitespace s = s - |> Pcre.replace ~pat:"^\\s+" ~templ:"" - |> Pcre.replace ~pat:"\\s$" ~templ:"" - |> Pcre.replace ~pat:"\\s+" ~templ:" " + |> Pcre.replace ~pat:"^\\s+" ~templ:"" + |> Pcre.replace ~pat:"\\s$" ~templ:"" + |> Pcre.replace ~pat:"\\s+" ~templ:" " +(** Generate attributes specific to a given function, based in its return type + and name. *) let function_attributes return_type name = let check_re re = if Pcre.pmatch ~pat:re name then @@ -203,16 +213,17 @@ (* Attributes based on the function name *) let name_attrs = - List.map - (fun (re,attrf) -> let a = check_re re in if Array.length a > 0 then attrf a else []) - name_checks + List.map ( + fun (re,attrf) -> + let a = check_re re in if Array.length a > 0 then attrf a else [] + ) name_checks |> List.flatten in (* Attributes based on the function type *) let type_attrs = - List.map - (fun (re,attrs) -> if Pcre.pmatch ~pat:re return_type then attrs else []) - type_checks + List.map ( + fun (re,attrs) -> if Pcre.pmatch ~pat:re return_type then attrs else [] + ) type_checks |> List.flatten in (* Any other attributes, specified manually *) @@ -222,19 +233,21 @@ List.find (fun fa -> fa.function_name = name) manual_function_attributes in match fa.function_attrs with - Some a -> a - | None -> [] + | Some a -> a + | None -> [] with - Not_found -> [] + | Not_found -> [] in name_attrs @ type_attrs @ manual_attrs +(** Generate attributes for function parameters *) let parameter_attributes function_name types names = let pmatch re str = Pcre.pmatch ~pat:re str in let non_get_functions = ["c_plgriddata"; "c_plgra"] in (* If all of the pieces are true, then the attribute(s) is(are) appropriate - for this parameter. *) + for this parameter. This is basically a long list of special cases + which usually, but not always, apply to multiple functions. *) let checks p_type p_name = [ (* Order goes: @@ -334,14 +347,14 @@ let manual_attrs = try let fa = - List.find (fun fa -> fa.function_name = function_name) manual_function_attributes + List.find (fun fa -> fa.function_name = function_name) + manual_function_attributes in match fa.parameter_attrs with - Some a -> - List.assoc param_name a - | None -> [] + | Some a -> List.assoc param_name a + | None -> [] with - Not_found -> [] + | Not_found -> [] in Hashtbl.add attr_hash param_name manual_attrs; (* Check for attributes, filter the ones we don't want, then add the rest @@ -356,13 +369,18 @@ List.iter2 perform_check types names; attr_hash +(** Build a string from a list of attributes *) let build_attribute_list l = List.map ( fun (attrs, t, n) -> String.concat " " [make_attribute_string attrs; t; n] ) l +(** Given a C function prototype, chop it up and find out what camlidl + attributes it should have. *) let process_prototype line = + (* This is an ugly, but for now effective, regexp to parse the PLplot function + prototypes. *) let pieces = line |> Pcre.extract ~pat:"^((?:(?:const|unsigned) )?\\w+ (?:\\*\\s*)?)(\\w+)\\s*\\(([\\w\\s\\*\\[\\],]*)\\)" ~full_match:false @@ -402,22 +420,31 @@ @ [");"] ) +(** Write a list of lines out to the given filename *) let write_file filename lines = let fout = open_out filename in List.iter (output_string fout) lines; close_out fout; () +(** Given "file", write out "file.inc" which should be ready for consumption by + camlidl. *) let process_file filename = - let lines = read_file filename in - let lines' = cleanup_lines lines |> Pcre.split ~pat:"\n" in - lines' - |> List.map ( - fun l -> try process_prototype l with Not_found -> l - ) - |> List.map minimize_whitespace - |> List.map (fun l -> l ^ "\n") - |> write_file (filename ^ ".inc") + read_file filename + |> cleanup_lines + |> Pcre.split ~pat:"\n" + |> List.map minimize_whitespace + |> List.map ( + fun l -> + try + process_prototype l + with + | Not_found -> + failwith ("Unhandled or malformed prototype: \n" ^ l) + ) + |> List.map minimize_whitespace + |> List.map (fun l -> l ^ "\n") + |> write_file (filename ^ ".inc") let () = if !Sys.interactive then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |