[comp.sys.xerox] Fix for Postscriptstream landscape bug

mheffron@orion.oac.uci.edu (Matt Heffron) (06/15/90)

There was a bug in the OPENPOSTSCRIPTSTREAM in my PostScript ImageStream 
driver that Arun made available for FTP.  The correct version (of
OPENPOSTSCRIPTSTREAM) is below.  The problem was the coordinates were 
displaced off-page when doing landscape output (except for Tedit, which 
worked).  Apologies to all.

-Matt Heffron

(DEFINEQ
(OPENPOSTSCRIPTSTREAM
  [LAMBDA (FILE OPTIONS)                          (* ; "Edited 13-Jun-90 13:01 by Matt Heffron")
    (LET ([FP (OPENSTREAM FILE 'OUTPUT NIL `((EOL ,POSTSCRIPT.EOL)
                                             (TYPE POSTSCRIPT)
                                             (SEQUENTIAL T]
          (IMAGEDATA (create \POSTSCRIPTDATA))
          PAPER IMAGESIZEFACTOR CLIP REG ROTATION PAGEREGION)
         (replace (STREAM OUTCHARFN) of FP with '\FILEOUTCHARFN)
         (replace (STREAM IMAGEDATA) of FP with IMAGEDATA)
         (replace (STREAM IMAGEOPS) of FP with \POSTSCRIPTIMAGEOPS)
         (printout FP "%%!PS-Adobe-2.0" T "%%%%Title: " (MKSTRING (OR (LISTGET OPTIONS 
                                                                             'DOCUMENT.NAME)
                                                                      FILE))
                T 
                "%%%%Creator: PostScript ImageStream Driver Copyright Beckman Instruments and Savoir"
                T "%%%%CreationDate: " (DATE)
                T "%%%%For: " (if (STRING-EQUAL INITIALS "Edited:")
                                  then (MKSTRING USERNAME)
                                else INITIALS)
                T "%%%%EndComments" T)
         (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR FP X)
                                                       (\FILEOUTCHARFN FP (CHARCODE EOL)))
         (SETQ PAPER (OR (CDR (FASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE)
                                                      (LISTGET OPTIONS 'PAPERTYPE)
                                                      POSTSCRIPT.PAGETYPE))
                                     POSTSCRIPT.PAGEREGIONS))
                         (ERROR "Unknown PostScript page type" PAPER)))
         (if (NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR]
                           (CL:PLUSP IMAGESIZEFACTOR)))
             then (SETQ IMAGESIZEFACTOR 1))
         (if (AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR)
                      (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR))
             then (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR)))
         (printout FP "/imagesizefactor " IMAGESIZEFACTOR " def" T)
         (printout FP "%%%%EndSetup" T)
         (replace POSTSCRIPTSCALE of IMAGEDATA with \PS.SCALE0)
         (replace (STREAM OUTCHARFN) of FP with '\POSTSCRIPT.OUTCHARFN)
         (SETQ IMAGESIZEFACTOR (/ (TIMES 72 \PS.SCALE0)
                                  IMAGESIZEFACTOR))
         (SETQ PAGEREGION (\PS.SCALEREGION IMAGESIZEFACTOR (CAR PAPER)))
         (SETQ CLIP (\PS.SCALEREGION IMAGESIZEFACTOR (CADR PAPER)))
         (replace POSTSCRIPTPAGEREGION of IMAGEDATA with PAGEREGION)
         (replace POSTSCRIPTCLIPPINGREGION of IMAGEDATA with CLIP)

         (* ;; "If a REGION parameter was supplied, it establishes the initial margins.")

         (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION))
                            (INTERSECTREGIONS REG CLIP))
                       CLIP))
         (replace POSTSCRIPTLEFTMARGIN of IMAGEDATA with (fetch LEFT of REG))
         (replace POSTSCRIPTBOTTOMMARGIN of IMAGEDATA with (fetch BOTTOM of
                                                                                         REG))
         (replace POSTSCRIPTTOPMARGIN of IMAGEDATA with (PLUS (fetch BOTTOM
                                                                             of REG)
                                                                          (fetch HEIGHT
                                                                             of REG)
                                                                          -1))
         (replace POSTSCRIPTRIGHTMARGIN of IMAGEDATA with (PLUS (fetch LEFT
                                                                               of REG)
                                                                            (fetch WIDTH
                                                                               of REG)
                                                                            -1))
         (\DSPFONT.PSC FP (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS]
                                              DEFAULTFONT)
                                     NIL NIL NIL FP))
         [if (replace POSTSCRIPTHEADING of IMAGEDATA with (LISTGET OPTIONS
                                                                                 'HEADING))
             then (replace POSTSCRIPTHEADINGFONT of IMAGEDATA
                         with (if (LISTGET OPTIONS 'HEADINGFONT)
                                      then (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT)
                                                      NIL NIL NIL FP)
                                    else (fetch POSTSCRIPTFONT of IMAGEDATA]
         (if (if (EQL (SETQ ROTATION (CL:GETF OPTIONS 'ROTATION 'DEFAULT))
                              'DEFAULT)
                     then (if (EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK)
                                  then (MENU \POSTSCRIPT.ORIENTATION.MENU)
                                else POSTSCRIPT.PREFER.LANDSCAPE)
                   elseif (NUMBERP ROTATION)
                     then (NOT (ZEROP ROTATION))
                   else ROTATION)
             then (\DSPROTATE.PSC FP 90)
                   (replace POSTSCRIPTTRANSY of IMAGEDATA with (MINUS (fetch WIDTH
                                                                                     of 
                                                                                           PAGEREGION
                                                                                         ))) 

                   (* ;; "WIDTH not HEIGHT since \DSPROTATE.PSC creates a NEW region for POSTSCRIPTPAGEREGION, it doesn't destructively modify PAGEREGION")
)
         (POSTSCRIPT.STARTPAGE FP)
         FP])
]

welch@CIS.OHIO-STATE.EDU (Arun Welch) (07/12/90)

There was a bug in the OPENPOSTSCRIPTSTREAM in my PostScript ImageStream
driver that Arun made available for FTP.  The correct version (of
OPENPOSTSCRIPTSTREAM) is below.  The problem was the coordinates were
displaced off-page when doing landscape output (except for Tedit, which
worked).  Apologies to all.

-Matt Heffron

(DEFINEQ
(OPENPOSTSCRIPTSTREAM
  [LAMBDA (FILE OPTIONS)                          (* ; "Edited 13-Jun-90 13:01 by Matt Heffron")
    (LET ([FP (OPENSTREAM FILE 'OUTPUT NIL `((EOL ,POSTSCRIPT.EOL)
                                             (TYPE POSTSCRIPT)
                                             (SEQUENTIAL T]
          (IMAGEDATA (create \POSTSCRIPTDATA))
          PAPER IMAGESIZEFACTOR CLIP REG ROTATION PAGEREGION)
         (replace (STREAM OUTCHARFN) of FP with '\FILEOUTCHARFN)
         (replace (STREAM IMAGEDATA) of FP with IMAGEDATA)
         (replace (STREAM IMAGEOPS) of FP with \POSTSCRIPTIMAGEOPS)
         (printout FP "%%!PS-Adobe-2.0" T "%%%%Title: " (MKSTRING (OR (LISTGET OPTIONS
                                                                             'DOCUMENT.NAME)
                                                                      FILE))
                T
                "%%%%Creator: PostScript ImageStream Driver Copyright Beckman Instruments and Savoir"
                T "%%%%CreationDate: " (DATE)
                T "%%%%For: " (if (STRING-EQUAL INITIALS "Edited:")
                                  then (MKSTRING USERNAME)
                                else INITIALS)
                T "%%%%EndComments" T)
         (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR FP X)
                                                       (\FILEOUTCHARFN FP (CHARCODE EOL)))
         (SETQ PAPER (OR (CDR (FASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE)
                                                      (LISTGET OPTIONS 'PAPERTYPE)
                                                      POSTSCRIPT.PAGETYPE))
                                     POSTSCRIPT.PAGEREGIONS))
                         (ERROR "Unknown PostScript page type" PAPER)))
         (if (NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR]
                           (CL:PLUSP IMAGESIZEFACTOR)))
             then (SETQ IMAGESIZEFACTOR 1))
         (if (AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR)
                      (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR))
             then (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR)))
         (printout FP "/imagesizefactor " IMAGESIZEFACTOR " def" T)
         (printout FP "%%%%EndSetup" T)
         (replace POSTSCRIPTSCALE of IMAGEDATA with \PS.SCALE0)
         (replace (STREAM OUTCHARFN) of FP with '\POSTSCRIPT.OUTCHARFN)
         (SETQ IMAGESIZEFACTOR (/ (TIMES 72 \PS.SCALE0)
                                  IMAGESIZEFACTOR))
         (SETQ PAGEREGION (\PS.SCALEREGION IMAGESIZEFACTOR (CAR PAPER)))
         (SETQ CLIP (\PS.SCALEREGION IMAGESIZEFACTOR (CADR PAPER)))
         (replace POSTSCRIPTPAGEREGION of IMAGEDATA with PAGEREGION)
         (replace POSTSCRIPTCLIPPINGREGION of IMAGEDATA with CLIP)

         (* ;; "If a REGION parameter was supplied, it establishes the initial margins.")

         (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION))
                            (INTERSECTREGIONS REG CLIP))
                       CLIP))
         (replace POSTSCRIPTLEFTMARGIN of IMAGEDATA with (fetch LEFT of REG))
         (replace POSTSCRIPTBOTTOMMARGIN of IMAGEDATA with (fetch BOTTOM of
                                                                                         REG))
         (replace POSTSCRIPTTOPMARGIN of IMAGEDATA with (PLUS (fetch BOTTOM
                                                                             of REG)
                                                                          (fetch HEIGHT
                                                                             of REG)
                                                                          -1))
         (replace POSTSCRIPTRIGHTMARGIN of IMAGEDATA with (PLUS (fetch LEFT
                                                                               of REG)
                                                                            (fetch WIDTH
                                                                               of REG)
                                                                            -1))
         (\DSPFONT.PSC FP (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS]
                                              DEFAULTFONT)
                                     NIL NIL NIL FP))
         [if (replace POSTSCRIPTHEADING of IMAGEDATA with (LISTGET OPTIONS
                                                                                 'HEADING))
             then (replace POSTSCRIPTHEADINGFONT of IMAGEDATA
                         with (if (LISTGET OPTIONS 'HEADINGFONT)
                                      then (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT)
                                                      NIL NIL NIL FP)
                                    else (fetch POSTSCRIPTFONT of IMAGEDATA]
         (if (if (EQL (SETQ ROTATION (CL:GETF OPTIONS 'ROTATION 'DEFAULT))
                              'DEFAULT)
                     then (if (EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK)
                                  then (MENU \POSTSCRIPT.ORIENTATION.MENU)
                                else POSTSCRIPT.PREFER.LANDSCAPE)
                   elseif (NUMBERP ROTATION)
                     then (NOT (ZEROP ROTATION))
                   else ROTATION)
             then (\DSPROTATE.PSC FP 90)
                   (replace POSTSCRIPTTRANSY of IMAGEDATA with (MINUS (fetch WIDTH
                                                                                     of
                                                                                           PAGEREGION
                                                                                         )))

                   (* ;; "WIDTH not HEIGHT since \DSPROTATE.PSC creates a NEW region for POSTSCRIPTPAGEREGION, it doesn't destructively modify PAGEREGION")
)
         (POSTSCRIPT.STARTPAGE FP)
         FP])
]