view release on metacpan or  search on metacpan

PostScript.c  view on Meta::CPAN

      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.channelName != 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.channelName, &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.channelName,
                       "\" wasn't opened for writing", (char *) 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;
  result = wi->top_group->class->PostScript(wi->top_group, True, &ps_info.bbox);
  Tcl_ResetResult(wi->interp);
  /*
   * If an error occurred, just proceed with the main pass.
   * There's no need to report the error now;  it can be
   * reported later (errors can happen later that don't
   * happen now, so we still have to check for errors later
   * anyway).
   */
  ps_info.prepass = 0;

  /*
   *--------------------------------------------------------
   * Generate the header and prolog for the Postscript.
   *--------------------------------------------------------
   */
  if (ps_info.prolog) {
    Tcl_AppendResult(wi->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
                     "%%Creator: Tk Zinc Widget\n", (char *) NULL);
#ifdef HAVE_PW_GECOS
    if (!Tcl_IsSafe(wi->interp)) {
      struct passwd *pwPtr = getpwuid(getuid());  /* INTL: Native. */
      Tcl_AppendResult(wi->interp, "%%For: ",
                       (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
                       (char *) NULL);
      endpwent();
    }
#endif /* HAVE_PW_GECOS */
    Tcl_AppendResult(wi->interp, "%%Title: Window ", Tk_PathName(tkwin), "\n",
                     (char *) NULL);
    time(&now);
    /* INTL: Native. */
    Tcl_AppendResult(wi->interp, "%%CreationDate: ", ctime(&now), (char *) NULL);
    if (!ps_info.rotate) {
      sprintf(string, "%d %d %d %d", (int) (ps_info.pageX + ps_info.scale*delta_x),
              (int) (ps_info.pageY + ps_info.scale*delta_y),
              (int) (ps_info.pageX + ps_info.scale*(delta_x + ps_info.width) + 1.0),
              (int) (ps_info.pageY + ps_info.scale*(delta_y + ps_info.height) + 1.0));
    }
    else {
      sprintf(string, "%d %d %d %d",
              (int) (ps_info.pageX - ps_info.scale*(delta_y + ps_info.height)),
              (int) (ps_info.pageY + ps_info.scale*delta_x),
              (int) (ps_info.pageX - ps_info.scale*delta_y + 1.0),
              (int) (ps_info.pageY + ps_info.scale*(delta_x + ps_info.width) + 1.0));
    }
    Tcl_AppendResult(wi->interp, "%%BoundingBox: ", string, "\n", (char *) NULL);
    Tcl_AppendResult(wi->interp, "%%Pages: 1\n", "%%DocumentData: Clean7Bit\n",
                     (char *) NULL);
    Tcl_AppendResult(wi->interp, "%%Orientation: ",
                     ps_info.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
    p = "%%DocumentNeededResources: font ";
    for (entry = Tcl_FirstHashEntry(&ps_info.fontTable, &search); entry != NULL;
         entry = Tcl_NextHashEntry(&search)) {
      Tcl_AppendResult(wi->interp, p, Tcl_GetHashKey(&ps_info.fontTable, entry),
                       "\n", (char *) NULL);
      p = "%%+ font ";
    }
    Tcl_AppendResult(wi->interp, "%%EndComments\n\n", (char *) NULL);

    /*
     * Insert the prolog
     */
    Tcl_AppendResult(wi->interp, Tcl_GetVar(wi->interp,"::tk::ps_preamable",
                     TCL_GLOBAL_ONLY), (char *) 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.colorLevel);
    Tcl_AppendResult(wi->interp, "%%BeginSetup\n", string, (char *) NULL);
    for (entry = Tcl_FirstHashEntry(&ps_info.fontTable, &search); entry != NULL;
         entry = Tcl_NextHashEntry(&search)) {
      Tcl_AppendResult(wi->interp, "%%IncludeResource: font ",
      Tcl_GetHashKey(&ps_info.fontTable, entry), "\n", (char *) NULL);