Changed GraphPS-Files (had problems with interface/implementation) (Re: [Caml-list] GraphPS missed...)

[Oliver Bandel <oliver@first.in-berlin.de>]

[-- Attachment #1: Type: text/plain, Size: 550 bytes --]

On Sun, Mar 20, 2005 at 07:06:35PM +0100, Oliver Bandel wrote:
> 
> Hello,
> 
> I found the documentation on GraphPS via CamlHump,
> but the ftp-adress which was mentioned in the documentation
> was unvalid.
> 
> Where to find GraphPS?

OK, I found it with Google's help.

But the code didn't compile.

There was a problem between the function-declarations
in the signature, which uses labels and the function
definitions in the ml-file.

I changed  the files and then it compiled without problems.


I attached the two files here.


Ciao,
   Oliver

[-- Attachment #2: graphics_ps.mli --]
[-- Type: text/plain, Size: 8572 bytes --]

(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
(*                                                                     *)
(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License.         *)
(*                                                                     *)
(***********************************************************************)
(* changed by Oliver Bandel, 24.03.2005 *)

(* $Id: graphics.mli,v 1.7 2001/03/08 09:17:16 weis Exp $ *)

(* Alternate [graphics] module: PostScript interpretation of Caml
   machine-independent graphics primitives. *)

(*** Initializations *)

val open_ps : string -> unit
        (* Opens the file where the PostScript code corresponding to
           the Caml drawing is written.
           At the end of the Caml program, this file will contain a
           stand alone PostScript file, suitable for direct
           visualization or printing. *)

val open_eps : string -> unit
        (* Opens the file where the encapsulated PostScript code
           corresponding to the Caml drawing is written.
           At the end of the Caml program, this file will contain an
           encapsulated PostScript file, suitable for insertion into a
           TeX file. *)

val open_graph : string -> unit
        (* Starts the graphics mode. The PostScript drawing initialization
           is emited. The page is cleared and the current point is set
           to (0, 0). The string argument is used to pass optional
           information on the graphics size (using the X Windows
           geometry convention). 
           If the empty string is given, a sensible default is selected. *)
val close_graph : unit -> unit
        (* Emits the set of PostScript commands corresponding to the
           program execution. Closes the PostScript output file if
           necessary. *)
val clear_graph : unit -> unit
        (* Clear the PostScript page. *)
val size_x : unit -> int
val size_y : unit -> int
        (* Returns the size of the graphics page. Coordinates of the page
           range over [0 .. size_x()-1] and [0 .. size_y()-1].
           Drawings outside of this rectangle are clipped, without causing
           an error. The origin (0,0) is at the lower left corner. *)

(*** Colors *)

type color = int
        (* A color is specified by its R, G, B components. Each component
           is in the range [0..255]. The three components are packed in
           an [int]: [0xRRGGBB], where [RR] are the two hexadecimal digits for
           the red component, [GG] for the green component, [BB] for the
           blue component. *)

val rgb : int -> int -> int -> color
        (* [rgb r g b] returns the integer encoding the color with red
           component [r], green component [g], and blue component [b].
           [r], [g] and [b] are in the range [0..255]. *)

val set_color : color -> unit 
        (* Set the current drawing color. *)

val black : color
val white : color
val red : color
val green : color
val blue : color
val yellow : color
val cyan : color
val magenta : color
        (* Some predefined colors. *)

val background : color
val foreground : color
        (* Default background and foreground colors (usually, either black
           foreground on a white background or white foreground on a
           black background).
           [clear_graph] fills the page with the [background] color.
           The initial drawing color is [foreground]. *)

(*** Point and line drawing *)

val plot : x:int -> y:int -> unit 
        (* Plot the given point with the current drawing color. *)
val moveto : x:int -> y:int -> unit 
        (* Position the current point. *)
val rmoveto : dx:int -> dy:int -> unit
        (* [rmoveto x y] translates the current point of the given vector. *)
val current_x : unit -> int
        (* Return the abscissa of the current point. *)
val current_y : unit -> int
        (* Return the ordinate of the current point. *)
val current_point : unit -> int * int
        (* Return the position of the current point. *)
val lineto : x:int -> y:int -> unit 
        (* Draw a line with endpoints the current point and the given point,
           and move the current point to the given point. *)
val rlineto : dx:int -> dy:int -> unit
        (* Draws a line with endpoints the current point and the
           current point translated of the given vector,
           and move the current point to this point. *)
val draw_rect : x:int -> y:int -> w:int -> h:int -> unit
        (* [draw_rect x y w h] draws the rectangle with lower left corner
           at [x,y], width [w] and height [h].
           The current point is unchanged. *)
val draw_arc :
        x:int -> y:int -> rx:int -> ry:int -> a1:int -> a2:int -> unit
        (* [draw_arc x y rx ry a1 a2] draws an elliptical arc with center
           [x,y], horizontal radius [rx], vertical radius [ry], from angle
           [a1] to angle [a2] (in degrees).
           The current point is unchanged. *)
val draw_ellipse : x:int -> y:int -> rx:int -> ry:int -> unit
        (* [draw_ellipse x y rx ry] draws an ellipse with center
           [x,y], horizontal radius [rx] and vertical radius [ry].
           The current point is unchanged.  *)
val draw_circle : x:int -> y:int -> r:int -> unit
        (* [draw_circle x y r] draws a circle with center [x,y] and
           radius [r].
           The current point is unchanged. *)
val draw_poly : (int * int) array -> unit
        (* Draw the given polygon with the current color. The array
           contains the coordinates of the vertices of the polygon.
           The current point is unchanged. *)
val set_line_width : int -> unit
        (* Set the width of points and lines drawn with the functions
           above. *)

(*** Text drawing *)

val draw_char : char -> unit
val draw_string : string -> unit
        (* Draw a character or a character string with lower left corner
           at current position. After drawing, the current position is set
           to the lower right corner of the text drawn. *)
val set_font : string -> unit
val set_text_size : int -> unit
        (* Set the font and character size used for drawing text.
           The interpretation of the arguments to [set_font] and
           [set_text_size] is implementation-dependent. *)
val text_size : string -> int * int
        (* Return the dimensions of the given text, if it were drawn with
           the current font and size. *)

(*** Filling *)

val fill_rect : x:int -> y:int -> w:int -> h:int -> unit
        (* [fill_rect x y w h] fills the rectangle with lower left corner
           at [x,y], width [w] and height [h], with the current color. *)
val fill_poly : (int * int) array -> unit
        (* Fill the given polygon with the current color. The array
           contains the coordinates of the vertices of the polygon. *)
val fill_arc :
        x:int -> y:int -> rx:int -> ry:int -> a1:int -> a2:int -> unit
        (* Fill an elliptical pie slice with the current color. The
           parameters are the same as for [draw_arc]. *)
val fill_ellipse : x:int -> y:int -> rx:int -> ry:int -> unit
        (* Fill an ellipse with the current color. The
           parameters are the same as for [draw_ellipse]. *)
val fill_circle : x:int -> y:int -> r:int -> unit
        (* Fill a circle with the current color. The
           parameters are the same as for [draw_circle]. *)

(*** Images *)

type image
        (* The abstract type for images, in internal representation.
           Externally, images are represented as matrices of colors.
           Only here for compatibility: drawing of image is not yet
           implemented. *)

val transp : color
        (* In matrices of colors, this color represents a ``transparent''
           point: when drawing the corresponding image, all pixels on the
           screen corresponding to a transparent pixel in the image will
           not be modified, while other points will be set to the color
           of the corresponding point in the image. This allows superimposing
           an image over an existing background. *)


[-- Attachment #3: graphics_ps.ml --]
[-- Type: text/plain, Size: 14545 bytes --]

(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
(*                                                                     *)
(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License.         *)
(*                                                                     *)
(***********************************************************************)
(* changed by Oliver Bandel, 24.03.2005 *)

open Printf;;

type command =
   | Open_graph of int * int
   | Close_graph

   | Set_rgb_color of int * int * int
   | Plot of int * int
   | Moveto of int * int
   | Lineto of int * int
   | Rmoveto of int * int
   | Rlineto of int * int

   | Draw_rect of int * int * int * int
   | Fill_rect of int * int * int * int

   | Draw_poly of (int * int) array
   | Fill_poly of (int * int) array

   | Draw_arc of int * int * int * int * int * int
   | Fill_arc of int * int * int * int * int * int

   | Draw_ellipse of int * int * int * int
   | Fill_ellipse of int * int * int * int

   | Draw_circle of int * int * int
   | Fill_circle of int * int * int

   | Set_line_width of int

   | Draw_char of char
   | Draw_string of string
   | Set_font of string * int
;;

let eps_mode = ref false;;
let ps_out_channel = ref stdout;;

let open_ps s = ps_out_channel := open_out s; eps_mode := false;;
let open_eps s = open_ps s; eps_mode := true;;

let current_ps_program = ref [];;

let add_command c = current_ps_program := c :: !current_ps_program;;

let size_x_ref = ref 640 and size_y_ref = ref 640;;

let parse_geometry s =
  let lim = String.length s in
  let rec find_x i =
   if i >= lim then raise Not_found else
   if s.[i] = 'x' then i else find_x (i + 1) in
  let rec find_digit i =
   if i >= lim then raise Not_found else
   match s.[i] with
   | '0' .. '9' -> i
   | _ -> find_digit (i + 1) in
  try
   let ix = find_x 0 in
   let dx = find_digit 0 in
   let sx = String.sub s dx (ix - dx) in
   let dy = find_digit ix in
   let sy = String.sub s dy (lim - dy) in
   int_of_string sx, int_of_string sy
  with Not_found -> (640, 640)
     | Failure _ -> (640, 640);;

let open_graph s =
 let x, y = parse_geometry s in
 size_x_ref := x; size_y_ref := y;
 add_command (Open_graph (x, y));;

let clear_graph () = current_ps_program := [];;
let size_x () = !size_x_ref;;
let size_y () = !size_y_ref;;

(* Colors *)

type color = int;;

let rgb r g b = (r lsl 16) + (g lsl 8) + b;;

let rgb_of_color c =
 let r = (c lsr 16) land 0xFF in
 let g = (c lsr 8) land 0xFF in
 let b = c land 0xFF in
 r, g, b;;

let black   = 0x000000
and white   = 0xFFFFFF
and red     = 0xFF0000
and green   = 0x00FF00
and blue    = 0x0000FF
and yellow  = 0xFFFF00
and cyan    = 0x00FFFF
and magenta = 0xFF00FF;;

let background = white
and foreground = black;;

let set_color c =
 let c = if c < 0 then background else c in
 let r, g, b = rgb_of_color c in
 add_command (Set_rgb_color (r, g, b));;

(* Drawing *)

let plot ~x ~y = add_command (Plot (x, y));;

let curr_x = ref 0;;
let curr_y = ref 0;;

let current_x () = !curr_x;;
let current_y () = !curr_y;;

let current_point () = !curr_x, !curr_y;;

let set_point x y = curr_x := x; curr_y := y;;

let moveto ~x ~y =
 set_point x y;
 add_command (Moveto (x, y));;

let lineto ~x ~y =
 set_point x y;
 add_command (Lineto (x, y));;

let rlineto ~dx ~dy = 
 set_point (current_x () + dx) (current_y () + dy);
 add_command (Rlineto (dx, dy));;

let rmoveto ~dx ~dy =
 set_point (current_x () + dx) (current_y () + dy);
 add_command (Rmoveto (dx, dy));;

let draw_arc ~x ~y ~rx ~ry ~a1 ~a2 = add_command (Draw_arc (x, y, rx, ry, a1, a2));;
let draw_ellipse ~x ~y ~rx ~ry = add_command (Draw_ellipse (x, y, rx, ry));;
let draw_circle ~x ~y ~r = add_command (Draw_circle (x, y, r));;

let set_line_width w = add_command (Set_line_width w);;

let draw_rect ~x ~y ~w ~h = add_command (Draw_rect (x, y, w, h));;
let fill_rect ~x ~y ~w ~h = add_command (Fill_rect (x, y, w, h));;
let fill_poly v = add_command (Fill_poly v);;
let draw_poly v = add_command (Draw_poly v);;

let fill_arc ~x ~y ~rx ~ry ~a1 ~a2 = add_command (Fill_arc (x, y, rx, ry, a1, a2));;

let fill_ellipse ~x ~y ~rx ~ry = add_command (Fill_ellipse (x, y, rx, ry));;
let fill_circle ~x ~y ~r = add_command (Fill_circle (x, y, r));;

(* Text *)
let default_font = "Helvetica-Bold";;
let default_font_size = 10;;

let x_text_size = ref default_font_size;;
let y_text_size = ref default_font_size;;

let draw_char c =
 let x = current_x ()
 and y = current_y () in
 set_point (x + !x_text_size) y;
 add_command (Draw_char c);;

let draw_string s =
 let x = current_x ()
 and y = current_y () in
 set_point (x + (String.length s * !x_text_size)) y;
 add_command (Draw_string s);;

(* The font machinery *)
let current_font = ref default_font;;

let fonts = Hashtbl.create 11;;

let add_font f =
 if not (Hashtbl.mem fonts f) then Hashtbl.add fonts f f;;

let parse_font f =
  match f with
  | "Times" -> f, !x_text_size
  | "Times-Italic" -> f, !x_text_size
  | "Times-Bold" -> f, !x_text_size
  | "Helvetica" -> f, !x_text_size
  | "Helvetica-Bold" -> f, !x_text_size
  | "Helvetica-Italic" -> f, !x_text_size
  | _ -> "Helvetica", !x_text_size;;

let change_font f =
 let f, sz = parse_font f in
 add_font f;
 current_font := f;
 x_text_size := sz;
 sz;;

let set_font f =
 let sz = change_font f in
 add_command (Set_font (f, sz));;

let init_font () = ignore (change_font default_font);;

init_font ();;

let set_text_size i =
 x_text_size := i;
 add_command (Set_font (!current_font, i));;

let text_size s = (String.length s * !x_text_size, !y_text_size);;

(* Images *)

type image;;

let transp = -1;;

(* Post Script functions embedded into the output *)
let ps_defs = "\
/m { moveto } def
/rm { rmoveto } def
/l { lineto } def
/c { currentpoint } def
/cp { currentlinewidth currentpoint } def
/dl { l c stroke m } def
/rl { rlineto c stroke m } def
/p { newpath m c lineto 1 setlinewidth stroke m setlinewidth} def
/pr  %% define the path for a rectangle w h x y
    { newpath moveto
      dup %% w h h
      0 exch rlineto %% rlineto 0 h -- w h
      exch 0 rlineto %% rlineto w 0 -- h
      0 exch sub 0 exch rlineto %% rlineto 0 -h --
      closepath } def
/dr %% w h x y
    { pr stroke moveto } def
/fr { pr fill moveto } def
/fc { 0 360 newpath arc fill moveto } def
/dc { 0 360 newpath arc stroke moveto } def
/ac { newpath m c } def
/fa { gsave translate scale newpath 0 0 m arc closepath fill grestore } def
/da { savematrix gsave translate scale newpath arc
      restorematrix stroke grestore } def
/fe { gsave translate scale newpath 0 0 1 0 360 arc fill grestore } def
/de { savematrix gsave translate scale newpath 0 0 1 0 360 arc
      restorematrix stroke grestore } def
/pc { newpath m} def
/dp { closepath stroke m} def
/fp { closepath fill m} def
/kcolor { 1 255 div } def
/color { kcolor mul } def
/stmp { /tmp exch def } def
/srgb {% r g b -
 color stmp color exch color exch tmp setrgbcolor 
} def
/t {
 show
} def
/savedmatrix [0 0 0 0 0 0] def
/savematrix {
 savedmatrix currentmatrix pop
} def
/restorematrix {
 savedmatrix setmatrix
} def
%% ISO fonts
/ISOLatin1Encoding [
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright
 /parenleft /parenright /asterisk /plus /comma /minus /period /slash
 /zero /one /two /three /four /five /six /seven
 /eight /nine /colon /semicolon /less /equal /greater /question
 /at /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O
 /P /Q /R /S /T /U /V /W /X /Y /Z /bracketleft /backslash /bracketright
                                                       /asciicircum /underscore
 /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o
 /p /q /r /s /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde
                                                                       /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
 /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
 /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
                                                            /registered /macron
 /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
                                                                /periodcentered
 /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf
                                                   /threequarters /questiondown
 /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
 /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
                                                         /Idieresis
 /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
 /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls
 /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
 /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
                                                         /idieresis
 /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
 /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis
] def
%% usage: isoname oldname makeisofont -
/makeisofont {
  dup findfont length dict dup begin
    exch findfont {
      exch dup /FID eq { pop pop } { exch def } ifelse
    } forall
    /Encoding ISOLatin1Encoding def
  end
  definefont pop
} def
";;

let make_iso_font f = sprintf
 "/ISO%s /%s makeisofont" f f;;

let hashtbl_assocs t =
 let res = ref [] in
 Hashtbl.iter (fun k v -> res := (k, v) :: !res) t;
 !res;;

let hashtbl_vals t =
 let res = ref [] in
 Hashtbl.iter (fun k v -> res := v :: !res) t;
 !res;;

let hashtbl_map f t =
 let res = ref [] in
 Hashtbl.iter (fun k v -> res := f k v :: !res) t;
 !res;;

let make_iso_fonts () =
 let font_list = hashtbl_vals fonts in
 String.concat "\n" (List.map make_iso_font font_list);;

let set_default_font default_font default_font_size = sprintf
 "/ISO%s findfont %i scalefont setfont\n" default_font default_font_size;;

let creator size_x size_y = sprintf
  "%%!PS-Adobe-2.0 EPSF-2.0\n\
   %%%%Creator: GraphPs\n\
   %%%%BoundingBox: 0 0 %i %i\n" size_x size_y;;

let document_fonts () =
  let font_list = hashtbl_vals fonts in
  sprintf
   "%%%%DocumentFonts: %s\n\
    %%%%EndComments\n" (String.concat " " font_list);;

let header size_x size_y =
  sprintf "%s%s" (creator size_x size_y) (document_fonts ());;

let prelude size_x size_y default_font default_font_size =
  sprintf
   "%s\
    %%BeginProcSet\n\
    gsave\n\
    %s\
    0 0 m\n\
    1 setlinewidth\n\
    1 setlinecap\n\
    2 setlinejoin\n\
    10 setmiterlimit\n\
    %s\n\
    %s\
    %%EndProcSet\n" (header size_x size_y)
        ps_defs
        (make_iso_fonts ())
        (set_default_font default_font default_font_size);;

(* Could be "showpage", if one wants automatic display of the current page. *)
let postlude () =
 if !eps_mode then "grestore\n" else "grestore\nshowpage\n%%end\n";;

let escape_char b = function
  | '(' | ')' | '\\' as c -> Buffer.add_char b '\\'; Buffer.add_char b c
  | c -> Buffer.add_char b c;;

let escape_char_for_ps c =
 let b = Buffer.create 3 in
 escape_char b c;
 Buffer.contents b;;

let escape_string_for_ps s =
 let l = String.length s in
 let b = Buffer.create l in
 for i = 0 to l - 1 do escape_char b s.[i] done;
 Buffer.contents b;;

type filling = Fill | Draw;;

let print_poly oc filling v =
  if Array.length v > 0 then begin
   let x, y = v.(0) in
   fprintf oc "c %i %i pc\n" x y;
   for i = 1 to Array.length v - 1 do
    let x, y = v.(i) in
    fprintf oc "%i %i l\n" x y
   done;
   if filling = Draw then fprintf oc "dp\n" else fprintf oc "fp\n"
  end;;

let to_ps oc = function
  | Open_graph (x, y) ->
     fprintf oc "%s" (prelude x y default_font default_font_size);
     set_color background;
     fill_rect 0 0 x y;
     set_color foreground
  | Close_graph ->
     fprintf oc "%s\n" (postlude ())
  | Set_rgb_color (r, g, b) ->
     fprintf oc "%i %i %i srgb\n" r g b
  | Plot (x, y) ->
     fprintf oc "cp %i %i p\n" x y
  | Moveto (x, y) ->
     fprintf oc "%i %i m\n" x y
  | Lineto (x, y) ->
     fprintf oc "%i %i dl\n" x y
  | Rmoveto (x, y) ->
     fprintf oc "%i %i rm\n" x y
  | Rlineto (x, y) ->
     fprintf oc "%i %i rl\n" x y
  | Set_line_width w ->
     fprintf oc "%i setlinewidth\n" w
  | Draw_char c ->
     fprintf oc "(%s) show\n" (escape_char_for_ps c)
  | Draw_string s ->
     fprintf oc "(%s) show\n" (escape_string_for_ps s)
  | Set_font (f, size) ->
     fprintf oc "/ISO%s findfont %i scalefont setfont\n" f (2 * size)
  | Draw_rect (x, y, w, h) ->
     fprintf oc "c %i %i %i %i dr\n" w h x y
  | Fill_rect (x, y, w, h) ->
     fprintf oc "c %i %i %i %i fr\n" w h x y
  | Fill_poly v ->
     print_poly oc Fill v
  | Draw_poly v ->
     print_poly oc Draw v
  | Draw_circle (x, y, r) ->
     fprintf oc "c %i %i %i dc\n" x y r
  | Fill_circle (x, y, r) ->
     fprintf oc "c %i %i %i fc\n" x y r
  | Draw_ellipse (x, y, rx, ry) ->
     fprintf oc "%i %i %i %i de\n" rx ry x y
  | Fill_ellipse (x, y, rx, ry) ->
     fprintf oc "%i %i %i %i fe\n" rx ry x y
  | Draw_arc (x, y, rx, ry, a1, a2) ->
     fprintf oc "0 0 1 %i %i %i %i %i %i da\n" a1 a2 rx ry x y
  | Fill_arc (x, y, rx, ry, a1, a2) ->
     fprintf oc "0 0 1 %i %i %i %i %i %i fa\n" a1 a2 rx ry x y
;;

let close_graph () =
 if !current_ps_program <> [] then begin
 let oc = !ps_out_channel in
 add_command Close_graph;
 let commands = !current_ps_program in
 List.iter (to_ps oc) (List.rev commands);
 current_ps_program := [];
 flush oc;
 if oc != stdout then close_out oc end
;;

at_exit close_graph;;