Start of the new PostScript implementation (not functional!)

2 files changed, 769 insertions, 119 deletions

diff --git a/generic/PostScript.c b/generic/PostScript.c
index 27923e2..9a72701 100644
--- a/generic/PostScript.c
+++ b/generic/PostScript.c
@@ -8,7 +8,7 @@
  */
 
 /*
- *  Copyright (c) 1993 - 1999 CENA, Patrick Lecoanet --
+ *  Copyright (c) 2004 CENA, Patrick Lecoanet --
  *
  * This code is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Library General Public
@@ -26,6 +26,12 @@
  *
  */
 
+/*
+ * This code is based on tkCanvPs.c which is copyright:
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ */
 
 /*
  **********************************************************************************
@@ -70,77 +76,377 @@ static const char compile_id[]="$Compile: " __FILE__ " " __DATE__ " " __TIME__ "
 static	char	ps_prolog[] = "";
 
 
+typedef struct _ZnPostScriptInfo {
+  ZnBBox	area;		/* Area to print, in device coordinates. */
+  ZnReal	page_x;		/* PostScript coordinates of anchor on page */
+  ZnReal	page_y;
+  ZnReal	page_width;	/* Printed width and height of output area. */
+  ZnReal	page_height;
+  Tk_Anchor	page_anchor;	/* Area anchor on Postscript page. */
+  ZnBool	landscape;	/* True means output is rotated ccw by 90 degrees
+				 * (landscape mode). */
+  char		*font_var;	/* If non-NULL, gives name of global variable
+				 * containing font mapping information. Malloc'ed. */
+  char		*color_var;	/* If non-NULL, give name of global variable
+				 * containing color mapping information. Malloc'ed. */
+  int		colormode;	/* Tell how color show be handled: 0 for mono,
+				 * 1 for gray, 2 for color. */
+  char		*filename;	/* Name of file in which to write PostScript; NULL
+				 * means return Postscript info as result. Malloc'ed. */
+  char		*channel_name;	/* If -channel is specified, the name of the channel
+				 * to use. Malloc'ed */
+  Tcl_Channel	chan;		/* Open channel corresponding to fileName. */
+  Tcl_HashTable font_table;	/* Hash table containing names of all font families
+				 * used in output. The table values are not used. */
+  ZnBool	prepass;	/* True means that we're currently in
+				 * the pre-pass that collects font information,
+				 * so the PostScript generated isn't relevant. */
+  ZnBool	prolog;		/* True means output should contain the file
+				 * prolog.ps in the header. */
+} ZnPostScriptInfo;
+
+
+static int ZnPsDimParse _ANSI_ARGS_((ClientData client_data, Tcl_Interp *interp,
+				     Tk_Window tkwin, Tcl_Obj *ovalue,
+				     char *widget_rec, int offset));
+static Tcl_Obj *ZnPsDimPrint _ANSI_ARGS_((ClientData client_data, Tk_Window tkwin,
+					  char *widget_rec, int offset,
+					  Tcl_FreeProc **free_proc));
+static int ZnPsColorModeParse _ANSI_ARGS_((ClientData client_data, Tcl_Interp *interp,
+					   Tk_Window tkwin, Tcl_Obj *ovalue,
+					   char *widget_rec, int offset));
+static Tcl_Obj *ZnPsColorModePrint _ANSI_ARGS_((ClientData client_data, Tk_Window tkwin,
+						char *widget_rec, int offset,
+						Tcl_FreeProc **free_proc));
+static int ZnBBoxParse _ANSI_ARGS_((ClientData client_data, Tcl_Interp *interp,
+				    Tk_Window tkwin, Tcl_Obj *ovalue,
+				    char *widget_rec, int offset));
+static	Tcl_Obj *ZnBBoxPrint _ANSI_ARGS_((ClientData client_data, Tk_Window tkwin,
+					  char *widget_rec, int offset,
+					  Tcl_FreeProc **free_proc));
+
+static	Tk_CustomOption psDimOption = {
+  (Tk_OptionParseProc *) ZnPsDimParse,
+  (Tk_OptionPrintProc *) ZnPsDimPrint,
+  NULL
+};
+
+static	Tk_CustomOption psColorModeOption = {
+  (Tk_OptionParseProc *) ZnPsColorModeParse,
+  (Tk_OptionPrintProc *) ZnPsColorModePrint,
+  NULL
+};
+
+static	Tk_CustomOption bboxOption = {
+  (Tk_OptionParseProc *) ZnBBoxParse,
+  (Tk_OptionPrintProc *) ZnBBoxPrint,
+  NULL
+};
+
 /*
- **********************************************************************************
+ * Information used for argv parsing.
+ */
+static Tk_ConfigSpec config_specs[] = {
+    {TK_CONFIG_CUSTOM, "-area", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, area), 0, &bboxOption},
+    {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, color_var), 0, NULL},
+    {TK_CONFIG_CUSTOM, "-colormode", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, colormode), 0, &psColorModeOption},
+    {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, filename), 0, NULL},
+    {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, channel_name), 0, NULL},
+    {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, font_var), 0, NULL},
+    {TK_CONFIG_BOOLEAN, "-landscape", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, landscape), 0, NULL},
+    {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, page_anchor), 0, NULL},
+    {TK_CONFIG_CUSTOM, "-pageheight", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, page_height), 0, &psDimOption},
+    {TK_CONFIG_CUSTOM, "-pagewidth", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, page_width), 0, &psDimOption},
+    {TK_CONFIG_CUSTOM, "-pagex", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, page_x), 0, &psDimOption},
+    {TK_CONFIG_CUSTOM, "-pagey", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, page_y), 0, &psDimOption},
+    {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL,
+	"", Tk_Offset(ZnPostScriptInfo, prolog), 0, NULL},
+    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+	(char *) NULL, 0, 0, NULL}
+};
+
+
+/*
+ *----------------------------------------------------------------------
  *
- * SetPostScriptFont --
+ * ZnPsDimParse
+ * ZnPsDimPrint --
+ *	Converter for the PostScript dimension options
+ *      (-pagex, -pagey, -pagewidth, -pageheight).
  *
- **********************************************************************************
+ *----------------------------------------------------------------------
  */
-static void
-SetPostScriptFont(ZnWInfo		*wi __unused,
-		  ZnPostScriptInfo	ps_info __unused,
-		  XFontStruct		*fs __unused)
+static int
+ZnPsDimParse(ClientData	client_data __unused,
+	     Tcl_Interp	*interp __unused,
+	     Tk_Window	tkwin __unused,
+	     Tcl_Obj	*ovalue,
+	     char	*widget_rec,
+	     int	offset)
 {
+  ZnReal *dim = (ZnReal *) (widget_rec + offset);
+#ifdef PTK
+  char	*value = Tcl_GetString(ovalue);
+#else
+  char	*value = (char *) ovalue;
+#endif
+  char	*end;
+  double d;
+
+  d = strtod(value, &end);
+  if (end == value) {
+  dim_error:
+    Tcl_AppendResult(interp, "bad distance \"", value, "\"", NULL);
+    return TCL_ERROR;
+  }
+
+  while ((*end != '\0') && isspace(UCHAR(*end))) {
+    end++;
+  }
+  
+  switch (*end) {
+  case 'c':
+    d *= 72.0/2.54;
+    end++;
+    break;
+  case 'i':
+    d *= 72.0;
+    end++;
+    break;
+  case 'm':
+    d *= 72.0/25.4;
+    end++;
+    break;
+  case 0:
+    break;
+  case 'p':
+    end++;
+    break;
+  default:
+    goto dim_error;
+  }
+
+  while ((*end != '\0') && isspace(UCHAR(*end))) {
+    end++;
+  }
+  if (*end != 0) {
+    goto dim_error;
+  }
+  *dim = d;
+
+  return TCL_OK;
 }
 
+static Tcl_Obj *
+ZnPsDimPrint(ClientData	client_data __unused,
+	     Tk_Window	tkwin __unused,
+	     char	*widget_rec,
+	     int	offset,
+#ifdef PTK
+	     Tcl_FreeProc **free_proc __unused
+#else
+	     Tcl_FreeProc **free_proc
+#endif
+)
+{
+  ZnReal *dim = (ZnReal *) (widget_rec + offset);
+  Tcl_Obj *obj = Tcl_NewDoubleObj(*dim);
+#ifdef PTK
+  return obj;
+#else
+ {
+   char *s1, *s2;
+
+   *free_proc = TCL_DYNAMIC;
+   s1 = Tcl_GetString(obj);
+   s2 = ZnMalloc(strlen(s1) + 1);
+   strcpy(s2, s1);
+   Tcl_DecrRefCount(obj);
+   return (Tcl_Obj *) s2;
+ }
+#endif
+}
 
 /*
- **********************************************************************************
+ *----------------------------------------------------------------------
  *
- * EmitPostScript --
+ * ZnPsColorModeParse
+ * ZnPsColorModePrint --
+ *	Converter for the PostScript -colormode option.
  *
- **********************************************************************************
+ *----------------------------------------------------------------------
  */
-static void
-EmitPostScript(ZnWInfo	*wi,
-	       FILE	*file,
-	       char	*title,
-	       ZnBool	landscape,
-	       int	color_mode,
-	       int	x_world,
-	       int	y_world,
-	       int	world_width,
-	       int	world_height,
-	       int	bbox_ox,
-	       int	bbox_oy,
-	       int	bbox_cx,
-	       int	bbox_cy)
+static int
+ZnPsColorModeParse(ClientData	client_data __unused,
+		   Tcl_Interp	*interp __unused,
+		   Tk_Window	tkwin __unused,
+		   Tcl_Obj	*ovalue,
+		   char		*widget_rec,
+		   int		offset)
 {
-  ZnPostScriptInfo	ps_info;
-  /*  double		scale;*/
-  ZnBBox		damaged_area, bbox;
-  ZnItem		current_item;
-  struct passwd		*pwd_info;
-  time_t		now;
-  char			*s;
-  XFontStruct		*fs;
-  int			i;
-
-  ps_info = (ZnPostScriptInfo) ZnMalloc(sizeof(ZnPostScriptStruct));
-  ps_info->file = file;
-  ps_info->title = title;
-  ps_info->landscape = landscape;
-  ps_info->color_mode = color_mode;
-  ps_info->x_world = x_world;
-  ps_info->y_world = y_world;
-  ps_info->world_width = world_width;
-  ps_info->world_height = world_height;
-  ps_info->page_bbox.orig.x = bbox_ox;
-  ps_info->page_bbox.orig.y = bbox_oy;
-  ps_info->page_bbox.corner.x = bbox_cx;
-  ps_info->page_bbox.corner.y = bbox_cy;
-  ps_info->fonts = ZnListNew(8, sizeof(XFontStruct *));
+  int	*mode = (int *) (widget_rec + offset);
+#ifdef PTK
+  char	*value = Tcl_GetString(ovalue);
+#else
+  char	*value = (char *) ovalue;
+#endif
+  int	result = TCL_OK;
 
-  /*
-   * Setup the new transform.
-   */
-  /*  scale = wi->scale;
-  damaged_area = wi->damaged_area;
-  wi->scale = ps_info->world_width /
-    (ps_info->page_bbox.orig.x - ps_info->page_bbox.corner.x);
-    ITEM_P.InvalidateItems(wi, ZnAny);*/
+  if (value != NULL) {
+    if (strcmp(value, "monochrome") == 0) {
+      *mode = 0;
+    }
+    else if (strcmp(value, "gray") == 0) {
+      *mode = 1;
+    }
+    else if (strcmp(value, "color") == 0) {
+      *mode = 2;
+    }
+    else {
+      Tcl_AppendResult(interp, " incorrect PostScript color mode \"",
+		       value, "\" should be \"monochrome\", \"gray\"",
+		       " or \"color\"", NULL);
+      result = TCL_ERROR;
+    }
+  }
+
+  return result;
+}
+
+static Tcl_Obj *
+ZnPsColorModePrint(ClientData	client_data __unused,
+		   Tk_Window	tkwin __unused,
+		   char		*widget_rec,
+		   int		offset,
+		   Tcl_FreeProc **free_proc __unused)
+{
+  int	*mode = (int *) (widget_rec + offset);
+  char	*s;
+
+  switch (*mode) {
+  case 0: s = "monochrome";
+    break;
+  case 1: s = "gray";
+    break;
+  case 2: s = "color";   
+    break;
+  default: s = "PsColorModeInvalid";
+    break;
+  }
+#ifdef PTK
+  return Tcl_NewStringObj(s, -1);
+#else
+  return (Tcl_Obj *) s;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZnBBoxParse
+ * ZnBBoxPrint --
+ *	Converter for the -area option.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ZnBBoxParse(ClientData	client_data __unused,
+	    Tcl_Interp	*interp __unused,
+	    Tk_Window	tkwin __unused,
+	    Tcl_Obj	*ovalue,
+	    char	*widget_rec,
+	    int		offset)
+{
+  ZnBBox  *bbox = (ZnBBox *) (widget_rec + offset);
+  int	  i, result, num_elems;
+  Tcl_Obj **elems;
+  double  d[4];
+
+  result = Tcl_ListObjGetElements(interp, ovalue, &num_elems, &elems);
+  if ((result == TCL_ERROR) ||
+      (num_elems != 0) ||
+      (num_elems != 4)) {
+  bbox_error:
+    Tcl_AppendResult(interp, " malformed area", NULL);
+    return TCL_ERROR;
+  }  
+
+  bbox->orig.x = bbox->orig.y = bbox->corner.x = bbox->corner.y = 0;
 
+  if (num_elems != 0) {
+    for (i = 0; i < 4; i++) {
+      result = Tcl_GetDoubleFromObj(interp, elems[0], &d[0]);
+      if (result == TCL_ERROR) {
+	goto bbox_error;
+      }
+    }
+    bbox->orig.x = d[0];
+    bbox->orig.y = d[1];
+    bbox->corner.x = d[2];
+    bbox->corner.y = d[3];
+  }
+
+  return TCL_OK;
+}
+
+static Tcl_Obj *
+ZnBBoxPrint(ClientData	client_data __unused,
+	    Tk_Window	tkwin __unused,
+	    char	*widget_rec,
+	    int		offset,
+#ifdef PTK
+	    Tcl_FreeProc **free_proc __unused
+#else
+	    Tcl_FreeProc **free_proc
+#endif
+	    )
+{
+  ZnBBox  *bbox = (ZnBBox *) (widget_rec + offset);  
+  Tcl_Obj *obj = NULL;
+
+  obj = Tcl_NewListObj(0, NULL);
+  Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bbox->orig.x));
+  Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bbox->orig.y));
+  Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bbox->corner.x));
+  Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bbox->corner.y));
+
+#ifdef PTK
+  return obj;
+#else
+  {
+    char *s1, *s2;
+
+    s1 = Tcl_GetString(obj);
+    s2 = ZnMalloc(strlen(s1) + 1);
+    strcpy(s2, s1);
+    Tcl_DecrRefCount(obj);
+    *free_proc = TCL_DYNAMIC;
+    return (Tcl_Obj *) s2;
+  }
+#endif
+}
+
+
+#if 0
+/*
+ **********************************************************************************
+ *
+ * EmitPostScript --
+ *
+ **********************************************************************************
+ */
   /*
    * Emit Encapsulated PostScript Header.
    */
@@ -194,16 +500,6 @@ EmitPostScript(ZnWInfo	*wi,
   /*
    * Iterate through all items emitting PostScript for each.
    */
-  current_item = ZnGroupTail(wi->top_group);
-  while (current_item != ZN_NO_ITEM) {
-    if (ISSET(current_item->flags, ZN_VISIBLE_BIT)) {
-      ZnIntersectBBox(&ps_info->page_bbox, &current_item->item_bounding_box, &bbox);
-      if (!ZnIsEmptyBBox(&bbox)) {
-	current_item->class->PostScript(current_item, ps_info);
-      }
-    }
-    current_item = current_item->previous;
-  }
 
   /*
    * Emit the page trailer.
@@ -221,30 +517,417 @@ EmitPostScript(ZnWInfo	*wi,
     s = "%%+ font";
   }
   fprintf(ps_info->file, "%%%%EOF\n");
+#endif
 
-  /*
-   * Restore the original transform.
-   */
-  /*wi->scale = scale;
-    ITEM_P.InvalidateItems(wi, ZnAny);*/
-  wi->damaged_area = damaged_area;
-
-
-  ZnListFree(ps_info->fonts);
-  ZnFree(ps_info);
+/*
+ *--------------------------------------------------------------
+ *
+ * ZnPostScriptY --
+ *
+ *	Given a y-coordinate in local coordinates, this procedure
+ *	returns a y-coordinate to use for PostScript output.
+ *
+ *--------------------------------------------------------------
+ */
+ZnReal
+ZnPostScriptY(ZnReal	y,
+	      void	*ps_info)
+{
+  return ((ZnPostScriptInfo *) ps_info)->area.corner.y - y;
 }
 
-
 /*
- **********************************************************************************
+ *----------------------------------------------------------------------------
  *
- * Exported functions struct --
+ * ZnPostScriptCmd --
  *
- **********************************************************************************
+ *	This procedure process the "postscript" command for
+ *	zinc widgets.
+ *
+ *----------------------------------------------------------------------------
  */
+int
+ZnPostScriptCmd(ZnWInfo	*wi,
+		int	argc,
+		Tcl_Obj	*CONST args[])
+{
+  ZnPostScriptInfo ps_info;
+  void		*old_info;
+  int		result;
+  int		delta_x = 0, delta_y = 0;
+  ZnReal	width, height;
+  CONST char	*p;
+  Tcl_DString	buffer;
+#define STRING_LENGTH 400
+  char		string[STRING_LENGTH+1];
+  ZnBBox	*area;
+  time_t	now;
+  Tcl_HashSearch search;
+  Tcl_HashEntry *entry;
+
+  old_info = wi->ps_info;
+  wi->ps_info = (void *) &ps_info;
+
+  /*
+   * A null area means print the currently visible area.
+   */
+  area = &ps_info.area;
+  area->orig.x = 0;
+  area->orig.y = 0;
+  area->corner.x = 0;
+  area->corner.y = 0;
+  /*
+   * Center the result on a letter format page
+   * The size will be deduced automatically from
+   * the area (default to a 1:1 scale along X axis).
+   */
+  ps_info.page_x = 72*4.25;
+  ps_info.page_y = 72*5.5;
+  ps_info.page_width = -1;
+  ps_info.page_height = -1;
+  ps_info.page_anchor = TK_ANCHOR_CENTER;
+
+  ps_info.landscape = False;
+  ps_info.font_var = NULL;
+  ps_info.color_var = NULL;
+  ps_info.colormode = 2;
+  ps_info.filename = NULL;
+  ps_info.channel_name = NULL;
+  ps_info.chan = NULL;
+  ps_info.prepass = False;
+  ps_info.prolog = True;
+  Tcl_InitHashTable(&ps_info.font_table, TCL_STRING_KEYS);
+  result = Tk_ConfigureWidget(wi->interp, wi->win, config_specs, argc-2,
+#ifdef PTK
+			      (Tcl_Obj **) args+2, (char *) &ps_info,
+			      TK_CONFIG_ARGV_ONLY
+#else
+			      (CONST char **) args+2, (char *) &ps_info,
+			      TK_CONFIG_ARGV_ONLY|TK_CONFIG_OBJS
+#endif
+);
+  if (result != TCL_OK) {
+    goto cleanup;
+  }
+
+  if ((area->corner.x - area->orig.x) == 0) {
+    area->orig.x = 0;
+    area->corner.x = Tk_Width(wi->win);
+  }
+  width = area->corner.x - area->orig.x;
+  if ((area->corner.y - area->orig.y) == 0) {
+    area->orig.y = 0;
+    area->corner.y = Tk_Height(wi->win);
+  }
+  height = area->corner.y - area->orig.y;
+
+  if ((ps_info.page_width < 0) || (ps_info.page_height < 0)) {
+    ZnReal scale;
+    if (ps_info.page_width >= 0) {
+      scale = ps_info.page_width / width;
+    }
+    else if (ps_info.page_height >= 0) {
+      scale = ps_info.page_height / height;
+    }
+    else {
+      scale = (72.0 / 25.4) * WidthMMOfScreen(Tk_Screen(wi->win));
+      scale /= WidthOfScreen(Tk_Screen(wi->win));
+    }
+    if (ps_info.page_width < 0) {
+      ps_info.page_width = width * scale;
+    }
+    if (ps_info.page_height < 0) {
+      ps_info.page_height = height * scale;
+    }
+  }
+
+  switch (ps_info.page_anchor) {
+  case TK_ANCHOR_NW:
+  case TK_ANCHOR_W:
+  case TK_ANCHOR_SW:
+    delta_x = 0;
+    break;
+  case TK_ANCHOR_N:
+  case TK_ANCHOR_CENTER:
+  case TK_ANCHOR_S:
+    delta_x = -width/2;
+    break;
+  case TK_ANCHOR_NE:
+  case TK_ANCHOR_E:
+  case TK_ANCHOR_SE:
+    delta_x = -width;
+    break;
+  }
+  switch (ps_info.page_anchor) {
+  case TK_ANCHOR_NW:
+  case TK_ANCHOR_N:
+  case TK_ANCHOR_NE:
+    delta_y = -height;
+    break;
+  case TK_ANCHOR_W:
+  case TK_ANCHOR_CENTER:
+  case TK_ANCHOR_E:
+    delta_y = -height/2;
+    break;
+  case TK_ANCHOR_SW:
+  case TK_ANCHOR_S:
+  case TK_ANCHOR_SE:
+    delta_y = 0;
+    break;
+  }
+
+  if (ps_info.filename != NULL) {
+
+    /*
+     * Check that -file and -channel are not both specified.
+     */
+    if (ps_info.channel_name != NULL) {
+      Tcl_AppendResult(wi->interp, "can't specify both -file and -channel", NULL);
+      result = TCL_ERROR;
+      goto cleanup;
+    }
+    
+    /*
+     * Check that we are not in a safe interpreter. If we are, disallow
+     * the -file specification.
+     */
+    if (Tcl_IsSafe(wi->interp)) {
+      Tcl_AppendResult(wi->interp, "can't specify -file in a safe interpreter", NULL);
+      result = TCL_ERROR;
+      goto cleanup;
+    }
+    
+    p = Tcl_TranslateFileName(wi->interp, ps_info.filename, &buffer);
+    if (p == NULL) {
+      goto cleanup;
+    }
+    ps_info.chan = Tcl_OpenFileChannel(wi->interp, p, "w", 0666);
+    Tcl_DStringFree(&buffer);
+    if (ps_info.chan == NULL) {
+      goto cleanup;
+    }
+  }
+
+  if (ps_info.channel_name != NULL) {
+    int mode;
+        
+    /*
+     * Check that the channel is found in this interpreter and that it
+     * is open for writing.
+     */
+    ps_info.chan = Tcl_GetChannel(wi->interp, ps_info.channel_name, &mode);
+    if (ps_info.chan == (Tcl_Channel) NULL) {
+      result = TCL_ERROR;
+      goto cleanup;
+    }
+    if ((mode & TCL_WRITABLE) == 0) {
+      Tcl_AppendResult(wi->interp, "channel \"", ps_info.channel_name,
+		       "\" wasn't opened for writing", NULL);
+      result = TCL_ERROR;
+      goto cleanup;
+    }
+  }
+
+  /*
+   *--------------------------------------------------------
+   * Make a pre-pass over all of the items, generating Postscript
+   * and then throwing it away.  The purpose of this pass is just
+   * to collect information about all the fonts in use, so that
+   * we can output font information in the proper form required
+   * by the Document Structuring Conventions.
+   *--------------------------------------------------------
+   */
+  ps_info.prepass = 1;
+
+  wi->top_group->class->PostScript(wi->top_group, True);
+  Tcl_ResetResult(wi->interp);
+
+  ps_info.prepass = 0;
+
+  /*
+   *--------------------------------------------------------
+   * Generate the header and prolog for the Postscript.
+   *--------------------------------------------------------
+   */
+  if (ps_info.prolog) {
+    ZnReal scale_x, scale_y;
+
+    scale_x = ps_info.page_width / width;
+    scale_y = ps_info.page_height/ height;
+
+    Tcl_AppendResult(wi->interp,
+		     "%!PS-Adobe-3.0 EPSF-3.0\n",
+		     "%%Creator: TkZinc Widget\n",
+		     NULL);
+#ifdef HAVE_PW_GECOS
+    if (!Tcl_IsSafe(wi->interp)) {
+      struct passwd *pw = getpwuid(getuid());
+      Tcl_AppendResult(wi->interp,
+		       "%%For: ", (pw != NULL) ? pw->pw_gecos : "Unknown", "\n",
+		       NULL);
+      endpwent();
+    }
+#endif /* HAVE_PW_GECOS */
+    Tcl_AppendResult(wi->interp,
+		     "%%Title: Window ", Tk_PathName(wi->win), "\n",
+		     NULL);
+    time(&now);
+    Tcl_AppendResult(wi->interp,
+		     "%%CreationDate: ", ctime(&now),
+		     NULL);
+
+    if (!ps_info.landscape) {
+      sprintf(string, "%d %d %d %d",
+	      (int) (ps_info.page_x + scale_x*delta_x),
+	      (int) (ps_info.page_y + scale_y*delta_y),
+	      (int) (ps_info.page_x + scale_x*(delta_x + width) + 1.0),
+	      (int) (ps_info.page_y + scale_y*(delta_y + height) + 1.0));
+    } else {
+      sprintf(string, "%d %d %d %d",
+	      (int) (ps_info.page_x - scale_x*(delta_y + height)),
+	      (int) (ps_info.page_y + scale_y*delta_x),
+	      (int) (ps_info.page_x - scale_x*delta_y + 1.0),
+	      (int) (ps_info.page_y + scale_y*(delta_x + width) + 1.0));
+    }
+    Tcl_AppendResult(wi->interp,
+		     "%%BoundingBox: ", string, "\n",
+		     NULL);
+    Tcl_AppendResult(wi->interp,
+		     "%%Pages: 1\n", 
+		     "%%DocumentData: Clean7Bit\n",
+		     NULL);
+    Tcl_AppendResult(wi->interp,
+		     "%%Orientation: ",
+		     ps_info.landscape ? "Landscape\n" : "Portrait\n",
+		     NULL);
+    p = "%%DocumentNeededResources: font ";
+    for (entry = Tcl_FirstHashEntry(&ps_info.font_table, &search);
+	 entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+      Tcl_AppendResult(wi->interp,
+		       p, Tcl_GetHashKey(&ps_info.font_table, entry), "\n",
+		       NULL);
+      p = "%%+ font ";
+    }
+    Tcl_AppendResult(wi->interp,
+		     "%%EndComments\n\n",
+		     NULL);
+    
+    /*
+     * Insert the prolog
+     */
+    Tcl_AppendResult(wi->interp,
+		     Tcl_GetVar(wi->interp,"::tk::ps_preamable", TCL_GLOBAL_ONLY),
+		     NULL);
+    
+    if (ps_info.chan != NULL) {
+      Tcl_Write(ps_info.chan, Tcl_GetStringResult(wi->interp), -1);
+      Tcl_ResetResult(wi->interp);
+    }
+
+    /*
+     *-----------------------------------------------------------
+     * Document setup:  set the color level and include fonts.
+     *-----------------------------------------------------------
+     */
+    sprintf(string, "/CL %d def\n", ps_info.colormode);
+    Tcl_AppendResult(wi->interp,
+		     "%%BeginSetup\n", string,
+		     NULL);
+    for (entry = Tcl_FirstHashEntry(&ps_info.font_table, &search);
+	 entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+      Tcl_AppendResult(wi->interp,
+		       "%%IncludeResource: font ",
+		       Tcl_GetHashKey(&ps_info.font_table, entry), "\n",
+		       NULL);
+    }
+    Tcl_AppendResult(wi->interp,
+		     "%%EndSetup\n\n",
+		     NULL);
+    
+    /*
+     *-----------------------------------------------------------
+     * Page setup:  move to page positioning point, rotate if
+     * needed, set scale factor, offset for proper anchor position,
+     * and set clip region.
+     *-----------------------------------------------------------
+     */
+    Tcl_AppendResult(wi->interp,
+		     "%%Page: 1 1\n",
+		     "save\n",
+		     NULL);
+    sprintf(string, "%.1f %.1f translate\n", ps_info.page_x, ps_info.page_y);
+    Tcl_AppendResult(wi->interp, string, NULL);
+    if (ps_info.landscape) {
+      Tcl_AppendResult(wi->interp,
+		       "90 rotate\n",
+		       NULL);
+    }
+    sprintf(string, "%.4g %.4g scale\n", scale_x, scale_y);
+    Tcl_AppendResult(wi->interp, string, NULL);
+    sprintf(string, "%d %d translate\n",
+	    (int) (delta_x - area->orig.x), (int) delta_y);
+    Tcl_AppendResult(wi->interp, string, NULL);
+    sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+	    (int) area->orig.x, ZnPostScriptY(area->orig.y, &ps_info),
+	    (int) area->corner.x, ZnPostScriptY(area->orig.y, &ps_info),
+	    (int) area->corner.x, ZnPostScriptY(area->corner.y, &ps_info),
+	    (int) area->orig.x, ZnPostScriptY(area->corner.y, &ps_info));
+    Tcl_AppendResult(wi->interp,
+		     string, " lineto closepath clip newpath\n",
+		     NULL);
+  }
+
+  if (ps_info.chan != NULL) {
+    Tcl_Write(ps_info.chan, Tcl_GetStringResult(wi->interp), -1);
+    Tcl_ResetResult(wi->interp);
+  }
+  
+  /*
+   *---------------------------------------------------------------------
+   * Second pass through all the items. This time PostScript is actually
+   * emitted.
+   *---------------------------------------------------------------------
+   */
+  wi->top_group->class->PostScript(wi->top_group, False);
+
+  /*
+   *---------------------------------------------------------------------
+   * Output page-end information, such as commands to print the page
+   * and document trailer stuff.
+   *---------------------------------------------------------------------
+   */
+  if (ps_info.prolog) {
+    Tcl_AppendResult(wi->interp,
+		     "restore showpage\n\n",
+		     "%%Trailer\nend\n%%EOF\n",
+		     NULL);
+  }
+  if (ps_info.chan != NULL) {
+    Tcl_Write(ps_info.chan, Tcl_GetStringResult(wi->interp), -1);
+    Tcl_ResetResult(wi->interp);
+  }
+
+ cleanup:
+  if (ps_info.font_var != NULL) {
+    ZnFree(ps_info.font_var);
+  }
+  if (ps_info.color_var != NULL) {
+    ZnFree(ps_info.color_var);
+  }
+  if (ps_info.filename != NULL) {
+    ZnFree(ps_info.filename);
+  }
+  if ((ps_info.chan != NULL) && (ps_info.channel_name == NULL)) {
+    Tcl_Close(wi->interp, ps_info.chan);
+  }
+  if (ps_info.channel_name != NULL) {
+    ZnFree(ps_info.channel_name);
+  }
+  Tcl_DeleteHashTable(&ps_info.font_table);
+  wi->ps_info = old_info;
+
+  return result;
+}
+
 
-struct _ZnPOSTSCRIPT ZnPOSTSCRIPT = {
-  EmitPostScript,
-  SetPostScriptFont
-};
 #endif /* _WIN32 */
diff --git a/generic/PostScript.h b/generic/PostScript.h
index e62786a..18939e4 100644
--- a/generic/PostScript.h
+++ b/generic/PostScript.h
@@ -39,43 +39,10 @@
 #include <X11/Xlib.h>
 
 
-/*
- * PostScript information record --
- */
-typedef struct _ZnPostScriptStruct {
-  FILE		*file;
-  char		*title;
-  ZnBool	landscape;
-  int		color_mode;
-  int		x_world;
-  int		y_world;
-  int		world_width;
-  int		world_height;
-  ZnBBox	page_bbox;
-  ZnList	fonts;
-} ZnPostScriptStruct, *ZnPostScriptInfo;
-
-
 struct _ZnWInfo;
 
 
-/*
- **********************************************************************************
- *
- * Methods defined in PostScript.c for internal use.
- *
- **********************************************************************************
- */
-
-extern struct _ZnPOSTSCRIPT {
-  void (*EmitPostScript)(struct _ZnWInfo *wi, FILE *file, char *title,
-			 ZnBool landscape, int color_mode,
-			 int x_world, int y_world, int world_width,
-			 int world_height, int bbox_ox, int bbox_oy,
-			 int bbox_cx, int bbox_cy);
-  void (*SetPostScriptFont)(struct _ZnWInfo *wi, ZnPostScriptInfo ps_info,
-			    XFontStruct *fs);
-} ZnPOSTSCRIPT;
+int ZnPostScriptCmd(struct _ZnWInfo *wi, int argc, Tcl_Obj *CONST *args);
 
 
 #endif	/* _PostScript_h */