From bad19ab45fe4d249fbc9ddd3a8e0ebae6314735f Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:48:21 -0700 Subject: [PATCH 01/18] PDFSTREAM: first implementation Makes PS file, then applies separate utility (if available) to convert PS to PDF --- library/PDFSTREAM | 228 +++++++++++++++++++++++++++++++++++++++++ library/PDFSTREAM.LCOM | Bin 0 -> 4918 bytes 2 files changed, 228 insertions(+) create mode 100644 library/PDFSTREAM create mode 100644 library/PDFSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM new file mode 100644 index 00000000..24fdd70a --- /dev/null +++ b/library/PDFSTREAM @@ -0,0 +1,228 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35 12465 + + :EDIT-BY rmk + + :PREVIOUS-DATE "24-Jun-2023 15:01:28" {WMEDLEY}PDFSTREAM.;34) + + +(PRETTYCOMPRINT PDFSTREAMCOMS) + +(RPAQQ PDFSTREAMCOMS + ([ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES EXPORTS.ALL (LOADCOMP) + POSTSCRIPTSTREAM)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (INITVARS (PDFCONVERTER 'ps2pdf)) + (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) + (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PDF-CONVERT) + (P (PDF-INIT)))) + +(ADDTOVAR PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) + +(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD EXPORTS.ALL (LOADCOMP) + POSTSCRIPTSTREAM) +) +(DEFINEQ + +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) + +(PDF.HARDCOPYW + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) + (PDF-CONVERT (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + FILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(RPAQ? PDFCONVERTER 'ps2pdf) + +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILE) + (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " ERRORFILE)) + +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) +) +(DEFINEQ + +(PDF-INIT + [LAMBDA NIL (* ; "Edited 23-Jun-2023 11:23 by rmk") + + (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") + + (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ + (FUNCTION CLOSE-PDF-STREAM]) + +(OPEN-PDF-STREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") + + (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") + + (* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ") + + (* ;; + "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.") + + (* ;; "") + + (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] + then + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie that and give it a PDF extension so it thinks that we are heading to a PDF printer.") + + (OPENPOSTSCRIPTSTREAM FILE OPTIONS) + else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) + PDF-CONVERTER-TEMPLATES)) + (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) + "-" + (RAND) + ".ps") + OPTIONS))) + (replace (STREAM IMAGEOPS) of PSSTREAM with \PDFIMAGEOPS) + + (* ;; "Hopefully the postscript implementation functions won't notice that we did a shift to get the IMAGETYPE and IMCLOSEFN") + + (replace (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) + of PSSTREAM) with FILE) + PSSTREAM]) + +(CLOSE-PDF-STREAM + [LAMBDA (PSSTREAM) (* ; "Edited 24-Jun-2023 13:57 by rmk") + + (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + + (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") + + (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") + + (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) + (PDF-CONVERT (CLOSEF PSSTREAM) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM]) + +(PDF-CONVERT + [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") + (* ; "Edited 16-Jul-2022 13:06 by rmk") + (* ; "Edited 8-Jul-2022 10:20 by rmk") + (* ; "Edited 7-May-2022 22:40 by rmk") + (* ; "Edited 7-Oct-2021 11:15 by rmk:") + + (* ;; "PSTMPFILENAME is the name of a closed PS file in a Unix tmp directory. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to TARGETPDFNAME. ") + + (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") + + (CL:UNLESS (INFILEP PSTMPFILENAME) + (ERROR "NO PS FILE TO CONVERT")) + (LET ((PDFTMPFILENAME (PACKFILENAME 'EXTENSION 'pdf 'BODY PSTMPFILENAME)) + (ERRORFILENAME (PACKFILENAME 'EXTENSION 'error 'BODY PSTMPFILENAME)) + COMPLETIONCODE) + + (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") + + (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") + + [SETQ COMPLETIONCODE (PROCESS-COMMAND + (CONCATLIST (SUBLIS `[(PSTMPFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY PSTMPFILENAME) + )) + (PDFTMPFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY + PDFTMPFILENAME))) + (ERRORFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY ERRORFILENAME] + (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV + "MEDLEY-PDFCONVERTER" + ))) + PDF-CONVERTER-TEMPLATES] + + (* ;; "Now use Medley names") + + (CLOSEF? PSTMPFILENAME) + (CL:UNLESS DONTDELETE (DELFILE PSTMPFILENAME)) + (CLOSEF? ERRORFILENAME) + (CL:WHEN (INFILEP ERRORFILENAME) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILENAME 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILENAME))) + 0) + (ERROR "Cannot create PDF file for " TARGETPDFNAME))) + (CL:WHEN (IGREATERP COMPLETIONCODE 0) + (ERROR "Cannot create PDF file for " TARGETPDFNAME)) + (RENAMEFILE PDFTMPFILENAME TARGETPDFNAME]) +) + +(PDF-INIT) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( +PDF.TEDIT 4633 . 5000)) (5378 12426 (PDF-INIT 5388 . 5957) (OPEN-PDF-STREAM 5959 . 8062) ( +CLOSE-PDF-STREAM 8064 . 8979) (PDF-CONVERT 8981 . 12424))))) +STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..2e961a9b83102bacf88ed999d18897340b244af5 GIT binary patch literal 4918 zcmb_fU2hxL5vA-VX^Ez23bzGpE0(j?Z6QoIYQk(D@lT^z~~?9Wf>1ZchqQX}R~ja%Itb(atPud4Eyue8pIg^{*?nev2}t@v?+%w`8|vY{4+FJms8yz^OX`tUi!6*6m zYY-bdmCD;CXwn)9bnop{W+Q(*3DmpqFoYw)59o9}!X+D%cyXXoP3>Ju;!J0gG)%O0 zXJ~1|0R`O-jpN{u1_T|F3^%vcH#%#G3QKng%*#Zl8E6OqMX71L&@6TN8jSW@ADS{m zKee?QXA1hh7&z->OP>{Q+w`JySblXoJ|C#>ePSNMA$KchA4+akV|j>9?j5$6+| zS_kns4>Tix5dic=v60hQ`hSUaR;WlW84|G8TqHr zPEO?B=B6`oblkV?!Y$)WO$m;Ns1)kvG*0J!X&iV@oG3)ONBNO#oPm8cgv9)2i!h=} zjgfh>euyWSv+q@|^TwU)-}3}q0O~GGMD(z6yGM_qw15}G>fXRyufa}~Ys|h9OyL-h zOHkJfI`qxY?iM|Ln5aK~BM7nz_9hY^3`r~?-sRFu!CEQ6yeWe1wAm zrSKo>3@DVCiCCl36x{V(nt$r+cuwvv!c6$6v8NC?4%lw3u8kVj`7|hE6b)LN;P)jI zA~O2^paB+U0y7YPoJJHPaJYxa!f+xsq2H0 zn#7M^voV`8$qanpMIDgujBNM~NsK5r!Vf_az5pstDHJESpR{NZk;a@Xi?d$7ca@?oNT*_T!x@_%!uls~fugd6YQ9Ggj=*gh6oV;oL} z7;m7PSVp#y$6t&JT+`yJfWz+tatCcn z(s-h>4E{EsGr8S998UO-3R9!orfh$VHn}~oWO>h~IT8rmEb_A%g0hQzWG7b82L(zo z=ps2=MF{l=>#;s~Z4V*bZ1kBJ_BcX~i9X#zY52H@@QwOrPtS1Qp3S6<5aM>b8$pCz zKq<-J_4+hJiblzpgU@)1PrI$%d=4;_IRn|n@^b3+%@klIGj?$Yn+DWvn+cshEmy1a z6?Je-QDsrvGoxOQ5Ut4b$}x^}9=3BPM`s+Mj#o?6&8!7IMd?mYv6q9CieUAlGu&No zdpMIgw}^3HsbERR>#)qkhI3WYAQHSb-!TK~l{WJhTkn+=bXwjZ#Zm zgH21ko+Py4v{xJ%}x{4`uOCa>f?=mGs!0Arh%G7eyZ@jrw;sR#C`%4BuDTk0**vCgEuE} zsF8kdB*w^>=5Y7h5gq^OHa z4~!Dy`5f8chWzPP?(14%v&wnH zxuwpgyuD%D*UM5{0W41N4~-ZHHcFN0r(;|OLH_?izwPX+T0FB1`IG4PBkZf156W$d z{qH=yjfM;?XqofS0`jL2vSgkOPbr1vgtH~>Zq6%5Fn5E1w3Ux096w;vlpc742bNNA za7U`;JaCX#Hj|i0f~lSOka|AGymjTsTIB?S`1K7M=PbNsk9A_%!aS_yv{X2J6*;2% EUwiL|*8l(j literal 0 HcmV?d00001 From f6a9b88b34c16ffe185be4fe867180b6ebe26ef2 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:49:18 -0700 Subject: [PATCH 02/18] POSTSCRIPTSTREAM: Adds extra field to postscript data for PDFSTREAM filename --- library/POSTSCRIPTSTREAM | 895 +++++++++++++++++----------------- library/POSTSCRIPTSTREAM.LCOM | Bin 91396 -> 91382 bytes 2 files changed, 448 insertions(+), 447 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 6d5a1729..80df2d18 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,9 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") -(FILECREATED "21-Jun-2021 20:29:32"  -{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;11 259283 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - previous date%: "12-Jun-2021 19:14:50" -{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;10) +(FILECREATED "24-Jun-2023 14:49:45" {WMEDLEY}POSTSCRIPTSTREAM.;13 258994 + + :EDIT-BY rmk + + :CHANGES-TO (FNS CLOSEPOSTSCRIPTSTREAM) + + :PREVIOUS-DATE "23-Jun-2023 12:05:56" {WMEDLEY}POSTSCRIPTSTREAM.;12) (* ; " @@ -14,7 +17,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQQ POSTSCRIPTSTREAMCOMS [ - (* ;; "PostScript printer support for Medley") + (* ;; "PostScript printer support for Medley") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) (INITRECORDS \POSTSCRIPTDATA) @@ -38,14 +41,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (ZAPFCHANCERY . ZC) (ZAPFDINGBATS . ZD))) - (* ;; "Font-reading code") + (* ;; "Font-reading code") (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS POSTSCRIPT.FONTSAVAILABLE) (COMS - (* ;; "Until macro in FONT is exported") + (* ;; "Until macro in FONT is exported") (MACROS \FSETCHARWIDTH)) (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) @@ -57,7 +60,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC \SWITCHFONTS.PSC \TERPRI.PSC) - (* ;; "DIG operations: ") + (* ;; "DIG operations: ") (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC @@ -67,19 +70,18 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) (COMS - (* ;; "Character-output, plus special-cases:") + (* ;; "Character-output, plus special-cases:") (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN \POSTSCRIPT.ACCENTPAIR) - (* ;; - "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + (* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) - (* ;; - "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + (* ;; + "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") (FNS \POSTSCRIPT.NSHASH) (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) @@ -176,7 +178,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (CREATECHARSET \CREATECHARSET.PSC] (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) - (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") + (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) NIL @@ -213,57 +215,59 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) (DATATYPE \POSTSCRIPTDATA - ((POSTSCRIPTACCENTED FLAG) (* ; - "T if we're to do NS-to-PS translations on characters in the current font.") - POSTSCRIPTFONT (* ; - "The fontdescriptor of the current font") - POSTSCRIPTX (* ; "The current X") - POSTSCRIPTY (* ; "... and Y") - POSTSCRIPTLEFTMARGIN (* ; "The margins") + ((POSTSCRIPTACCENTED FLAG) (* ; + "T if we're to do NS-to-PS translations on characters in the current font.") + POSTSCRIPTFONT (* ; + "The fontdescriptor of the current font") + POSTSCRIPTX (* ; "The current X") + POSTSCRIPTY (* ; "... and Y") + POSTSCRIPTLEFTMARGIN (* ; "The margins") POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING - (* ; "Line to line spacing") - POSTSCRIPTCOLOR (* ; - "Color (or grey shade) in effect; 0.0=black, 1.0=white.") - POSTSCRIPTSCALE (* ; "Scale of the stream") - POSTSCRIPTOPERATION (* ; - "Default operation (PAINT, REPLACE, ...)") - POSTSCRIPTCLIPPINGREGION (* ; - "The current region available to be written into") - POSTSCRIPTPAGENUM (* ; "Current page number") - POSTSCRIPTHEADING (* ; "The heading") - POSTSCRIPTHEADINGFONT (* ; "Font for the heading") - POSTSCRIPTSPACEFACTOR (* ; - "Expansion factor for spaces (see DSPSPACEFACTOR)") - POSTSCRIPTSPACEWIDTH (* ; - "The width of a space in the current font") - POSTSCRIPTLANDSCAPE (* ; - "non-NIL for paper in 'landscape' mode") - POSTSCRIPTCHARSTOSHOW (* ; - "non-NIL if the string (PostScript-type string) of chars has already been started") - POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") - POSTSCRIPTMOVEFLG (* ; "Need to move") - POSTSCRIPTWIDTHS (* ; - "The widths vector of the current font") - POSTSCRIPTTRANSX (* ; "Translation in X") - POSTSCRIPTTRANSY (* ; "... and Y") - POSTSCRIPTPENDINGXFORM (* ; - "A userspace to devicespace transform is pending") - POSTSCRIPTPAGEREGION (* ; "The whole page") - POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") - POSTSCRIPTSCALEHACK (* ; - "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") - POSTSCRIPTTEMPARRAY (* ; - "For converting FIXP to string of digit chars") - POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") - POSTSCRIPTROTATION (* ; - "Rotation value currently in effect.") - POSTSCRIPTPENDINGROTATION (* ; - "Rotation to take effect at next SETXFORM.") - POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") - (POSTSCRIPTNSCHARSET BYTE) (* ; - "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") - (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; - "Width of the space in the current font, used to compute the scaled space width.") + (* ; "Line to line spacing") + POSTSCRIPTCOLOR (* ; + "Color (or grey shade) in effect; 0.0=black, 1.0=white.") + POSTSCRIPTSCALE (* ; "Scale of the stream") + POSTSCRIPTOPERATION (* ; + "Default operation (PAINT, REPLACE, ...)") + POSTSCRIPTCLIPPINGREGION (* ; + "The current region available to be written into") + POSTSCRIPTPAGENUM (* ; "Current page number") + POSTSCRIPTHEADING (* ; "The heading") + POSTSCRIPTHEADINGFONT (* ; "Font for the heading") + POSTSCRIPTSPACEFACTOR (* ; + "Expansion factor for spaces (see DSPSPACEFACTOR)") + POSTSCRIPTSPACEWIDTH (* ; + "The width of a space in the current font") + POSTSCRIPTLANDSCAPE (* ; + "non-NIL for paper in 'landscape' mode") + POSTSCRIPTCHARSTOSHOW (* ; + "non-NIL if the string (PostScript-type string) of chars has already been started") + POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") + POSTSCRIPTMOVEFLG (* ; "Need to move") + POSTSCRIPTWIDTHS (* ; + "The widths vector of the current font") + POSTSCRIPTTRANSX (* ; "Translation in X") + POSTSCRIPTTRANSY (* ; "... and Y") + POSTSCRIPTPENDINGXFORM (* ; + "A userspace to devicespace transform is pending") + POSTSCRIPTPAGEREGION (* ; "The whole page") + POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") + POSTSCRIPTSCALEHACK (* ; + "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") + POSTSCRIPTTEMPARRAY (* ; + "For converting FIXP to string of digit chars") + POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") + POSTSCRIPTROTATION (* ; + "Rotation value currently in effect.") + POSTSCRIPTPENDINGROTATION (* ; + "Rotation to take effect at next SETXFORM.") + POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") + (POSTSCRIPTNSCHARSET BYTE) (* ; + "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") + (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; + "Width of the space in the current font, used to compute the scaled space width.") + POSTSCRIPTTARGETINFO (* ; + "For use of other imagetypes (like PDF) that might piggy-back on postscript.") ) POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY @@ -271,28 +275,28 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) (RECORD POSTSCRIPTXFORM ( - (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") + (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") - PSXCLIP (* ; "Clipping region") - PSXPAGE (* ; "Page region") - PSXX (* ; "X position?") - PSXY (* ; "Y position?") - PSXLEFT (* ; "Left margin") - PSXRIGHT (* ; "Right margin") - PSXTOP (* ; "Top margin") - PSXBOTTOM (* ; "Bottom Margin") - PSXTRANX (* ; "X-translation in effect") - PSXTRANY (* ; "Y-translation in effect") - PSXLAND (* ; "Landscape?") - PSXXFORMPEND (* ; "Are there transforms pending? ") - )) + PSXCLIP (* ; "Clipping region") + PSXPAGE (* ; "Page region") + PSXX (* ; "X position?") + PSXY (* ; "Y position?") + PSXLEFT (* ; "Left margin") + PSXRIGHT (* ; "Right margin") + PSXTOP (* ; "Top margin") + PSXBOTTOM (* ; "Bottom Margin") + PSXTRANX (* ; "X-translation in effect") + PSXTRANY (* ; "Y-translation in effect") + PSXLAND (* ; "Landscape?") + PSXXFORMPEND (* ; "Are there transforms pending? ") + )) ) (/DECLAREDATATYPE '\POSTSCRIPTDATA '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD) + BYTE WORD POINTER) '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) (\POSTSCRIPTDATA 0 POINTER) (\POSTSCRIPTDATA 2 POINTER) @@ -328,15 +332,16 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (\POSTSCRIPTDATA 62 POINTER) (\POSTSCRIPTDATA 64 POINTER) (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15))) - '68) + (\POSTSCRIPTDATA 67 (BITS . 15)) + (\POSTSCRIPTDATA 68 POINTER)) + '70) ) (/DECLAREDATATYPE '\POSTSCRIPTDATA '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD) + BYTE WORD POINTER) '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) (\POSTSCRIPTDATA 0 POINTER) (\POSTSCRIPTDATA 2 POINTER) @@ -372,8 +377,9 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (\POSTSCRIPTDATA 62 POINTER) (\POSTSCRIPTDATA 64 POINTER) (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15))) - '68) + (\POSTSCRIPTDATA 67 (BITS . 15)) + (\POSTSCRIPTDATA 68 POINTER)) + '70) (DEFINEQ (POSTSCRIPT.INIT @@ -486,24 +492,24 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ) (ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) (ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD)) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD)) @@ -1112,11 +1118,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (DECLARE%: EVAL@COMPILE (PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) - (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) - of (\GETCHARSETINFO (\CHARSET CHARCODE) - FONTDESC)) - (\CHAR8CODE CHARCODE) - WIDTH))) + (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO + (\CHARSET CHARCODE) + FONTDESC)) + (\CHAR8CODE CHARCODE) + WIDTH))) ) (DEFINEQ @@ -1260,11 +1266,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen STREAM]) (CLOSEPOSTSCRIPTSTREAM - [LAMBDA (STREAM) (* ; "Edited 8-Mar-93 10:31 by jds") - (POSTSCRIPT.ENDPAGE STREAM) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL) - (* BOUT STREAM (CHARCODE ^D)) - ]) + [LAMBDA (STREAM) (* ; "Edited 24-Jun-2023 13:48 by rmk") + (* ; "Edited 8-Mar-93 10:31 by jds") + (POSTSCRIPT.ENDPAGE STREAM) (* BOUT STREAM (CHARCODE ^D)) + (* ; "Should this be the lsat byte?") + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL]) ) (RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) @@ -3537,210 +3543,210 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* ( - (* ;; "Mapping of NS characters to Postscript renderings.") + (* ;; "Mapping of NS characters to Postscript renderings.") - (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") + (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") ("^S" NIL "2,320") - (* ; "pressfont em dash") + (* ; "pressfont em dash") ("^V" NIL "2,261") - (* ; "pressfont en dash") + (* ; "pressfont en dash") ("^G" NIL "0,140") ("0,244" NIL "2,250") - (* ; "generic currency symbol") + (* ; "generic currency symbol") ("0,251" NIL "2,140") - (* ; "left single quote") + (* ; "left single quote") ("0,254" SYMBOL "2,254") - (* ; "left arrow") + (* ; "left arrow") ("0,255" SYMBOL "2,255") - (* ; "uparrow") + (* ; "uparrow") ("0,256" SYMBOL "2,256") - (* ; "right arrow") + (* ; "right arrow") ("0,257" SYMBOL "2,257") - (* ; "down arrow") + (* ; "down arrow") ("0,260" SYMBOL "2,260") - (* ; "degree") + (* ; "degree") ("0,261" SYMBOL "2,261") - (* ; "+/-") + (* ; "+/-") ("0,264" SYMBOL "2,264") - (* ; "times") + (* ; "times") ("0,267" NIL "2,264") - (* ; "Center-dot") + (* ; "Center-dot") ("0,270" SYMBOL "2,270") - (* ; "divide") + (* ; "divide") ("0,271" NIL "2,047") - (* ; "right single quote") + (* ; "right single quote") ("0,274" FUNCTION " f14 ") - (* ; "1/4") + (* ; "1/4") ("0,275" FUNCTION " f12 ") - (* ; "1/2") + (* ; "1/2") ("0,276" FUNCTION " f34 ") - (* ; "3/4") + (* ; "3/4") ("0,322" SYMBOL "2,342") - (* ; "registered") + (* ; "registered") ("0,323" SYMBOL "2,343") - (* ; "copyright") + (* ; "copyright") ("0,324" SYMBOL "2,344") - (* ; "tm") + (* ; "tm") ("0,334" FUNCTION " f18 ") - (* ; "1/8") + (* ; "1/8") ("0,335" FUNCTION " f38 ") - (* ; "3/8") + (* ; "3/8") ("0,336" FUNCTION " f58 ") - (* ; "5/8") + (* ; "5/8") ("0,337" FUNCTION " f78 ") - (* ; "7/8") + (* ; "7/8") ("0,342" NIL "2,235") - (* ; "Eth (slashed D?)") + (* ; "Eth (slashed D?)") ("0,354" NIL "2,237") - (* ; "Thorn") + (* ; "Thorn") ("0,363" NIL "2,236") - (* ; "eth") + (* ; "eth") ("0,374" NIL "2,240") - (* ; "thorn") + (* ; "thorn") ("41,172" DINGBAT "0,110") - (* ; "filled star") + (* ; "filled star") ("42,42" DINGBAT "0,161") - (* ; "ballot-box") + (* ; "ballot-box") ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) - (* ; "Checked ballot-box") + (* ; "Checked ballot-box") ("357,44" NIL "2,261") - (* ; "n dash") + (* ; "n dash") ("357,45" NIL "2,320") - (* ; "m dash") + (* ; "m dash") ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "M quad") + (* ; "M quad") ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "N quad") + (* ; "N quad") ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "FIGURE quad") + (* ; "FIGURE quad") ("357,57" APPLY* ("M" 0.2) \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "This space (1/5M)") + (* ; "This space (1/5M)") ("357,60" NIL "2,262") - (* ; "dagger") + (* ; "dagger") ("357,61" NIL "2,263") - (* ; "double dagger") + (* ; "double dagger") ("357,062" SYMBOL "2,361") - (* ; "angleright") + (* ; "angleright") ("357,063" SYMBOL "2,341") - (* ; "angleleft") + (* ; "angleleft") ("357,70" SYMBOL "2,315") - (* ; "perpendicular") + (* ; "perpendicular") ("357,101" NIL "2,275") - (* ; "per mil o/oo") + (* ; "per mil o/oo") ("357,104" ACCENTPAIR "<" NIL "/") - (* ; "not less than") + (* ; "not less than") ("357,105" ACCENTPAIR ">" "/") - (* ; "not greater than") + (* ; "not greater than") ("357,110" SYMBOL "2,312") - (* ; "parallel") + (* ; "parallel") ("357,111" SYMBOL "2,315") - (* ; "not parallel") + (* ; "not parallel") ("357,112" SYMBOL "2,316") - (* ; "element") + (* ; "element") ("357,113" SYMBOL "2,317") - (* ; "notelement") + (* ; "notelement") ("357,114" SYMBOL "2,047") - (* ; "suchthat") + (* ; "suchthat") ("357,115" SYMBOL "2,334") - (* ; "implied by, double arrow left") + (* ; "implied by, double arrow left") ("357,116" SYMBOL "2,333") - (* ; "iff, double arrow") + (* ; "iff, double arrow") ("357,117" SYMBOL "2,336") - (* ; "implies, double arrow right") + (* ; "implies, double arrow right") ("357,120" SYMBOL "2,253") - (* ; "double arrow") + (* ; "double arrow") ("357,121" SYMBOL "2,333") - (* ; "double arrow") + (* ; "double arrow") ("357,122" SYMBOL "2,333") - (* ; "l/r arrow") + (* ; "l/r arrow") ("357,126" SYMBOL "2,307") - (* ; "intersection") + (* ; "intersection") ("357,127" SYMBOL "2,310") - (* ; "union") + (* ; "union") ("357,130" SYMBOL "2,312") - (* ; "reflexsuperset") + (* ; "reflexsuperset") ("357,131" SYMBOL "2,315") - (* ; "reflexsubset") + (* ; "reflexsubset") ("357,132" SYMBOL "2,311") - (* ; "propersuperset") + (* ; "propersuperset") ("357,133" SYMBOL "2,314") - (* ; "propersubset") + (* ; "propersubset") ("357,137" SYMBOL "2,313") - (* ; "notsubset") + (* ; "notsubset") ("357,141" SYMBOL "2,306") - (* ; "emptyset") + (* ; "emptyset") ("357,142" SYMBOL "2,305") - (* ; "circleplus") + (* ; "circleplus") ("357,144" SYMBOL "2,304") - (* ; "circlemultiply") + (* ; "circlemultiply") ("357,146" NIL "2,267") - (* ; "bullet") + (* ; "bullet") ("357,147" SYMBOL "2,260") - (* ; - "center circle (composition), lowered degree") + (* ; + "center circle (composition), lowered degree") ("357,152" SYMBOL "2,330") - (* ; "logicalnot") + (* ; "logicalnot") ("357,154" SYMBOL "2,320") - (* ; "angle") + (* ; "angle") ("357,160" SYMBOL "2,136") - (* ; "perpendicular") + (* ; "perpendicular") ("357,161" SYMBOL "2,265") - (* ; "proportional") + (* ; "proportional") ("357,162" SYMBOL "2,272") - (* ; "equivalence") + (* ; "equivalence") ("357,165" SYMBOL "2,362") - (* ; "integral") + (* ; "integral") ("357,167" SYMBOL "2,273") - (* ; "approxequal") + (* ; "approxequal") ("357,170" SYMBOL "2,100") - (* ; "congruent") + (* ; "congruent") ("357,172" SYMBOL "2,345") - (* ; "summation") + (* ; "summation") ("357,173" SYMBOL "2,325") - (* ; "product") + (* ; "product") ("357,174" SYMBOL "2,326") - (* ; "radical") + (* ; "radical") ("357,242" SYMBOL "2,246") - (* ; "florin") + (* ; "florin") ("357,260" SYMBOL "2,351") - (* ; "Ceiling, left ") + (* ; "Ceiling, left ") ("357,261" SYMBOL "2,371") - (* ; "Ceiling, right") + (* ; "Ceiling, right") ("357,262" SYMBOL "2,353") - (* ; "Floor, left ") + (* ; "Floor, left ") ("357,263" SYMBOL "2,373") - (* ; "Floor, right") + (* ; "Floor, right") ("357,264" SYMBOL "2,44") - (* ; "exists") + (* ; "exists") ("357,265" SYMBOL "2,42") - (* ; "forall") + (* ; "forall") ("357,266" SYMBOL "2,331") - (* ; "logicaland") + (* ; "logicaland") ("357,267" SYMBOL "2,332") - (* ; "logicalor") + (* ; "logicalor") ("357,271" SYMBOL "2,321") - (* ; "gradient") + (* ; "gradient") ("357,272" SYMBOL "2,266") - (* ; "partialdiff") + (* ; "partialdiff") ("357,313" SYMBOL "2,252") - (* ; "spade") + (* ; "spade") ("357,317" DINGBAT "0,63") - (* ; "check") + (* ; "check") ("357,375" FUNCTION " f13 ") - (* ; "1/3") + (* ; "1/3") ("357,376" FUNCTION " f23 ") - (* ; "2/3") + (* ; "2/3") ("361,041" ACCENT "0,4" A) ("361,042" ACCENT "0,1" A) ("361,043" ACCENT "0,2" A) ("361,044" ACCENT "0,6" A) ("361,045" ACCENTPAIR A "0,305") - (* ; "A-macron") + (* ; "A-macron") ("361,046" ACCENTPAIR A "0,306") - (* ; "A-breve") + (* ; "A-breve") ("361,047" ACCENT "0,3" A) ("361,050" ACCENT "0,5" A) ("361,055" ACCENT "0,7" C) @@ -3748,15 +3754,15 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,061" ACCENT "0,10" E) ("361,062" ACCENT "0,11" E) ("361,063" ACCENTPAIR E "0,305") - (* ; "E-macron") + (* ; "E-macron") ("361,065" ACCENT "0,12" E) ("361,066" ACCENTPAIR E NIL "0,316") - (* ; "E-ogonek") + (* ; "E-ogonek") ("361,076" ACCENT "0,17" I) ("361,077" ACCENT "0,14" I) ("361,100" ACCENT "0,15" I) ("361,102" ACCENTPAIR I "0,305") - (* ; "I-macron") + (* ; "I-macron") ("361,104" ACCENT "0,16" I) ("361,114" ACCENT "0,20" N) ("361,117" ACCENT "0,24" O) @@ -3764,31 +3770,31 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,121" ACCENT "0,22" O) ("361,122" ACCENT "0,25" O) ("361,123" ACCENTPAIR O "0,305") - (* ; "O-macron") + (* ; "O-macron") ("361,124" ACCENT "0,23" O) ("361,134" ACCENT "0,26" S) ("361,137" ACCENT "0,32" U) ("361,140" ACCENT "0,27" U) ("361,141" ACCENT "0,30" U) ("361,143" ACCENTPAIR U "0,305") - (* ; "U-macron") + (* ; "U-macron") ("361,145" ACCENT "0,31" U) ("361,155" ACCENT "0,33" Y) ("361,160" ACCENT "0,34" Z) ("361,165" ACCENTPAIR Y "0,305") - (* ; "Y-macron") + (* ; "Y-macron") ("361,166" ACCENTPAIR "0,341" "0,305") - (* ; "AE-macron") + (* ; "AE-macron") ("361,167" ACCENTPAIR "0,352" "0,305") - (* ; "OE-macron") + (* ; "OE-macron") ("361,241" ACCENT "0,204" a) ("361,242" ACCENT "0,201" a) ("361,243" ACCENT "0,202" a) ("361,244" ACCENT "0,206" a) ("361,245" ACCENTPAIR a "0,305") - (* ; "a-macron") + (* ; "a-macron") ("361,246" ACCENTPAIR a "0,306") - (* ; "a-breve") + (* ; "a-breve") ("361,247" ACCENT "0,203" a) ("361,250" ACCENT "0,205" a) ("361,255" ACCENT "0,207" c) @@ -3796,17 +3802,17 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,261" ACCENT "0,210" e) ("361,262" ACCENT "0,211" e) ("361,263" ACCENTPAIR e "0,305") - (* ; "e-macron") + (* ; "e-macron") ("361,265" ACCENT "0,212" e) ("361,266" ACCENTPAIR e NIL "0,316") - (* ; "e-ogonek") + (* ; "e-ogonek") ("361,267" ACCENTPAIR e "0,317") - (* ; "e-caron") + (* ; "e-caron") ("361,276" ACCENT "0,217" i) ("361,277" ACCENT "0,214" i) ("361,300" ACCENT "0,215" i) ("361,302" ACCENTPAIR "0,365" "0,305") - (* ; "i-macron") + (* ; "i-macron") ("361,304" ACCENT "0,216" i) ("361,314" ACCENT "0,220" n) ("361,317" ACCENT "0,224" o) @@ -3814,246 +3820,246 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,321" ACCENT "0,222" o) ("361,322" ACCENT "0,225" o) ("361,323" ACCENTPAIR o "0,305") - (* ; "o-macron") + (* ; "o-macron") ("361,324" ACCENT "0,223" o) ("361,334" ACCENT "0,226" s) ("361,337" ACCENT "0,232" u) ("361,340" ACCENT "0,227" u) ("361,341" ACCENT "0,230" u) ("361,343" ACCENTPAIR u "0,305") - (* ; "u-macron") + (* ; "u-macron") ("361,344" ACCENTPAIR u "0,306") - (* ; "u-breve") + (* ; "u-breve") ("361,345" ACCENT "0,231" u) ("361,355" ACCENT "0,233" y) ("361,360" ACCENT "0,234" z) ("361,365" ACCENTPAIR y "0,305") - (* ; "y-macron") + (* ; "y-macron") ("361,366" ACCENTPAIR "0,361" "0,305") - (* ; "ae-macron") + (* ; "ae-macron") ("361,367" ACCENTPAIR "0,372" "0,305") - (* ; "oe-macron") + (* ; "oe-macron") ("361,371" ACCENTPAIR a "0,317") - (* ; "a-caron") + (* ; "a-caron") ("361,375" ACCENTPAIR g "0,317") - (* ; "g-caron") + (* ; "g-caron") - (* ;; "Special code assignments for Dictionary of Old English, UToronto:") + (* ;; "Special code assignments for Dictionary of Old English, UToronto:") ("361,370" ACCENTPAIR a ("0,305" "0,306")) - (* ; "a - breve-macron") + (* ; "a - breve-macron") ("361,372" ACCENTPAIR e "0,306") - (* ; "e-breve") + (* ; "e-breve") ("361,373" ACCENTPAIR e "0,305" "0,56") - (* ; "e macron underdot") + (* ; "e macron underdot") ("361,374" ACCENTPAIR e ("0,305" "0,306")) - (* ; "e - breve-macron") + (* ; "e - breve-macron") ("361,376" ACCENTPAIR "0,365" "0,306") - (* ; "i-breve") + (* ; "i-breve") ("362,242" ACCENTPAIR "0,365" "0,317") - (* ; "i-caron") + (* ; "i-caron") ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) - (* ; " i - breve-macron") + (* ; " i - breve-macron") ("362,243" ACCENTPAIR n "0,305") - (* ; "n-macron") + (* ; "n-macron") ("362,244" ACCENTPAIR m "0,305") - (* ; "m-macron") + (* ; "m-macron") ("362,245" ACCENTPAIR o "0,317") - (* ; "o-caron") + (* ; "o-caron") ("362,246" ACCENTPAIR o "0,306") - (* ; "o-breve") + (* ; "o-breve") ("362,247" ACCENTPAIR o ("0,305" "0,306")) - (* ; "o - breve-macron") + (* ; "o - breve-macron") ("362,250" ACCENTPAIR o "0,305" "0,56") - (* ; "o-macron underdot") + (* ; "o-macron underdot") ("362,251" ACCENTPAIR o "0,316") - (* ; "o-ogonek") + (* ; "o-ogonek") ("362,252" ACCENTPAIR u "0,317") - (* ; "u-caron") + (* ; "u-caron") ("362,253" ACCENTPAIR u ("0,305" "0,306")) - (* ; "u - breve-macron") + (* ; "u - breve-macron") ("362,254" ACCENTPAIR y "0,306") - (* ; "y-breve") + (* ; "y-breve") ("362,256" ACCENTPAIR y "0,317") - (* ; "y-caron") + (* ; "y-caron") ("362,255" ACCENTPAIR y ("0,305" "0,306")) - (* ; "y - breve-macron") - (* ; "235 = Eth") - (* ; "236 = eth") - (* ; "237 = Thorn") - (* ; "240 = thorn") + (* ; "y - breve-macron") + (* ; "235 = Eth") + (* ; "236 = eth") + (* ; "237 = Thorn") + (* ; "240 = thorn") - (* ;; "NS Greek characters") + (* ;; "NS Greek characters") ("46,101" SYMBOL "2,101") - (* ; "Alpha") + (* ; "Alpha") ("46,102" SYMBOL "2,102") - (* ; "Beta") + (* ; "Beta") ("46,103" SYMBOL 0) - (* ; "--empty--") + (* ; "--empty--") ("46,104" SYMBOL "2,107") - (* ; "Gamma") + (* ; "Gamma") ("46,105" SYMBOL "2,104") - (* ; "Delta") + (* ; "Delta") ("46,106" SYMBOL "2,105") - (* ; "Epsilon") + (* ; "Epsilon") ("46,107" SYMBOL 0) - (* ; "Stigma") + (* ; "Stigma") ("46,110" SYMBOL 0) - (* ; "Digamma") + (* ; "Digamma") ("46,111" SYMBOL "2,132") - (* ; "Zeta") + (* ; "Zeta") ("46,112" SYMBOL "2,110") - (* ; "Eta") + (* ; "Eta") ("46,113" SYMBOL "2,121") - (* ; "Theta") + (* ; "Theta") ("46,114" SYMBOL "2,111") - (* ; "Iota") + (* ; "Iota") ("46,115" SYMBOL "2,113") - (* ; "Kappa") + (* ; "Kappa") ("46,116" SYMBOL "2,114") - (* ; "Lambda") + (* ; "Lambda") ("46,117" SYMBOL "2,115") - (* ; "Mu") + (* ; "Mu") ("46,120" SYMBOL "2,116") - (* ; "Nu") + (* ; "Nu") ("46,121" SYMBOL "2,130") - (* ; "Xi") + (* ; "Xi") ("46,122" SYMBOL "2,117") - (* ; "Omicron") + (* ; "Omicron") ("46,123" SYMBOL "2,120") - (* ; "Pi") + (* ; "Pi") ("46,124" SYMBOL 0) - (* ; "Koppa") + (* ; "Koppa") ("46,125" SYMBOL "2,122") - (* ; "Rho") + (* ; "Rho") ("46,126" SYMBOL "2,123") - (* ; "Sigma") + (* ; "Sigma") ("46,127" SYMBOL 0) - (* ; "--empty--") + (* ; "--empty--") ("46,130" SYMBOL "2,124") - (* ; "Tau") + (* ; "Tau") ("46,131" SYMBOL "2,125") - (* ; "Upsilon") + (* ; "Upsilon") ("46,132" SYMBOL "2,106") - (* ; "Phi") + (* ; "Phi") ("46,133" SYMBOL "2,103") - (* ; "Chi") + (* ; "Chi") ("46,134" SYMBOL "2,131") - (* ; "Psi") + (* ; "Psi") ("46,135" SYMBOL "2,132") - (* ; "Omega") + (* ; "Omega") ("46,141" SYMBOL "2,141") - (* ; "alpha") + (* ; "alpha") ("46,142" SYMBOL "2,142") - (* ; "beta") + (* ; "beta") ("46,143" SYMBOL 0) - (* ; "(md beta)") + (* ; "(md beta)") ("46,144" SYMBOL "2,147") - (* ; "gamma") + (* ; "gamma") ("46,145" SYMBOL "2,144") - (* ; "delta") + (* ; "delta") ("46,146" SYMBOL "2,145") - (* ; "epsilon") + (* ; "epsilon") ("46,147" SYMBOL "2,126") - (* ; "stigma") + (* ; "stigma") ("46,150" SYMBOL 0) - (* ; "digamma") + (* ; "digamma") ("46,151" SYMBOL "2,172") - (* ; "zeta") + (* ; "zeta") ("46,152" SYMBOL "2,150") - (* ; "eta") + (* ; "eta") ("46,153" SYMBOL "2,161") - (* ; "theta") + (* ; "theta") ("46,154" SYMBOL "2,151") - (* ; "iota") + (* ; "iota") ("46,155" SYMBOL "2,153") - (* ; "kappa") + (* ; "kappa") ("46,156" SYMBOL "2,154") - (* ; "lambda") + (* ; "lambda") ("46,157" SYMBOL "2,155") - (* ; "mu") + (* ; "mu") ("46,160" SYMBOL "2,156") - (* ; "nu") + (* ; "nu") ("46,161" SYMBOL "2,170") - (* ; "xi") + (* ; "xi") ("46,162" SYMBOL "2,157") - (* ; "omicron") + (* ; "omicron") ("46,163" SYMBOL "2,160") - (* ; "pi") + (* ; "pi") ("46,164" SYMBOL 0) - (* ; "(koppa)") + (* ; "(koppa)") ("46,165" SYMBOL "2,162") - (* ; "rho") + (* ; "rho") ("46,166" SYMBOL "2,163") - (* ; "sigma") + (* ; "sigma") ("46,167" SYMBOL "2,126") - (* ; "(fl sigma)") + (* ; "(fl sigma)") ("46,170" SYMBOL "2,164") - (* ; "tau") + (* ; "tau") ("46,171" SYMBOL "2.165") - (* ; "upsilon") + (* ; "upsilon") ("46,172" SYMBOL "2,146") - (* ; "phi") + (* ; "phi") ("46,173" SYMBOL "2,143") - (* ; "chi") + (* ; "chi") ("46,174" SYMBOL "2,171") - (* ; "psi") + (* ; "psi") ("46,175" SYMBOL "2,167") - (* ; "omega") + (* ; "omega") - (* ;; "NS Miscellaneous symbols") + (* ;; "NS Miscellaneous symbols") ("041,142" SYMBOL "2,271") - (* ; "notequal") + (* ; "notequal") ("041,145" SYMBOL "2,243") - (* ; "lessequal") + (* ; "lessequal") ("041,146" SYMBOL "2,263") - (* ; "greaterequal") + (* ; "greaterequal") ("041,147" SYMBOL "2,245") - (* ; "infinity") + (* ; "infinity") ("041,150" SYMBOL "2,134") - (* ; "therefore") + (* ; "therefore") ("041,155" SYMBOL "2,262") - (* ; "second") + (* ; "second") ("356,055" SYMBOL "2,055") - (* ; "minus") + (* ; "minus") ("356,106" SYMBOL "2,340") - (* ; "lozenge") + (* ; "lozenge") ("356,163" SYMBOL "2,351") - (* ; "topleftbracket") + (* ; "topleftbracket") ("356,164" SYMBOL "2,353") - (* ; "bottomleftbracket") + (* ; "bottomleftbracket") ("356,165" SYMBOL "2,352") - (* ; "centerbracket") + (* ; "centerbracket") ("356,166" SYMBOL "2,371") - (* ; "toprightbracket") + (* ; "toprightbracket") ("356,167" SYMBOL "2,373") - (* ; "bottomrightbracket") + (* ; "bottomrightbracket") ("356,176" SYMBOL "2,176") - (* ; "similar") + (* ; "similar") ("356,314" SYMBOL "2,251") - (* ; "heart") + (* ; "heart") ("356,340" SYMBOL "2,374") - (* ; "toprightbracce") + (* ; "toprightbracce") ("356,341" SYMBOL "2,357") - (* ; "braceextend") + (* ; "braceextend") ("356,342" SYMBOL "2,375") - (* ; "centerrightbracce") + (* ; "centerrightbracce") ("356,343" SYMBOL "2,376") - (* ; "bottomrightbracce") + (* ; "bottomrightbracce") ("356,344" SYMBOL "2,354") - (* ; "topleftbracce") + (* ; "topleftbracce") ("356,345" SYMBOL "2,356") - (* ; "bottomleftbracce") + (* ; "bottomleftbracce") ("356,346" SYMBOL "2,355") - (* ; "centerleftbracce") + (* ; "centerleftbracce") ("356,355" SYMBOL "2,363") - (* ; "integraltop") + (* ; "integraltop") ("356,356" SYMBOL "2,365") - (* ; "integralbottom") + (* ; "integralbottom") ("356,357" SYMBOL "2,364") - (* ; "integralcenter"))) + (* ; "integralcenter"))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS *POSTSCRIPT-NS-HASH*) @@ -4063,35 +4069,30 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) - (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") + (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") - (POSTSCRIPT.SHOWACCUM STREAM) - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch POSTSCRIPTRIGHTMARGIN - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX - of IMAGEDATA) - CHARWID] - [COND - ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of - IMAGEDATA)) - (COND - ((ffetch POSTSCRIPTPENDINGXFORM of - IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTFONTCHANGEDFLG - of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA] - (POSTSCRIPT.OUTSTR STREAM STRING))) + (POSTSCRIPT.SHOWACCUM STREAM) + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch POSTSCRIPTRIGHTMARGIN of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX of IMAGEDATA) + CHARWID] + [COND + ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of IMAGEDATA)) + (COND + ((ffetch POSTSCRIPTPENDINGXFORM of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTFONTCHANGEDFLG of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA] + (POSTSCRIPT.OUTSTR STREAM STRING))) ) ) @@ -4106,14 +4107,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T + ) + ("Landscape" T "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL + ) + ("Portrait" 'NIL "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ T)) + )) + TITLE _ "Default Orientation" CENTERFLG _ T)) (RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70 NIL)))) @@ -4235,11 +4236,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) (RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") - (Regular 'REGULAR "This is a Regular Slope font"))) + (Regular 'REGULAR "This is a Regular Slope font"))) (RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") - (Medium 'MEDIUM "This is a Medium Weight font") - (Light 'LIGHT "This is a Light Weight font"))) + (Medium 'MEDIUM "This is a Medium Weight font") + (Light 'LIGHT "This is a Light Weight font"))) (ADDTOVAR BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU @@ -4283,9 +4284,9 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) (RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>")))) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>")))) (RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) (DEFINEQ @@ -4310,36 +4311,36 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ) (ADDTOVAR PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)))) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) (ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) (ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) (ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) (RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) @@ -4351,14 +4352,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2))) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST @@ -4386,38 +4387,38 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen "Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22629 29733 (POSTSCRIPT.INIT 22639 . 29731)) (30777 65561 (PSCFONT.READFONT 30787 . -32695) (PSCFONT.SPELLFILE 32697 . 33275) (PSCFONT.COERCEFILE 33277 . 34849) ( -PSCFONTFROMCACHE.SPELLFILE 34851 . 35836) (PSCFONTFROMCACHE.COERCEFILE 35838 . 37490) ( -PSCFONT.WRITEFONT 37492 . 38507) (READ-AFM-FILE 38509 . 44380) (CONVERT-AFM-FILES 44382 . 45594) ( -POSTSCRIPT.GETFONTID 45596 . 46991) (POSTSCRIPT.FONTCREATE 46993 . 59392) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59394 . 61791) (POSTSCRIPT.FONTSAVAILABLE 61793 . 65559)) (66110 -75256 (OPENPOSTSCRIPTSTREAM 66120 . 74922) (CLOSEPOSTSCRIPTSTREAM 74924 . 75254)) (75301 81122 ( -POSTSCRIPT.HARDCOPYW 75311 . 78660) (POSTSCRIPT.TEDIT 78662 . 79142) (POSTSCRIPT.TEXT 79144 . 79435) ( -POSTSCRIPTFILEP 79437 . 80073) (MAKEEPSFILE 80075 . 81120)) (81123 126009 (POSTSCRIPT.BITMAPSCALE -81133 . 83589) (POSTSCRIPT.CLOSESTRING 83591 . 84125) (POSTSCRIPT.ENDPAGE 84127 . 84998) ( -POSTSCRIPT.OUTSTR 85000 . 86021) (POSTSCRIPT.PUTBITMAPBYTES 86023 . 94494) (POSTSCRIPT.PUTCOMMAND -94496 . 95545) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95547 . 100995) (POSTSCRIPT.SHOWACCUM 100997 . 103235) ( -POSTSCRIPT.STARTPAGE 103237 . 105816) (\POSTSCRIPTTAB 105818 . 106689) (\PS.BOUTFIXP 106691 . 108041) -(\PS.SCALEHACK 108043 . 110872) (\PS.SCALEREGION 110874 . 111434) (\SCALEDBITBLT.PSC 111436 . 115736) -(\SETPOS.PSC 115738 . 116200) (\SETXFORM.PSC 116202 . 118021) (\STRINGWIDTH.PSC 118023 . 118477) ( -\SWITCHFONTS.PSC 118479 . 124636) (\TERPRI.PSC 124638 . 126007)) (126044 181764 (\BITBLT.PSC 126054 . -126607) (\BLTSHADE.PSC 126609 . 130891) (\CHARWIDTH.PSC 130893 . 131660) (\CREATECHARSET.PSC 131662 . -133360) (\DRAWARC.PSC 133362 . 135842) (\DRAWCIRCLE.PSC 135844 . 138253) (\DRAWCURVE.PSC 138255 . -142276) (\DRAWELLIPSE.PSC 142278 . 144755) (\DRAWLINE.PSC 144757 . 147107) (\DRAWPOINT.PSC 147109 . -147697) (\DRAWPOLYGON.PSC 147699 . 150813) (\DSPBOTTOMMARGIN.PSC 150815 . 151380) ( -\DSPCLIPPINGREGION.PSC 151382 . 152825) (\DSPCOLOR.PSC 152827 . 153668) (\DSPFONT.PSC 153670 . 157880) - (\DSPLEFTMARGIN.PSC 157882 . 158451) (\DSPLINEFEED.PSC 158453 . 159029) (\DSPPUSHSTATE.PSC 159031 . -160794) (\DSPPOPSTATE.PSC 160796 . 163305) (\DSPRESET.PSC 163307 . 163953) (\DSPRIGHTMARGIN.PSC 163955 - . 164527) (\DSPROTATE.PSC 164529 . 165552) (\DSPSCALE.PSC 165554 . 166485) (\DSPSCALE2.PSC 166487 . -167306) (\DSPSPACEFACTOR.PSC 167308 . 168280) (\DSPTOPMARGIN.PSC 168282 . 168999) (\DSPTRANSLATE.PSC -169001 . 171575) (\DSPXPOSITION.PSC 171577 . 172176) (\DSPYPOSITION.PSC 172178 . 172750) ( -\FILLCIRCLE.PSC 172752 . 175398) (\FILLPOLYGON.PSC 175400 . 179316) (\FIXLINELENGTH.PSC 179318 . -180812) (\MOVETO.PSC 180814 . 181565) (\NEWPAGE.PSC 181567 . 181762)) (181820 204972 ( -\POSTSCRIPT.CHANGECHARSET 181830 . 182634) (\POSTSCRIPT.OUTCHARFN 182636 . 195493) ( -\POSTSCRIPT.PRINTSLUG 195495 . 197462) (\POSTSCRIPT.SPECIALOUTCHARFN 197464 . 199896) (\UPDATE.PSC -199898 . 201121) (\POSTSCRIPT.ACCENTFN 201123 . 202065) (\POSTSCRIPT.ACCENTPAIR 202067 . 204970)) ( -205070 206715 (\PSC.SPACEDISP 205080 . 205359) (\PSC.SPACEWID 205361 . 205980) (\PSC.SYMBOLS 205982 . -206713)) (206824 209815 (\POSTSCRIPT.NSHASH 206834 . 209813)) (254855 255569 (POSTSCRIPTSEND 254865 . -255567))))) + (FILEMAP (NIL (22912 30016 (POSTSCRIPT.INIT 22922 . 30014)) (30996 65780 (PSCFONT.READFONT 31006 . +32914) (PSCFONT.SPELLFILE 32916 . 33494) (PSCFONT.COERCEFILE 33496 . 35068) ( +PSCFONTFROMCACHE.SPELLFILE 35070 . 36055) (PSCFONTFROMCACHE.COERCEFILE 36057 . 37709) ( +PSCFONT.WRITEFONT 37711 . 38726) (READ-AFM-FILE 38728 . 44599) (CONVERT-AFM-FILES 44601 . 45813) ( +POSTSCRIPT.GETFONTID 45815 . 47210) (POSTSCRIPT.FONTCREATE 47212 . 59611) ( +\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59613 . 62010) (POSTSCRIPT.FONTSAVAILABLE 62012 . 65778)) (66335 +75659 (OPENPOSTSCRIPTSTREAM 66345 . 75147) (CLOSEPOSTSCRIPTSTREAM 75149 . 75657)) (75704 81525 ( +POSTSCRIPT.HARDCOPYW 75714 . 79063) (POSTSCRIPT.TEDIT 79065 . 79545) (POSTSCRIPT.TEXT 79547 . 79838) ( +POSTSCRIPTFILEP 79840 . 80476) (MAKEEPSFILE 80478 . 81523)) (81526 126412 (POSTSCRIPT.BITMAPSCALE +81536 . 83992) (POSTSCRIPT.CLOSESTRING 83994 . 84528) (POSTSCRIPT.ENDPAGE 84530 . 85401) ( +POSTSCRIPT.OUTSTR 85403 . 86424) (POSTSCRIPT.PUTBITMAPBYTES 86426 . 94897) (POSTSCRIPT.PUTCOMMAND +94899 . 95948) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95950 . 101398) (POSTSCRIPT.SHOWACCUM 101400 . 103638) ( +POSTSCRIPT.STARTPAGE 103640 . 106219) (\POSTSCRIPTTAB 106221 . 107092) (\PS.BOUTFIXP 107094 . 108444) +(\PS.SCALEHACK 108446 . 111275) (\PS.SCALEREGION 111277 . 111837) (\SCALEDBITBLT.PSC 111839 . 116139) +(\SETPOS.PSC 116141 . 116603) (\SETXFORM.PSC 116605 . 118424) (\STRINGWIDTH.PSC 118426 . 118880) ( +\SWITCHFONTS.PSC 118882 . 125039) (\TERPRI.PSC 125041 . 126410)) (126447 182167 (\BITBLT.PSC 126457 . +127010) (\BLTSHADE.PSC 127012 . 131294) (\CHARWIDTH.PSC 131296 . 132063) (\CREATECHARSET.PSC 132065 . +133763) (\DRAWARC.PSC 133765 . 136245) (\DRAWCIRCLE.PSC 136247 . 138656) (\DRAWCURVE.PSC 138658 . +142679) (\DRAWELLIPSE.PSC 142681 . 145158) (\DRAWLINE.PSC 145160 . 147510) (\DRAWPOINT.PSC 147512 . +148100) (\DRAWPOLYGON.PSC 148102 . 151216) (\DSPBOTTOMMARGIN.PSC 151218 . 151783) ( +\DSPCLIPPINGREGION.PSC 151785 . 153228) (\DSPCOLOR.PSC 153230 . 154071) (\DSPFONT.PSC 154073 . 158283) + (\DSPLEFTMARGIN.PSC 158285 . 158854) (\DSPLINEFEED.PSC 158856 . 159432) (\DSPPUSHSTATE.PSC 159434 . +161197) (\DSPPOPSTATE.PSC 161199 . 163708) (\DSPRESET.PSC 163710 . 164356) (\DSPRIGHTMARGIN.PSC 164358 + . 164930) (\DSPROTATE.PSC 164932 . 165955) (\DSPSCALE.PSC 165957 . 166888) (\DSPSCALE2.PSC 166890 . +167709) (\DSPSPACEFACTOR.PSC 167711 . 168683) (\DSPTOPMARGIN.PSC 168685 . 169402) (\DSPTRANSLATE.PSC +169404 . 171978) (\DSPXPOSITION.PSC 171980 . 172579) (\DSPYPOSITION.PSC 172581 . 173153) ( +\FILLCIRCLE.PSC 173155 . 175801) (\FILLPOLYGON.PSC 175803 . 179719) (\FIXLINELENGTH.PSC 179721 . +181215) (\MOVETO.PSC 181217 . 181968) (\NEWPAGE.PSC 181970 . 182165)) (182223 205375 ( +\POSTSCRIPT.CHANGECHARSET 182233 . 183037) (\POSTSCRIPT.OUTCHARFN 183039 . 195896) ( +\POSTSCRIPT.PRINTSLUG 195898 . 197865) (\POSTSCRIPT.SPECIALOUTCHARFN 197867 . 200299) (\UPDATE.PSC +200301 . 201524) (\POSTSCRIPT.ACCENTFN 201526 . 202468) (\POSTSCRIPT.ACCENTPAIR 202470 . 205373)) ( +205473 207118 (\PSC.SPACEDISP 205483 . 205762) (\PSC.SPACEWID 205764 . 206383) (\PSC.SYMBOLS 206385 . +207116)) (207227 210218 (\POSTSCRIPT.NSHASH 207237 . 210216)) (254693 255407 (POSTSCRIPTSEND 254703 . +255405))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index f41c947a45e2183f232c47ac0eea3d28cc179820..bf3a121e359188d0dbf053eaea242e9aab15fe9e 100644 GIT binary patch delta 3655 zcma(Udr;Kpah8YRPe2iQgM1tycPPi*aU5{SCaKeDCz@z7eI;$xNhgWTWSrD#G?TX4RPjlC5XA>d_uIpUY3#K3$L??U z+ud&;-+tfTcmEW7>saiwwJmIEqseDwT8&DQls3D=YW7-9eyfEkbo$bkEyJZcjjo(& z^+tWQQD328O2yid4WolYp#e5B%oJ>_v(0L8SOec&DL;VhC(Bh#Qs~O(XjT|2v__3a z!NQ?`Yla>l4R0zkGPA?wv$|bAzt8NoyZt^t?%l=)(XOrC;b3#^sMTr(8whU3eIL0& zg+hh?ulU~q{HMcAS5Z}6t!GB7#qKX{46yKq$CzX^H=CSIR$r;##gsOu@6oQRn9=RE zcGz9*zETTj4U;xEbe&Oy(Hj&@`eM_e!TxYC{PnuosO7|{1kk;a74=6OqEF;d;sC-co)KBh!x!cCU&lOIS?}lVtydP& z{)7SY)Hq3L{9e6JBGnF5#0$UV* zpS~_E?F@iPe)>ic${o0YY2lt#P=bVZ63q%CN8Uf#GW*GUSA$+cS368zA5%)Q=kwqK z$?mlKBMk28hAjEy=d}-2+ixbzAKgpY-2*Xl;ATGB9lI%Z-P;39j=Hr18D+QnCCOy5 z%vz}L19p4xQIlDe0!E(~#YIu~S9{0@U`v9siReDn6_Z}%(!H)vu@X;u!Mo|Om9AHoL zgm}OP=izu-`#6Fc<^xuW|8zbvC5cYcumsqJ{Deenh6S{?cLA+I0vQV?5c9nVDoZ5O z(+QBtUrhw;dp?y&0=-EPMCwQqQN;@h?N|tSNciQ2#T-%qCk;w>JRZNzT6jM42ltg`BNg~&jJ@t!QM20bID39w3PMXIgMk?;nW2gq zs`36{;-wOM&A#aq*VFmVYOtdC$!ZV}k-|vH`Hm6rUgmBi==hWo@CD$7HI(&jHTdvJ z{Adl}gUr)bf_TeKMWv{t3~j3ee8c(aIx0+KJ;k-V zp1S{ZJ#^w)WdpR#lN5}xF@C%Ol>D^@$inN&1j-~0TOZoYv@AFIx#+b;4hD?q-E21MFs=eb0FI{-CEUbvCV4+bEY53d3-)BN`tEq=Cr z7*1&7jeT`Bco))JAP(0w9F3J z_3}|~X0#TWL*0;%R(Etm;lnlVUIn?aqIo6$NjF6u+e2;J+Cu>j_t44vLl2#&gkDgh zg^I|SH)q8O(!+fM2qwQ3SH_<#UDkwDKqpRGERPAA=& zJ?GwYfA^f^7g>D%mSVwLza-v!yTBpfl)2gU)Oy zHW%pCqDI}>ziFVSHyjfC`$V-Ey}i<3`&>z2C_Ff1c_ui}8|<^V`a6TYmQCSMZ}?eb zUV){%XLGL7v&eOj^1NRAq<4L>*<>;sb?9v{{2%w>tpkHYnP#!YZD@P38j3@tYS6bVqK%2UVb!k2%t#x}U<|lBYBV`NYW;@-0VVzMwJc z#R^YA!lH;~yT>K!6|EICqP|d6XW~y94C1N{s13Kog*DLc+|IVaLmVN zRZ&_|lOwKMCkk@LO+LQ!<|>qL-RzW?UW%91W1LI>*hZ8ejo~=!D};1e8m~sf&&Rp> z!FVUiwl4!HXD93DN$AQmktna6(4oaM!705p!Cl8sa=C4iC%n?0DvwXbVrzDid*S_O zr)nOyE=`s4)~z7QVUm3O($su8;QQp0uRVC0TOYVlrqA&FcFgcP zSntQnV>2FXS-#3f+4WUdgdobhXIIDvW*7ahKTh~2$PD?|Y<_%;*W;J`HlNcgRazyh zsKe#CJeMpd&Y5Gp9;aKf`!H2OUO(5sUWtGu805rULmYmP#K(sBWI>~ReJ&15WndWq zse2AWahzy0Jpr16Ms@*!qfG4k5s=EZ0*9H39*42_0iBhSvjX|zTq?6ia8#k;2^5lP zO3)W*@h58P10KmP3WY^lt-w_CAe1PGd7@-*lF*>BR#r+LTq#l3ja0Kw=0O~0@xq9g z70w40HpfQXY~Or{=j%To_%2pO0P|*0i*7|yRcr1-2E&v-QA+QY# zU>E`aSU|IE3jvQA+rJR-{Ic1FfNRe}i)ieOq6|^M_u!r=GR{QNR&0+3Jap`2G>vIu zXlz#ujZMXnGyh^T9#>R`K(5CYLlQe60G@L;DiFXM3wS8l;aKV=#gQ701KeHgLLAX6 zT0)T5mvA3@mlC3TDcMdfB?fDkk=nJ4#_lMpHJ@2RJe7KHrqaB~H1g7`sJ|-8ypqQDuOy%I(#cskoiaL;P7@3wLH3FS zc_5OpBZJhb42qDWCh{+;2|1=Fq<f6k*yxV?iVJ{%j;?S`!&}E9$PIHWrZaWC1_J>Yl#M;qJj;Z)X@A zcy;pQZ7Br&Lb6v2DJrT}@|p2`dEbN(f#0sEFF6;)tYjCOVX>Sw9?Q-?4gAvjy4#2E z-q9jr+RSPjz>Av#1w?p^zHCMcl}etdNR;LMt70G*x2n6D#m* zF1~_N+E_tJ{Go!*Y_g4V*Rht`I;)i|E7v&FRG@bo2$WukXNfIz(1?0Jmn5L60(CTao+)WGqPGISWvy_q#ZEf z1bo-9vKn&zN*&%7hibryru#KuLseP}W>i~iX}_JXCFZMKr1}(f%tf_LtpmJonN$Y> ztfr<#U&!960Xw@@$L}*1>83UAaufU0Zu+EUd1(K>V=rFs5( zTE}14lW~EMkZnGy*-@Wzi2Q)pIkWg_Iey@$1h4sNsf`lgYlHPj)H^HzzFOF{M0G6< z5b_rRS}F{~^R_ooLAN!4bD^N#(iaL3vWo%8VAmUHbEGtY7Gb(ZTIOAiRNKpqfbT+< z(L@e+Hh~&@2b+l9;%4I7(aej5FSXTdw3#+c)_P9nzr4UqsSj^Nu_D;{O!r_vGN}vq zZ4up07oO4s8z2os{BZ-Q(*6x>@%r;5d!5(n^I4l+b~ipE5IM1dmaL=&GH}91MGd#W z>W5cunXI2o?w?O{SM0g1^^BOMj^iLNS8P6Yx3l)q~VL?Yvy_m3wOt^l3W;!20n?Zq~ax7p{cc1ZZTdbg|-@F^s) N--Vz!Qosrd{{k^-4o(07 From 58196b4011e72113e1115954191e71da1a62d5cd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:49:31 -0700 Subject: [PATCH 03/18] HARDCOPY: fixes printer menu --- sources/HARDCOPY | 141 ++++++++++++++++++++++++------------------ sources/HARDCOPY.LCOM | Bin 47158 -> 47249 bytes 2 files changed, 80 insertions(+), 61 deletions(-) diff --git a/sources/HARDCOPY b/sources/HARDCOPY index f252f932..09eaff6e 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Oct-2022 18:47:42" {DSK}larry>ilisp>medley>sources>HARDCOPY.;2 103854 +(FILECREATED "22-Jun-2023 17:31:38" {WMEDLEY}HARDCOPY.;11 104907 - :CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}larry>ilisp>medley>sources>HARDCOPY.;1) + :CHANGES-TO (FNS MakeMenuOfPrinters) + + :PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}HARDCOPY.;10) (* ; " @@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (INITVARS (TEXTDEFAULTTABS (LIST 20320)) (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))) (* ; - "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") + "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) (COMS (FNS \BLTSHADE.GENERICPRINTER) @@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY) [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35] + (IMICASPERPT 35) + (DEFAULTTAB 36] + (* ; "screen-points: 1/2 inch") (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT] [COMS (* ; @@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:") - (* ; "Edited 11-Jul-90 13:35 by jds") + [LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk") + (* ; "Edited 29-May-93 14:18 by rmk:") + (* ; "Edited 11-Jul-90 13:35 by jds") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (CREATE MENU ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST COLLECT (LIST (COND - ((LISTP P) - (IF (CADDR P) - THEN (CONCAT (CADR P) - " " - (CADDR P)) - ELSE (CADR P))) - (T P)) - (KWOTE P))) + ((LISTP P) + (IF (CADDR P) + THEN (CONCAT (CADR P) + " " + (CADDR P)) + ELSE (CADR P))) + (T (CL:IF (OR (NULL P) + (ZEROP (NCHARS P))) + "(Default printer)" + P))) + (KWOTE P))) (LIST (LIST "Other..." (KWOTE 'OTHER) "You will be prompted for a printer"))) TITLE _ MENUTITLE @@ -686,7 +694,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. -(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") +(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -729,7 +737,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (CLOSEF IMAGESTREAM])]) (COPY.TEXT.TO.IMAGE - [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk") + [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk") + (* ; "Edited 20-Jul-2022 17:14 by rmk") (* ; "Edited 8-Oct-2021 22:23 by rmk:") (* ; "Edited 10-Apr-95 21:23 by rmk:") @@ -741,7 +750,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (FONTARRAY (FONTMAPARRAY FONTS)) (MAXFONT (ARRAYSIZE FONTARRAY)) (INSTRM (GETSTREAM INFILE 'INPUT)) - DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] + DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] (* ;;  "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch") @@ -775,17 +784,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (\OUTCHAR IMAGESTREAM (CHARCODE ^T)) (RETURN)) - (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale") + (* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.") [SETQ FC (IF TABS THEN (OR (CAR (NTH TABS FC)) (ERROR "Undefined absolute tab number" FC)) - ELSE (TIMES FC (OR DEFAULTTAB - (SETQ DEFAULTTAB - (TIMES 8 (CHARWIDTH (CHARCODE SPACE) - (FONTCREATE (ELT FONTARRAY 1) - NIL NIL NIL IMAGESTREAM] + ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB + (TIMES 8 + (CHARWIDTH (CHARCODE SPACE) + (FONTCREATE (ELT FONTARRAY + 1) + NIL NIL NIL + IMAGESTREAM] (DSPXPOSITION FC IMAGESTREAM)) (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F)) (* ; "EOS after ^F") @@ -912,15 +923,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (RPAQQ IMICASPERPT 35) +(RPAQQ DEFAULTTAB 36) + (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35)) + (IMICASPERPT 35) + (DEFAULTTAB 36)) ) (* "END EXPORTED DEFINITIONS") ) + + + +(* ; "screen-points: 1/2 inch") + (DECLARE%: DONTCOPY DOEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED") (DEFMACRO \MICASTOPTS (MICAS) @@ -1083,40 +1102,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2018 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) ( -HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251 - . 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 ( -MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987 - . 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) ( -PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) ( -GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 ( -ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 ( -DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) ( -PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 . -27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) ( -PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) ( -\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE -38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) ( -52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402) -(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371 - . 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) ( -\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) ( -\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR -61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) ( -\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984) -(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 ( -MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE -75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) ( -\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE -79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) ( -\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 . -82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) ( -\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) ( -\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454 - . 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) ( -\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) ( -\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 . -95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE -101660 . 103157))))) + (FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) ( +HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405 + . 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 ( +MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448 + . 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) ( +PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) ( +GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 ( +ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 ( +DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) ( +PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 . +28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) ( +PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) ( +\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE +39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) ( +53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364) +(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333 + . 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) ( +\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) ( +\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR +62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) ( +\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946) +(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 ( +MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE +76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) ( +\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE +80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) ( +\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 . +83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) ( +\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) ( +\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507 + . 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) ( +\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) ( +\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 . +97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE +102713 . 104210))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index fa59fbbe6feefd39fadfdeb781be606d9a11ef7a..ace4369d8e170d5b702c796e511ecb2f70613252 100644 GIT binary patch delta 739 zcmaiy&rcIU6vx}CfGm(`EGi|jFB=0}k}W&4{XrKcEZr>ywm;|(Nr@&l?JCvMl5IH= z17}Z~G4bxj#7MGqg+#q@_o5g73S;nKyou9#P!khgCiCXyz4?6S&CJmWdio7LS=%MD zxV+sEi9}?OBn1;i4)Y-JmFDJFt!`GK*#I7P)>67==%q(DTFq^%Vz%azYEFx1vZdfG z#sT1XLjG`wtb}63qCPr{rV*Z@byVrPPbkBj z!+XA;zx1Ww<#OM3G4uE4i>rNfYPhxQ>0GNK@noFM>})IU^lw+ z;KY$reV)Tf!>GRTR%<7(R$KZBiUC(8*fFn^z$CCqUE)O^?)33uqNh+9pj+fo4VG+|$=vcXfY ZeVx%}>>&N{YK-pLeh%yeI4Ch z!}UV^1A;vLLR^D16|4e+T*Ey5LxXi)fR0g6GBVKhD$Rigrn!}&2@okMaN%)`7}nr3 zoV=Z}fyvl>vL#b8h?>Xb52QA~XZp$^e2$fYfiZyr2;{+}pd-uV@7%?KDa@PX_wV;f zVPaz3B+SH^4^rU+t=}=9540h%=d+Pv+!pU^XRUM$2lBE-ej4I~%<467hlcTaymuE|+z1KBjR6s#4vHXmGD%`{nQ ftMKH84Z@SBY|xwhd5g^CyBlPgL6UzrOkoEAp$5dg From c4554894b3a91fcd615d863080ebb1aaa917307b Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 25 Jun 2023 17:16:27 -0700 Subject: [PATCH 04/18] PDFSTREAM: define PDF fonts as POSTSCRIPT fonts --- library/PDFSTREAM | 18 +++++++++++------- library/PDFSTREAM.LCOM | Bin 4918 -> 5006 bytes 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 24fdd70a..0e786e58 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35 12465 +(FILECREATED "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36 12655 :EDIT-BY rmk - :PREVIOUS-DATE "24-Jun-2023 15:01:28" {WMEDLEY}PDFSTREAM.;34) + :CHANGES-TO (FNS PDF-INIT) + + :PREVIOUS-DATE "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -114,12 +116,14 @@ (DEFINEQ (PDF-INIT - [LAMBDA NIL (* ; "Edited 23-Jun-2023 11:23 by rmk") + [LAMBDA NIL (* ; "Edited 25-Jun-2023 16:41 by rmk") + (* ; "Edited 23-Jun-2023 11:23 by rmk") (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ - (FUNCTION CLOSE-PDF-STREAM]) + (FUNCTION CLOSE-PDF-STREAM))) + (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]) (OPEN-PDF-STREAM [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") @@ -222,7 +226,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( -PDF.TEDIT 4633 . 5000)) (5378 12426 (PDF-INIT 5388 . 5957) (OPEN-PDF-STREAM 5959 . 8062) ( -CLOSE-PDF-STREAM 8064 . 8979) (PDF-CONVERT 8981 . 12424))))) + (FILEMAP (NIL (2702 5036 (PDFFILEP 2712 . 3626) (PDF.HARDCOPYW 3628 . 4055) (PDF.TEXT 4057 . 4665) ( +PDF.TEDIT 4667 . 5034)) (5412 12616 (PDF-INIT 5422 . 6147) (OPEN-PDF-STREAM 6149 . 8252) ( +CLOSE-PDF-STREAM 8254 . 9169) (PDF-CONVERT 9171 . 12614))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 2e961a9b83102bacf88ed999d18897340b244af5..8d53ee8000c9f69483c0df611aa1a0b6cde20b23 100644 GIT binary patch delta 284 zcmdm{)~7xpLfBN-t29s7$iT>0!O+ag#L&vvWMZ}flbPnkkD?PdNeBnHxaoTOd4?!t z<|!!oxVbABnNGYbVUDcL(8>UaER;04G~7IWT%Chl9Yb7Q6qJmR6+z6Ntiz~iZ>C^q zWM*orVCCxK8KUbHsZf-gtzhNs;ppe?8mt@Qub{!@<`=90vsqKYDj>);%+o(KSl0z; z@?>#F^UW(5+n5>6C+o9n`K2=e0hr(du>=@2OpO%W{QW`#g8V`5(Q|ZhaRKUgc2zJm lQSgH}&j{#P6LWkc|qPvslmY0stD$MZo|7 delta 194 zcmeBE-=;PpLfAytt29s7$iT>0!O+yo$lS`%aALLrqv^ysdct}6B^jA{=?a;73QBIF zK0XRYCKK;UD4}XGFt#!>QqttoaP#zWbq;cM3~_at+{0*YsbFYiVrHsf Date: Sun, 2 Jul 2023 18:25:41 -0700 Subject: [PATCH 05/18] PDFSTREAM: fix convert template --- library/PDFSTREAM | 17 ++++++++--------- library/PDFSTREAM.LCOM | Bin 5006 -> 4987 bytes 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 0e786e58..48291023 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36 12655 +(FILECREATED " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37 12671 :EDIT-BY rmk - :CHANGES-TO (FNS PDF-INIT) - - :PREVIOUS-DATE "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35) + :PREVIOUS-DATE "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -105,8 +103,9 @@ (RPAQ? PDFCONVERTER 'ps2pdf) -(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILE) - (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " ERRORFILE)) +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILENAME) + (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " + ERRORFILENAME)) (RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -226,7 +225,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2702 5036 (PDFFILEP 2712 . 3626) (PDF.HARDCOPYW 3628 . 4055) (PDF.TEXT 4057 . 4665) ( -PDF.TEDIT 4667 . 5034)) (5412 12616 (PDF-INIT 5422 . 6147) (OPEN-PDF-STREAM 6149 . 8252) ( -CLOSE-PDF-STREAM 8254 . 9169) (PDF-CONVERT 9171 . 12614))))) + (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( +PDF.TEDIT 4633 . 5000)) (5428 12632 (PDF-INIT 5438 . 6163) (OPEN-PDF-STREAM 6165 . 8268) ( +CLOSE-PDF-STREAM 8270 . 9185) (PDF-CONVERT 9187 . 12630))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 8d53ee8000c9f69483c0df611aa1a0b6cde20b23..97a1344cf9b7705a55cb49e1c75d5e95e7d68cd7 100644 GIT binary patch delta 224 zcmeBE|E)G5TtvZ0*Q+!~*T}%gSi#WT%D}+N$arG5fs?tW0+*7JB~UUCB57o7WoTw) zVy>i+RFs;WpIeZblbWKCT2W9`tZJo@mtT^RnU}7RnWv!S7V6`pU}QP*u7m}Kep4eQ zO)d>LPajw3AXmo_R~H2(OcxkhOx9&oP&HRDG%_JKXtwzi00+*7J36i9#m4UI9p}CSm zQc-Gher`c#PHKumYDGa&v8t6qfQy^1r=MqtLS~+Vl8>9af|2ROyAsOCh8tQL0Fi}~ zCYOerr;n?1kgH>etBb Date: Mon, 17 Jul 2023 23:04:38 -0700 Subject: [PATCH 06/18] PDFSTREAM: Fix logic around closing the postscript sub-stream --- library/PDFSTREAM | 23 ++++++++++++++--------- library/PDFSTREAM.LCOM | Bin 4987 -> 5072 bytes 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 48291023..d96b6716 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37 12671 +(FILECREATED "17-Jul-2023 22:33:21" {WMEDLEY}PDFSTREAM.;38 12982 :EDIT-BY rmk - :PREVIOUS-DATE "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36) + :CHANGES-TO (FNS CLOSE-PDF-STREAM) + + :PREVIOUS-DATE " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -158,7 +160,8 @@ PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 24-Jun-2023 13:57 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 17-Jul-2023 22:32 by rmk") + (* ; "Edited 24-Jun-2023 13:57 by rmk") (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") @@ -166,9 +169,11 @@ (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") - (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (PDF-CONVERT (CLOSEF PSSTREAM) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM]) + (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) + (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) + (PDF-CONVERT (CLOSEF PSSTREAM) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) + of PSSTREAM))))]) (PDF-CONVERT [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") @@ -225,7 +230,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( -PDF.TEDIT 4633 . 5000)) (5428 12632 (PDF-INIT 5438 . 6163) (OPEN-PDF-STREAM 6165 . 8268) ( -CLOSE-PDF-STREAM 8270 . 9185) (PDF-CONVERT 9187 . 12630))))) + (FILEMAP (NIL (2710 5044 (PDFFILEP 2720 . 3634) (PDF.HARDCOPYW 3636 . 4063) (PDF.TEXT 4065 . 4673) ( +PDF.TEDIT 4675 . 5042)) (5470 12943 (PDF-INIT 5480 . 6205) (OPEN-PDF-STREAM 6207 . 8310) ( +CLOSE-PDF-STREAM 8312 . 9496) (PDF-CONVERT 9498 . 12941))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 97a1344cf9b7705a55cb49e1c75d5e95e7d68cd7..dde4ea6f6487716270c554883fd9f388b38c664d 100644 GIT binary patch delta 384 zcmZvX%}T>S6or#b2?1AH++G4|BaCDwu}NlSOeQgsCLuFc1Q$i^qV&fa5qt`<T7dP&a3B59hn*yl*~l-5;-E8y((^5HW}egizC@1kZ*>>gb?qxcy^d zn;L`?SA(;%e||Zh4o3Y8=-*Du>kSHil5vLeAVgdg%}Yb^9>=j~CiR+MeJYr$fOpQT+^2r#WBHLSZ@Hk{@e q7u+x6T+~1hECW6#lXi8bG&O?14*1)$>R1rQ9WP>8&gXZ^tNH=eC}KSN!lVf@X?^5ZCYXl!GT+_bOA1+ z8xdTBV^`qB6a_nQe7^tu=WYLM?`5z9s-8ZKRjN}1#9_M5sIeI7&yE5~rkw^>Kad)X z*vxcfT-U|TbTTW)#Sq2gtiIo6sHXF~vbsfCK@NIRgw0b;(_{><=FR>;r$uE&Itapu zdntEw?nB1%RWv&w)OH9M_rqL0I!8Sjfh8&LhjA}c{bsuMS$~b|K*9`j@dVLcy^ELI zTZ$kE;_{?*I565s{6O{Mvp!FAkT$$1&Un!LHV7_~ILk9H4U@bPyPzhryvgZ;=$kO? Ry2m_DGFZQS_0js2z5zYmS5W`} From 781709e4e1a63577476f4e86d5b42e99596856ce Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 12 Sep 2023 13:49:56 -0700 Subject: [PATCH 07/18] PDF Stream: slight generalization --- library/PDFSTREAM | 99 +++++++++++++++++++++++------------------ library/PDFSTREAM.LCOM | Bin 5072 -> 5235 bytes 2 files changed, 55 insertions(+), 44 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index d96b6716..aee1b3fd 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jul-2023 22:33:21" {WMEDLEY}PDFSTREAM.;38 12982 +(FILECREATED "24-Jul-2023 10:37:31" {WMEDLEY}PDFSTREAM.;44 13139 :EDIT-BY rmk - :CHANGES-TO (FNS CLOSE-PDF-STREAM) + :CHANGES-TO (VARS PDFSTREAMCOMS) + (FNS PDF.HARDCOPYW CLOSE-PDF-STREAM PS-TO-PDF PDF-CONVERT) - :PREVIOUS-DATE " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37) + :PREVIOUS-DATE "19-Jul-2023 09:28:33" {WMEDLEY}PDFSTREAM.;40) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -27,15 +28,18 @@ (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC] - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES EXPORTS.ALL (LOADCOMP) - POSTSCRIPTSTREAM)) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) + EXPORTS.ALL) + (FILES (LOADCOMP) + POSTSCRIPTSTREAM)) (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) (INITVARS (PDFCONVERTER 'ps2pdf)) (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) (VARS (DEFAULTPRINTERTYPE 'PDF)) (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) - (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PDF-CONVERT) - (P (PDF-INIT)))) + (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (P (MOVD? 'CL:IDENTITY 'TRUEFILENAME) + (PDF-INIT)))) (ADDTOVAR PRINTERTYPES ((PDF) (CANPRINT (PDF)) @@ -55,7 +59,11 @@ (CREATECHARSET \CREATECHARSET.PSC))) (DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD EXPORTS.ALL (LOADCOMP) +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) + + +(FILESLOAD (LOADCOMP) POSTSCRIPTSTREAM) ) (DEFINEQ @@ -81,10 +89,11 @@ (SETFILEPTR FILE 0)))]) (PDF.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 23-Jun-2023 13:28 by rmk") + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") (* ; "Edited 6-Mar-2023 22:43 by rmk") (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) - (PDF-CONVERT (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) FILE]) (PDF.TEXT @@ -105,9 +114,8 @@ (RPAQ? PDFCONVERTER 'ps2pdf) -(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILENAME) - (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " - ERRORFILENAME)) +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) + (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) (RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -160,7 +168,8 @@ PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 17-Jul-2023 22:32 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 17-Jul-2023 22:32 by rmk") (* ; "Edited 24-Jun-2023 13:57 by rmk") (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") @@ -171,25 +180,29 @@ (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (PDF-CONVERT (CLOSEF PSSTREAM) + (RENAMEFILE (PS-TO-PDF (CLOSEF PSSTREAM)) (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM))))]) -(PDF-CONVERT - [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") +(PS-TO-PDF + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Jul-2023 22:30 by rmk") + (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") (* ; "Edited 8-Jul-2022 10:20 by rmk") (* ; "Edited 7-May-2022 22:40 by rmk") (* ; "Edited 7-Oct-2021 11:15 by rmk:") - (* ;; "PSTMPFILENAME is the name of a closed PS file in a Unix tmp directory. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to TARGETPDFNAME. ") + (* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ") (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") - (CL:UNLESS (INFILEP PSTMPFILENAME) + (SETQ PSFILE (TRUEFILENAME PSFILE)) + (SETQ PDFFILE (if PDFFILE + then (TRUEFILENAME PDFFILE) + else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) + (CL:UNLESS (INFILEP PSFILE) (ERROR "NO PS FILE TO CONVERT")) - (LET ((PDFTMPFILENAME (PACKFILENAME 'EXTENSION 'pdf 'BODY PSTMPFILENAME)) - (ERRORFILENAME (PACKFILENAME 'EXTENSION 'error 'BODY PSTMPFILENAME)) + (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) COMPLETIONCODE) (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") @@ -197,17 +210,13 @@ (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") [SETQ COMPLETIONCODE (PROCESS-COMMAND - (CONCATLIST (SUBLIS `[(PSTMPFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY PSTMPFILENAME) - )) - (PDFTMPFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY - PDFTMPFILENAME))) - (ERRORFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY ERRORFILENAME] + (CONCATLIST (SUBLIS `[(PSFILE \, (SLASHIT (PACKFILENAME 'HOST NIL + 'BODY PSFILE))) + (PDFFILE \, (SLASHIT (PACKFILENAME 'HOST NIL + 'BODY PDFFILE))) + (ERRORFILE \, (SLASHIT (PACKFILENAME + 'HOST NIL 'BODY + ERRORFILE] (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER" ))) @@ -215,22 +224,24 @@ (* ;; "Now use Medley names") - (CLOSEF? PSTMPFILENAME) - (CL:UNLESS DONTDELETE (DELFILE PSTMPFILENAME)) - (CLOSEF? ERRORFILENAME) - (CL:WHEN (INFILEP ERRORFILENAME) - (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILENAME 'LENGTH) - (CL:UNLESS DONTDELETE (DELFILE ERRORFILENAME))) + (CLOSEF? PSFILE) + (CL:UNLESS DONTDELETE (DELFILE PSFILE)) + (CLOSEF? ERRORFILE) + (CL:WHEN (INFILEP ERRORFILE) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILE))) 0) - (ERROR "Cannot create PDF file for " TARGETPDFNAME))) + (ERROR "Cannot create PDF file for " PDFFILE))) (CL:WHEN (IGREATERP COMPLETIONCODE 0) - (ERROR "Cannot create PDF file for " TARGETPDFNAME)) - (RENAMEFILE PDFTMPFILENAME TARGETPDFNAME]) + (ERROR "Cannot create PDF file for " PDFFILE)) + PDFFILE]) ) +(MOVD? 'CL:IDENTITY 'TRUEFILENAME) + (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2710 5044 (PDFFILEP 2720 . 3634) (PDF.HARDCOPYW 3636 . 4063) (PDF.TEXT 4065 . 4673) ( -PDF.TEDIT 4675 . 5042)) (5470 12943 (PDF-INIT 5480 . 6205) (OPEN-PDF-STREAM 6207 . 8310) ( -CLOSE-PDF-STREAM 8312 . 9496) (PDF-CONVERT 9498 . 12941))))) + (FILEMAP (NIL (2929 5370 (PDFFILEP 2939 . 3853) (PDF.HARDCOPYW 3855 . 4389) (PDF.TEXT 4391 . 4999) ( +PDF.TEDIT 5001 . 5368)) (5718 13064 (PDF-INIT 5728 . 6453) (OPEN-PDF-STREAM 6455 . 8558) ( +CLOSE-PDF-STREAM 8560 . 9864) (PS-TO-PDF 9866 . 13062))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index dde4ea6f6487716270c554883fd9f388b38c664d..cba1e2e5d4305d08b30acc0f71437b9ca21dc404 100644 GIT binary patch delta 1650 zcmb7E&yU+g6wVKXHr7J3YO7KSsZSBr+JdB>v7N*|bl0&biK%0|wv*jRt<)~Npf06Z zrHh1Ap-3D!v+@B6Bn}*U;8qq+9QKGfAR%$)Z-A;d4i#@a*=8eD2`)2l=9_u*y>H%o zzpX!$zt}oY_4>OX->*}ZYCu#=YgyXSzBrVp=L5V_q(-;P};jK*8w_+i58xK~fonArn}l6o5Q4Y>CJ{rcS=ob}ykG-|MW z_YfV5H}yFqeAFP8Mrw*AcRimu=q+U~p87X!a`foRimn6Eh-PNDif_(FcARi#f`k(e z5(VULknjCBwmbwU3`Q(Y6|kb1jl6J})LkTjVGwg6k7`=9ZE0E!9&HVn>$CBvN1tCP z>FV+C#V?C1r|};jmQP-pT`v?0#XC3@HecoAFO9!`XbAHTUtef!R`{F`^CPM_=}H`^ z7G%SOm<9HLaa}+&&uFaa;s?5@nnB@K6eeln#9ovlaU1lak$t<;tDkZL%WX??1O!l` z$Y-e+22SWQh(HAv$6<_5WY;PeH&KrKH4lL(;idw`MyXIJ3%)xA`^WNUPl}g6;3OBr z<|<$Bl(G*i>*ckzV)k9-ouZxnR9VlSSFX**;&$h;m{0n7++zIxYCrdrhuwKBHc$4S zem&tX?R@*h+kg7inYCTb9XxsdcR{9R3(|O)tHjj;YR-cK+S2pzW-(Ay(`9}h95o2^ zSjufL=!Tf6Z9oH;5!!Sv?FLY4EbfrjVxOQmapI76vrW`C|;D(U9&%4>H^8*(?s&+tRr z9Y)wO*me}gY0|KLpSKUxKLJ_dFfSJc7S$#COm=k6FG|@T=PqZH>ZR=UYI99e6ujE= z!;bCeO(`2zZ${F~+a#WjKpuo6cLU^`!w}nz<6EA~g49dLh>E?liLEHdKUZ&;M!9k| zsPT`O+w?jvPYW4KRz7%mIN`$N$MQOs(5_Ejek=Rt{97CUlMnV3Y@c4>rHT}IzVr|N CwvD;~ delta 1481 zcma)6OOM<{5S|A@jFnAxNq7i|wivX^SYjsbwmtS3DZ3uKXQmUsaQ7}7M4|+CfrNxv zO@f5PVg3Th2M*l1aAP?l?S%^x2Yx|*0|*Imq-;-iJXsE0+SS$dRn_;oy8r6@e&y@; zE)uJI{fh@(s!<&%b#&dK-`v;cx~+oJCjI3hu^f#$bkK$mXNMn6A0FL%aCiWRUmndK zZ8_itv0&ZAA9aOHnH$2r&!HWR#!yYs>-E}jaQ89d&gM28qPJD0GvWdBUdJ4g`OyB4 z_OhT3w{;r`9oQ5c=5yH{-h|o1&%p5}ZZu}1D`V&=qez_TO9dxM*&dH~Mc2m?&<487 zQFDl$h4sybZXItmzO5_B$%~^smdfK_nkUb_HK^5U^*gxKcAn4IUweQ2q?YELe1EC8 zll}0*<*Nqdax9>r8)Yveq-a?1K@tloyp$&r+i=0qvSw>MuK*n1Ryqk#@ZvBDnB;Nf z#Xf@s2(UDb(_E;?4Reo{my%&}>f(s=<4F1pkqkIuq??YJ#JB>(bBw4!RH(nvY}RVc z?6=mH>`Ck8#*2;Y@7CMdHRasKCpoWT`LtMhwyikx_jg*kfB1d*J>kW+Tz}l+MWj+j zl+Kg;e||U39d6-1x&F+4Qu^0x9cmLu3wAjrpq5^825MSQt+|05Sx^R`yvQ!Mc{GY~ zk_n)JTU3yk3+cCkYW5PNX{UZN&>=}5x8Q)5n`aou6HBvqfng?Yk5fM>Y+V2J+pCksyK77 zy2t5H+^f~Z{e>##Q`$IYlnww3kL3hAwjjH`{_32VW`ZU{Kd!<3h@&4M~#v0pC;#7*B8wAkFo?LjX zu4MmQ2(qs(o Date: Sat, 23 Sep 2023 16:20:30 -0700 Subject: [PATCH 08/18] PDFSTREAM uses AFTERCLOSE streamprop so doesn't require change to POSTSCRIPTSTREAM --- library/PDFSTREAM | 221 +- library/PDFSTREAM.LCOM | Bin 5235 -> 4189 bytes library/POSTSCRIPTSTREAM | 4424 --------------------------------- library/POSTSCRIPTSTREAM.LCOM | Bin 91382 -> 0 bytes 4 files changed, 95 insertions(+), 4550 deletions(-) delete mode 100644 library/POSTSCRIPTSTREAM delete mode 100644 library/POSTSCRIPTSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM index aee1b3fd..8d882dd8 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,45 +1,57 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Jul-2023 10:37:31" {WMEDLEY}PDFSTREAM.;44 13139 +(FILECREATED "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48 10752 :EDIT-BY rmk - :CHANGES-TO (VARS PDFSTREAMCOMS) - (FNS PDF.HARDCOPYW CLOSE-PDF-STREAM PS-TO-PDF PDF-CONVERT) + :CHANGES-TO (FNS OPEN-PDF-STREAM PS-TO-PDF) - :PREVIOUS-DATE "19-Jul-2023 09:28:33" {WMEDLEY}PDFSTREAM.;40) + :PREVIOUS-DATE "23-Sep-2023 15:31:33" {WMEDLEY}PDFSTREAM.;47) (PRETTYCOMPRINT PDFSTREAMCOMS) (RPAQQ PDFSTREAMCOMS - ([ADDVARS [PRINTERTYPES ((PDF) - (CANPRINT (PDF)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE] - [PRINTFILETYPES (PDF (TEST PDFFILEP) - (EXTENSION (PDF)) - (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] - (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC] - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) - EXPORTS.ALL) - (FILES (LOADCOMP) - POSTSCRIPTSTREAM)) - (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + ((FILES (SYSLOAD) + POSTSCRIPTSTREAM) + [COMS (* ; "Hook into hardcopy interface") + (ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION + ROTATION TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + + (* ;; "") + + + (* ;; "Implementation of PDF streams") + (INITVARS (PDFCONVERTER 'ps2pdf)) + (* ; "Mac with ghostscript?") (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) - (VARS (DEFAULTPRINTERTYPE 'PDF)) - (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) - (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) - (P (MOVD? 'CL:IDENTITY 'TRUEFILENAME) - (PDF-INIT)))) + (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF))) + +(FILESLOAD (SYSLOAD) + POSTSCRIPTSTREAM) + + + +(* ; "Hook into hardcopy interface") + (ADDTOVAR PRINTERTYPES ((PDF) (CANPRINT (PDF)) @@ -57,85 +69,42 @@ (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC))) -(DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) +(ADDTOVAR VARS (DEFAULTPRINTERTYPE 'PDF)) + +(ADDTOVAR FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + +(ADDTOVAR P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)) -(FILESLOAD (LOADCOMP) - POSTSCRIPTSTREAM) -) -(DEFINEQ -(PDFFILEP - [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") - (* ; "Edited 5-Mar-93 21:40 by rmk:") - (* ; "Edited 14-Jan-93 10:56 by jds") - (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) - '("PDF") - :TEST - (FUNCTION STRING-EQUAL)) - (CL:WHEN (STREAMP FILE) - (SETFILEPTR FILE 0) - (PROG1 (AND (EQ (BIN FILE) - (CHARCODE %%)) - (EQ (BIN FILE) - (CHARCODE P)) - (EQ (BIN FILE) - (CHARCODE D)) - (EQ (BIN FILE) - (CHARCODE F))) - (SETFILEPTR FILE 0)))]) +(* ;; "") -(PDF.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 24-Jul-2023 10:37 by rmk") - (* ; "Edited 23-Jun-2023 13:28 by rmk") - (* ; "Edited 6-Mar-2023 22:43 by rmk") - (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) - (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) - FILE]) -(PDF.TEXT - [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 23-Jun-2023 13:23 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION - ROTATION ,(NOT (NOT - POSTSCRIPT.TEXTFILE.LANDSCAPE - ]) -(PDF.TEDIT - [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (LET ((TSTREAM (OPENTEXTSTREAM FILE))) - (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) - (CLOSEF TSTREAM]) -) + +(* ;; "Implementation of PDF streams") + (RPAQ? PDFCONVERTER 'ps2pdf) + + +(* ; "Mac with ghostscript?") + + (ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) - -(RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) +(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) ) (DEFINEQ -(PDF-INIT - [LAMBDA NIL (* ; "Edited 25-Jun-2023 16:41 by rmk") - (* ; "Edited 23-Jun-2023 11:23 by rmk") - - (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") - - (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ - (FUNCTION CLOSE-PDF-STREAM))) - (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]) - (OPEN-PDF-STREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") + [LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk") + (* ; "Edited 22-Sep-2023 11:04 by rmk") + (* ; "Edited 24-Jun-2023 14:49 by rmk") (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") @@ -148,44 +117,45 @@ (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] then - (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie that and give it a PDF extension so it thinks that we are heading to a PDF printer.") + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.") (OPENPOSTSCRIPTSTREAM FILE OPTIONS) else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) PDF-CONVERTER-TEMPLATES)) (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (SETQ FILE (OR (AND (NEQ FILE T) + (OUTFILEP FILE)) + (ERROR "PDF target file not found" FILE))) (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) "-" (RAND) ".ps") OPTIONS))) - (replace (STREAM IMAGEOPS) of PSSTREAM with \PDFIMAGEOPS) - - (* ;; "Hopefully the postscript implementation functions won't notice that we did a shift to get the IMAGETYPE and IMCLOSEFN") - - (replace (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) - of PSSTREAM) with FILE) + (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM))) + (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE) PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 24-Jul-2023 10:37 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk") + (* ; "Edited 24-Jul-2023 10:37 by rmk") (* ; "Edited 17-Jul-2023 22:32 by rmk") (* ; "Edited 24-Jun-2023 13:57 by rmk") - (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + (* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") - (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") - - (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) - (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (RENAMEFILE (PS-TO-PDF (CLOSEF PSSTREAM)) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) - of PSSTREAM))))]) + (STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ; + "Maybe just remove only CLOSE-PDF-STREAMfrom the list?") + (LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL))) + (CL:IF TARGETINFO + (RENAMEFILE (PS-TO-PDF PSSTREAM) + TARGETINFO) + PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Jul-2023 22:30 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 15:30 by rmk") + (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") (* ; "Edited 8-Jul-2022 10:20 by rmk") @@ -207,20 +177,24 @@ (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") - (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") + (* ;; + "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.") - [SETQ COMPLETIONCODE (PROCESS-COMMAND - (CONCATLIST (SUBLIS `[(PSFILE \, (SLASHIT (PACKFILENAME 'HOST NIL - 'BODY PSFILE))) - (PDFFILE \, (SLASHIT (PACKFILENAME 'HOST NIL - 'BODY PDFFILE))) - (ERRORFILE \, (SLASHIT (PACKFILENAME - 'HOST NIL 'BODY - ERRORFILE] - (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS + `((PSFILE \, (SLASHIT (TRUEFILENAME + PSFILE) + NIL T)) + (PDFFILE \, (SLASHIT (TRUEFILENAME + PDFFILE) + NIL T)) + (ERRORFILE \, (SLASHIT (TRUEFILENAME + ERRORFILE) + NIL T))) + (ASSOC (OR PDFCONVERTER + (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER" - ))) - PDF-CONVERTER-TEMPLATES] + ))) + PDF-CONVERTER-TEMPLATES] (* ;; "Now use Medley names") @@ -236,12 +210,7 @@ (ERROR "Cannot create PDF file for " PDFFILE)) PDFFILE]) ) - -(MOVD? 'CL:IDENTITY 'TRUEFILENAME) - -(PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2929 5370 (PDFFILEP 2939 . 3853) (PDF.HARDCOPYW 3855 . 4389) (PDF.TEXT 4391 . 4999) ( -PDF.TEDIT 5001 . 5368)) (5718 13064 (PDF-INIT 5728 . 6453) (OPEN-PDF-STREAM 6455 . 8558) ( -CLOSE-PDF-STREAM 8560 . 9864) (PS-TO-PDF 9866 . 13062))))) + (FILEMAP (NIL (3630 10729 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 + . 10727))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index cba1e2e5d4305d08b30acc0f71437b9ca21dc404..ba009eae5b2a9602d4822a9e6fbe44635eea02e4 100644 GIT binary patch literal 4189 zcmds4OK;mo5S9}ZXxRoxP_zdhf&qa5Q~@d?C0UOYi7An?iBKd%Qceu?5I^WxiERmz z`UrwtdhAbVdrpDgQXuF2rREQ`{brY@DBEe8Ll3PE((LTa?Ci{ZGb_z@`mXQjeb;kz z*Y5{(J+yjvtqq4%*H4_tbK_8@>ycyGiPiPau)9|5kWnowipCat5KA1JRI{eX=|nfH zW{r$Sr`GB;8Y*e(-uQSjI!gCxd_pQcyFYMj&)I(d<lzg=Lku&VN%Dj-9+zh)AaZWb$XkYzv0As5|F0!{rH^6A@A`O%G3!XXUh$Sv2G)v z=i_N~YPEO8uUS^k#-wAn6fLAGg>e=omkjukxB>ievB6m^Q|X75Qt8se5!=$cy&dv*A6CQ)KxzHS6Sxkgl2J zL{Sh?y-mR|;d_TvYh_H+put@$2?k`W(a?7v=o?Pr_*WMQ5J>)i~I`8BgIDuMiQY(|0N=*>DN^AIe#$G(X zIX|A`l{{VZ9HBzBZ^PTCVbWR6A7oChjjK4nFSE*LRb{-aeK4u?jZ+!Ai zI-RFe8qI|CY?AJc4o2y|s*qujDsjoOxnn@axl88tREP#w(P??1l5|wk%DT+0NN17e z-2W^~XHyiz)paDhUZu$KtpPd{`VBIl0|QuI%DYimacY`pGSeue0Q+TSVJUOnK!G3; z$Rz3{upMG_h{6zuyJV6b_=)X6!~sGKJ|WxUdoo$3l}|5~N|)tDc1zZ)%iq5&{jn%& zL9Ktng}r-8N)_>Qq2RS^D^g7W>u@Auw<=iHdDi9<>u_~-^&y}37VwHt3k~tLEnVuq zkiV~`G5P)54GBe|(tRPBuOGkpNg!Gx__h1^&5wn(byb*s`R8XP&1_aFiH0JToKgUx zc8alj^OUL~%8n<(YMONdu$UI$GEt5o1U$`Z2DJViGTN0I=wqi_$i# z2vkj3La6q3PPqT< zO;e0nK0)@R1K3i@tfRU7t%QNOd13qEMy>h*92G-~Fh;Z9#4{W7GD)@>%MqR}e5@P+ z;KbODLhIhWWiDyr$r6(mZ^vF>*=1TZN~v5XjrB?Uf^LzzIUYa3t71N;!=35=-gxqq zSLyU%XD?MDs#vzYWknDdKA_EShiLDb24~okq%fek6S5`g04Dw|eh_kwWyzKosRCSjy+^%9K1$l2fw zM*+M7p-|!`Xl?jp_hDn%jX0?qMwf`QfF^_%RdRYknI2I%kbWSfD}ulq5vWqwGeOE@ z+yS1QGV;ZPc(P~n{LFg>r}ojD<*Tz8j0G1W3a?^o%W^&OfGq@Vc?Yu66kcjk>?HKn z(z1e}i*U#!D|k6uLoX>Lo3wkw0Aqp^&T->M9%vCECJJegSI=XDa6mrHoJB3LP6Y*J z;~Cg#D%ldNKk zeImQXWM%^7r=|hQojv+?G(V(AhvV6Nwl^J3=66&Db}VkIT=#Ez;Ydp~na#(-B5505 z(6u~qHk9%=20M6BFT+0p5zI6BKmY2==R4e%4|xIYzr(nqAF)+>iZns&UA) z`8(IGlT~%v#X(N1?{4;O9Q0%{&rh2F^=xr|uTR+8oOp>pisHS`XcR`NYGABk&Z9VO z=!ggC=mh76<83OR-E20ibhv*3(Qe+^v03=~57O{08j;<$+db+lKhTZg9xYz{iTb07 zH``V$9@VT}FG*PyBlRenrgf@~XEOG~)MK4T(QH>Gx=#H#QM*C3lQw)92724Q0?$^j z?`-wk?Y9{M=Eb3G-&su@$G^UO4?pAUY{AtBmD*N|Ql;fqosiot_u5-z0E(&Ig01^g zH65x1u0}gE_FvvM^QNkaWx;G4#&bHn1?`4 zb*pvJx`er?9z*pw)p{CJfUP>v2#J7P3inSA&ky#`<`2+qQ=+zUAes)PBQI2AZ=|CH zeVc}Xo_f4J2eGkHsk~c&Car-$cW0wA8F<5yuik%;Ash&PK*x1T9^KxgI7)RoN`hFI zB!-SA?Q=lXaWWRe4^4gnrR-j*;N_qTpJoQ zK!q@%7jGxj%@~YgFoDy2T-m6+Gw?)D=qA6hd>^xt&#v+BL;M+?S=$z|R5}W#I7eJh zELysV=Xs(TdNUu8$BIpyMB3AA2q>PJ1X%fFK(SO7p=h*a(`w^ZYgL2bRT%1)ab{R% z;2k|XJQTT&q!V#-$lJCJ0gVZ62SN;Va~vg8uP_dLCyEsa_EB~v8>d$m4Q!lAHVZ~q9Xki5Ec4=lv+kpTGvI0?J z7Xw|kyYxAJ1^Ear{xSX*S1d5k;gl`0P`N-(6{#lG(N%N-+%Z=9i@9>}}5OJ8j%iYKPx!W|IS1lPE z-1R50X?IgBRw$SW*#!YbvylfT=}`jbBezF^&@E_6B?-dbv1$6Lr=uy^n_#HmQDa+y zb9UM2txg#=?DMF%q&ModR>9vA7DIj{NBnrn^eSm+HH|}%JO?$5k);5Y;11e!soFd{ zuTlq%MwMLre93Zr{mI3Pvrk^k50B?xG|mp6Vy@k$YN2G~;#896!Rg6g=8KE@f{xDV z6|CJdqNT~D!?Nu%OC!5vEqBE# z;?2c{nID4!B3MMR`;H=C5%Y_E5H|HI31f1k=&LV*g@o?fo_Z{(a9X>0Xd-ae2?8N#^D+u z*O5w7MC5eJEZ`up4KbjE*66}}c7|w^z17RL6$s(uj=M>ysR@J-B9!=RklRs3k&-SgC@G7BtUY44cwa3f9tOvoxG9665f7 zrFv7wvhvm{m%Ul(l~-d@HrMgTvOyo-m}!I)sV0RvT09QNjeI&FGl-fW4*(|ka^B)?IYq0gR`0i8W*IQ6PD6EaC*2CA%&ft zJBTzfs>hTE8L@jUN0_D9ad9eJsAkU1UJE53r2Y?-(3I>p$b%0c$_XntET^Z!2}xU*<30r_LXx`^L0JjE!C zDUn|U@6C0^4A!oMF|CbiL+TGW#tMhcJZ2d+C8gfry;RG>ri$#8PjIBH`%Upb(eVHP diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM deleted file mode 100644 index 80df2d18..00000000 --- a/library/POSTSCRIPTSTREAM +++ /dev/null @@ -1,4424 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "24-Jun-2023 14:49:45" {WMEDLEY}POSTSCRIPTSTREAM.;13 258994 - - :EDIT-BY rmk - - :CHANGES-TO (FNS CLOSEPOSTSCRIPTSTREAM) - - :PREVIOUS-DATE "23-Jun-2023 12:05:56" {WMEDLEY}POSTSCRIPTSTREAM.;12) - - -(* ; " -Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. -") - -(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) - -(RPAQQ POSTSCRIPTSTREAMCOMS - [ - (* ;; "PostScript printer support for Medley") - - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) - (INITRECORDS \POSTSCRIPTDATA) - (FNS POSTSCRIPT.INIT) - (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) - (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD))) - - (* ;; "Font-reading code") - - (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE - PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES - POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS - POSTSCRIPT.FONTSAVAILABLE) - (COMS - (* ;; "Until macro in FONT is exported") - - (MACROS \FSETCHARWIDTH)) - (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) - (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY)) - (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE) - (FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR - POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE - POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK - \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC - \SWITCHFONTS.PSC \TERPRI.PSC) - - (* ;; "DIG operations: ") - - (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC - \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC - \DSPBOTTOMMARGIN.PSC \DSPCLIPPINGREGION.PSC \DSPCOLOR.PSC \DSPFONT.PSC - \DSPLEFTMARGIN.PSC \DSPLINEFEED.PSC \DSPPUSHSTATE.PSC \DSPPOPSTATE.PSC \DSPRESET.PSC - \DSPRIGHTMARGIN.PSC \DSPROTATE.PSC \DSPSCALE.PSC \DSPSCALE2.PSC \DSPSPACEFACTOR.PSC - \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC - \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) - (COMS - (* ;; "Character-output, plus special-cases:") - - (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG - \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN - \POSTSCRIPT.ACCENTPAIR) - - (* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") - - (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) - - (* ;; - "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") - - (FNS \POSTSCRIPT.NSHASH) - (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) - *POSTSCRIPT-NS-TRANSLATIONS*) - (GLOBALVARS *POSTSCRIPT-NS-HASH*)) - (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \POSTSCRIPT.FRACTION)) - (VARS (\POSTSCRIPT.ORIENTATION.MENU (create MENU ITEMS _ '(("Landscape" T - "Print this file/document/image in Landscape Orientation" - ) - ("Portrait" 'NIL - "Print this file/document/image in Portrait Orientation" - )) - TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ - (create POSITION XCOORD _ -1 YCOORD _ 0) - CHANGEOFFSETFLG _ 'Y)) - (\POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T - "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL - "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ - T)) - PS.BITMAPARRAY \POSTSCRIPT.JOB.SETUP SlopeMenuItems WeightMenuItems) - [ADDVARS (BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - (MENU - \POSTSCRIPT.ORIENTATION.OPTIONS.MENU - )) - - "Select the default Orientation for PostScript output" - (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - 'ASK) - - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" '(SETQ - POSTSCRIPT.PREFER.LANDSCAPE - T) - - "Default printing to Landscape Orientation" - ) - ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - NIL) - - "Default printing to Portrait Orientation" - ] - (VARS (BackgroundMenu NIL)) - (CONSTANTS (GOLDEN.RATIO 1.618034) - (\PS.SCALE0 100) - (\PS.TEMPARRAYLEN 20)) - (INITVARS (POSTSCRIPT.BITMAP.SCALE 1) - (POSTSCRIPT.EOL 'CR) - (POSTSCRIPT.IMAGESIZEFACTOR 1) - (POSTSCRIPT.PREFER.LANDSCAPE NIL) - (POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) - (POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) - (POSTSCRIPT.TEXTURE.SCALE 4) - [POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>"] - (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) - [COMS (FNS POSTSCRIPTSEND) - (ADDVARS (PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR - REGION ROTATION TITLE] - [ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) - [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT] - (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC] - (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) - - (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") - - [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2] - (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST - POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE - POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE - \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE - POSTSCRIPT.PAGEREGIONS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (POSTSCRIPT.INIT))) - (PROP (FILETYPE MAKEFILE-ENVIRONMENT) - POSTSCRIPTSTREAM) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA - POSTSCRIPT.PUTCOMMAND - ]) - - - -(* ;; "PostScript printer support for Medley") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD FONTID (FONTIDNAME FONTXFACTOR FONTOBLIQUEFACTOR)) - -(RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) - -(DATATYPE \POSTSCRIPTDATA - ((POSTSCRIPTACCENTED FLAG) (* ; - "T if we're to do NS-to-PS translations on characters in the current font.") - POSTSCRIPTFONT (* ; - "The fontdescriptor of the current font") - POSTSCRIPTX (* ; "The current X") - POSTSCRIPTY (* ; "... and Y") - POSTSCRIPTLEFTMARGIN (* ; "The margins") - POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING - (* ; "Line to line spacing") - POSTSCRIPTCOLOR (* ; - "Color (or grey shade) in effect; 0.0=black, 1.0=white.") - POSTSCRIPTSCALE (* ; "Scale of the stream") - POSTSCRIPTOPERATION (* ; - "Default operation (PAINT, REPLACE, ...)") - POSTSCRIPTCLIPPINGREGION (* ; - "The current region available to be written into") - POSTSCRIPTPAGENUM (* ; "Current page number") - POSTSCRIPTHEADING (* ; "The heading") - POSTSCRIPTHEADINGFONT (* ; "Font for the heading") - POSTSCRIPTSPACEFACTOR (* ; - "Expansion factor for spaces (see DSPSPACEFACTOR)") - POSTSCRIPTSPACEWIDTH (* ; - "The width of a space in the current font") - POSTSCRIPTLANDSCAPE (* ; - "non-NIL for paper in 'landscape' mode") - POSTSCRIPTCHARSTOSHOW (* ; - "non-NIL if the string (PostScript-type string) of chars has already been started") - POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") - POSTSCRIPTMOVEFLG (* ; "Need to move") - POSTSCRIPTWIDTHS (* ; - "The widths vector of the current font") - POSTSCRIPTTRANSX (* ; "Translation in X") - POSTSCRIPTTRANSY (* ; "... and Y") - POSTSCRIPTPENDINGXFORM (* ; - "A userspace to devicespace transform is pending") - POSTSCRIPTPAGEREGION (* ; "The whole page") - POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") - POSTSCRIPTSCALEHACK (* ; - "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") - POSTSCRIPTTEMPARRAY (* ; - "For converting FIXP to string of digit chars") - POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") - POSTSCRIPTROTATION (* ; - "Rotation value currently in effect.") - POSTSCRIPTPENDINGROTATION (* ; - "Rotation to take effect at next SETXFORM.") - POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") - (POSTSCRIPTNSCHARSET BYTE) (* ; - "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") - (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; - "Width of the space in the current font, used to compute the scaled space width.") - POSTSCRIPTTARGETINFO (* ; - "For use of other imagetypes (like PDF) that might piggy-back on postscript.") - ) - POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 - POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY - _ (ARRAY \PS.TEMPARRAYLEN 'BYTE 0 0) - POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) - -(RECORD POSTSCRIPTXFORM ( - (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") - - PSXCLIP (* ; "Clipping region") - PSXPAGE (* ; "Page region") - PSXX (* ; "X position?") - PSXY (* ; "Y position?") - PSXLEFT (* ; "Left margin") - PSXRIGHT (* ; "Right margin") - PSXTOP (* ; "Top margin") - PSXBOTTOM (* ; "Bottom Margin") - PSXTRANX (* ; "X-translation in effect") - PSXTRANY (* ; "Y-translation in effect") - PSXLAND (* ; "Landscape?") - PSXXFORMPEND (* ; "Are there transforms pending? ") - )) -) - -(/DECLAREDATATYPE '\POSTSCRIPTDATA - '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD POINTER) - '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) - (\POSTSCRIPTDATA 0 POINTER) - (\POSTSCRIPTDATA 2 POINTER) - (\POSTSCRIPTDATA 4 POINTER) - (\POSTSCRIPTDATA 6 POINTER) - (\POSTSCRIPTDATA 8 POINTER) - (\POSTSCRIPTDATA 10 POINTER) - (\POSTSCRIPTDATA 12 POINTER) - (\POSTSCRIPTDATA 14 POINTER) - (\POSTSCRIPTDATA 16 POINTER) - (\POSTSCRIPTDATA 18 POINTER) - (\POSTSCRIPTDATA 20 POINTER) - (\POSTSCRIPTDATA 22 POINTER) - (\POSTSCRIPTDATA 24 POINTER) - (\POSTSCRIPTDATA 26 POINTER) - (\POSTSCRIPTDATA 28 POINTER) - (\POSTSCRIPTDATA 30 POINTER) - (\POSTSCRIPTDATA 32 POINTER) - (\POSTSCRIPTDATA 34 POINTER) - (\POSTSCRIPTDATA 36 POINTER) - (\POSTSCRIPTDATA 38 POINTER) - (\POSTSCRIPTDATA 40 POINTER) - (\POSTSCRIPTDATA 42 POINTER) - (\POSTSCRIPTDATA 44 POINTER) - (\POSTSCRIPTDATA 46 POINTER) - (\POSTSCRIPTDATA 48 POINTER) - (\POSTSCRIPTDATA 50 POINTER) - (\POSTSCRIPTDATA 52 POINTER) - (\POSTSCRIPTDATA 54 POINTER) - (\POSTSCRIPTDATA 56 POINTER) - (\POSTSCRIPTDATA 58 POINTER) - (\POSTSCRIPTDATA 60 POINTER) - (\POSTSCRIPTDATA 62 POINTER) - (\POSTSCRIPTDATA 64 POINTER) - (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15)) - (\POSTSCRIPTDATA 68 POINTER)) - '70) -) - -(/DECLAREDATATYPE '\POSTSCRIPTDATA - '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD POINTER) - '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) - (\POSTSCRIPTDATA 0 POINTER) - (\POSTSCRIPTDATA 2 POINTER) - (\POSTSCRIPTDATA 4 POINTER) - (\POSTSCRIPTDATA 6 POINTER) - (\POSTSCRIPTDATA 8 POINTER) - (\POSTSCRIPTDATA 10 POINTER) - (\POSTSCRIPTDATA 12 POINTER) - (\POSTSCRIPTDATA 14 POINTER) - (\POSTSCRIPTDATA 16 POINTER) - (\POSTSCRIPTDATA 18 POINTER) - (\POSTSCRIPTDATA 20 POINTER) - (\POSTSCRIPTDATA 22 POINTER) - (\POSTSCRIPTDATA 24 POINTER) - (\POSTSCRIPTDATA 26 POINTER) - (\POSTSCRIPTDATA 28 POINTER) - (\POSTSCRIPTDATA 30 POINTER) - (\POSTSCRIPTDATA 32 POINTER) - (\POSTSCRIPTDATA 34 POINTER) - (\POSTSCRIPTDATA 36 POINTER) - (\POSTSCRIPTDATA 38 POINTER) - (\POSTSCRIPTDATA 40 POINTER) - (\POSTSCRIPTDATA 42 POINTER) - (\POSTSCRIPTDATA 44 POINTER) - (\POSTSCRIPTDATA 46 POINTER) - (\POSTSCRIPTDATA 48 POINTER) - (\POSTSCRIPTDATA 50 POINTER) - (\POSTSCRIPTDATA 52 POINTER) - (\POSTSCRIPTDATA 54 POINTER) - (\POSTSCRIPTDATA 56 POINTER) - (\POSTSCRIPTDATA 58 POINTER) - (\POSTSCRIPTDATA 60 POINTER) - (\POSTSCRIPTDATA 62 POINTER) - (\POSTSCRIPTDATA 64 POINTER) - (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15)) - (\POSTSCRIPTDATA 68 POINTER)) - '70) -(DEFINEQ - -(POSTSCRIPT.INIT - [LAMBDA NIL (* ; "Edited 14-May-2018 10:48 by rmk:") - (* ; "Edited 4-Feb-93 21:08 by jds") - (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE)) - - (* ;; "Add POSTSCRIPT font descriptions to the active font profile.") - - [MAPC - [CL:REMOVE-DUPLICATES (NCONC (for FD in FONTDEFS - join (for FP in (CDR (ASSOC 'FONTPROFILE - (CDR FD))) - collect (CAR FP))) - '(FONT7 FONT6 FONT5 FONT4 FONT3 FONT2 FONT1 BOLDFONT LITTLEFONT - BIGFONT PRETTYCOMFONT COMMENTFONT USERFONT SYSTEMFONT - CLISPFONT LAMBDAFONT CHANGEFONT DEFAULTFONT] - (FUNCTION (LAMBDA (CLASS) - (LET - (COPYFD OLDPSCFD) - (if (BOUNDP CLASS) - then - (SETQ CLASS (EVALV CLASS)) - (if (TYPEP CLASS 'FONTCLASS) - then (SETQ COPYFD (OR (fetch (FONTCLASS INTERPRESSFD) of CLASS) - (fetch (FONTCLASS PRESSFD) of CLASS) - (fetch (FONTCLASS DISPLAYFD) of CLASS))) - (if (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch (FONTCLASS - OTHERFDS) - of CLASS))) - then [if (NOT (CDR OLDPSCFD)) - then (RPLACD OLDPSCFD (if (LISTP COPYFD) - then COPYFD - else (FONTUNPARSE - COPYFD] - else (push (fetch (FONTCLASS OTHERFDS) of CLASS) - (CONS 'POSTSCRIPT (if (LISTP COPYFD) - then COPYFD - else (FONTUNPARSE COPYFD] - [FOR FD IN FONTDEFS - DO (FOR FP IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) - DO (COND - ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP)) - - (* ;; "There's already a postscript spec, so leave it be.") - - ) - (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP) - (CL:FOURTH FP) - (CL:THIRD FP] - - (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.") - - (FOR FD IN (FONTSAVAILABLE '* '* '* '* 'POSTSCRIPT) - DO (APPLY (FUNCTION SETFONTDESCRIPTOR) - FD)) - (SETQ POSTSCRIPTFONTCACHE NIL) - (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T)) - - (* ;; "\POSTSCRIPT.OUTCHARFN uses this array to quickly determine whether a character needs any special processing -- T means yes") - - (for x from (CHARCODE SP) to 126 unless (FMEMB x (CHARCODE (%( %) \))) - do (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE x) - NIL)) - - (* ;; "RMK: Maybe the following is equivalent to alot of the stuff above??") - - (FONTPROFILE.ADDDEVICE 'POSTSCRIPT 'INTERPRESS) - (SETQ \POSTSCRIPTIMAGEOPS (create IMAGEOPS - IMAGETYPE _ 'POSTSCRIPT - IMCLOSEFN _ (FUNCTION CLOSEPOSTSCRIPTSTREAM) - IMXPOSITION _ (FUNCTION \DSPXPOSITION.PSC) - IMYPOSITION _ (FUNCTION \DSPYPOSITION.PSC) - IMMOVETO _ (FUNCTION \MOVETO.PSC) - IMFONT _ (FUNCTION \DSPFONT.PSC) - IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.PSC) - IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.PSC) - IMLINEFEED _ (FUNCTION \DSPLINEFEED.PSC) - IMDRAWLINE _ (FUNCTION \DRAWLINE.PSC) - IMDRAWCURVE _ (FUNCTION \DRAWCURVE.PSC) - IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.PSC) - IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.PSC) - IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.PSC) - IMBLTSHADE _ (FUNCTION \BLTSHADE.PSC) - IMBITBLT _ (FUNCTION \BITBLT.PSC) - IMSCALEDBITBLT _ (FUNCTION \SCALEDBITBLT.PSC) - IMNEWPAGE _ (FUNCTION \NEWPAGE.PSC) - IMSCALE _ (FUNCTION \DSPSCALE.PSC) - IMSCALE2 _ (FUNCTION \DSPSCALE2.PSC) - IMCOLOR _ (FUNCTION \DSPCOLOR.PSC) - IMTERPRI _ (FUNCTION \TERPRI.PSC) - IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.PSC) - IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.PSC) - IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.PSC) - IMFONTCREATE _ 'POSTSCRIPT - IMCLIPPINGREGION _ (FUNCTION \DSPCLIPPINGREGION.PSC) - IMRESET _ (FUNCTION \DSPRESET.PSC) - IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.PSC) - IMFILLPOLYGON _ (FUNCTION \FILLPOLYGON.PSC) - IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.PSC) - IMCHARWIDTH _ (FUNCTION \CHARWIDTH.PSC) - IMDRAWARC _ (FUNCTION \DRAWARC.PSC) - IMROTATE _ (FUNCTION \DSPROTATE.PSC) - IMTRANSLATE _ (FUNCTION \DSPTRANSLATE.PSC) - IMDRAWPOINT _ (FUNCTION \DRAWPOINT.PSC) - IMPUSHSTATE _ (FUNCTION \DSPPUSHSTATE.PSC) - IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC))) - (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255)) - (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) -) - -(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) - -(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD)) - - - -(* ;; "Font-reading code") - -(DEFINEQ - -(PSCFONT.READFONT - [LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:") - (* ; "Edited 1-Sep-89 10:55 by jds") - - (* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.") - - (LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T] - (PF (create PSCFONT))) - [replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"] - - (* ;; "Read until we hit a 255 byte, marking the end of the font-id section.") - - (CL:DO NIL - ((EQ (BIN S) - 255)) - - (* ;; "Body of the loop is empty, the test does all of the work") - - ) - (replace (PSCFONT IL-FONTID) of PF with (CAR FID)) - (replace (PSCFONT FIRSTCHAR) of PF with (\WIN S)) - (replace (PSCFONT LASTCHAR) of PF with (\WIN S)) - (replace (PSCFONT ASCENT) of PF with (\WIN S)) - (replace (PSCFONT DESCENT) of PF with (\WIN S)) - (replace (PSCFONT WIDTHS) of PF with (SETQ W (ARRAY 256 'SMALLPOSP 0 0))) - (for C from 0 to 255 do (SETA W C (\WIN S))) - (CLOSEF S) - - (* ;; - "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.") - - (replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) - OF PF))) - (PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME)) - (CREATE PSCFONT USING PF))) - PF]) - -(PSCFONT.SPELLFILE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 22:15 by rmk:") - (* ; "Edited 5-Oct-92 15:23 by jds") - - (* ;; - "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.") - - (CL:WHEN POSTSCRIPTFONTDIRECTORIES - (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST)) - FAMILY) - SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES '(PSCFONT PF PSC)))]) - -(PSCFONT.COERCEFILE - [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) - (* ; "Edited 5-Oct-93 16:28 by rmk:") - - (* ;; -"This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching file.") - - (COND - ((AND (NEQ EXPANSION 'REGULAR) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) - ROTATION DEVICE]) - -(PSCFONTFROMCACHE.SPELLFILE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 17:54 by rmk:") - (* ; "Edited 5-Oct-92 15:23 by jds") - - (* ;; "Tries to find postscript font information in the cache, indexed by the name-field of the fontfile. ") - - (LET [(CACHE (CDR (ASSOC (L-CASE (FILENAMEFIELD (\FONTFILENAME (OR (CDR (FASSOC FAMILY - POSTSCRIPT.FONT.ALIST - )) - FAMILY) - SIZE FACE 'PSCFONT 0) - 'NAME)) - POSTSCRIPTFONTCACHE] - (IF CACHE - THEN (CREATE PSCFONT USING CACHE]) - -(PSCFONTFROMCACHE.COERCEFILE - [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) - (* ; "Edited 5-Oct-93 17:00 by rmk:") - - (* ;; "This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching font in the cache.") - - (COND - ((AND (NEQ EXPANSION 'REGULAR) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) - ROTATION DEVICE]) - -(PSCFONT.WRITEFONT - [LAMBDA (FONTFILENAME PF) (* ; - "Edited 5-Aug-93 16:28 by sybalskY:MV:ENVOS") - - (* ;; "Given a PSCFONT data structure, write it out as a properly-named xxx.PSCFONT file, for later reading.") - - NIL - (LET ([S (OPENSTREAM FONTFILENAME 'OUTPUT NIL '((TYPE BINARY) - (SEQUENTIAL T] - (W (fetch (PSCFONT WIDTHS) of PF)) - (*READTABLE* (FIND-READTABLE "INTERLISP"))) - (PRIN3 (fetch (PSCFONT FID) of PF) - S) - (BOUT S 0) - (BOUT S 255) - (\WOUT S (fetch (PSCFONT FIRSTCHAR) of PF)) - (\WOUT S (fetch (PSCFONT LASTCHAR) of PF)) - (\WOUT S (fetch (PSCFONT ASCENT) of PF)) - (\WOUT S (fetch (PSCFONT DESCENT) of PF)) - (for C from 0 to 255 do (\WOUT S (ELT W C))) - (CLOSEF S) - FONTFILENAME]) - -(READ-AFM-FILE - [LAMBDA (FILE BOLDNESS ITALICNESS) (* ; - "Edited 5-Aug-93 16:37 by sybalskY:MV:ENVOS") - - (* ;; - "Read an Adobe-version-3 AFM file, and extract the metrics from it for making a PSCFONT file.") - - (LET ((IFILE (OPENSTREAM FILE 'INPUT)) - (PSCFONT (create PSCFONT)) - (FCHAR 1000) - (LCHAR 0) - (W (ARRAY 256 'SMALLPOSP 0 0)) - TOKEN WEIGHT SLOPE HEIGHT CMCOUNT FBBOX) - (with PSCFONT PSCFONT (repeatuntil (STRING-EQUAL "FontName" (RSTRING IFILE)) - do (READCCODE IFILE)) - (repeatwhile (STRING-EQUAL "" (SETQ TOKEN (RSTRING IFILE))) - do (READCCODE IFILE)) - [COND - ((NOT (AND (BOUNDP 'WeightMenu) - (type? MENU WeightMenu))) - (SETQ WeightMenu (create MENU - ITEMS _ WeightMenuItems - MENUFONT _ (FONTCREATE 'HELVETICA 12] - [COND - ((NOT (AND (BOUNDP 'SlopeMenu) - (type? MENU SlopeMenu))) - (SETQ SlopeMenu (create MENU - ITEMS _ SlopeMenuItems - MENUFONT _ (FONTCREATE 'HELVETICA 12] - (OR (SETQ WEIGHT BOLDNESS) - (printout T T "Font WEIGHT for " PSCFONT ": " (SETQ WEIGHT (MENU WeightMenu)) - T)) - (OR (SETQ SLOPE ITALICNESS) - (printout T T "Font SLOPE for " PSCFONT ": " (SETQ SLOPE (MENU SlopeMenu)) - T)) - (SETQ FID (LIST TOKEN WEIGHT SLOPE 'REGULAR)) - [SETQ IL-FONTID (COND - ((AND (EQ SLOPE 'REGULAR) - (EQ WEIGHT 'MEDIUM)) - TOKEN) - (T (POSTSCRIPT.GETFONTID FID WEIGHT SLOPE 'REGULAR] - [repeatuntil (STRING-EQUAL "StartCharMetrics" TOKEN) - do (SETQ TOKEN (RSTRING IFILE)) - (COND - [(STRING-EQUAL "FontBBox" TOKEN) - (SETQ FBBOX (LIST (READ IFILE) - (READ IFILE) - (READ IFILE) - (READ IFILE))) - - (* ;; "The Ascender and Descender properties from the AFM file are currently ignored, and the values from the FontBBox are used, SCALED to the height of the font.") - - (SETQ DESCENT (IABS (CADR FBBOX))) - (SETQ ASCENT (CADDDR FBBOX)) - (SETQ HEIGHT (IPLUS ASCENT DESCENT)) - [SETQ DESCENT (FIXR (FTIMES DESCENT (/ 1000 HEIGHT] - (SETQ ASCENT (FIXR (FTIMES ASCENT (/ 1000 HEIGHT] - (T (READCCODE IFILE] - (SETQ CMCOUNT (RATOM IFILE)) - (repeatuntil (EQ (CHARCODE EOL) - (READCCODE IFILE)) do) - (SETQ WIDTHS W) - (for CC from 1 to CMCOUNT - do (LET (CCODE) - (repeatuntil (EQ 'C (RATOM IFILE)) do) - (SETQ CCODE (READ IFILE)) - (RATOMS 'WX IFILE) - (SETQ CWIDTH (READ IFILE)) - [COND - ((CL:PLUSP CCODE) (* ; - "This character appears in the standard encoding, so just use the charcode.") - (COND - ((ILESSP CCODE FCHAR) - (SETQ FCHAR CCODE))) - (COND - ((IGREATERP CCODE LCHAR) - (SETQ LCHAR CCODE))) - (SETA W CCODE CWIDTH)) - (T (* ; "A character not in the standard encoding; look it up to see if it's one we need (eth & thorn are brought into the CS-0 codespace for UToronto's work).") - (repeatuntil (EQ 'N (RATOM IFILE)) do - - (* ;; - "Skip to the N entry, which gives the Adobe-standard name.") -) - (SETQ CNAME (RATOM IFILE)) - (* ; "GET THE NAME") - (SETQ CCODE (LISTGET *POSTSCRIPT-EXTRA-CHARACTERS* CNAME)) - (COND - (CCODE (COND - ((ILESSP CCODE FCHAR) - (SETQ FCHAR CCODE))) - (COND - ((IGREATERP CCODE LCHAR) - (SETQ LCHAR CCODE))) - (SETA W CCODE CWIDTH] - (repeatuntil (EQ (CHARCODE EOL) - (READCCODE IFILE)) do))) - (SETQ FIRSTCHAR FCHAR) - (SETQ LASTCHAR LCHAR)) - (CLOSEF IFILE) - PSCFONT]) - -(CONVERT-AFM-FILES - [LAMBDA (FILE-LIST) (* ; - "Edited 5-Aug-93 16:47 by sybalskY:MV:ENVOS") - (for FL in FILE-LIST do (LET ((FNAME (pop FL)) - FONT FILENAME) - (for AFM-FILE in FL as WEIGHT - in '(MEDIUM MEDIUM BOLD BOLD) as SLOPE - in '(REGULAR ITALIC REGULAR ITALIC) - do (SETQ FONT (READ-AFM-FILE AFM-FILE WEIGHT - SLOPE)) - (SETQ FILENAME (\FONTFILENAME - FNAME 1 (LIST WEIGHT SLOPE - 'REGULAR) - 'PSCFONT 0)) - (PSCFONT.WRITEFONT FILENAME FONT]) - -(POSTSCRIPT.GETFONTID - [LAMBDA (FID WEIGHT SLOPE EXPANSION) (* ; - "Edited 20-Nov-92 15:04 by sybalsky:mv:envos") - (LET (FONTID) - (SETQ FONTID (create FONTID - FONTIDNAME _ (CAR FID) - FONTXFACTOR _ 1.0 - FONTOBLIQUEFACTOR _ 0.0)) - [if (AND (NEQ (CADDR FID) - SLOPE) - (EQ SLOPE 'ITALIC)) - then (replace (FONTID FONTOBLIQUEFACTOR) of FONTID - with (CONSTANT (TAN 7.0] - (if (AND (NEQ (CADR FID) - WEIGHT) - (EQ WEIGHT 'BOLD)) - then (* ; "Fake bold by slight expansion.") - (replace (FONTID FONTXFACTOR) of FONTID with 1.1)) - [if (NEQ EXPANSION 'REGULAR) - then (replace (FONTID FONTXFACTOR) of FONTID - with (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (if (EQ EXPANSION 'COMPRESSED) - then (CONSTANT (QUOTIENT 1.0 GOLDEN.RATIO)) - else GOLDEN.RATIO] - FONTID]) - -(POSTSCRIPT.FONTCREATE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 29-Oct-93 16:39 by rmk:") - (* ; "Edited 3-Feb-93 17:22 by jds") - (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD - FACECHANGED (WEIGHT (CAR FACE)) - (SLOPE (CADR FACE)) - (EXPANSION (CADDR FACE))) - - (* ;; - "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") - - [COND - [(EQ SIZE 1) - - (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") - - (COND - ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - - (* ;; "Check in-core cache for exact match first") - - (SETQ FACECHANGED NIL)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - - (* ;; "Check file for exact match next") - - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED NIL)) - ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION - ROTATION DEVICE)) - - (* ;; "Then check cache for coerced match") - - (SETQ FACECHANGED T)) - ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION - DEVICE)) - - (* ;; "Check file for coerced match") - - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED T))) - (COND - (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) - 0.1))) - (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (COND - (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD - with (POSTSCRIPT.GETFONTID (fetch (PSCFONT - FID) - of PSCFD) - WEIGHT SLOPE EXPANSION] - ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) - (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) - 'PSCFONT)) - - (* ;; "Scale the ASCENT and DESCENT") - - (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) - 0.1))) - (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (SETQ SCALEFONTP T)) - (T - (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") - - (COND - ([SETQ PSCFD (COND - ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION - DEVICE)) - (PSCFONT.READFONT FULLNAME] - (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) - (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) - (SETQ SCALEFONTP NIL] - (COND - (PSCFD - (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") - - (SETQ FD - (create FONTDESCRIPTOR - OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) - FONTSCALE _ 100 - FONTDEVICE _ DEVICE - FONTFAMILY _ FAMILY - FONTSIZE _ SIZE - FONTFACE _ FACE - ROTATION _ 0 - \SFHeight _ (IPLUS ASCENT DESCENT) - \SFAscent _ ASCENT - \SFDescent _ DESCENT)) - (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO 0 FD))) - (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) - [COND - [SCALEFONTP (for CH from 0 to 255 - do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE - (ELT FIXPWIDTHS - CH) - 0.1] - (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH - (ELT FIXPWIDTHS CH] - (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) - - (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") - - (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH - (\FGETWIDTH WIDTHSBLOCK CH))) - [LET [(TMP (COND - (FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE)) - (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] - - (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") - - (COND - ((AND TMP (NEQ FAMILY (CAR TMP))) - (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) - SIZE - (COPY FACE) - 0 DEVICE] - [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION - DEVICE)) - (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD - ROTATION DEVICE))) - - (* ;; - "Now run thru the mapping table, filling in the new font from whatever source is specified:") - - [MAPHASH *POSTSCRIPT-NS-HASH* - (FUNCTION (LAMBDA (MAPPING CODE) - (DESTRUCTURING-BIND - (KIND CODE2 BASECHAR) - MAPPING - - (* ;; - "Depending on what kind of item it is, process it:") - - (SELECTQ KIND - (NIL - (* ;; - "Translating an NS character to a PSC char in CS 0.") - - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - (\CHAR8CODE - CODE2)))) - (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH - FD CODE (ELT SYMWIDTHS - (\CHAR8CODE - CODE2]) - (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH - FD CODE (ELT DINGWIDTHS - (\CHAR8CODE - CODE2]) - (FUNCTION - (* ;; - "This is fake and only works for the fractions. Need a better case.") - - [\FSETCHARWIDTH - FD CODE - (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) - (FIXR (FTIMES 1.3 - (\FGETWIDTH - PSCWIDTHSBLOCK - (CHARCODE 1]) - (ACCENT (* ; - "CODE2 is the rendering character but width comes from width of basechar") - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - BASECHAR))) - (ACCENTPAIR - - (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent") - - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - CODE2))) - (PROGN - - (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else") - - NIL] - - (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") - - (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) - (CL:WHEN (EQ (CAR MAPPING) - 'APPLY*) - (\FSETCHARWIDTH - FD CODE (APPLY* (CADDDR - MAPPING - ) - FD - (CADR MAPPING)) - ))] - FD) - (T NIL]) - -(\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS - [LAMBDA (TYPE FD ROTATION DEVICE) (* ; "Edited 5-Oct-93 18:21 by rmk:") - - (* ;; "Returns the scaled widths for a unit font of type TYPE (SYMBOL or ZAPFDINGBATS) compatible with FD. A separate function so that the unit widths can be easily cached.") - - (LET [TYPEFONT WIDTHS NEWWIDTHS (SIZE (FETCH FONTSIZE OF FD)) - (FONTFILE (OR (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR FONTFACE) - OF FD) - ROTATION DEVICE) - (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE] - [SETQ TYPEFONT (COND - ((PSCFONTFROMCACHE.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR - FONTFACE) - OF FD) - ROTATION DEVICE)) - ((SETQ FONTFILE (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR - FONTFACE) - OF FD) - ROTATION DEVICE)) - (PSCFONT.READFONT FONTFILE)) - ((PSCFONTFROMCACHE.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE)) - ((SETQ FONTFILE (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE)) - (PSCFONT.READFONT FONTFILE] - (CL:WHEN (AND TYPEFONT (SETQ WIDTHS (FETCH (PSCFONT WIDTHS) OF TYPEFONT))) - (SETQ NEWWIDTHS (ARRAY 256 'SMALLPOSP 0 0)) - - (* ;; "Have to copy because of scaling") - - [FOR CH FROM 0 TO 255 DO (SETA NEWWIDTHS CH - (FIXR (TIMES SIZE (ELT WIDTHS CH) - 0.1] - NEWWIDTHS)]) - -(POSTSCRIPT.FONTSAVAILABLE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 12-Jan-88 13:04 by Matt Heffron") - - (* ;; "the filtering code was borrowed from Richard Burton's \SEARCHINTERPRESSFONTS. Note that without it [HELVETICA * (MEDIUM REGULAR REGULAR)] would pick up [HELVETICA-NARROW * (MEDIUM REGULAR REGULAR)] as well.") - - (LET - ((PATTERN (\FONTFILENAME (OR (CDR (ASSOC FAMILY POSTSCRIPT.FONT.ALIST)) - FAMILY) - SIZE FACE 'PSCFONT)) - [INVERSE.ALIST (for PAIR in POSTSCRIPT.FONT.ALIST collect (CONS (CDR PAIR) - (CAR PAIR] - FONTSAVAILABLE) - (SETQ FONTSAVAILABLE - (for FD in [for DIRECTORY in POSTSCRIPTFONTDIRECTORIES - join (for FILE in (DIRECTORY (CONCAT DIRECTORY PATTERN)) - collect (LET* ((RAWFD (\FONTINFOFROMFILENAME FILE DEVICE) - ) - (RAWNAME (CAR RAWFD))) - (RPLACA RAWFD - (OR (CDR (ASSOC RAWNAME - INVERSE.ALIST)) - RAWNAME] - when (AND (OR (EQ FAMILY '*) - (EQ FAMILY (CAR FD))) - (OR (EQ SIZE '*) - (EQ SIZE (CADR FD)) - (EQ (CADR FD) - 1)) - (OR (EQ FACE '*) - (EQUAL FACE (CADDR FD)) - (EQUAL [CDR (ASSOC FACE '((MRR MEDIUM REGULAR REGULAR) - (STANDARD MEDIUM REGULAR REGULAR) - (MIR MEDIUM ITALIC REGULAR) - (ITALIC MEDIUM ITALIC REGULAR) - (BRR BOLD REGULAR REGULAR) - (BOLD BOLD REGULAR REGULAR) - (BIR BOLD ITALIC REGULAR) - (BOLDITALIC BOLD ITALIC REGULAR] - (CADDR FD))) - (NOT (MEMBER FD $$VAL))) collect FD)) - (if (EQ SIZE '*) - then - -(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)") - - (for FD in FONTSAVAILABLE - join (if (EQ 1 (CADR FD)) - then (CONS FD (for NF - in (for S from 2 to - \POSTSCRIPT.MAX.WILD.FONTSIZE - collect (LET ((NFD (COPY FD))) - (RPLACA (CDR NFD) - S) - NFD)) - unless (MEMBER NF FONTSAVAILABLE) collect - NF)) - else (LIST FD))) - else FONTSAVAILABLE]) -) - - - -(* ;; "Until macro in FONT is exported") - -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) - (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO - (\CHARSET CHARCODE) - FONTDESC)) - (\CHAR8CODE CHARCODE) - WIDTH))) -) -(DEFINEQ - -(OPENPOSTSCRIPTSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") - (* ; - "Edited 31-May-93 12:42 by sybalsky:mv:envos") - (* ; "Edited 23-Dec-92 01:17 by jds") - - (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") - - (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) - 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) - (SEQUENTIAL T] - (IMAGEDATA (create \POSTSCRIPTDATA)) - PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX] - (replace (STREAM IMAGEDATA) of STREAM with IMAGEDATA) - (replace (STREAM IMAGEOPS) of STREAM with \POSTSCRIPTIMAGEOPS) - (replace (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION BOUT)) - - (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") - - (printout STREAM "%%!PS-Adobe-2.0" T %# (CL:WHEN BBOX - (PRINTOUT STREAM "%%%%BoundingBox: " - (CL:FLOOR (CAR BBOX) - \PS.SCALE0) - " " - (CL:FLOOR (CADR BBOX) - \PS.SCALE0) - " " - (CL:CEILING (CADDR BBOX) - \PS.SCALE0) - " " - (CL:CEILING (CADDDR BBOX) - \PS.SCALE0) - T)) - "%%%%Title: " - (MKSTRING (OR (LISTGET OPTIONS 'DOCUMENT.NAME) - FILE)) - T "%%%%Creator: PostScript Driver Copyright (C) 1988-1992 Venue and others" T - "%%%%CreationDate: " (DATE) - T %# (COND - ((EQ 'LPT (FILENAMEFIELD STREAM 'HOST)) - - (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") - - (PRINTOUT NIL "%%%%For: " (MKSTRING USERNAME) - T))) - "%%%%EndComments" T) - (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR STREAM X) - (\BOUTEOL STREAM)) - (SETQ PAPER (OR (CDR (CL:ASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE) - (LISTGET OPTIONS 'PAPERTYPE) - POSTSCRIPT.PAGETYPE)) - POSTSCRIPT.PAGEREGIONS :TEST #'STRING-EQUAL)) - (ERROR "Unknown PostScript page type" PAPER))) - - (* ;; "Set the paper size:") - - (PRINTOUT STREAM (L-CASE (OR (LISTGET OPTIONS 'PAGETYPE) - (LISTGET OPTIONS 'PAPERTYPE) - POSTSCRIPT.PAGETYPE)) - T) - (COND - ((NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR] - (CL:PLUSP IMAGESIZEFACTOR))) - (SETQ IMAGESIZEFACTOR 1))) - [COND - ((AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR) - (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR)) - (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR] - (printout STREAM "/imagesizefactor " IMAGESIZEFACTOR " def" T) - (printout STREAM "%%%%EndSetup" T) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with \PS.SCALE0) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA - with (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (CAR PAPER))) - - (* ;; - "Initial clipping region can be specified separately from the page size, default is to page size.") - - [replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA - with (SETQ CLIP (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (OR (CADR PAPER) - (CAR PAPER] - - (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") - - (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) - (INTERSECTREGIONS REG CLIP)) - (CREATEREGION 3600 3600 54000 72000))) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (REGION LEFT) of REG)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (REGION BOTTOM) of REG)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA - with (PLUS (fetch (REGION BOTTOM) of REG) - (fetch (REGION HEIGHT) of REG) - -1)) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with (PLUS (fetch (REGION LEFT) of REG) - (fetch (REGION WIDTH) of REG) - -1)) - (\DSPFONT.PSC STREAM (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS] - DEFAULTFONT) - NIL NIL NIL STREAM)) - (\SWITCHFONTS.PSC STREAM IMAGEDATA) - [COND - ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA - with (LISTGET OPTIONS 'HEADING)) - (replace (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) of IMAGEDATA - with (COND - ((LISTGET OPTIONS 'HEADINGFONT) - (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) - NIL NIL NIL STREAM)) - (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] - - (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") - - (COND - ([COND - ((CL:GETF OPTIONS 'LANDSCAPE NIL)) - ((EQL (CL:GETF OPTIONS 'ROTATION 'DEFAULT) - 'DEFAULT) - (COND - ((EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - (MENU \POSTSCRIPT.ORIENTATION.MENU)) - (T POSTSCRIPT.PREFER.LANDSCAPE))) - (T (CL:GETF OPTIONS 'ROTATION] - (POSTSCRIPT.SET-FAKE-LANDSCAPE STREAM 90))) - - (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") - - (\EXTERNALFORMAT STREAM (CREATE EXTERNALFORMAT - NAME _ 'POSTSCRIPT - OUTCHARFN _ (FUNCTION \POSTSCRIPT.OUTCHARFN) - EOL _ (FETCH (STREAM EOLCONVENTION) OF STREAM))) - (POSTSCRIPT.STARTPAGE STREAM) - STREAM]) - -(CLOSEPOSTSCRIPTSTREAM - [LAMBDA (STREAM) (* ; "Edited 24-Jun-2023 13:48 by rmk") - (* ; "Edited 8-Mar-93 10:31 by jds") - (POSTSCRIPT.ENDPAGE STREAM) (* BOUT STREAM (CHARCODE ^D)) - (* ; "Should this be the lsat byte?") - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL]) -) - -(RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) -(DEFINEQ - -(POSTSCRIPT.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) - (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (ALLOW.BUTTON.EVENTS) - (LET* ((STREAM (OPENPOSTSCRIPTSTREAM FILE (LIST 'DOCUMENT.NAME TITLE 'ROTATION Landscape? - 'IMAGESIZEFACTOR SCALEFACTOR))) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (SCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) - SCALE) - [COND - [REGION (SETQ REGION (COPY REGION)) (* ; "In case we need to change it.") - [COND - ((< (fetch BITMAPWIDTH of BITMAP) - (+ (fetch (REGION LEFT) of REGION) - (fetch (REGION WIDTH) of REGION))) - (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH - of BITMAP) - (fetch (REGION - LEFT) - of REGION] - (COND - ((< (fetch BITMAPHEIGHT of BITMAP) - (+ (fetch (REGION BOTTOM) of REGION) - (fetch (REGION HEIGHT) of REGION))) - (replace (REGION HEIGHT) of REGION - with (- (fetch BITMAPHEIGHT of BITMAP) - (fetch (REGION BOTTOM) of REGION] - (T (SETQ REGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch BITMAPWIDTH of BITMAP) - HEIGHT _ (fetch BITMAPHEIGHT of BITMAP] - (SETQ SCALE (TIMES POSTSCRIPT.BITMAP.SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) - of IMAGEDATA))) - (BITBLT BITMAP (fetch (REGION LEFT) of REGION) - (fetch (REGION BOTTOM) of REGION) - STREAM - (PLUS (fetch (REGION LEFT) of SCLIP) - (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of SCLIP) - (TIMES SCALE (fetch (REGION WIDTH) of REGION))) - 2)) - (PLUS (fetch (REGION BOTTOM) of SCLIP) - (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of SCLIP) - (TIMES SCALE (fetch (REGION HEIGHT) of REGION))) - 2)) - (fetch (REGION WIDTH) of REGION) - (fetch (REGION HEIGHT) of REGION) - 'INPUT - 'REPLACE) - (CLOSEF STREAM) - (FULLNAME STREAM]) - -(POSTSCRIPT.TEDIT - [LAMBDA (FILE PFILE) (* ; "Edited 18-Sep-91 18:16 by jds") - - (* ;; "Make a PS file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.") - - [COND - ((STRINGP FILE) - (SETQ FILE (MKATOM FILE] - (SETQ FILE (OPENTEXTSTREAM FILE)) - (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT) - (CLOSEF? FILE) - PFILE]) - -(POSTSCRIPT.TEXT - [LAMBDA (FILE PSCFILE FONTS HEADING TABS) (* ; "Edited 23-Apr-89 11:31 by TAL") - (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS - `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE]) - -(POSTSCRIPTFILEP - [LAMBDA (FILE) (* ; "Edited 5-Mar-93 21:40 by rmk:") - (* ; "Edited 14-Jan-93 10:56 by jds") - (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) - '("PS" "PSC" "PSF") - :TEST - (FUNCTION STRING-EQUAL)) - (PROGN (SETFILEPTR FILE 0) - (PROG1 (AND (EQ (BIN FILE) - (CHARCODE %%)) - (EQ (BIN FILE) - (CHARCODE !))) - (SETFILEPTR FILE 0]) - -(MAKEEPSFILE - [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Apr-94 14:48 by rmk:") - - (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") - - (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT)) - (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) - IMAGEOBJ STREAM)) - (BOUNDINGBOX (LIST 0 0 (FETCH XSIZE OF IMAGEBOX) - (FETCH YSIZE OF IMAGEBOX] - [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT - `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) - ,(FETCH YSIZE OF IMAGEBOX] - (MOVETO (FETCH XKERN OF IMAGEBOX) - (FETCH YDESC OF IMAGEBOX) - STREAM) - (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) - IMAGEOBJ STREAM) - (CLOSEF STREAM]) -) -(DEFINEQ - -(POSTSCRIPT.BITMAPSCALE - [LAMBDA (WIDTH HEIGHT) (* ; "Edited 29-Apr-98 08:46 by rmk:") - (* ; - "Edited 20-Nov-92 14:52 by sybalsky:mv:envos") - (LET* ([PAGEREGION (\PS.SCALEREGION (/ 72 POSTSCRIPT.BITMAP.SCALE) - (CADR (FASSOC POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS] - (LONGEDGE (MAX (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION HEIGHT) of PAGEREGION))) - (SHORTEDGE (MIN (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION HEIGHT) of PAGEREGION))) - [MINDIMP (MIN (FQUOTIENT LONGEDGE (SETQ HEIGHT (TIMES HEIGHT POSTSCRIPT.BITMAP.SCALE))) - (FQUOTIENT SHORTEDGE (SETQ WIDTH (TIMES WIDTH POSTSCRIPT.BITMAP.SCALE] - (MINDIML (MIN (FQUOTIENT SHORTEDGE HEIGHT) - (FQUOTIENT LONGEDGE WIDTH))) - (PPL (if (EQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - then (MENU \POSTSCRIPT.ORIENTATION.MENU) - else POSTSCRIPT.PREFER.LANDSCAPE)) - MINDIM OTHERDIM SF1 SF2) - (if PPL - then (SETQ MINDIM MINDIML) - (SETQ OTHERDIM MINDIMP) - else (SETQ MINDIM MINDIMP) - (SETQ OTHERDIM MINDIML)) - (SETQ SF1 (if (GREATERP MINDIM 1) - then 1 - elseif (GREATERP MINDIM 0.75) - then 0.75 - elseif (GREATERP MINDIM 0.5) - then 0.5 - elseif (GREATERP MINDIM 0.25) - then 0.25 - else MINDIM)) - (SETQ SF2 (if (GREATERP OTHERDIM 1) - then 1 - elseif (GREATERP OTHERDIM 0.75) - then 0.75 - elseif (GREATERP OTHERDIM 0.5) - then 0.5 - elseif (GREATERP OTHERDIM 0.25) - then 0.25 - else OTHERDIM)) - (if (AND (LESSP SF1 1) - (LESSP SF1 SF2)) - then (CONS SF2 (NOT PPL)) - else (CONS SF1 PPL]) - -(POSTSCRIPT.CLOSESTRING - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM ") ") - (replace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL) - T) - (T NIL]) - -(POSTSCRIPT.ENDPAGE - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) - (COND - ((NOT (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA) - (POSTSCRIPT.PUTCOMMAND STREAM "grestore savepage restore "))) - (POSTSCRIPT.PUTCOMMAND STREAM "showpage" :EOL))) - - (* ;; -"Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of IMAGEDATA with NIL]) - -(POSTSCRIPT.OUTSTR - [LAMBDA (STREAM X) (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") - (DECLARE (LOCALVARS . T)) - (COND - ((FIXP X) (* ; "Common case, speed helps") - (\PS.BOUTFIXP STREAM X)) - [(STRINGP X) (* ; "Other common case") - (COND - [(ffetch (STRINGP FATSTRINGP) of X) - (for c infatstring X do (BOUT STREAM (\CHAR8CODE c] - (T (\BOUTS STREAM (ffetch (STRINGP BASE) of X) - (ffetch (STRINGP OFFST) of X) - (ffetch (STRINGP LENGTH) of X] - [(LITATOM X) - (for c inatom X do (BOUT STREAM (\CHAR8CODE c] - ((ZEROP X) - (BOUT STREAM (CHARCODE 0))) - (T [COND - ((TYPEP X 'RATIO) - (SETQ X (FLOAT X] - (for c in (CHCON X) do (BOUT STREAM (\CHAR8CODE c]) - -(POSTSCRIPT.PUTBITMAPBYTES - [LAMBDA (STREAM BITMAP DELIMFLG) - (DECLARE (GLOBALVARS PS.BITMAPARRAY) - (LOCALVARS . T)) (* ; "Edited 12-Jun-2021 15:17 by rmk:") - (LET* - ((WIDTH (fetch BITMAPWIDTH of BITMAP)) - (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) - (BMBASE (fetch BITMAPBASE of BITMAP)) - (BYTESPERROW (LRSH (IPLUS WIDTH 7) - 3)) - (BYTEOFFSETPERROW (LSH (fetch BITMAPRASTERWIDTH of BITMAP) - 1)) - (PS.BITMAPARRAYBASE (fetch (ARRAYP BASE) of PS.BITMAPARRAY))) - (COND - (DELIMFLG (LET ((POS 0) - BYTE) - (BOUT STREAM (CHARCODE SPACE)) - (BOUT STREAM (CHARCODE <)) - (\BOUTEOL STREAM) - (for R from (SUB1 HEIGHT) to 0 by -1 as ROWOFFSET - from (ITIMES (SUB1 HEIGHT) - BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) - do (for B from 1 to BYTESPERROW as BYTEOFFSET - from ROWOFFSET by 1 - do (COND - ((IGEQ POS 254) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 BYTE))) - (SETQ POS (IPLUS POS 2))) - (\BOUTEOL STREAM) - (SETQ POS 0)) - (BOUT STREAM (CHARCODE SPACE)) - (BOUT STREAM (CHARCODE >)) - (\BOUTEOL STREAM))) - (T - (LET* - ((PRVBM (BITMAPCREATE WIDTH 1)) - (PRVBASE (fetch BITMAPBASE of PRVBM))) - (for R from 0 to (SUB1 HEIGHT) as ROWOFFSET - from (ITIMES (SUB1 HEIGHT) - BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) - do - (LET ((POS 0) - (BYTEOFFSET ROWOFFSET) - (B 1) - (PRVO 0) - BYTE REPC) - [while (ILEQ B BYTESPERROW) - do (SETQ REPC - (for BB from B to BYTESPERROW as BO from BYTEOFFSET - by 1 as PO from PRVO by 1 - while (EQ (\GETBASEBYTE BMBASE BO) - (\GETBASEBYTE PRVBASE PO)) count T)) - (COND - [(IGEQ REPC 3) - (SETQ B (IPLUS B REPC)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) - (SETQ PRVO (IPLUS PRVO REPC)) - (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) - do (COND - ((IGEQ POS 251) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 3)) - [COND - ((IGEQ REPC 256) - (BOUT STREAM (CHARCODE F)) - (BOUT STREAM (CHARCODE F))) - (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH REPC 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 REPC] - (SETQ REPC (IDIFFERENCE REPC 256)) - (SETQ POS (IPLUS POS 4] - (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - (SETQ REPC - (for BB from B to BYTESPERROW as BO from - BYTEOFFSET - by 1 while (EQ (\GETBASEBYTE BMBASE BO) - BYTE) count T)) - (COND - [(IGEQ REPC 3) - (SETQ B (IPLUS B REPC)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) - (SETQ PRVO (IPLUS PRVO REPC)) - (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) - do (COND - ((IGEQ POS 249) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 2)) - [COND - ((IGEQ REPC 256) - (BOUT STREAM (CHARCODE F)) - (BOUT STREAM (CHARCODE F))) - (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH REPC 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 REPC] - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 BYTE))) - (SETQ REPC (IDIFFERENCE REPC 256)) - (SETQ POS (IPLUS POS 4] - (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - (COND - ((IGEQ POS 251) - (\BOUTEOL STREAM) - (SETQ POS 0))) - [COND - ((FMEMB BYTE '(178 179 180)) - - (* ;; "BYTE is B2, B3, or B4; quote it") - - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 4)) - (SETQ POS (IPLUS POS 2] - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE (LOGAND 15 BYTE) - )) - (SETQ B (IPLUS B 1)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET 1)) - (SETQ PRVO (IPLUS PRVO 1)) - (SETQ POS (IPLUS POS 2] - (\BOUTEOL STREAM)) - (\MOVEBYTES BMBASE ROWOFFSET PRVBASE 0 BYTESPERROW]) - -(POSTSCRIPT.PUTCOMMAND - [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") - (LET* ((STREAM (ARG S.STRS 1)) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - S#S) - (freplace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with NIL) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (POSTSCRIPT.SHOWACCUM STREAM))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (for STR# from 2 to S.STRS do (COND - ((EQ (SETQ S#S (ARG S.STRS STR#)) - :EOL) - (\BOUTEOL STREAM)) - (T (POSTSCRIPT.OUTSTR STREAM S#S]) - -(POSTSCRIPT.SET-FAKE-LANDSCAPE - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - - (* ;; "Set up for (or disable) fake landscaping") - - (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLAND (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) - 90) - (T 0))) - LAND C0 P0 C P ML MB MR MT) - (COND - ((AND ROTATION (NEQ (SETQ LAND (NOT (ZEROP ROTATION))) - (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\DSPTRANSLATE.PSC STREAM 0 0) - (SETQ C0 (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) - (SETQ P0 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) - (SETQ C (create REGION - WIDTH _ (fetch (REGION HEIGHT) of C0) - HEIGHT _ (fetch (REGION WIDTH) of C0))) - (SETQ P (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch (REGION HEIGHT) of P0) - HEIGHT _ (fetch (REGION WIDTH) of P0))) - [COND - (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) - of C0)) - [replace (REGION BOTTOM) of C with - (- (fetch (REGION WIDTH) - of P0) - (+ (fetch (REGION LEFT) - of C0) - (fetch (REGION WIDTH) - of C0] - (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - ) - (SETQ MB (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of - IMAGEDATA - ) - 1)) - (SETQ MR (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA)) - (SETQ MT (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - ) - 1))) - (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) - of P0) - (+ (fetch (REGION BOTTOM) - of C0) - (fetch (REGION HEIGHT) - of C0] - (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) - of C0)) - (SETQ ML (- (fetch (REGION HEIGHT) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - 1)) - (SETQ MB (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA)) - (SETQ MR (- (fetch (REGION HEIGHT) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - 1)) - (SETQ MT (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - C) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with P) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with ML) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with MB) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with MR) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with MT) - (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA with LAND) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\DSPRESET.PSC STREAM))) - OLAND]) - -(POSTSCRIPT.SHOWACCUM - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") - - (* ;; - "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") - - (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") - - (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") - - (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") - - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM)) - KERN) - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (SETQ KERN (STREAMPROP STREAM 'KERN)) - [COND - [(EQP (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA) - 1) - (COND - (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT ") " KERN " 0 3 -1 roll ashow"))) - (T (POSTSCRIPT.OUTSTR STREAM ") S"] - (T (POSTSCRIPT.OUTSTR STREAM ") ") - (POSTSCRIPT.OUTSTR STREAM (DIFFERENCE (ffetch (\POSTSCRIPTDATA - POSTSCRIPTSPACEWIDTH) - of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH - ) of IMAGEDATA))) - (COND - (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT " 0 " (CHARCODE SPACE) - " " KERN " 0 " - " 6 -1 roll awidthshow"))) - (T (POSTSCRIPT.OUTSTR STREAM (CONSTANT (CONCAT " 0 " (CHARCODE SPACE) - " 4 -1 roll widthshow"] - (\BOUTEOL STREAM) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL]) - -(POSTSCRIPT.STARTPAGE - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") - - (* ;; "Start up a new page in a Postscript document.") - - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - NEW-PAGE) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) - (* ; "shouldnt need this") - (SETQ NEW-PAGE (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGENUM) of IMAGEDATA))) - (* ; "Page number goes up by 1") - - (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") - - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Page: " NEW-PAGE " " NEW-PAGE :EOL - "%%%%BeginPageSetup" :EOL "/savepage save def" :EOL (FQUOTIENT 1 \PS.SCALE0) - " imagesizefactor mul dup scale" :EOL "%%%%EndPageSetup" :EOL) - (\SETXFORM.PSC STREAM IMAGEDATA T) - - (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with T) - (* ; "nothing printed yet...") - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA) - - (* ;; "Here we handle headings.") - - (LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) - of IMAGEDATA] - (\DSPRESET.PSC STREAM) - (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) - of IMAGEDATA)) - (RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0)) - 0 STREAM) (* ; "Skip an inch before page number") - (POSTSCRIPT.OUTSTR STREAM "Page ") - (POSTSCRIPT.OUTSTR STREAM NEW-PAGE) - (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") - (\TERPRI.PSC STREAM) - (\DSPFONT.PSC STREAM FONT))) - (T (\DSPRESET.PSC STREAM]) - -(\POSTSCRIPTTAB - [LAMBDA (POSTSCRIPTDATA) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of POSTSCRIPTDATA] - (IDIFFERENCE TABSPACE (IREMAINDER (IDIFFERENCE (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of POSTSCRIPTDATA) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) - of POSTSCRIPTDATA)) - TABSPACE]) - -(\PS.BOUTFIXP - [LAMBDA (STREAM N) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - - (* ;; "BOUT the decimal representation of N to STREAM using temp storage from the imagedata. Done this way for speed.") - - (DECLARE (LOCALVARS . T)) - [COND - ((MINUSP N) - (BOUT STREAM (CHARCODE -)) - (SETQ N (IMINUS N] - (COND - [(LESSP N 10) - (BOUT STREAM (IPLUS N (CHARCODE 0] - [(LESSP N 1000000000) - (LET ([BASE (fetch (ARRAYP BASE) of (fetch (\POSTSCRIPTDATA POSTSCRIPTTEMPARRAY) - of (fetch (STREAM IMAGEDATA) - of STREAM] - (i (SUB1 \PS.TEMPARRAYLEN))) - [for old i by -1 do (\PUTBASEBYTE BASE i (IPLUS (IREMAINDER N 10) - (CHARCODE 0))) - repeatwhile (NEQ 0 (SETQ N (IQUOTIENT N 10] - (\BOUTS STREAM BASE i (IDIFFERENCE \PS.TEMPARRAYLEN i] - (T (* ; "Just in case we get a bignum") - (for c in (CHCON N) do (BOUT STREAM (\CHAR8CODE c]) - -(\PS.SCALEHACK - [LAMBDA (STREAM SCALEFACTOR) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA)) - FACTOR) - (COND - ((AND (NUMBERP SCALEFACTOR) - (NOT (EQP OLDSCALE SCALEFACTOR))) - (POSTSCRIPT.SHOWACCUM STREAM) - (SETQ FACTOR (/ OLDSCALE SCALEFACTOR)) - [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) - do (change (fetch (REGION LEFT) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION BOTTOM) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION WIDTH) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION HEIGHT) of REG) - (FIXR (CL:* DATUM FACTOR] - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with - SCALEFACTOR) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T))) - OLDSCALE]) - -(\PS.SCALEREGION - [LAMBDA (SCALE REGION) (* ; "Edited 5-Apr-89 16:15 by TAL") - (* ; "Scales a region") - (create REGION - LEFT _ (FIXR (TIMES SCALE (fetch (REGION LEFT) of REGION))) - BOTTOM _ (FIXR (TIMES SCALE (fetch (REGION BOTTOM) of REGION))) - WIDTH _ (FIXR (TIMES SCALE (fetch (REGION WIDTH) of REGION))) - HEIGHT _ (FIXR (TIMES SCALE (fetch (REGION HEIGHT) of REGION]) - -(\SCALEDBITBLT.PSC - [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT - SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM - SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") - (* ; "Edited 8-May-2018 15:05 by rmk:") - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") - - (OR (NUMBERP SCALE) - (SETQ SCALE 1)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (SCALE1 (TIMES SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA))) - (SCALE2 (TIMES SCALE1 (OR (NUMBERP POSTSCRIPT.BITMAP.SCALE) - 1))) - DESTREGION - (BITMAPWIDTH (fetch BITMAPWIDTH of SOURCEBITMAP)) - (BITMAPHEIGHT (fetch BITMAPHEIGHT of SOURCEBITMAP)) - TEMPBM) - [COND - ((NULL DESTINATIONLEFT) - (SETQ DESTINATIONLEFT (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA] - [COND - ((NULL DESTINATIONBOTTOM) - (SETQ DESTINATIONBOTTOM (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] - (COND - ((OR (NULL WIDTH) - (NULL HEIGHT)) - (SETQ WIDTH BITMAPWIDTH) - (SETQ HEIGHT BITMAPHEIGHT))) - (COND - ((GREATERP WIDTH BITMAPWIDTH) - (SETQ WIDTH BITMAPWIDTH))) - (COND - ((GREATERP HEIGHT BITMAPHEIGHT) - (SETQ HEIGHT BITMAPHEIGHT))) - [SETQ DESTREGION (INTERSECTREGIONS (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM (TIMES SCALE1 WIDTH - ) - (TIMES SCALE1 HEIGHT] - (COND - ((AND DESTREGION (OR (NULL CLIPPINGREGION) - (REGIONSINTERSECTP DESTREGION CLIPPINGREGION))) - [COND - ((AND (EQ SOURCELEFT 0) - (EQ SOURCEBOTTOM 0) - (EQP WIDTH BITMAPWIDTH) - (EQP HEIGHT BITMAPHEIGHT)) (* ; - "Avoid copy if sending entire bitmap") - (SETQ TEMPBM SOURCEBITMAP)) - (T (SETQ TEMPBM (BITMAPCREATE WIDTH HEIGHT 1)) - (BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM TEMPBM 0 0 WIDTH HEIGHT SOURCETYPE - 'REPLACE] - (POSTSCRIPT.PUTCOMMAND STREAM "/bitbltsave save def " DESTINATIONLEFT " " - DESTINATIONBOTTOM " translate " (TIMES SCALE2 WIDTH) - " " - (TIMES SCALE2 HEIGHT) - " scale " WIDTH " " HEIGHT (COND - ((EQ OPERATION 'PAINT) - " true") - (T - (* ;; - "RMK: For REPLACE, was %"false%", but then white was black.") - - " true")) - " thebitimage" :EOL) - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEMPBM NIL) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "bitbltsave restore" :EOL) - (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) - T) - (T NIL]) - -(\SETPOS.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - " " - (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - " M ") - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) - -(\SETXFORM.PSC -(LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") (* ;; "Write transforms into the PS file to make what it prints match what we think it should print.") (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) (COND ((NOT NORESTORE) (POSTSCRIPT.OUTSTR STREAM "grestore "))) (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) (* ;; "Scaling") (COND ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) 1)) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) " dup scale" :EOL))) (* ;; "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) (* ;; "Any rotation that is in effect.") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) " rotate " :EOL) (* ;; "Any translations that are in effect.") (COND ((NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA)))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) " " (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) " translate" :EOL))) (* ;; "Clipping region:") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) " " (fetch (REGION WIDTH) of CLIP) " " (fetch (REGION LEFT) of CLIP) " " (fetch (REGION BOTTOM) of CLIP) " CLP" :EOL) (* ;; "And force recaching of location and font.") (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) -) - -(\STRINGWIDTH.PSC - [LAMBDA (STREAM STR RDTBL) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) - (\STRINGWIDTH.GENERIC STR (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) - RDTBL - (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA]) - -(\SWITCHFONTS.PSC - [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") - (* ; "Edited 11-May-93 02:11 by jds") - - (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") - - (LET* [(FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of POSTSCRIPTDATA)) - (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - OTHERDEVICEFONTPROPS - ) of FONT) - 'PSCFONT] - [COND - [(LISTP FONTID) - [COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of POSTSCRIPTDATA))) - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*)) - (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") - - (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of - FONTID) - " /" - (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) - "-Acnt") - " encodefont" :EOL) - (CL:PUSH (fetch (FONTID FONTIDNAME) of FONTID) - (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF POSTSCRIPTDATA] - (COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*) - (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH NIL) - (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) - " findfont [" - (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 " - (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " " - (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 0] makefont setfont" :EOL)) - (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH T) - (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) - of FONTID) - "-Acnt") - " findfont [" - (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 " - (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " " - (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 0] makefont setfont" :EOL] - (T [COND - ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of - POSTSCRIPTDATA - ))) - ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*)) - (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") - - (POSTSCRIPT.PUTCOMMAND STREAM "/" FONTID " /" (CONCAT FONTID "-Acnt") - " encodefont" :EOL) - (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF - POSTSCRIPTDATA - ] - (COND - ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*) - (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with NIL) - (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) - " /" FONTID " F" :EOL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with T) - (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) - " /" - (CONCAT FONTID "-Acnt") - " F" :EOL] - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with - NIL]) - -(\TERPRI.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (NEWY (PLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of IMAGEDATA] - (COND - ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] - (DSPNEWPAGE STREAM)) - (T (replace (STREAM CHARPOSITION) of STREAM with 0) - (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) - of IMAGEDATA) - NEWY))) - NIL]) -) - - - -(* ;; "DIG operations: ") - -(DEFINEQ - -(\BITBLT.PSC - [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT - SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM) - (* ; "Edited 7-Apr-89 19:53 by TAL") - (\SCALEDBITBLT.PSC SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT - DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION - CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM 1]) - -(\BLTSHADE.PSC - [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "Maybe we should do something with OPERATION") - - (LET ((RGN (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT)) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - TEXTUREBM TEXTUREWIDTH LEFT BOTTOM WIDTH HEIGHT) - [COND - [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch ( - \POSTSCRIPTDATA - - POSTSCRIPTCLIPPINGREGION - ) of - IMAGEDATA] - (T (SETQ RGN (INTERSECTREGIONS RGN (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA] - (COND - (RGN (SETQ LEFT (fetch (REGION LEFT) of RGN)) - (SETQ BOTTOM (fetch (REGION BOTTOM) of RGN)) - (SETQ WIDTH (CL:1- (fetch (REGION WIDTH) of RGN))) - (SETQ HEIGHT (CL:1- (fetch (REGION HEIGHT) of RGN))) - [COND - ((FIXP TEXTURE) - (SETQ TEXTURE (SELECT TEXTURE ((BLACKSHADE -1) - 0.0) - (WHITESHADE 1.0) - TEXTURE] - [COND - ((AND (FLOATP TEXTURE) - (<= 0.0 TEXTURE 1.0)) - (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " - TEXTURE " R" :EOL)) - ((OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM)) - ((BITMAPP TEXTURE) - (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE] - (COND - (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") - (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) - " " - (QUOTIENT BOTTOM 100.0) - " M " - (SETQ WIDTH (QUOTIENT WIDTH 100.0)) - " 0 rlineto 0 " - (QUOTIENT HEIGHT 100.0) - " rlineto " - (MINUS WIDTH) - " 0 rlineto closepath" :EOL) - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " - (LSH (fetch BITMAPRASTERWIDTH of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" - :EOL))) - (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) - T) - (T NIL]) - -(\CHARWIDTH.PSC - [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") - (COND - ((EQ CHARCODE (CHARCODE SPACE)) - (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) - of STREAM))) - ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM - IMAGEDATA - ) - of STREAM)) - CHARCODE]) - -(\CREATECHARSET.PSC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?) - (* ; "Edited 8-May-93 22:55 by rmk:") - (LET* ((CSINFO (CREATE CHARSETINFO - OFFSETS _ NIL)) - (WIDTHS (FETCH (CHARSETINFO WIDTHS) OF CSINFO))) - (REPLACE (CHARSETINFO IMAGEWIDTHS) OF CSINFO WITH WIDTHS) - - (* ;; "Make imagewidths point to widths. Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc. But...") - - (CL:UNLESS (EQ CHARSET 0) - - (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width. We know that the AVGCHARWIDTH field of the FONTDESC will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in. However, we do know that charset 0 is all set up before any other characters are dealt with.") - - (FOR I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A) - FONTDESC)) FROM 0 TO 255 - FIRST (CL:WHEN (EQ 0 AVGCHARWIDTH) - - (* ;; - "This is what \AVGCHARWIDTH in FONT does, but we don't have it here. Just to be extremely safe.") - - [SETQ AVGCHARWIDTH (MAX 1 (FIXR (FTIMES 0.6 (FONTPROP FONTDESC - 'HEIGHT]) - DO (\FSETWIDTH WIDTHS I AVGCHARWIDTH))) - CSINFO]) - -(\DRAWARC.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWARC.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") - (printout T T - "[In \DRAWARC.PSC: Functional BRUSH not supported.] -[Using ROUND 1 point BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) - (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") - )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) - " arc stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWCIRCLE.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") - (printout T T - "[In \DRAWCIRCLE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) - (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") - )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWCURVE.PSC - [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH SHAPE COLOR PSPLINE XA YA DXA DYA N PREVX PREVY PREV-DX3 PREV-DY3) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH) - (SETQ SHAPE 'ROUND)) - ((LISTP BRUSH) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T - (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") - - (printout T T - "[In \DRAWCURVE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - (SETQ SHAPE 'ROUND] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (SETQ PSPLINE (PARAMETRICSPLINE KNOTS CLOSED NIL)) - (SETQ N (pop PSPLINE)) - (SETQ XA (pop PSPLINE)) - (SETQ YA (pop PSPLINE)) - (SETQ DXA (pop PSPLINE)) - (SETQ DYA (pop PSPLINE)) - (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") - WIDTH " setlinewidth " (SETQ PREVX (ELT XA 1)) - " " - (SETQ PREVY (ELT YA 1)) - " M" :EOL) - (SETQ PREV-DX3 (FQUOTIENT (ELT DXA 1) - 3.0)) - (SETQ PREV-DY3 (FQUOTIENT (ELT DYA 1) - 3.0)) - (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND - STREAM - (FPLUS PREVX PREV-DX3) - " " - (FPLUS PREVY PREV-DY3) - " " - (FDIFFERENCE (SETQ PREVX (ELT XA C)) - (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) - 3.0))) - " " - (FDIFFERENCE (SETQ PREVY (ELT YA C)) - (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) - 3.0))) - " " PREVX " " PREVY " curveto" :EOL)) - (POSTSCRIPT.PUTCOMMAND STREAM "stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM PREVX PREVY)) - NIL]) - -(\DRAWELLIPSE.PSC - [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWELLIPSE.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH, big trouble!") - (printout T T - "[In \DRAWELLIPSE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION - " 0 360 ellipse stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWLINE.PSC - [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "DRAWLINE method for postscript streams.") - - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - [COND - ((NOT (NUMBERP WIDTH)) - - (* ;; "The WIDTH = NIL should have been handled before here, but just in case!") - - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - [COND - ((NOT (ZEROP WIDTH)) - (COND - ((LESSP X2 X1) - - (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") - - (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) - ((NOT (OR (FLOATP COLOR) - (LISTP DASHING))) (* ; "Simple case, no dash or gray") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) - (T (* ; - "COLOR is interpreted as gray factor") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " - (OR (FLOATP COLOR) - "0") - " [") - (for D in (LISTP DASHING) do - - (* ;; - "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") - - (POSTSCRIPT.PUTCOMMAND STREAM - (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] - (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) - (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) - -(\DRAWPOINT.PSC - [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") - - (* ;; "draw a point on the stream ") - - (if (BITMAPP BRUSH) - then (LET ((WIDTH (fetch BITMAPWIDTH of BRUSH)) - (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) - (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) - (- Y (IQUOTIENT HEIGHT 2)) - WIDTH HEIGHT OPERATION)) - else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) - -(\DRAWPOLYGON.PSC - [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING)(* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") - (LET ((LASTPOINT (CAR (LAST POINTS))) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH SHAPE COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH) - (SETQ SHAPE 'ROUND)) - ((LISTP BRUSH) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T - (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") - - (printout T T - "[In \DRAWPOLYGON.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - (SETQ SHAPE 'ROUND] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") - WIDTH " setlinewidth " (fetch (POSITION XCOORD) of (CAR POINTS)) - " " - (fetch (POSITION YCOORD) of (CAR POINTS)) - " M" :EOL) - (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM - (fetch (POSITION XCOORD) of P) - " " - (fetch (POSITION YCOORD) of P) - " lineto" :EOL)) - (COND - (CLOSED (POSTSCRIPT.PUTCOMMAND STREAM " closepath"))) - (POSTSCRIPT.PUTCOMMAND STREAM " stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) - (fetch (POSITION YCOORD) of LASTPOINT]) - -(\DSPBOTTOMMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) - of (fetch (STREAM IMAGEDATA) of STREAM) with YPOSITION))))]) - -(\DSPCLIPPINGREGION.PSC - [LAMBDA (STREAM REGION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) - (COND - ([AND REGION (NOT (AND (EQP (fetch (REGION LEFT) of OLDCLIP) - (fetch (REGION LEFT) of REGION)) - (EQP (fetch (REGION BOTTOM) of OLDCLIP) - (fetch (REGION BOTTOM) of REGION)) - (EQP (fetch (REGION WIDTH) of OLDCLIP) - (fetch (REGION WIDTH) of REGION)) - (EQP (fetch (REGION HEIGHT) of OLDCLIP) - (fetch (REGION HEIGHT) of REGION] - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - REGION) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))) - OLDCLIP]) - -(\DSPCOLOR.PSC - [LAMBDA (STREAM COLOR) (* ; "Edited 14-Jan-93 17:14 by jds") - - (* ;; - "Postscript %"color%" setter -- really sets gray shade for now. 0.0 = black, 1.0 = white.") - - (POSTSCRIPT.SHOWACCUM STREAM) - (PROG1 (FETCH (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM)) - (COND - ((AND (NUMBERP COLOR) - (<= 0 COLOR 1)) - (REPLACE (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM) WITH COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL COLOR " setgray ")) - (COLOR (\ILLEGAL.ARG COLOR))))]) - -(\DSPFONT.PSC - [LAMBDA (STREAM FONT) (* ; - "Edited 26-May-93 01:06 by sybalsky:mv:envos") - (* ; "Edited 11-May-93 02:11 by jds") - (* ; "Edited 19-Jan-93 17:17 by jds") - - (* ;; "Change fonts on the PostScript stream STREAM to be FONT.") - - (* ;; "Doesn't actually write the font-change command to the stream (it saves doing that until the font is actually needed, so that multiple font changes don't yield larger PS files).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) - NEWFONT FONTID) - (COND - ((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM) - (FONTCOPY OLDFONT FONT))) - (type? FONTDESCRIPTOR NEWFONT) - (NEQ NEWFONT OLDFONT)) - - (* ;; "OK, it's a good font.") - - (POSTSCRIPT.SHOWACCUM STREAM) (* ; - " Write out any accumulated characters.") - - (* ;; "Change the font in the Lisp stream:") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA with NEWFONT) - - (* ;; "and now update all font-dependent fields in the imagedata, EXCEPT POSTSCRIPTSPACEWIDTH and POSTSCRIPTNATURALSPACEWIDTH. These latter 2 must stay as-is up thru the actual writing of characters by SHOWACCUM, so") - - (\POSTSCRIPT.CHANGECHARSET IMAGEDATA 0) - (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of - NEWFONT))) - [replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) - of IMAGEDATA) - (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA with (\FGETWIDTH (fetch - (\POSTSCRIPTDATA - POSTSCRIPTWIDTHS) - of IMAGEDATA) - (CHARCODE SPACE] - (\FIXLINELENGTH.PSC STREAM IMAGEDATA) - [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - - OTHERDEVICEFONTPROPS - ) of - NEWFONT - ) - 'PSCFONT] - (COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*) - (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF IMAGEDATA WITH NIL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with - T))) - - (* ;; "Remember to actually write a change command") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with - T))) - OLDFONT]) - -(\DSPLEFTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with XPOSITION) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) - -(\DSPLINEFEED.PSC - [LAMBDA (STREAM LINELEADING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) - of (fetch (STREAM IMAGEDATA) of STREAM) with LINELEADING)) - ))]) - -(\DSPPUSHSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (push (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA) - (create POSTSCRIPTXFORM - PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA)) - PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of - IMAGEDATA)) - PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - ) - PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) - PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) - of IMAGEDATA]) - -(\DSPPOPSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (XFORM (pop (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXCLIP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXPAGE) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXBOTTOM) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXTOP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLEFT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXRIGHT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLAND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXXFORMPEND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with - (fetch ( - POSTSCRIPTXFORM - PSXTRANX) - of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with - (fetch ( - POSTSCRIPTXFORM - PSXTRANY) - of XFORM]) - -(\DSPRESET.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (replace (STREAM CHARPOSITION) of STREAM with 0) - (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - (FONTPROP (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) - 'ASCENT]) - -(\DSPRIGHTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with XPOSITION) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) - -(\DSPROTATE.PSC - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "rotate the postscript stream by ROTATION") - - (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OROT (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA)) - LAND C0 P0 C P ML MB MR MT) - (COND - ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) - of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA with ROTATION) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\DSPRESET.PSC STREAM))) - OROT]) - -(\DSPSCALE.PSC - [LAMBDA (STREAM SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - NSCALE) - (COND - ((AND NIL - - (* ;; "Changing SCALE is not implemented. According to IRM.") - - (NUMBERP SCALE) - (CL:PLUSP SCALE)) - (SETQ NSCALE (QUOTIENT SCALE OSCALE)) - - (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") - - (POSTSCRIPT.PUTCOMMAND STREAM " " NSCALE " " NSCALE " scale" :EOL) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with SCALE))) - OSCALE]) - -(\DSPSCALE2.PSC - [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "SETS X AND Y SCALE ") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - NSCALE) - (COND - ((AND X-SCALE (NUMBERP X-SCALE) - (CL:PLUSP X-SCALE)) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - - (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") - - (POSTSCRIPT.PUTCOMMAND STREAM " " X-SCALE " " Y-SCALE " scale" :EOL))) - T]) - -(\DSPSPACEFACTOR.PSC - [LAMBDA (STREAM FACTOR) (* ; - "Edited 26-May-93 01:18 by sybalsky:mv:envos") - (DECLARE (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFACTOR (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA))) - [COND - ((AND (NUMBERP FACTOR) - (NOT (EQUAL FACTOR OLDFACTOR))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA with FACTOR) - (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA] - OLDFACTOR]) - -(\DSPTOPMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch - (STREAM IMAGEDATA) - of STREAM) - with YPOSITION))))]) - -(\DSPTRANSLATE.PSC - [LAMBDA (STREAM TX TY) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (MDX (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - TX)) - (MDY (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - TY))) - (COND - ((NOT (AND (ZEROP MDX) - (ZEROP MDY))) - (POSTSCRIPT.SHOWACCUM STREAM) - (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) do (CL:INCF (fetch (REGION - LEFT) - of REG) - MDX) - (CL:INCF (fetch (REGION - BOTTOM) - of REG) - MDY)) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - MDY) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - MDY) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - MDY) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with TX) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with TY) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T]) - -(\DSPXPOSITION.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - OLDX) - (PROG1 (SETQ OLDX (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - [COND - ((AND XPOSITION (NOT (EQUAL XPOSITION OLDX))) - (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA])]) - -(\DSPYPOSITION.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - OLDY) - (PROG1 (SETQ OLDY (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA)) - (COND - ((AND YPOSITION (NOT (EQUAL YPOSITION OLDY))) - (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - YPOSITION))))]) - -(\FILLCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") - (LET (TEXTUREBM TEXTUREWIDTH) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (if (FIXP TEXTURE) - then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) - (if TEXTUREBM - then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" :EOL) - else (POSTSCRIPT.PUTCOMMAND STREAM " eofill" :EOL "grestore" :EOL)) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\FILLPOLYGON.PSC - [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) - (* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") - (DECLARE (SPECVARS FILL.WRULE)) - - (* ;; "OPERATION is ignored here") - - (LET ((LASTPOINT (CAR (LAST KNOTS))) - TEXTUREBM TEXTUREWIDTH) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (if (NOT (OR (ZEROP WINDNUMBER) - (EQL WINDNUMBER 1))) - then (SETQ WINDNUMBER FILL.WRULE)) - (if (FIXP TEXTURE) - then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) - " " - (fetch (POSITION YCOORD) of (CAR KNOTS)) - " M" :EOL) - (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch - (POSITION XCOORD) - of K) - " " - (fetch (POSITION YCOORD) of K) - " lineto" :EOL)) - (POSTSCRIPT.PUTCOMMAND STREAM " closepath" :EOL) - (if TEXTUREBM - then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern")) - (POSTSCRIPT.PUTCOMMAND STREAM (if (ZEROP WINDNUMBER) - then " fill" - else " eofill") - :EOL "grestore" :EOL) - (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) - (fetch (POSITION YCOORD) of LASTPOINT]) - -(\FIXLINELENGTH.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "Called by margin, font or rotation change to update the LINELENGTH field in the stream.") - - (LET [(TMP (MIN MAX.SMALLP (FIX (QUOTIENT (DIFFERENCE (fetch (\POSTSCRIPTDATA - POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTLEFTMARGIN) - of IMAGEDATA)) - (fetch FONTAVGCHARWIDTH of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] - (replace (STREAM LINELENGTH) of STREAM with (COND - ((GREATERP TMP 1) - TMP) - (T 10]) - -(\MOVETO.PSC - [LAMBDA (STREAM X Y) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) - (COND - ([NOT (AND (EQP X (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - (EQP Y (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] - (POSTSCRIPT.SHOWACCUM STREAM) - (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X) - (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y) - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T]) - -(\NEWPAGE.PSC - [LAMBDA (STREAM) (* ; "Edited 5-Apr-89 17:31 by TAL") - (POSTSCRIPT.ENDPAGE STREAM) - (POSTSCRIPT.STARTPAGE STREAM]) -) - - - -(* ;; "Character-output, plus special-cases:") - -(DEFINEQ - -(\POSTSCRIPT.CHANGECHARSET - [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") - - (* ;; -"Called when the character set information cached in a display stream doesn't correspond to CHARSET") - - (PROG* ((FONT (ffetch POSTSCRIPTFONT of PSDATA)) - (CSINFO (\GETCHARSETINFO CHARSET FONT))) - - (* ;; "since the call to \getcharsetinfo has NOSLUG? = NIL, we know that we will get a reasonable character set back") - - (UNINTERRUPTABLY - (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) - of CSINFO)) - (freplace POSTSCRIPTNSCHARSET of PSDATA with CHARSET))]) - -(\POSTSCRIPT.OUTCHARFN - [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Output a character to be printed.") - -(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") - -(* ;;; "This is called a lot, so the code is unrolled for efficiency.") - - (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE) - (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (XPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) - CHARWID NEWXPOS MAPPING) - (CL:UNLESS (EQ (\CHARSET CHAR) - (ffetch POSTSCRIPTNSCHARSET of IMAGEDATA)) - - (* ;; "Switch character set so that we get the right char width.") - - (\POSTSCRIPT.CHANGECHARSET IMAGEDATA (\CHARSET CHAR))) - [SETQ CHARWID (SELCHARQ CHAR - (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of - IMAGEDATA - )) - (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of - IMAGEDATA - ) - (\CHAR8CODE CHAR] - - (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") - - [COND - [[OR (NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA)) - (AND (ILEQ CHAR 254) - (NOT (CL:AREF \POSTSCRIPT.CHARTYPE CHAR] - - (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") - - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - CHARWID] - (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with - T)) - (COND - [(ILESSP CHAR (CHARCODE " ")) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - [(IGEQ CHAR 127) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (T (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM (CHARCODE \)) - (BOUT STREAM CHAR)) - (BOUT STREAM CHAR] - [(SETQ MAPPING (GETHASH CHAR *POSTSCRIPT-NS-HASH*)) - (* ; - "Special character that's taken care of by the NS mapping.") - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - CHARWID] - (SELECTQ (CAR MAPPING) - (NIL - (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") - - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING))) - (SYMBOL - (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") - - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) - 'SYMBOL)) - (ACCENT (* ; "Special accent mapping we did") - (\POSTSCRIPT.ACCENTFN STREAM (CADR MAPPING))) - (ACCENTPAIR (* ; - "Given base char & accent, overlap them.") - (\POSTSCRIPT.ACCENTPAIR STREAM (CADR MAPPING) - (CADDR MAPPING) - (CADDDR MAPPING))) - (DINGBAT (* ; "A Zapf dingbat") - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) - 'ZAPFDINGBATS)) - (APPLY* (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - - (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") - - [freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA - with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF - IMAGEDATA - ) - (APPLY* (CADDR MAPPING) - STREAM - (CADR MAPPING)))]) - (FUNCTION (* ; "Done as special PS code.") - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM (CADR MAPPING))) - (\ILLEGAL.ARG (CAR MAPPING] - (T (* ; "Special char") - (SELCHARQ CHAR - ((EOL LF) - (\TERPRI.PSC STREAM) - - (* ;; - "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") - - (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) - (FF (DSPNEWPAGE STREAM) - (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) - (TAB (SETQ NEWXPOS (IPLUS XPOS (\POSTSCRIPTTAB IMAGEDATA))) - [COND - ((IGREATERP NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - (\POSTSCRIPTTAB IMAGEDATA] - (\MOVETO.PSC STREAM NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA))) - ("357,140" (* ; " Ballot box, checked") - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - CHARWID] - (LET ((OLDFONT (\DSPFONT.PSC STREAM))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch - (FONTDESCRIPTOR - FONTSIZE) - of OLDFONT) - (fetch (FONTDESCRIPTOR - FONTFACE) - of OLDFONT))) - (\UPDATE.PSC STREAM IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM " bboxchk ") - (\DSPFONT.PSC STREAM OLDFONT))) - (PROGN [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - CHARWID] - (COND - ((IGEQ CHAR 255) - - (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") - - (\POSTSCRIPT.PRINTSLUG STREAM CHAR)) - (T (SETQ CHAR (\CHAR8CODE CHAR)) - (COND - ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) - of IMAGEDATA)) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) - of IMAGEDATA with T))) - (BOUT STREAM (CHARCODE \)) - (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM CHAR)) - (PROGN [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with NEWXPOS) - CHAR]) - -(\POSTSCRIPT.PRINTSLUG - [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") - - (DECLARE (LOCALVARS . T)) - (LET ((IMAGEDATA (FETCH (STREAM IMAGEDATA) OF STREAM))) - (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF - IMAGEDATA - ) - (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) - (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) OF IMAGEDATA) - (\CHAR8CODE CHAR)) - (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA - POSTSCRIPTFONT) - OF IMAGEDATA)) - 'PAINT) - (\MOVETO.PSC STREAM (IPLUS (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) - (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) - OF IMAGEDATA) - (\CHAR8CODE CHAR))) - (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA]) - -(\POSTSCRIPT.SPECIALOUTCHARFN - [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") - - (DECLARE (LOCALVARS . T)) - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (AND FAMILY (\DSPFONT.PSC STREAM] - (CL:WHEN OLDFONT - (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of - OLDFONT) - (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) - (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T)) - [COND - [(ILESSP CHAR (CHARCODE " ")) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - [(IGEQ CHAR 127) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (T (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM (CHARCODE \)) - (BOUT STREAM CHAR)) - (BOUT STREAM CHAR] - (CL:WHEN OLDFONT (\DSPFONT.PSC STREAM OLDFONT)) - CHAR]) - -(\UPDATE.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "Make any outstanding font, scale, location updates, prepatory to something that might depend heavily on it. (e.g. before starting to output characters, or making a scale change)") - (* ; - "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA]) - -(\POSTSCRIPT.ACCENTFN - [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") - (* ; "Edited 3-Feb-93 01:05 by jds") - -(* ;;; "Output an accented character to be printed. .") - -(* ;;;; "Need to inc CHARPOSITION of STREAM") - - (DECLARE (LOCALVARS . T)) - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (COND - ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA)) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T))) - (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) - CHAR]) - -(\POSTSCRIPT.ACCENTPAIR - [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; - "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") - (* ; "Edited 3-Feb-93 01:29 by jds") - -(* ;;; "Output an accented character to be printed. .") - -(* ;;;; "Prints the character as \xxx, with 3 octal digits, to avoid tripping up on EOLs and other postscript-special characters.") - - (DECLARE (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) - (BOUT STREAM (CHARCODE %))) - (BOUT STREAM (CHARCODE %()) - (for ACCENT inside ACCENTS do (BOUT STREAM (CHARCODE "\")) - (for CH - instring (SUBSTRING (CONCAT "000" - (OCTALSTRING - ACCENT)) - -3) - do (BOUT STREAM CH))) - (POSTSCRIPT.PUTCOMMAND STREAM ") (") - (for ACCENT inside UNDER-ACCENTS - do (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT)) - -3) do (BOUT STREAM CH))) - (BOUT STREAM (CHARCODE %))) - (COND - (NIL (OR (IEQP ACCENT (CHARCODE "0,313")) - (IEQP ACCENT (CHARCODE "0,316"))) (* ; - "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") - (POSTSCRIPT.PUTCOMMAND STREAM " 0 ")) - ((ILESSP CHAR (CHARCODE a)) (* ; - "upper case, so adjust offset for accent") - (POSTSCRIPT.PUTCOMMAND STREAM " " (/ (fetch \SFAscent of FONT) - 3.0) - " ")) - (T (POSTSCRIPT.PUTCOMMAND STREAM " 0 "))) - (POSTSCRIPT.PUTCOMMAND STREAM " " (FONTPROP FONT 'SIZE) - " ") - (POSTSCRIPT.PUTCOMMAND STREAM " accentor ") - CHAR]) -) - - - -(* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") - -(DEFINEQ - -(\PSC.SPACEDISP - [LAMBDA (STREAM WIDTH) (* ; "Edited 28-Sep-93 13:50 by jds") - (POSTSCRIPT.PUTCOMMAND STREAM (\PSC.SPACEWID (DSPFONT NIL STREAM) - WIDTH) - " 0 rmoveto "]) - -(\PSC.SPACEWID - [LAMBDA (FONTDESC CHAR) (* ; "Edited 28-Sep-93 13:41 by jds") - - (* ;; "Spacing character with a special width (e.g. M space, thin (1/5-M) space...") - - (* ;; "If CHAR is a list, it's (CHARCODE FACTOR), and we return a width of FACTOR * (CHARWIDTH CHARCODE). Otherwise, we just return the width of CHARCODE.") - - (COND - [(LISTP CHAR) - (FIXR (FTIMES (CADR CHAR) - (CHARWIDTH (CHARCODE.DECODE (CAR CHAR)) - FONTDESC] - (T (CHARWIDTH (CHARCODE.DECODE CHAR) - FONTDESC]) - -(\PSC.SYMBOLS - [LAMBDA (STREAM CHAR) (* ; "Edited 2-Nov-94 17:01 by jds") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (\DSPFONT.PSC STREAM))) - (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch (FONTDESCRIPTOR FONTSIZE) - of OLDFONT) - (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (COND - ((EQUAL CHAR "0,161") - (POSTSCRIPT.OUTSTR STREAM " bboxchk "))) - (\DSPFONT.PSC STREAM OLDFONT]) -) - - - -(* ;; "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") - -(DEFINEQ - -(\POSTSCRIPT.NSHASH - [LAMBDA (MAPPING-LIST) (* ; - "Edited 30-Jul-93 14:46 by sybalskY:MV:ENVOS") - (* ; "Edited 4-May-93 02:21 by jds") - (* ; "Edited 3-Feb-93 00:33 by jds") - (for MAPPING in MAPPING-LIST unless (EQ (CAR MAPPING) - '*) - do (* ; - "Skip comments in the mapping list.") - (LET [(CHARCODE (CHARCODE.DECODE (CAR MAPPING] - - (* ;; "Fill in the translation entry for this character:") - - (PUTHASH CHARCODE - [DESTRUCTURING-BIND - (KIND CODE2 BASECHAR UNDERACCENTS) - (SETQ MAPPING (CDR MAPPING)) - (CONS KIND (SELECTQ KIND - ((SYMBOL NIL DINGBAT) - (CONS (CHARCODE.DECODE CODE2))) - (FUNCTION (CONS CODE2)) - ((ACCENT ACCENTPAIR) - (LIST (CHARCODE.DECODE CODE2) - (CHARCODE.DECODE BASECHAR) - (AND UNDERACCENTS (CHARCODE.DECODE UNDERACCENTS)) - )) - (APPLY* (* ; - "Apply setup function to coerce argument data") - - (* ;; "MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN SETUPFN) PRINTFN gets applied to stream and result of applying SETUPFN to DATA. WIDTHFN gets applied to coerced data and fontdescriptor") - - (LIST (APPLY* (OR (CAR (CDDDDR MAPPING)) - (FUNCTION CL:IDENTITY)) - (CADR MAPPING)) - (CADDR MAPPING) - (CADDDR MAPPING))) - (ERROR "UNRECOGNIZED POSTSCRIPT CHARACTER TYPE" MAPPING] - *POSTSCRIPT-NS-HASH*) - - (* ;; "If this character is in the lower 127, we need to mark it for special handling in \POSTSCRIPT.CHARTYPE, by putting a T in the array at the charcode's position:") - - (CL:WHEN (<= CHARCODE 254) - (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE CHARCODE) - T))]) -) - -(RPAQQ *POSTSCRIPT-UNACCENTED-FONTS* (Dancer ZapfDingbats "Dancer" "ZapfDingbats")) - -(RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* - ( - (* ;; "Mapping of NS characters to Postscript renderings.") - - - (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") - - ("^S" NIL "2,320") - (* ; "pressfont em dash") - ("^V" NIL "2,261") - (* ; "pressfont en dash") - ("^G" NIL "0,140") - ("0,244" NIL "2,250") - (* ; "generic currency symbol") - ("0,251" NIL "2,140") - (* ; "left single quote") - ("0,254" SYMBOL "2,254") - (* ; "left arrow") - ("0,255" SYMBOL "2,255") - (* ; "uparrow") - ("0,256" SYMBOL "2,256") - (* ; "right arrow") - ("0,257" SYMBOL "2,257") - (* ; "down arrow") - ("0,260" SYMBOL "2,260") - (* ; "degree") - ("0,261" SYMBOL "2,261") - (* ; "+/-") - ("0,264" SYMBOL "2,264") - (* ; "times") - ("0,267" NIL "2,264") - (* ; "Center-dot") - ("0,270" SYMBOL "2,270") - (* ; "divide") - ("0,271" NIL "2,047") - (* ; "right single quote") - ("0,274" FUNCTION " f14 ") - (* ; "1/4") - ("0,275" FUNCTION " f12 ") - (* ; "1/2") - ("0,276" FUNCTION " f34 ") - (* ; "3/4") - ("0,322" SYMBOL "2,342") - (* ; "registered") - ("0,323" SYMBOL "2,343") - (* ; "copyright") - ("0,324" SYMBOL "2,344") - (* ; "tm") - ("0,334" FUNCTION " f18 ") - (* ; "1/8") - ("0,335" FUNCTION " f38 ") - (* ; "3/8") - ("0,336" FUNCTION " f58 ") - (* ; "5/8") - ("0,337" FUNCTION " f78 ") - (* ; "7/8") - ("0,342" NIL "2,235") - (* ; "Eth (slashed D?)") - ("0,354" NIL "2,237") - (* ; "Thorn") - ("0,363" NIL "2,236") - (* ; "eth") - ("0,374" NIL "2,240") - (* ; "thorn") - ("41,172" DINGBAT "0,110") - (* ; "filled star") - ("42,42" DINGBAT "0,161") - (* ; "ballot-box") - ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) - (* ; "Checked ballot-box") - ("357,44" NIL "2,261") - (* ; "n dash") - ("357,45" NIL "2,320") - (* ; "m dash") - ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "M quad") - ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "N quad") - ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "FIGURE quad") - ("357,57" APPLY* ("M" 0.2) - \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "This space (1/5M)") - ("357,60" NIL "2,262") - (* ; "dagger") - ("357,61" NIL "2,263") - (* ; "double dagger") - ("357,062" SYMBOL "2,361") - (* ; "angleright") - ("357,063" SYMBOL "2,341") - (* ; "angleleft") - ("357,70" SYMBOL "2,315") - (* ; "perpendicular") - ("357,101" NIL "2,275") - (* ; "per mil o/oo") - ("357,104" ACCENTPAIR "<" NIL "/") - (* ; "not less than") - ("357,105" ACCENTPAIR ">" "/") - (* ; "not greater than") - ("357,110" SYMBOL "2,312") - (* ; "parallel") - ("357,111" SYMBOL "2,315") - (* ; "not parallel") - ("357,112" SYMBOL "2,316") - (* ; "element") - ("357,113" SYMBOL "2,317") - (* ; "notelement") - ("357,114" SYMBOL "2,047") - (* ; "suchthat") - ("357,115" SYMBOL "2,334") - (* ; "implied by, double arrow left") - ("357,116" SYMBOL "2,333") - (* ; "iff, double arrow") - ("357,117" SYMBOL "2,336") - (* ; "implies, double arrow right") - ("357,120" SYMBOL "2,253") - (* ; "double arrow") - ("357,121" SYMBOL "2,333") - (* ; "double arrow") - ("357,122" SYMBOL "2,333") - (* ; "l/r arrow") - ("357,126" SYMBOL "2,307") - (* ; "intersection") - ("357,127" SYMBOL "2,310") - (* ; "union") - ("357,130" SYMBOL "2,312") - (* ; "reflexsuperset") - ("357,131" SYMBOL "2,315") - (* ; "reflexsubset") - ("357,132" SYMBOL "2,311") - (* ; "propersuperset") - ("357,133" SYMBOL "2,314") - (* ; "propersubset") - ("357,137" SYMBOL "2,313") - (* ; "notsubset") - ("357,141" SYMBOL "2,306") - (* ; "emptyset") - ("357,142" SYMBOL "2,305") - (* ; "circleplus") - ("357,144" SYMBOL "2,304") - (* ; "circlemultiply") - ("357,146" NIL "2,267") - (* ; "bullet") - ("357,147" SYMBOL "2,260") - (* ; - "center circle (composition), lowered degree") - ("357,152" SYMBOL "2,330") - (* ; "logicalnot") - ("357,154" SYMBOL "2,320") - (* ; "angle") - ("357,160" SYMBOL "2,136") - (* ; "perpendicular") - ("357,161" SYMBOL "2,265") - (* ; "proportional") - ("357,162" SYMBOL "2,272") - (* ; "equivalence") - ("357,165" SYMBOL "2,362") - (* ; "integral") - ("357,167" SYMBOL "2,273") - (* ; "approxequal") - ("357,170" SYMBOL "2,100") - (* ; "congruent") - ("357,172" SYMBOL "2,345") - (* ; "summation") - ("357,173" SYMBOL "2,325") - (* ; "product") - ("357,174" SYMBOL "2,326") - (* ; "radical") - ("357,242" SYMBOL "2,246") - (* ; "florin") - ("357,260" SYMBOL "2,351") - (* ; "Ceiling, left ") - ("357,261" SYMBOL "2,371") - (* ; "Ceiling, right") - ("357,262" SYMBOL "2,353") - (* ; "Floor, left ") - ("357,263" SYMBOL "2,373") - (* ; "Floor, right") - ("357,264" SYMBOL "2,44") - (* ; "exists") - ("357,265" SYMBOL "2,42") - (* ; "forall") - ("357,266" SYMBOL "2,331") - (* ; "logicaland") - ("357,267" SYMBOL "2,332") - (* ; "logicalor") - ("357,271" SYMBOL "2,321") - (* ; "gradient") - ("357,272" SYMBOL "2,266") - (* ; "partialdiff") - ("357,313" SYMBOL "2,252") - (* ; "spade") - ("357,317" DINGBAT "0,63") - (* ; "check") - ("357,375" FUNCTION " f13 ") - (* ; "1/3") - ("357,376" FUNCTION " f23 ") - (* ; "2/3") - ("361,041" ACCENT "0,4" A) - ("361,042" ACCENT "0,1" A) - ("361,043" ACCENT "0,2" A) - ("361,044" ACCENT "0,6" A) - ("361,045" ACCENTPAIR A "0,305") - (* ; "A-macron") - ("361,046" ACCENTPAIR A "0,306") - (* ; "A-breve") - ("361,047" ACCENT "0,3" A) - ("361,050" ACCENT "0,5" A) - ("361,055" ACCENT "0,7" C) - ("361,060" ACCENT "0,13" E) - ("361,061" ACCENT "0,10" E) - ("361,062" ACCENT "0,11" E) - ("361,063" ACCENTPAIR E "0,305") - (* ; "E-macron") - ("361,065" ACCENT "0,12" E) - ("361,066" ACCENTPAIR E NIL "0,316") - (* ; "E-ogonek") - ("361,076" ACCENT "0,17" I) - ("361,077" ACCENT "0,14" I) - ("361,100" ACCENT "0,15" I) - ("361,102" ACCENTPAIR I "0,305") - (* ; "I-macron") - ("361,104" ACCENT "0,16" I) - ("361,114" ACCENT "0,20" N) - ("361,117" ACCENT "0,24" O) - ("361,120" ACCENT "0,21" O) - ("361,121" ACCENT "0,22" O) - ("361,122" ACCENT "0,25" O) - ("361,123" ACCENTPAIR O "0,305") - (* ; "O-macron") - ("361,124" ACCENT "0,23" O) - ("361,134" ACCENT "0,26" S) - ("361,137" ACCENT "0,32" U) - ("361,140" ACCENT "0,27" U) - ("361,141" ACCENT "0,30" U) - ("361,143" ACCENTPAIR U "0,305") - (* ; "U-macron") - ("361,145" ACCENT "0,31" U) - ("361,155" ACCENT "0,33" Y) - ("361,160" ACCENT "0,34" Z) - ("361,165" ACCENTPAIR Y "0,305") - (* ; "Y-macron") - ("361,166" ACCENTPAIR "0,341" "0,305") - (* ; "AE-macron") - ("361,167" ACCENTPAIR "0,352" "0,305") - (* ; "OE-macron") - ("361,241" ACCENT "0,204" a) - ("361,242" ACCENT "0,201" a) - ("361,243" ACCENT "0,202" a) - ("361,244" ACCENT "0,206" a) - ("361,245" ACCENTPAIR a "0,305") - (* ; "a-macron") - ("361,246" ACCENTPAIR a "0,306") - (* ; "a-breve") - ("361,247" ACCENT "0,203" a) - ("361,250" ACCENT "0,205" a) - ("361,255" ACCENT "0,207" c) - ("361,260" ACCENT "0,213" e) - ("361,261" ACCENT "0,210" e) - ("361,262" ACCENT "0,211" e) - ("361,263" ACCENTPAIR e "0,305") - (* ; "e-macron") - ("361,265" ACCENT "0,212" e) - ("361,266" ACCENTPAIR e NIL "0,316") - (* ; "e-ogonek") - ("361,267" ACCENTPAIR e "0,317") - (* ; "e-caron") - ("361,276" ACCENT "0,217" i) - ("361,277" ACCENT "0,214" i) - ("361,300" ACCENT "0,215" i) - ("361,302" ACCENTPAIR "0,365" "0,305") - (* ; "i-macron") - ("361,304" ACCENT "0,216" i) - ("361,314" ACCENT "0,220" n) - ("361,317" ACCENT "0,224" o) - ("361,320" ACCENT "0,221" o) - ("361,321" ACCENT "0,222" o) - ("361,322" ACCENT "0,225" o) - ("361,323" ACCENTPAIR o "0,305") - (* ; "o-macron") - ("361,324" ACCENT "0,223" o) - ("361,334" ACCENT "0,226" s) - ("361,337" ACCENT "0,232" u) - ("361,340" ACCENT "0,227" u) - ("361,341" ACCENT "0,230" u) - ("361,343" ACCENTPAIR u "0,305") - (* ; "u-macron") - ("361,344" ACCENTPAIR u "0,306") - (* ; "u-breve") - ("361,345" ACCENT "0,231" u) - ("361,355" ACCENT "0,233" y) - ("361,360" ACCENT "0,234" z) - ("361,365" ACCENTPAIR y "0,305") - (* ; "y-macron") - ("361,366" ACCENTPAIR "0,361" "0,305") - (* ; "ae-macron") - ("361,367" ACCENTPAIR "0,372" "0,305") - (* ; "oe-macron") - ("361,371" ACCENTPAIR a "0,317") - (* ; "a-caron") - ("361,375" ACCENTPAIR g "0,317") - (* ; "g-caron") - - (* ;; "Special code assignments for Dictionary of Old English, UToronto:") - - ("361,370" ACCENTPAIR a ("0,305" "0,306")) - (* ; "a - breve-macron") - ("361,372" ACCENTPAIR e "0,306") - (* ; "e-breve") - ("361,373" ACCENTPAIR e "0,305" "0,56") - (* ; "e macron underdot") - ("361,374" ACCENTPAIR e ("0,305" "0,306")) - (* ; "e - breve-macron") - ("361,376" ACCENTPAIR "0,365" "0,306") - (* ; "i-breve") - ("362,242" ACCENTPAIR "0,365" "0,317") - (* ; "i-caron") - ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) - (* ; " i - breve-macron") - ("362,243" ACCENTPAIR n "0,305") - (* ; "n-macron") - ("362,244" ACCENTPAIR m "0,305") - (* ; "m-macron") - ("362,245" ACCENTPAIR o "0,317") - (* ; "o-caron") - ("362,246" ACCENTPAIR o "0,306") - (* ; "o-breve") - ("362,247" ACCENTPAIR o ("0,305" "0,306")) - (* ; "o - breve-macron") - ("362,250" ACCENTPAIR o "0,305" "0,56") - (* ; "o-macron underdot") - ("362,251" ACCENTPAIR o "0,316") - (* ; "o-ogonek") - ("362,252" ACCENTPAIR u "0,317") - (* ; "u-caron") - ("362,253" ACCENTPAIR u ("0,305" "0,306")) - (* ; "u - breve-macron") - ("362,254" ACCENTPAIR y "0,306") - (* ; "y-breve") - ("362,256" ACCENTPAIR y "0,317") - (* ; "y-caron") - ("362,255" ACCENTPAIR y ("0,305" "0,306")) - (* ; "y - breve-macron") - (* ; "235 = Eth") - (* ; "236 = eth") - (* ; "237 = Thorn") - (* ; "240 = thorn") - - (* ;; "NS Greek characters") - - ("46,101" SYMBOL "2,101") - (* ; "Alpha") - ("46,102" SYMBOL "2,102") - (* ; "Beta") - ("46,103" SYMBOL 0) - (* ; "--empty--") - ("46,104" SYMBOL "2,107") - (* ; "Gamma") - ("46,105" SYMBOL "2,104") - (* ; "Delta") - ("46,106" SYMBOL "2,105") - (* ; "Epsilon") - ("46,107" SYMBOL 0) - (* ; "Stigma") - ("46,110" SYMBOL 0) - (* ; "Digamma") - ("46,111" SYMBOL "2,132") - (* ; "Zeta") - ("46,112" SYMBOL "2,110") - (* ; "Eta") - ("46,113" SYMBOL "2,121") - (* ; "Theta") - ("46,114" SYMBOL "2,111") - (* ; "Iota") - ("46,115" SYMBOL "2,113") - (* ; "Kappa") - ("46,116" SYMBOL "2,114") - (* ; "Lambda") - ("46,117" SYMBOL "2,115") - (* ; "Mu") - ("46,120" SYMBOL "2,116") - (* ; "Nu") - ("46,121" SYMBOL "2,130") - (* ; "Xi") - ("46,122" SYMBOL "2,117") - (* ; "Omicron") - ("46,123" SYMBOL "2,120") - (* ; "Pi") - ("46,124" SYMBOL 0) - (* ; "Koppa") - ("46,125" SYMBOL "2,122") - (* ; "Rho") - ("46,126" SYMBOL "2,123") - (* ; "Sigma") - ("46,127" SYMBOL 0) - (* ; "--empty--") - ("46,130" SYMBOL "2,124") - (* ; "Tau") - ("46,131" SYMBOL "2,125") - (* ; "Upsilon") - ("46,132" SYMBOL "2,106") - (* ; "Phi") - ("46,133" SYMBOL "2,103") - (* ; "Chi") - ("46,134" SYMBOL "2,131") - (* ; "Psi") - ("46,135" SYMBOL "2,132") - (* ; "Omega") - ("46,141" SYMBOL "2,141") - (* ; "alpha") - ("46,142" SYMBOL "2,142") - (* ; "beta") - ("46,143" SYMBOL 0) - (* ; "(md beta)") - ("46,144" SYMBOL "2,147") - (* ; "gamma") - ("46,145" SYMBOL "2,144") - (* ; "delta") - ("46,146" SYMBOL "2,145") - (* ; "epsilon") - ("46,147" SYMBOL "2,126") - (* ; "stigma") - ("46,150" SYMBOL 0) - (* ; "digamma") - ("46,151" SYMBOL "2,172") - (* ; "zeta") - ("46,152" SYMBOL "2,150") - (* ; "eta") - ("46,153" SYMBOL "2,161") - (* ; "theta") - ("46,154" SYMBOL "2,151") - (* ; "iota") - ("46,155" SYMBOL "2,153") - (* ; "kappa") - ("46,156" SYMBOL "2,154") - (* ; "lambda") - ("46,157" SYMBOL "2,155") - (* ; "mu") - ("46,160" SYMBOL "2,156") - (* ; "nu") - ("46,161" SYMBOL "2,170") - (* ; "xi") - ("46,162" SYMBOL "2,157") - (* ; "omicron") - ("46,163" SYMBOL "2,160") - (* ; "pi") - ("46,164" SYMBOL 0) - (* ; "(koppa)") - ("46,165" SYMBOL "2,162") - (* ; "rho") - ("46,166" SYMBOL "2,163") - (* ; "sigma") - ("46,167" SYMBOL "2,126") - (* ; "(fl sigma)") - ("46,170" SYMBOL "2,164") - (* ; "tau") - ("46,171" SYMBOL "2.165") - (* ; "upsilon") - ("46,172" SYMBOL "2,146") - (* ; "phi") - ("46,173" SYMBOL "2,143") - (* ; "chi") - ("46,174" SYMBOL "2,171") - (* ; "psi") - ("46,175" SYMBOL "2,167") - (* ; "omega") - - (* ;; "NS Miscellaneous symbols") - - ("041,142" SYMBOL "2,271") - (* ; "notequal") - ("041,145" SYMBOL "2,243") - (* ; "lessequal") - ("041,146" SYMBOL "2,263") - (* ; "greaterequal") - ("041,147" SYMBOL "2,245") - (* ; "infinity") - ("041,150" SYMBOL "2,134") - (* ; "therefore") - ("041,155" SYMBOL "2,262") - (* ; "second") - ("356,055" SYMBOL "2,055") - (* ; "minus") - ("356,106" SYMBOL "2,340") - (* ; "lozenge") - ("356,163" SYMBOL "2,351") - (* ; "topleftbracket") - ("356,164" SYMBOL "2,353") - (* ; "bottomleftbracket") - ("356,165" SYMBOL "2,352") - (* ; "centerbracket") - ("356,166" SYMBOL "2,371") - (* ; "toprightbracket") - ("356,167" SYMBOL "2,373") - (* ; "bottomrightbracket") - ("356,176" SYMBOL "2,176") - (* ; "similar") - ("356,314" SYMBOL "2,251") - (* ; "heart") - ("356,340" SYMBOL "2,374") - (* ; "toprightbracce") - ("356,341" SYMBOL "2,357") - (* ; "braceextend") - ("356,342" SYMBOL "2,375") - (* ; "centerrightbracce") - ("356,343" SYMBOL "2,376") - (* ; "bottomrightbracce") - ("356,344" SYMBOL "2,354") - (* ; "topleftbracce") - ("356,345" SYMBOL "2,356") - (* ; "bottomleftbracce") - ("356,346" SYMBOL "2,355") - (* ; "centerleftbracce") - ("356,355" SYMBOL "2,363") - (* ; "integraltop") - ("356,356" SYMBOL "2,365") - (* ; "integralbottom") - ("356,357" SYMBOL "2,364") - (* ; "integralcenter"))) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS *POSTSCRIPT-NS-HASH*) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) - - (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") - - (POSTSCRIPT.SHOWACCUM STREAM) - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch POSTSCRIPTRIGHTMARGIN of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX of IMAGEDATA) - CHARWID] - [COND - ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of IMAGEDATA)) - (COND - ((ffetch POSTSCRIPTPENDINGXFORM of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTFONTCHANGEDFLG of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA] - (POSTSCRIPT.OUTSTR STREAM STRING))) -) -) - -(RPAQ \POSTSCRIPT.ORIENTATION.MENU - (create MENU ITEMS _ '(("Landscape" T "Print this file/document/image in Landscape Orientation" - ) - ("Portrait" 'NIL - "Print this file/document/image in Portrait Orientation")) - TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ - (create POSITION XCOORD _ -1 YCOORD _ 0) - CHANGEOFFSETFLG _ 'Y)) - -(RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T - "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL - "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ T)) - -(RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 -66 67 68 69 70 NIL)))) - - -(RPAQQ \POSTSCRIPT.JOB.SETUP - ("/bdef {bind def} bind def" "/ldef {load def} bdef" "/S /show ldef" "/M /moveto ldef" - "/DR {transform round exch round exch itransform} bdef" - "/L {gsave newpath setlinewidth 0 setlinecap" - " M lineto currentpoint stroke grestore M} bdef" - "/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" - " M lineto currentpoint stroke grestore M} bdef" - "/F {findfont exch scalefont setfont} bdef" - "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" - " neg 0 rlineto closepath clip newpath} bdef" - "/R {gsave setgray newpath M dup 0 rlineto exch 0 exch" - " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" - "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" - " /startangle exch def" " /orientation exch def" " /minorrad exch def" - " /majorrad exch def" " /y exch def" " /x exch def" - " /savematrix mtrx currentmatrix def" " x y translate" " orientation rotate" - " majorrad minorrad scale" " 0 0 1 startangle endangle arc" " savematrix setmatrix" - " end } bdef" "/concatprocs" " {/proc2 exch cvlit def" " /proc1 exch cvlit def" - " /newproc proc1 length proc2 length add array def" " newproc 0 proc1 putinterval" - " newproc proc1 length proc2 putinterval" " newproc cvx" " } bdef" - "/resmatrix matrix def" "/findresolution" " {72 0 resmatrix defaultmatrix dtransform" - " /yres exch def /xres exch def" " xres dup mul yres dup mul add sqrt" " } bdef" - "/thebitimage" " {/maskp exch def" " /bihgt exch def" " /biwid exch def" - " /byte 1 string def" " /strbufl biwid 8 div ceiling cvi def" - " /strbuf strbufl string def" - " maskp not{{1 exch sub} currenttransfer concatprocs settransfer} if" " biwid bihgt" - " maskp { true } { 1 } ifelse" " [biwid 0 0 bihgt 0 0]" " {/col 0 def" - " {currentfile byte readhexstring pop 0 get" " dup 16#B2 eq {pop" - " currentfile byte readhexstring pop 0 get 1 add" - " currentfile byte readhexstring pop pop /nbyte byte 0 get def" - " { strbuf col nbyte put /col col 1 add def} repeat}" - " {dup 16#B3 eq {pop /col col" " currentfile byte readhexstring pop" - " 0 get add 1 add def}" " {16#B4 eq {currentfile byte readhexstring pop pop} if" - " strbuf col byte 0 get put /col col 1 add def} ifelse" " } ifelse" - " col strbufl ge { exit } if } loop" " strbuf }" - " maskp { imagemask } { image } ifelse" " } bdef" "/setuserscreendict 22 dict def" - "setuserscreendict begin" " /tempctm matrix def" " /temprot matrix def" - " /tempscale matrix def" "end" "/setuserscreen" " {setuserscreendict begin" - " /spotfunction exch def" " /screenangle exch def" " /cellsize exch def" - " /m tempctm currentmatrix def" " /rm screenangle temprot rotate def" - " /sm cellsize dup tempscale scale def" - " sm rm m m concatmatrix m concatmatrix pop" - " 1 0 m dtransform /y1 exch def /x1 exch def" - " /veclength x1 dup mul y1 dup mul add sqrt def" - " /frequency findresolution veclength div def" " /newscreenangle y1 x1 atan def" - " m 2 get m 1 get mul m 0 get m 3 get mul sub" - " 0 gt { { neg } /spotfunction load concatprocs" - " /spotfunction exch def } if" - " frequency newscreenangle /spotfunction load setscreen" " end" " } bdef" - "/setpatterndict 18 dict def" "setpatterndict begin" " /bitison" - " {/ybit exch def /xbit exch def" - " /bytevalue bstring ybit bwidth mul xbit 8 idiv add get def" - " /mask 1 7 xbit 8 mod sub bitshift def" " bytevalue mask and 0 ne" " } bdef" - "end" "/bitpatternspotfunction" " {setpatterndict begin" " /y exch def /x exch def" - " /xindex x 1 add 2 div bpside mul 1 sub cvi def" - " /yindex y 1 add 2 div bpside mul 1 sub cvi def" " xindex yindex bitison" - " {/onbits onbits 1 add def 1}" " {/offbits offbits 1 add def 0} ifelse" " end" - " } bdef" "/setpattern" " {setpatterndict begin" " /cellsz exch def" - " /angle exch def" " /bwidth exch def" " /bpside exch def" " /bstring exch def" - " /onbits 0 def /offbits 0 def" - " cellsz angle /bitpatternspotfunction load setuserscreen" " {} settransfer" - " offbits offbits onbits add div setgray" " end" " } bdef" - "%% - - - - - Fraction-setting code, to support NS fonts better - - - - -" - "/fractiondict 20 dict def" "/fractionshow " "{ fractiondict begin" "/denom exch def " - "/num exch def " "/regfont currentfont def" - "/fractfont currentfont [.65 0 0 .6 0 0] makefont def " "gsave newpath 0 0 moveto " - "(1) true charpath flattenpath pathbbox " "/height exch def pop pop pop" " grestore" - "0 .4 height mul rmoveto" "fractfont setfont num show" - "0 .4 height mul neg rmoveto regfont setfont (\244) show" - "fractfont setfont denom show regfont setfont end } bdef" - "/f14 { (1) (4) fractionshow } bdef" "/f12 { (1) (2) fractionshow } bdef" - "/f34 { (3) (4) fractionshow } bdef" "/f18 { (1) (8) fractionshow } bdef" - "/f38 { (3) (8) fractionshow } bdef" "/f58 { (5) (8) fractionshow } bdef" - "/f78 { (7) (8) fractionshow } bdef" "/f13 { (1) (3) fractionshow } bdef" - "/f23 { (2) (3) fractionshow } bdef" "/bboxdict 20 dict def" - "/bboxchk { bboxdict begin" "/regfont currentfont def" - "/chkfont currentfont [1.25 0 0 1.25 0 0] makefont def " "gsave newpath 0 0 moveto " - "(\161) true charpath flattenpath pathbbox " "/height exch def pop pop pop " - " grestore " " currentpoint " " .2 height mul .3 height mul rmoveto" - "chkfont setfont (\063) show" " moveto" " regfont setfont" "(\161) show end } bdef" - "/rencdict 15 dict def" "/encodefont { rencdict begin" "/newname exch def" - "/oldfont exch def" "/newcodes [" "8#001 /Aacute" "8#002 /Acircumflex" - "8#003 /Adieresis" "8#004 /Agrave" "8#005 /Aring" "8#006 /Atilde" "8#007 /Ccedilla" - "8#010 /Eacute" "8#011 /Ecircumflex" "8#012 /Edieresis" "8#013 /Egrave" "8#014 /Iacute" - "8#015 /Icircumflex" "8#016 /Idieresis" "8#017 /Igrave" "8#020 /Ntilde" "8#021 /Oacute" - "8#022 /Ocircumflex" "8#023 /Odieresis" "8#024 /Ograve" "8#025 /Otilde" "8#026 /Scaron" - "8#027 /Uacute" "8#030 /Ucircumflex" "8#031 /Udieresis" "8#032 /Ugrave" - "8#033 /Ydieresis" "8#034 /Zcaron" "8#177 /periodinferior" "8#201 /aacute" - "8#202 /acircumflex" "8#203 /adieresis" "8#204 /agrave" "8#205 /aring" "8#206 /atilde" - "8#207 /ccedilla" "8#210 /eacute" "8#211 /ecircumflex" "8#212 /edieresis" - "8#213 /egrave" "8#214 /iacute" "8#215 /icircumflex" "8#216 /idieresis" "8#217 /igrave" - "8#220 /ntilde" "8#221 /oacute" "8#222 /ocircumflex" "8#223 /odieresis" "8#224 /ograve" - "8#225 /otilde" "8#226 /scaron" "8#227 /uacute" "8#230 /ucircumflex" "8#231 /udieresis" - "8#232 /ugrave" "8#233 /ydieresis" "8#234 /zcaron" "8#235 /Eth" "8#236 /eth" - "8#237 /Thorn" "8#240 /thorn" " ] def" - "/olddict oldfont findfont def /newfont olddict maxlength dict def" - "olddict { exch dup /FID ne { dup /Encoding eq" - "{ exch dup length array copy newfont 3 1 roll put }" - "{ exch newfont 3 1 roll put } ifelse }" " { pop pop } ifelse } forall" - "newfont /FontName newname put" "newcodes aload pop" - "newcodes length 2 idiv { newfont /Encoding get 3 1 roll put } repeat " - "newname newfont definefont pop end } def" " /accentdict 10 dict def " - " /accentor { accentdict begin /scaler exch def /delta exch def " - "/unders exch def /accents exch def /mainch exch def /scrt (X) def" - " /w1 mainch stringwidth pop def " " currentpoint mainch show currentpoint 4 2 roll " - "accents { /ch exch def 2 copy moveto " " scrt 0 ch put " - " /w2 scrt stringwidth pop def " - " w1 w2 sub 2 div delta rmoveto scrt show " - " /delta delta 150 scaler mul 9 div add def" " } forall " - "unders { /ch exch def 2 copy moveto " " scrt 0 ch put " - " /w2 scrt stringwidth pop def " - " ch 46 eq { w1 w2 sub 2 div -175 scaler mul 9 div rmoveto scrt show 0 175 rmoveto }" - " { w1 w2 sub 2 div 0 rmoveto scrt show } ifelse " " } forall " - " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) - -(RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") - (Regular 'REGULAR "This is a Regular Slope font"))) - -(RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") - (Medium 'MEDIUM "This is a Medium Weight font") - (Light 'LIGHT "This is a Light Weight font"))) - -(ADDTOVAR BackgroundMenuCommands - ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU - \POSTSCRIPT.ORIENTATION.OPTIONS.MENU - )) - "Select the default Orientation for PostScript output" - (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - "Always ask whether to print in Landscape or Portrait Orientation") - ("Landscape" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE T) - "Default printing to Landscape Orientation") - ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE NIL) - "Default printing to Portrait Orientation")))) - -(RPAQQ BackgroundMenu NIL) -(DECLARE%: EVAL@COMPILE - -(RPAQQ GOLDEN.RATIO 1.618034) - -(RPAQQ \PS.SCALE0 100) - -(RPAQQ \PS.TEMPARRAYLEN 20) - - -(CONSTANTS (GOLDEN.RATIO 1.618034) - (\PS.SCALE0 100) - (\PS.TEMPARRAYLEN 20)) -) - -(RPAQ? POSTSCRIPT.BITMAP.SCALE 1) - -(RPAQ? POSTSCRIPT.EOL 'CR) - -(RPAQ? POSTSCRIPT.IMAGESIZEFACTOR 1) - -(RPAQ? POSTSCRIPT.PREFER.LANDSCAPE NIL) - -(RPAQ? POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) - -(RPAQ? POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) - -(RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) - -(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>")))) - -(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) -(DEFINEQ - -(POSTSCRIPTSEND - - [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ") - - (* ; "Edited 20-Nov-95 11:26 by ") - - - - (* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).") - - - - (SELECTQ (MKATOM (UNIX-GETPARM "ARCH")) - - (dos (DOSPRINT HOST FILE PRINTOPTIONS)) - - (UnixPrint HOST FILE PRINTOPTIONS]) -) - -(ADDTOVAR PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)))) - -(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) - -(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) - -(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) - -(RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) - - - -(* ;; -"NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk" -) - - -(APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2))) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST - POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE - POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE - \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(POSTSCRIPT.INIT) -) - -(PUTPROPS POSTSCRIPTSTREAM FILETYPE :TCOMPL) - -(PUTPROPS POSTSCRIPTSTREAM MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML ) - -(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) -) -(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT ( -"Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" - 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (22912 30016 (POSTSCRIPT.INIT 22922 . 30014)) (30996 65780 (PSCFONT.READFONT 31006 . -32914) (PSCFONT.SPELLFILE 32916 . 33494) (PSCFONT.COERCEFILE 33496 . 35068) ( -PSCFONTFROMCACHE.SPELLFILE 35070 . 36055) (PSCFONTFROMCACHE.COERCEFILE 36057 . 37709) ( -PSCFONT.WRITEFONT 37711 . 38726) (READ-AFM-FILE 38728 . 44599) (CONVERT-AFM-FILES 44601 . 45813) ( -POSTSCRIPT.GETFONTID 45815 . 47210) (POSTSCRIPT.FONTCREATE 47212 . 59611) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59613 . 62010) (POSTSCRIPT.FONTSAVAILABLE 62012 . 65778)) (66335 -75659 (OPENPOSTSCRIPTSTREAM 66345 . 75147) (CLOSEPOSTSCRIPTSTREAM 75149 . 75657)) (75704 81525 ( -POSTSCRIPT.HARDCOPYW 75714 . 79063) (POSTSCRIPT.TEDIT 79065 . 79545) (POSTSCRIPT.TEXT 79547 . 79838) ( -POSTSCRIPTFILEP 79840 . 80476) (MAKEEPSFILE 80478 . 81523)) (81526 126412 (POSTSCRIPT.BITMAPSCALE -81536 . 83992) (POSTSCRIPT.CLOSESTRING 83994 . 84528) (POSTSCRIPT.ENDPAGE 84530 . 85401) ( -POSTSCRIPT.OUTSTR 85403 . 86424) (POSTSCRIPT.PUTBITMAPBYTES 86426 . 94897) (POSTSCRIPT.PUTCOMMAND -94899 . 95948) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95950 . 101398) (POSTSCRIPT.SHOWACCUM 101400 . 103638) ( -POSTSCRIPT.STARTPAGE 103640 . 106219) (\POSTSCRIPTTAB 106221 . 107092) (\PS.BOUTFIXP 107094 . 108444) -(\PS.SCALEHACK 108446 . 111275) (\PS.SCALEREGION 111277 . 111837) (\SCALEDBITBLT.PSC 111839 . 116139) -(\SETPOS.PSC 116141 . 116603) (\SETXFORM.PSC 116605 . 118424) (\STRINGWIDTH.PSC 118426 . 118880) ( -\SWITCHFONTS.PSC 118882 . 125039) (\TERPRI.PSC 125041 . 126410)) (126447 182167 (\BITBLT.PSC 126457 . -127010) (\BLTSHADE.PSC 127012 . 131294) (\CHARWIDTH.PSC 131296 . 132063) (\CREATECHARSET.PSC 132065 . -133763) (\DRAWARC.PSC 133765 . 136245) (\DRAWCIRCLE.PSC 136247 . 138656) (\DRAWCURVE.PSC 138658 . -142679) (\DRAWELLIPSE.PSC 142681 . 145158) (\DRAWLINE.PSC 145160 . 147510) (\DRAWPOINT.PSC 147512 . -148100) (\DRAWPOLYGON.PSC 148102 . 151216) (\DSPBOTTOMMARGIN.PSC 151218 . 151783) ( -\DSPCLIPPINGREGION.PSC 151785 . 153228) (\DSPCOLOR.PSC 153230 . 154071) (\DSPFONT.PSC 154073 . 158283) - (\DSPLEFTMARGIN.PSC 158285 . 158854) (\DSPLINEFEED.PSC 158856 . 159432) (\DSPPUSHSTATE.PSC 159434 . -161197) (\DSPPOPSTATE.PSC 161199 . 163708) (\DSPRESET.PSC 163710 . 164356) (\DSPRIGHTMARGIN.PSC 164358 - . 164930) (\DSPROTATE.PSC 164932 . 165955) (\DSPSCALE.PSC 165957 . 166888) (\DSPSCALE2.PSC 166890 . -167709) (\DSPSPACEFACTOR.PSC 167711 . 168683) (\DSPTOPMARGIN.PSC 168685 . 169402) (\DSPTRANSLATE.PSC -169404 . 171978) (\DSPXPOSITION.PSC 171980 . 172579) (\DSPYPOSITION.PSC 172581 . 173153) ( -\FILLCIRCLE.PSC 173155 . 175801) (\FILLPOLYGON.PSC 175803 . 179719) (\FIXLINELENGTH.PSC 179721 . -181215) (\MOVETO.PSC 181217 . 181968) (\NEWPAGE.PSC 181970 . 182165)) (182223 205375 ( -\POSTSCRIPT.CHANGECHARSET 182233 . 183037) (\POSTSCRIPT.OUTCHARFN 183039 . 195896) ( -\POSTSCRIPT.PRINTSLUG 195898 . 197865) (\POSTSCRIPT.SPECIALOUTCHARFN 197867 . 200299) (\UPDATE.PSC -200301 . 201524) (\POSTSCRIPT.ACCENTFN 201526 . 202468) (\POSTSCRIPT.ACCENTPAIR 202470 . 205373)) ( -205473 207118 (\PSC.SPACEDISP 205483 . 205762) (\PSC.SPACEWID 205764 . 206383) (\PSC.SYMBOLS 206385 . -207116)) (207227 210218 (\POSTSCRIPT.NSHASH 207237 . 210216)) (254693 255407 (POSTSCRIPTSEND 254703 . -255405))))) -STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM deleted file mode 100644 index bf3a121e359188d0dbf053eaea242e9aab15fe9e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 91382 zcmeFa3v^u9c^*15fJh1wApnG78m8%^F-3z60bw2hK}NRcU}k_BU}nw;1CRto2?jZk z@E8Fs2>H>(x3-%{b61-#+x0VXvtlQ9n=*fTC>oHh1097G|IQI{WO$|Nj5olS+?d3+djGY%blKEsQwU z;i8=!w@1@fI9r%ZPvo+tV%R!7k+xHl_HeEyd)O|etw{f|mX;psA&F{}>68_Y#(T$} zTJDYZM`KnbemZ{YbbKIe^@K02Jb8JcGFP@%maVY$6KC`3R4zUJk%uY^7guLjKm6XJ zQ<^L#C$h!K(j@xI_x*SzcFbxCM`K2R1E&Wfr~CWE*6N(w-`s~TuU>iJw3W;`rF3mC z)&kx(GL_3&WePOFSyN1y;e8E8Y*d2Y14((jHXMylaAFhQYbYZ|1s-yaUy*t>r9n;QLo5lORvS`%TEHda89oyd%>$lXK1}*Lu zdB^tGOq$GB(TWUMc7NpLkcDKNlcy*dyHLv6lUTvh z@ncrgZ?!cA0`2{wv(|dN9BdCZwfFDgr5g`*{d_qXd^W$eH#gt?*vE25p9?i@{dJ+E z<6P5cvRj8U=clX4cyX*_g;tgqnb+uQ;EVh_oq5~(e?XV_-|e(=#+R-JKBkg0t^bM| zZCrL*_fTSc&sLXCHgDadlcAZmDi20y?CYB8aBE6QTe)eYYyEAZ%_B~SgNI+?cfD=B zlYhJ2mffBEss}LOrjK8}Rl(Oz@z?54U4I`vwn&$qA^O*~dEDtVGJ;$8IaCtd+DpH| z`R?xdZvJfU_xIRU)Jl%{sA1CoG-VrxPtYaj#Ca>O`AP zbm&B!DS)xK1=t0^JV-B|Navk1>E6^-F_%pOU6lx6t2Y3Wo&v-)KMg2w zVsg5ewuXkHwV;eX`Z&J2-)xc1gFJDHC2MFfY88Metf7IJO2p$T5gRbzrGe#!qJydi zK2;j`4@u(WDa<)2lCyooxk(z8b@CKm%sJ zfbE!wm}E|sGDhw|9Jv$r*`fp5N-6^JQfm#fRr44yAaW-huSYC5x3wpd(vp^qM#&gT zvanhgfTXj9Q8N?YfE|)6I=Sglr@%D_PvJ9UBt|CYpWm9smrAvh@)^lowpc{36X{VP z6)75w8xw2|4#;bAMO;*+$cT@RA+G_ zE6pSLBGgJcIo%=fDCIErk4hzML^q3b22SBi3hA>&Y!t~D!iR8^6zCZ&ujHP@dYI3H z_y`o@tff@D0SuoeFPWW4;*inW4#d?;q;r^-lFE!>;54CT#V8G)@}?%vsA^FfJ+g8j zx}~>>44yJZ(&?0B_N$d3a>tmS_$gVBTzbTpjq^tnKqr^m$4}xz=nzgi@;oT3Fb#;3 zCAvUzK`c?TbN<{oh?0g>bUX&i#-%~5cr0rDWOI`~jdXP2F>@F(ob=;X6f~nTw&P5jyD;gc(XQ8+v{7)W4{t$0@-af4jUJVVhMu#!x- zp2c5`F-xRv#43*92V4X54pg1+RKd;@)oQL56)`n?%nIJUCm0AOm=v04qVry&h2}wR z(Z6o_*B)-lX1J6QEYnQq4`!^&t(}d(&4$K;2eYA2#`^P&b%Ro7(wFu>gfywPSmu{L za8vmyMS z|C2xJul{j=L+S&&&vak9Hw#WE+COOJdXvOuM*-#Z1de3WxfED}n4DBF0RyM#q}bp) zz<4lyFc7h5nJfTcaQLZSdJqmCjD=GKhsPW?HecivP$Df$1h}!3w+U60Xi>9;;?yMV z&UnNp4FJgM=_#cjp2E(;d9@~w8GEBt1YD$nYKAgyDY_&J&W16Xu$I^;z!l76ma^w5 zfx~3yv$<(-n8&c{cQKLlbU4AkU7@X}ggv~NTI5Gw{{8zn{(u9|?AV@&Qc!hmb+Gpb=Oj;&Vt7$|N0g%_D4gqiPQquVHq?4Wi@-sdiT&0j? zS2WK4t_UVgCL(5)a##>dK-4-b94;~5b(0c|;A8iu_;BoOz5|nyl!Jm@lO7R9 zgm|A|tK{!&P#vz40w?3E6Znqq=V)E!a$V);G_Sw;&T7Ku9+UN5epcQEVpsQ#_eds~Z7MY>*35q&^okM13YGfx1lEqoCA5Q%&VSYes>@L0D#|@>Udd38XTho~y8)U6St)2$lf)ar&f+PWbihsuo%Ve_fVk&~y~Y~V;Yd$8Zlj=AHAKzgV8z_jSP zz?SMAU`BK%hNhDM7OEV$UuU`_z*oC?WMsn0GvM#@rdmm%-aODCQHXJ<>F_F~5||4H z19$nL2=9|cIWnB~p!LIDq4r=PQ{IRLGa>w+|C2xJul{j=HQ1)Tc1pu*OrsxMM?w0~ zsB|u^|0xA{-AxBL(GV~-p0@u1ad`3mE<>C~d)xp$jfxEz)UenCMh%NSsMM&~15b@g zJvh~%^nU=XzOxhANg=ltyg(Nf7P4M|g3#uqz@E3)G z5WCK_I&G@lL9(U>s&rOoI-E{j1xdFGQ^u_%x4QW`MFuC@GFj&kzkcRmb*9TXs2d{b zHgpa_#C2$W8>B7KY>*#KGB>7Dpv%%ZYBS0GxKxNu_DSK>SY|iL?a6!_GM*A;ilkAzzzBdPplIiq=U*Ef&E; zDQb~u^+{(uT|mvaMLREMHmC?v-s0akB`exDg2@8VtM%=++sSk z8;7Cn9PDhVUOFnRRqs7Dz4zDl4$-^Q{f50mF7F(o-g~O{W1H_=;NInv7kHG_tor3? zQ0cQrx!z;yQMDSLY28fRX%9Wz!%VBci)_B&wDKep6VZLJnhmMvozE8pS$`t`^Vy)T z#hmuRsw~KJJj6T?8=9ogNpAgL?i$cZIBsZaf)JuFI)`8Tl5_YU;`dd0E&hovM?DY+ zj(@=$fP9iv8Q42c8^7~A{7I@lmj>$!e_DnkGpvVtYglq;I@Fg`_U~-`-_n05cd+Vo zEVYN)ov>rw{N&ZZr`p>(q`pkZ#`jd~BeFpR)~lW_9j`h^7H@uG%sKMfM!$39{CaPr zwwF#+&qmLlc=ybajl)#+Q>ghd=g9bLpLC8~&pAiV9v8`lwB_L)aKeDaVW`RuV5DR6 z+2aSL1_>XA05%mA9)j+aK$w85AwXT0Hk^bwZ^DLP7jkh_kQ5}rRMk2OI)$?!{|9)L zJU|YqHVC-x^*9J2y2^)4A3B87rEI$D-kOW))Vr#DHeQ6Rt!>hmBRe06h2zDjo}-0k_4UHO$=Ws-9V_QvcT%8 z6!aI8ib9a1+D6fWSs;8R3^cT44Y~z`E?Y-;;AMo+(U8^ zjHJHn2qfrU*AYmfy{?IQ_IDk@l1bP7CT6st327*G8-(&9Tw0r5T}#f-uIA^~Ru?W^ z30rZ@Q+Q-$d2M)jj#1}t<^j< z{69+sY_4hRo&yI+)4o0576kAmGS=x}NOvu}L}?claYAwYkBkXsEQFrVhn~xYo?ZWy zKu-izoR-meWPYT-hHEDsCv9eTYQPnFG9&0P^=?Eyww~3a1Ssl0~21YKs6+7EzpY0e2xAct{0_{zE^V^3D-~O|2YzMaPDSSIW z&l`I?K)l>HoYofuPHUT@Al`Gf^J$X&_E86&)B*4CJL)1^R-L@JdbW#t3H&AX()H$g z(S7h2yznc$`e!>{hzLz}#&_J2qL820Gh^%k#&MU z3zmCzShdcsK zKwCIfNRr+bTU~b2unk)T9Q5ftfC+;dFjkSi*zVgOJhPImHr&b}n+QA%HwCdVgR+`W z50&f$(aZqKCBT46D05$HM|)E!vwb+L_GR|l8NDyFv@geA42*$x1hTIC#6ht^Iga7( zGE99yqvmm;lWCqN9M4nMWS(s4U;>fM&@V<0T@uz1#+0ml1dYSLfPiEdsLmy7vdG?_ zhw06pE2^_fh%J>a(L$hOU^bluxuuNu1}wHDAmBoSfaCzCr3$;ntSKn5sR$(yX1Hn| zyxK*b{T^6;^K$NER_I$@P>u};hXJo?alYMVFYSO|`c-Iqk|_~tKlbVQneOVkZDd{8 zI+(CC*)devOC0TE8wVDs&O4avd7kS3Q(uJ(TO)KQE|mWnw|We(5B?3m z33y+<6NrC){k>vS*u@+5-Ot-x7JS7&NXZTPv)if*k5&r|Er03#G!O6OJ_BhHYr69+HVq3lIZB8fN z#Z6xbcy0do1G%mJyQ5U~anTe1d0 z?hBH&29@a~VF&V1fGN@-7Kp}VWW_NoMN6toyE#Sq5h$Zy5(0nHtOkFRE-RQ4G z7(R}r0MTp3KpWF<6r?KsM!-MvFW5``9@~FMJ6@5(G+4%Au$FT%Ah=UTnvB9|d^8w5 zh+P!Rgju=W7v93q zV2MGv&TNl1sySNUdU~t3LG!J5G{~G*$mM+b>2dHpj9ngiI#DA&zQ8bYPa%JE^GL3c z886fUViBknmR@>n{ZDg%R#9v!mWq+EMGg^m6H|iV%$3XoN{_mO6M?^h&h(CX1Z1De z_0E%548T#}29)P*nqX(vHvx-UmxJ*#;^}|Fb@o@f4O3oKGIk1;e zwQ=fd%4#!ckCQ19?`41=%{gnPSp6OY4HwzH5EHyx!#bkVFoIUc0V`1;t2MlyJTX9b z3K@y>$mAr6JI^Xok7SAVS;?mbho*#yM`dO-jVF=88LttmDu`BKHYx^3L_ZeoNr>&p z-R1`&2ZR6RogfG6%^Mi+wkMhxv#xiQgO7y9gWbQI-P)U(?>_&r%+Y5cIQi~aM|*fL zoI|8mnFKKV+WYTu+H$<%nP6D|amt3nf+7OiTb=G8h$UF9AIifntJyhpu%m5EeOOr9<%w3f`AQ1Fpk32z+dxA z$+zTx3(g#^iq>c6D@=53oK@9-%XW^2f;(TOze_tC32l4SJ&c@C@O!^K%z&gTB##^K zbdEX}f6`{Bb9ClN)d_DMaE@TCVUTLh;n2+CtG6yYM~=>ftLy(KeQ&4JQ>MP3ewgQ` z5^9gW%{k#5zquK8dW4W_4LK(u-EWn}Ueqci>J&gsJ! zA9mtRTW@s+JG#ZaW=KuPr^g_>dPv|4#`e(6>8dld)#02*XG1fCRVN;riLd_~=k(E; zq3ZfgcXIx90YHZ=g4y&w4yH1n&JU+yAPW&S6Ejg@43!s!n3wBCKs_`ja6rCj6S--a z)}xC8toP|C)S9ith`Te;a^61IcQ%_#u^}CstwjMoV3do)h`)rSak41~fY58l@W3$2 zBQWU4_3Dg(^iweEHsnQ`=c@)HyIW;Ua$0~|dt#V@4niPY{j^5DHybH7XuI$f2q zTk$a7%;LTJ_qtL)EgaOp=ye!x52*?&48+uJ$?H4 zRN*YyfI7u z6xp>51!Cd^dDe-*T>%j&&hr_Y=Uw_R*ujtTF)VU!_2FQp%qjKkD}#LDHid6cT3cM? z0f?4PhE!rO^X{#tNiH(S$-~$sV_yLO%(5c)!(SnQYa?v5uTB`fS7jQ^QAiF^3pkrv zSA(OW6gZIj=uAj=R3<3H{J2s-5oxHhp_0?giP!^^YD2finN!tpc-Ut&N+dCBlgPS4 z)r$a~OJ)Rm0G&zHJ=ct25bmo<*`cx_e${n}ppm-3_0R<+(^ zMim%8Nzes9z@gXd|N%2xur$9>Bl!ayhy3ZVc5Pv0 zIR%$tDu`hGUIA4uu3T9wU0PkZyk@0V7d|kzY9&`Le|VJ)C#;?%2$xesL%oqxV9?IM zj$+Q5U4|p{+Wg$=m2eA8xM5^XqnTV-tH=vLVTAENxJJ+q1l{xlYfr8=yz3ny4@E*?OJpRMbr+Q>h@BsI)ZZjb^<{T7w zD*b)^-uCj+&gR?7i#wmLj#c)rAE<BL^{`ceMNulL5l za}?Uz&tEFW4v*?)HSKx0O0Om#r7FhS9{W^b@#ZftJ%6@4*2ebf~Pdcd2 z8RuDraIQn8GL`ZxLOJDw{EeN_`VzSFHml;9*3K?9u9>zkKtb5bt+oyTcHZu)Zh6Z72|#o5EK zTN)F7mtQ|>ztSN@j9EgOBFWAh4C`pm;ScBwYRyv!711IH{*wbwg+_KL>ZV*No zMxy~>0%;GhN79P{;9T}%gPIT^jPgnVz|h+iOCn;_6=8@^77%26G60ZTSKg1FRe2nE zRpBbOA`zqpJf|~(c@(CD2vMc*$&!izRjZ1m@>iMo4&@&dL+kX!1UbmT2p#W4Faalt z2QuP0EnIl7t4AVl1F?;alCK~eLq;J;G8O>ljsV{X=t$s1%xC@#d(4ou zqY<7FIy8a-irplst3(I_|4GmAgLrI;IHE}zAZGFdR)}K=(o2)mKvyJOgH^|nPlSoh zbCN`B{w+ng0xpScyrkt)LnPoezY_jH1(8|x$=(9tVwc9PAz)vl9yHe@>4`pLGh$^G z27;fknTD;5ejB+9dreOI{g@d`p2VbQAn*mvL>m&bM7Eyhvya!3HaJ$Q4n&zaN!~cQ zd{D^`A-)88R#ys=sV`@Cp9iw`FqpHI99W;Zf{sn??q%w z<-Ujv_SKGz5L-VfoKEM;t8^nBi93=1~Jt&HBp!gR!^vnr_Ea3bGo1P*;Q>TzGQ!iMcBae}C@r z*-L9;ZA4Y3mY0@SKDca>!g5W$(jwoXKrRl&)5t4j$ z7Ey~kU zqBwdXIeMRypNoNy>O|RI0D&s&y%!Y&Qefjel46YF3XHrDX0ae;@D>ORiS%=i5{M06 zi%GyH4fIF?!G^_9JaA}>BG!PEYVLI5*(chk)_VL9YS_c%*bs9uCY>uL4f#ZoVA1?Q zi$q{v-+cd&~3Z)E#2L4=;3%#Gdd431~BlCALw4iUN4?c%|#0$em zmo}35A}Xf>gTw%a^;V5dUWqm}!CK9yQ~RR+ba%ntiy6t{P63X7!+TPy0SRN0Kb5yAA?q_B7xs{oZ zb!SHF+&F_ofU^ug3v}iluThU<_q8euf6Q(KTS0>+OrRbg#IIuQDViHB~U75u#KP<{@WKgK(yRX~v{sVZGfBftfplsA`f>0Ea(OaG)SaIuq%S zl#;O4PiAViU!OoH!GcPo2FR0#=sBCuK_G;cm4_l8pi;~@6MzHY2iarEA>%E65E@Sr zngoPYI5t{5R!sx(y{{cBSIO{!<7wp-|LF>eFrfX*xn>HSB5_3JEq-$AM z&_RlGr9DKUi@c4}M`09vY!mt95!)02s59!-vrRrKzZTIMEqz763r3L#i$Tbm;Ej*l;m>*F3=nG#8-qKh!ei7!YHj5D}f^G8DfZ{!d|C^TQibQ_HVdraxEvR3QvtNBh z-1vs-<^g$PFv@VUs_Q4_@m&B`#&;PsJQ%XZ1^)d22y+%@v{UqL4VZ5LKPLGxeYKO~ zXY+XK%z47L2w$0B`5-YiaI%0V;EC0_D`0}=tShr0m}7oNXZUAR7DpyCXZ1uNg?E=8 zU@eEW4%y|H^*Kb^;Dv50Gnous+HY6w^4CLci#xx{IUoOe=w~abos9{b49U%skG;^e z^y+ng)^_08@l2(eyS#C}I=*z{k+Ii4c{T7Ka%3?5OoFU;xp4h2628}bY&+n8exb=$ z{j_&Bt5t20Et+^1mY?I5<{ZSSvBb{Cdlv2X;k&ZGzi&J6$kzjVpUwV$=<7|^BIu(> ztC^)6=W?%YK9>LVcm^Z*_;}`P*AipyDE{1D-1$wrd{@)P0hxf$R}+jy|Q9sp`ppFzUz|AY2W3`mU`?-;};$qdxmIQO8bu@E@#qzylxCPd40J!O&s z_XUU;$VmWpJcPCetp^@p;Z?7S`bJ<*XGsuTh#t609DZM8upqvQ*wXr0^@UTaa|m|z z7N%H@4+)0A3k*O6i_||22%9+yvH+SedlKV@J_*=3>p&w#R@~_`@FoUwWlj@SeP^tTc=V8YCe4-+T7>UY5yqp5*d|HfztHnTyD`D|lB(a!X zdKLfA{c(HKJur6dB$vvsk1si0?M<*taSqpc<2-*Z;^l(E+2GN|O^NcybLrg>Q&;5PmU5hv^wnF2hT&&V(0lZv2zV-#Q0h+Z=ea zGY0x8Q5jY%Qi(|dW_x(=Zzd`ux?p7e5LPf;w}N4B1sw{@iot*st2Ez0zgKUS$DHo3 zfs*5iSZr_ZcKV&Zo15V=C;BzV+Sz!U6UQ9HVdsOd?yovg{6wqkf8xZ=kN?v*`grJT z{%PfJegvN%{UJUd(___5k9FJW8CKKtgD;(9RW^2h1AjMnzJk9`LkVT9W?Vi8>k*>$ zc*7AM!eWpC8h&Vp;RhQ`HNN`&6K`^B9Ti_|2Xii0%} zl%X_iaeR#`BD}_Y;hAeiVcj7Kw^vd)Ni7Oyr&7SK zl7c3W>%&rpej%lWpOr>c5Nl&m1oJ^9pvS^uWRj}DkudP7J%LbQ4usFrEIekFthOJ5-Ld)3_}KQ5&t#cYtd4E>e>ST$ z?T|iDSVLld=i6oKg$1k#~LK{M+X*%lnqk8ZV}$%-ahLL+_! z$At`oToGL#mI@<=t-8DG-SuXRL|#)Yf-Ex3cP>D{bdJP>tiZ)aFgo+7`j#GSX0=98 z*^2yL3qotB96i=*l(mooPMu`n4rZ9lS%$3qFn(Y>NkR*-lK3CFqm!Xa5$rAGOiB8I z?v?Zjv^I`P`FT3T7SNhNlfesq7OYN4VAOVh`!BaBB0BuZ%K48jJ~My*kqeJLHq$!O zHq!wxWN$TRLGy3zx9@6tdY@3c^E>Bto1M*X3!_y{ES60cYP;*YsuO*d*~YRfl49ZH zbBpC1$*Ay$0-bkvKR>qda31olgVlV9GD+A4X*{Iwn#c!nL^->-==!pKWy2`@{`5;wvySbOTfiO%6mObdvEN!7ugw>GJeV7kP<~zGos?Zr# zDW?@4T2kz^Ats7ScED&sB|AIsRmri=uu3g-_E*&mUVZ&@B&)?XL|9x_c=PUqI)O53 zVlExNWXECK8C zz!KHw5kFCvM|@IEe+0wp@*vZ#%L96<%_D2zy1WMOVE6l)_Y#9ulLf^{ZPpveIVg~M zFRTKG{2sI3GHS?Rjgw_Q!CV%!@(P+~Iq+{oB&@+PZrA7H2s=?fZAg5l;V>&y`G%F< zc#Ft9vV17{#IENgYdvKOM-rKBEAv9~Wg(5S8~00L#o~t2oRi{D`P06(d|vLDr^-N% zM7%P)GcznU;%@okEqjn0;z6+x2Xgh+Lzja9sn4X?F46{QI{h#Jsm9hM>Ly$c8z2SF zflPVoA%?73Ths$0L9h!f3RL28ETpx%QmI%UTqv*2lT-#;W;722bnBv7Us*r5C0(@G zRFa7*^%h1P8dAnWpx6n&?BEb7Y0>9=v`!l$|Lm7JEwt#Dr9D_OHSjV)X376fGW!%ntq*1C- z!Tz=Y{v|SUUxmDOq4TIt#3ixay>T|7k`nW+J=iQjRA-CUdHImFnBYBb?9N1%x3sFy z1WH2OP1+<6JCO)OKNOC_V8Ca@6$L4028)jp%_=5R47SNsqka!Yp@e9V3j>&mbWUkn zBCunruS0<#{6mTmX+tJa3($)_q-`Kikm>>()l>pA>0>R%r$I9;VpxLb{x1e)eUPNtm3@irzzc7Gg@o{l?NDNS z&#Rd~eN{r5a99)awgfw%1apQ|w}3tck{v^5zp@tu-=clB40?rrhS1*RDl@|Nv z7ZP@*{|4u_@rkr=ZakuiLm_*H&byiIV)Gv^hW9`*HnLt(r%f_P|52l z5;HfAmxE&x_TXT3JOujIc*3LqnKHZ_l1o1)J*s{~sxb`6efiBgzuBL^N9Su|SM{?` z=WB9T<+td3O%bd7dv(61iBI zxRQWeL=qrZC4s%e338;61Z>VEfxRaQ+Gx}d5rUim^x|JYE7z{p2hcqd4$u%Z22tS+ z%w=M*t21DMQ063M@B;!E64uj}F+i@`deH`^kE~s&>5nvwb!{7rFA9BXT|Gi@wf!|v zR7D$DbHewet}P?9n*JgbE44PS!HFhHt+rkRG8}r;+FG}#%nf*;^#4pskr9Av4*okP{Rc*GuX&v$@!(pd@$`0k6sKQrk^_j_uc=onK?#7^BEK z@;S;Ehw}hLTE3$!6xbJrr9o_`fC}UuPq2^e$_b!xr=UzoqC=kn`T)4XyMCZ)Z3Sr6rj@zK--nQ`IzIoQ%_AAMN$aJQ^8 z&qCti8d|8E@6duwn@fm?!EN04lc%zqt6uKn0ybT&8LxVis){9)a-J*bJ?DWT?;AZ7 zYy0xj#Y5GkAiRFy-O)n|EOh`22ea?TiU-J#Wa*W5dyk;W7n+|{iKge~pHKaoY7n}( zubS2m%@D)v$Sc{=)>qgtit+Lz zWoGHNN4vgQ9_`{R&iGyEC^rrb=!xQHoxA={G$i7+FP*t}Byl4L5) zV_|y%I?=`jK{0Z&a|ygYk4goD<>T&Z^oO-()}E1V6jJ@g6yi|M9T?h=#MS`t2`DUQR$>F%+s(ZF zM5AKQclMBYp>8iJlWeSE9kxRrnS+L{JpRLSV#G2kPb#dSF_|C2Ns)j~0mf-17)ukR zGfl63B;kWit}=VO3&wsjaPZc{ziu$8RY~*d;&Y?EZ%_m|o49gBK6tR^oGDx7?eH(u z_okXWDt~%A6S*9M*Lz!7`a|8BG_`6WJty6=^N~^N&n|ST(+g3TR36 z8@?$G91RHx31ay>Fop)R^g*99^i)B@L#9)R-2le~T=X0KOI)57vbO_d4kiFa#mA!v zj!^hDf!*yc2kmXSuX%H%96ZCs%H~4~P~-(Fs2?sfKnh5-K%i=0%Lm7{6Wz~@Wjhnq zyy{}(g1z{MC>5Be`*D>#&9A^ym%GXX0;$n?nL0yPGQiQ*;63(IUC-Xo@(sFs)9(m; z)t!{#d|6G(Dg7}rZvN}NSB9vjpp7deHLiiYtUxZWW^u{ zIipw#eEn5X7}vx(B*1vZjoj`)af5djK92cno4&BIOak=5I%2PaJqH zY>mLp4pNSAuYGBG4Qckidk_h5{89?4I&2|_G=*VnZu!y*obwPE963OVx*<`=QVlZ} zMs-4eq|)er)OvDuiCb7#=GM67e%MA507otEl+r}XhpopKmdjMddIUK@`MP_OvQw`V zx@)&yVVNkMlD#=ATJ{4`)b<(yx~86h>$Q4i(;MI`#E6BFxiY@cx0rKr5{r{x!`U z@@U6s=V;gH!O`xe{r3^h5!RvZ0$)#1a5^mE?#7N@KYLc0d zgob>tARf^o8@h~vGg!i7@)1N!OpH>bHi?YlU5bn>zE;x}tGHp1jZu zsfjB~A?w>(S&D1!L*$7X4p97m#>U$Rm$NhzB#P|sZ~tV=XzRv-%xJ5!0P5oX`A;(X zkA0<9u>E*|mF(C7c1T4-s-Zj&wu)#Xa09l_T(y#!7u5nk zeN)IEsri0t@Ac=U_P0_=6@i?21&Q;D6BlL3YT|&Ujd5ulmUe(XB0G%1me5~K#1&$_ z7$dnzL%be?fTD2;2^~C<4pXaRs@KO5+(3=dAYli!iy_yc_!SLb4pO8}-~&8S zmk0XBF9ITBNXP<>@abXz<0b0lN-h(JKtW4yG*3k~fLcIAM1uJ0662$4QaC%E1nZ%a zqd*u>uc)1q|60Yv&8#1BFPi+T3J->4n3#3V&~V z;qPsDp1_ZVPi##9XkhpT{QYhmqik&&9At1N9}6SYGo$Xe0CQoJGXCOk6O+*-1gIkp zBdCH?%1w<@OaYHx#RDuErE8>rka(kkf4C1g==}tz-dUc9($W`PTm{YwR6E-5S8#hf za9sfScxQ7Oa;y=A)~(oLuaA2noL0!sEe3%j0zg~7!%CcImtdi~^wAuQ0}+PzH^&Qn z=|zKm{&-mK6>d!e>5^Q1BK^9k6rY6^I+pb7LnQZx-CgLEVB`bl&| zgefi}!G201@GG{Cxi-M;SPHUl${|(*V4TAFwbBQQ##hQfO2NxAJTXCuTa zTykhp*p3Ky8L;C$#MTH0Gesrn9$uH}iD{(q4V*rQv`5YUv>aqyi8%4q-QPSC3O+LeTIAaL&#+=WF`gAX$sHenuKYU&1tD)sh;fr( zatZTl>QPeZmppvxr9?vlr@CS8g-A;53=^^5PQpW~}^@vy~-oxU`0uUM)Q!*oZ6nh<&%ClF1tH?}C5CJg5BiUuxVtEJiv{hJH z?v-znW464qW?gye^5vD)wYhTNqYtz^GIfP;s8Q!pyoW;Hhl$H2zj+?v6RWcyMha9* z9hM>lSO4abr+5I%vz>z=j!I9s4V>ps-+E_HfNcs+;ND5FS#ZcrQ{qRtP zp_TzRm}~LD4Kk512=XXSQ{$rabwOTi5VCFt^jHwQOBmYZ+`0uv%CV}Kt%=s}86{4Yu}A^N4Try4xm5wsu$Y7MlI zu9$3e&#ZUKeh7d;1nLh0FwB?VG0fa-@DL$$=qU)2#W_OO^}T!7!rv*a>Ezt8dC=lL)B*l<}}H8G|_ihNc?G3yed)@K4D zv`}7@(leb5w+ia1%Yb4`Q6q|p6mh|KDIiIkF9W`m9poL>=2*_*o0~t8z~w*(|B`FN zL$X^^@E&CAIXElN`N_g9=K=n8PE^jGMX3XY7^F$XAu566P*rM3Q3W?TsFQ{*nN ziYFZtMkNw1lE4lS#czOP3d7kL=*B_+>{0@5neXm_+W`N<)`EUx@P*-D@>if|yo-Nt zBP5ZYq7VyEO$PM1$vU5gZZfIP%I*RXiapSHh?b3^G z%x{2kMK9_oqo5ZDpig0NABXft5)fE$g6vZS6Tp(Fgxh&xazO_A3N~pX5=wQh1q31` zV7+cfRSrPMVqgclQYown$~c>JUwUfw0}xq2mcfo0^ec2FUAq+Hu!1BvAX&!{KgU>| z02u^n5%9kl2`Z=}-NwVeY*&*9j)9}$3dtj) z8cQ{(0wR{BIJYBoA@8WeTuK=)PA!aRXfU9I6=jNDT1%PY8!>ktn$yVPwDm(Hnsg54 zHn_m#2cS%M<9>~BLV);j-1If(Ot@?>qW)%K+2cOn0UP|T9|0TurzVyN{6QU-_`Amj ziy@&f!(vWYOU$x&kB^uo=SBm1(#4aF0ZWA7g^GEf0>XfUqB&2?mdEfGdh1 zqlwwMN@d~l6+{F2@68Syr}c-RaDPyi*!T7y8uAdKX@VW7J3wRlji*7cx|Ai9bS#dm z*Uf2#T-=(5n?3Y$=jbPDO+(uU+VdR!cv7{%e}TsMZkO;32GX!VzE^X*7h70r_OH{B znx&b}g4FDH?Bvaju0%3r4~tTBKbKq$d~vk(uBOe{Xj{`}U&54Iner^-@G7m@+#A%T zUbpr#sl@vslu<&;+@B za|}pBMXEJl$1C59Ekz6wR{BHIDkZ#v_n)Cxh3CYkXF? z#=8>vu{S)I38mTIxeX&I@_0KKkQUa2hHM}+-MCkcXf230ZGPzlU}WM2{>9~2aW zUykCb0Ae*yrRoE`a4j5J#Zxt~Kh|bPcq3l{VNfX)Bp=L!qDx{7#ta2;l;M^rhKVO4 z*%p3T*GfzhVzY1t8Ix&NM+9;tqbH`rV~iTGK#=572e;#rAnB)GZpS1+N>6N^U%p4g z7`0=OA#q7;A7^k$V47;R%mmb3Cdq(bKP;P6DvEVa-kuoE8W53)i)n1VthyxCpfMf* z)OI~pMep2VZ>YF(N)v4(s)=|X_cU-}0cusoW?0nQu-OEzOGUq*m-Dr$)< zzZ0Igu~>mM;30S9UL1_BXY7p&*`OU{Y0<`m*-#J;dh!s?0tAwio;)7FBR{K*%_GVc zS11zO4fevpS~A>-98L)dUw{snXa)p$9-YkacVKTA$J_G=g+mYd3qTsdZUeZ$8Bf@< z_`yM;dqrz!4FZVTEbOYIqtRg|c);^%n9nJ(0{rL21!0)Vz{#H;Wa z-^7JpOSlod>Z@Vn+9|<5LN$txqRrlTUC?Y8Z&E?XgcCHV*(ApIm`rx!XS(p%r z9T?Iya8Csk&|9qm^wGv^1bz5ax`$AvhxGB@>|hC4L(j(W@Zm|HrE(S?V;`!tpU4-h zS%XH0ef+>1*~bU|;4aw5>v{BysnTnts3O!?KALyKwvk>%xo4YEHaUJ1y9gN*n27+cnvLBsj$d zpU#kB{m*2U@VC0;I$R$`(85bN0oc=QHcifQ4UPgC$FPwEP%E8!Iw>RRbV|;N4@~sI z=m8}i#f$*YQNpm?CZ$$g z6UZCt@)`g(jvwY7cjgRmY-`>?kveKBVZv%E-O14=qtRNZUJoYEHHPuW$+pPdfo^2y zJ@!VYhIC|LEE@u680e{fO)eqhF9gW>wd~IcH3Gn1Ahl~>i@9G8^skI&>wf@L3 zQW3^5FnyWy@%a9OZ$QtV^I380=u7I9bum;`4^e)YFRRBr>UW>|)r`Cj!*)XD_o?5o z`t4`;af*~i|5WDb?&;3cgo?YlgO3iMCKA|>?^w2f6 z$Q->U3#Y9vtG@dNp<^0E7Pym5R>TcPwTlS(3dQoP6V@2Z`2r-i9+&0@>Nq{EyoIu% z&eK(d-jI184|b}s90GNd-JJk|XAP$tO4Zu%$RQo_4sRr`Ynj3k@ zR3XgW%wVV5DsE0FcpkSrDhiD(Lu+TgVR#={aMsl$rB=;CMxfEC&1(>K0-~4NTChK= z&1w+7p;6$U`t5WlTfhsQr)=?eJ;Y>e>8(2AcQXM5Hwzs`N*`8zNCRBqg?%q;z7uL7 zLw=282MtRNSZ@^SqyFeLLP0u=c8#wF@aP2D_W!8yz&-;H?E7zs2RJIF56VLA|HDSW zM5lGze7%(YUYbh_HGjJ-j#=tw-C&}biFWs@BkiQVvqP^FFlK&+`$7RdEQo3>`Rt;ufb@EnM8;9FgLCsrZ0;a*lT1i()RZHR(0nsmOHT zfQ2@)2LeOf=u}xm8f!ag&zZE%Rq5iY9T%eZ0qu{E9>&G8*B5(pQtXcK@f*% zgD4Ih_tN_!(R?+CR7UpEweO&p+#uGkee& zhn8fK_2&#KS`4j$6t%Z8oDNOf8(ntxd%q10m~5?P(a{j+2I|x&B4SkhOj zVx-@kdHE8!y}Q~IO|?oin3-D}Keo8@Ybo6P^F`*{Kf`*b_0AOerhX+wuBl25c5xr- zB*f^2XJh^G6gT-&%J41y-AdatDG{lxkBB%gk=l5V%;O6xQpO8S*RPG2aYbBpY+5;$ z{%&fqoLMYq>zzvLNgUDR8_KrK#)7H&)A4kx%6CP*-0&0?*&~0d@)Q-z&i519#M!kv zI5wDEe}}xLwon;Ldd@CnU~TMj_T2Lhw?E?7ZuXN=P|KjJg>EFU(?wC^%H)ox;4q%qRl%b~6 za0;=)nKY|`RxbErNB(}+!Fo0YXK^p3x@(KTml+q4^tKH50NCm+(K#3ojim4F#1!Ac z{I3vsM_U>|u}}xq;Pv zWSE!~z=%Oi3i6Fj3Je&-Vptl)K;9YPz$}68%mtaTItxlU z=E@}>hq!Skrp)CQEb~ga)(VGd(a1DDE!>Xma6fWY+;h z=jTqMH=j`aHy)8|91#atW^hTy+X8X@Ci{Ls8^Z!AKuMQY2xNvcuq41;O9JpngI;0; z73hUMw`$8*Hc3!NifXHK1q%@DmC!rN4Ii^-fZ8~SeFUpfKKd~ZbK`g5C(Cn!nf0Fg zF@~qL02hYaKz+(v9*aSslsxFgxPdTGJ;a5Xeb{v3Cy%tS<=SwtSt{T#8)uLW2ZYN2 z#4w_u-b_1ka&YdqpjROOdF<9&dkKcXwc2)O+gWbn#fLOSC#Q)dSD{Mw+1qiJR;T+Zs12s-= zLn$;wU<}>;jC$Z?eFV4=>*KzFIB;@(=4O}Tz-?Gc4#QFs!4ie{^xGA=x^z+sk*NVr zk1{o=W4C0?DsYg;K=`asiQ)^&tK~147ylXbE}-z8HFbll7ca*+hkm86nkfvAV{S}L z6%i$0MO-JTI?tHa5Yym_C1OY+Ap0?h3lShcK=vQohwVT6#&%$<#mlWjoRC0lz~^Phz-ZArWk~ao^Wnf>kLBA%s=w1 zUH*3F>%)6@eyy6Zzb%SY3hwYJ1oiv5%=U2=wc&i`>wy4J$6M`k<#oEo@VDd^XZwFa z`j@j~Hy+7s?|bbRW!kHm?azVB%n+IL7XQf9v$7VQEtyuPJzgqbR_G_D|MCF1M z;Pz6RZr#Jhl1+ah@&4&XQ_8FCH8Z@Y%y?(WZnG;rJO9$I9NYO7yK-UY7rhSc^*>J7 z>#x|11^Fcx5box$8;>>@+}fYWDf^oBuPD#5jRRH6WcERbihrz1evu2f*Q>Waq^sj< zK2)cBp7@d`wmZ3cYg!j~*7SDu)_ZjkR-TcqtJcVrx0|V>=cva@D31%#JDacG+RtOz z*-%n0w>s65(Y*ehT#&oE`ud;QmHj(k#hSJ3Y;@@tXb$<2tFQlF<=&l*x9C+9#y^Do ze}N`*$nq2%e&F3Yi@^B{`JH-PCd`e)z?>-|N8wq8|B9HD@~u*AIV=)P@)F) zyN49WYBMMuzmE(msPAiO{D#Uc`?Y_Wu%*)X|AKZdu8_FRE_8Pa?V#VF9rRV&L0`K1 z{SPGUtKa|Ukd;9`#CJQKgiuH&fUpfA{7JtQsE-UACn>Iob&}*^V&2H`>Lfss?=qB= zB$lnSvK%CnD&qx%N?SwFh5H$VU53%j1EPbltMt8K5D3j2!5}cb3HAs4S4Gi%9|O3L zz-%($w+rDaz%?M*6ezX^0JO~(ak6eP?W*FyzQ%Z!F=?FK?2ON(P(Ma3@2lcu$Y)lB z+P!f_zg)4eR7@wccFqHkF%W}>z^+dMgd+O&1UbDmC<0K8fhaTE)OAWGxwo%C;zVN` zP~1RVo}7Ub1}F}-t2iDMM#?;(TqXjxQWBs}B!O58k|5!xF(VX*!F+>XPwlr_LKxdY z$W?0;z=NQ)YP0a#^LBA0g-|TR_GAf~A*_Qp@hoN?XrL30Ly$5uRYN=Zgh|F}1p-a@IDCiFOk zpfLtX-#)>y`)?qdzEjfECI8i3~0+4)Ef!zHA_Me0;CeCePbGUtr}@^ zL7s5zcc{~9mLHK)YC8ahU6<8hOK7r#X-sd4>W`zIOuE7*pUq7}kWfpwuwRjMxt{WtljB!f7~S(~ld#C+fqb<4QS5!hX72y2Lf}<<`>2ubdHQZu zfSDm%EF=6r*WY*}U{pUlBO{ndGE**14TGhi&|EMU&_Rh2)H6A0=TrgED8Csm=3iPGZxdh- z8T-Q`2Qu7pMb-ueoG{RUh7d6eftS(~y;4+yidm=XK}P78L31|?pNs%s58s7wwa*C5 zP^?HoaUyTHT=x{}mJ0zX{F&PUx(K@icZcyB-@xsxz6xs9aC^PeflIhMoVM3C-|2LH z77-dcuy{X3zh6U0i-gn49jw2K8|#m8Qjc?Z{`$4Ct#N}APClF4YWn!qz@O==m09~W z#4i1i)KTKWeY_93D^3Y75`3)b%VXE)e`+jveJpfM&w<3x80US-E!;i(-)R!A-ny^p z%em*~e<~Mz4go;?*)fs*wPbh{*wnx%4qM&;J1NEav$i0A|q@`TP$6Y3K|E0ODX4JO~hnTvUO8 zI2aTk4A2NB?m`2w1iCkK93&3(je{h9x+0H*Vsq;ZH4ciE>5YTPLp6>VY+cN8(0woh zgmzVU(Pd-$mNbrDO0yQ-)y<9UXt+nx)JOt=QWB7+>VcY{7$G!jPIWz~^`>5fT3A)O zpcdSM2DR{hH9@T!3y`6FrJtX|ycoN~Wv2jw2T4|#J&$-K*l4?>Z`gy7AKdJvOLNO> zE2~HjvX2{n*|iP7?5Rf5S7PQEl!Hcx6Bz+@1i%w*7Rg#EjEEcW4#)==!}g#RXl@Pv zOGyxjFgHtOOGS}n5v`!T&|O)U73d~9Au%uNU?H0ry0Hj?s3spzZ5$pP3S330UW1M) zV3QD6iZ&o)DiS8IKDj~>RM-m6*T5xVm`o+=Mb93@dp%6Ql$$mV!cR-YFEU1n)!D`% zOLB;Uf#*F~6Zt+MOM0M4t9_|72VBL>vIQJ=k5><0P*cyKYUslU$nGF-$bf<5nU&;MO=6UM@@INbWXH}!Sy&7lJFbsAelym`%gd* zQbVg0;HC{Wo;L=lD7LBt6he}%>af$1B&#}dtS2(d8i!65DYoE42^rPVf5a6^Wa4L+ICEc6L!mHK_?uBSPm}rNQ zYSUKpd|Pl@2Os@Z^=jZdvR&!g&TMG9eYPbR1W}U<&2$7o&Nv;RnbzR*WFq&R)2XDD zzh3@)StWk~F|v4b&v&nXfEn4HPdjaRSa4K0u3vYXZM;)gE^w24`RRSCEv^n7lGYm! zkh5bbxV4v`ufZ*HY3#mMa)@LvND>nM&wS=(b9HyTA7?Kh`pxmm>o+&w${FqV?;oG( zt}e_Rq|jWy1IxJ3xvRHA01=Q{05FII1`Cs(n7{^!K%}6jQy;?!Fj!q4WHz;V@G_{) z0(P#+!nPzFW74`*gRlkToQCoYx@H_0Dw~36Bs&Qn8PHS-R3g~Y2C+<6iO3_9^R5U6 z7)nc7z$7a93F;olc%Z@p%$q7q0P2hufD^DcU4bNz-%dhwWziV1^}VtZG$tBMW5<%r z(vd8kRNE+!#N* z=Axhkf!IXRe)wVI!$ogGg;r0`aqGu_95*$uTv;n!T3xujW?iOH&8_N4sn+AbjrqB9 zW$wd-)d0V9_C)%D(^mS7olDTGX)an)fWz$m)I)PUkt#7XB9Bhx^k-}f7T0)VWgZrn zB==+sSqxiR*HlO82c3wOUX=bn8s5`qM&H!aE~Vf^z}hBhUdv_ z9xwoeDYIdrjF4v%8nYrRWZG*bF*cN zuuB)y(C(o%R2!lX@%xo;uj~*KpyhIWvRZT<NnUtf9C46F3B|4{Kxn&^5k7y$ zuv9`}(X7+d!h)&b4OEV~)xtqiYO~RT4v-uj6Ef4JurLLC`r#>OGOZ7Zeu>vpAKss$ zLx0wHFekBbK$CeBMn)UPGrge*1U{Zl7fbY@MsKtb6AZC4G|xPLiW0>b)s=eNct@Wi zxQt4`h|;ZC+nC)NRJ73mGu%6ZQTFES0^K`K@l3ss@~Aa4a}xNjXpaIQ8UT!xO1@j- z>486vZ#;LO)CIZ&Nh^Wsdt@C zWxdC_PaSi?FjB#eVhGlvHdbb>;HhrG?o_@1@x* zb5~AlOkf-lzY@~1 zFX>MM5bphZPtBH3SaWNa`i@z%%Vq20Y^AcY)(ia_>djqRvW_AUzVXr4<0>Nj74PFU zuTB(2OAYTXoV@V6-cTmz=YSn9UnZ2g@;JQwEO$^>EO7Kh#a$69Zgphb*S z<;PQa{l(d}D^^%C!&Xb!%nuW}VB#KVIkiI=k=nS@vS&2s4BI&#Kut~7hZ0iqNYWM` zP3n=P8fhAkdSn8WKVCu|$mf~6!w5&(mroa_te#6CWpH^iKeT|90PQ^EesfPahfM%S z!^^n$U=q|c6ZUKKz}+w!oO`gma_OljA!T}yFFPgF?$)=Q)diF=Af~MWN_-V}H80=} zzZQjmVgGjQPWsd>{axY%!B~NSnz6#>yFeH4^&umS5%{_U=Iy<-U z#Qd83j2-4OOvAI6mY!H$d1|>##mSW?pQKHUZ5IaDge$U;(2NUqvZ&%}bI@ayrC}(eW;r=QT^MDodMDAp^53SWw_OAVt!59zst`+J?CH8XO3=_pbiN|l zds<{);jTXT6!V_}+@lIh>VEuXP-qO(Z^Ta1 z4>Jph`=eOMfu{1}yqz6)XrX_id}Zk)4^EXP9?UslBOb)^JjhJvgWfxEZz>pn?Earf zmBv5v5Z+LvZ!W#ptMXpL&8TG_<-C2a?`$@g>f`=M!E!Q6b%cdw*4|~0NPdQ*78lsC zfC_vzBr_y+^4>%p*aeYanc2vvC^AzeYjR?WSVU3^q63-~ED6a+SV(8AuX?HM9wx3$ zhRw)ETX~|-HfP`9Xt_vgSuNa|+Ei-E-MAKvU1_#xF1+t`r-G-e&z5y`Kv z#8U2ns0BnOBndL}AT~u%b~}e`uj`haGfJW*vm!zLJPkpMp3ouYjK4>>L>BJ=nsl{A zyd8q-xE<9LF;KN4+TgIJ3nfr-XwHHqNQp*dOOjAWN@}DJef-=&MggG(tzioUBYB)` zk)AXd3<+73Xr+<71;e8Ap#((USMWBFTvTb{Gvo?_%zf%FL0uoGU1Ks&Jf7@450Dxs zf?*VWgN75BUMw7MRV8!6S+bs-n_a#F!f9a*Od9-17KFtB`Fdsc$vI*jE`zj%NOr_jq7)=`B zq?%G(U94Vg^hs|rF^LJvJ#x{^tq1VC((ko&9v>OR{W3q5mX-IOFCl zz2zJ`1%-&{5{f?H%o2ZE7Pb%R(ZGU5iS*E$E}Y3uI0Xz2ngL@fJzr){_JFWNw*TbB?sS&;D7w!52653j4i3e3fpnag`%A`_Qx6}_9jQPWnB-Mrx znl&>G=%PFFQ90Zm8bA3?yrZ@q^xV6a4brCL32M-gjGlHYBW?HYh30U~6Uk#G#ry6} z$t`u)m)>SXE#&;SdsB8%*sWjolHIk?98ulJK;ygnOW7W5w|+U?z%GR?aDTX6zvhr? zmm3Q0-ABX$s`N|iK877|b!lzC6e4`rm4R{ku7xdRRqchBds2 z^q|Q}fQuHQ<0l~0>CcfE!!QHEg4)L7DBd=1b?k*ra77uAPEx}pER??q;0MpiW? z+T(At9*m@}jEsycBku^RnwK%Y%yzwH>cUAu=fqX7Zu~XPp!Rp{ynl4dy}jeU3uk-Z zJzfiW{(BD_9&l@cD~les7oOHj95$R+?~&QFlFhscE(I(boCD!L02dstnN8gb zIf_ecgVwQR5z8ID)}+btTT?OiYH$$EB!GY_0+Y}O9DmK9#kS5q!OmK9K~8n?P^ zHb6M8+}XDeWW`bZ^JO9HfnsnUS7`%vuDD{GY|>S8C&`3Cck$1^N8kbP!U-!G@WKFp z?i@vp(*VZw2g8oa0$IF6Y(q_4x#%;d(cZsy}=#x_{%2pMU(Yyp`87la5A z&Z=`TkDb9;<=$?ZwH(w)1vC@xI-w4pi$!Xs%4oT4-bds|IqZ?b_KM9_4tbnI9xG(A zXd7xPqrN_REJ6&azBa4A{_s zwK&FHBVs%9U^KAd5W2RK!Sm7xcaqRS6so|%Fm{CE6epy6s~L_%;ZdG^c~6N%zY_2s zI~kf#K3-im%Y_0RLx5^#!_;MPE~OB(0)_Cd!W(PEa@fC*L{u;?y~+rd`u${vj6DL% zR_oDHa2^islM@SVx=K2YR$z9kaII4O6@S|^=GO5uXjM)h^Eew#w{Rjx$$jhUQtQ3K zI7tD6q672R1slIhs3SlH3JZiN@x;X&^XVssW@6)HLuB|IesMGvJ_QXVt!Tc#1Db&4 z`xX`$oyXEcw3WM~dHU=d?8UTj!7u|wd*ti@J5g=+Fx}SM0Lot=>=h4@SGa;uxxIdQ z^xRt}Ii*Kcn>tP%d^)L##NbJU?iJjLoa3Hc zQ#MV+jtor@b9!N2{7>%Nja!*jyi1Tc@8??RM=yn*h#5l% z9D+)u*ime?nOuTJiyE>?un4!LI_nkn{Az~HT{phDkBiA-Ofoxwh>g@gY*X5GF%7!F$yn!n&gmPHG)* z(EHbZf+hBasiMKm$*}rKK0bqI@eSbKO*6l0Ryc=g7WeMES;Lc*DegwZDYBqDN_>gL zUa%sgi|0i_=jekW7k34NQ*lc@<}wKUV&xovbjbJ7Cs-4 za7{sJDX>hvSZ*>W3rZ~^hmp};TrMYCoSfxO2vzVwkPv))31}g?wDqhzoZCeSfH}UAh%|=EHG0(xtJO$7-CB0dUnNx=Y0`rzZBhwF(Ir_zO-WWK;>+p zfXDs&2lUN;D#ho7P@Wu;6_`e%3=F3-0s=)Sf?cE{!lfc2k;xe`f(}yz`hC$0MmXwy zMTlYa@pvS)FE1%VuMirDAWii`jU@W7_Q%WWU2s2A0m4kplS~?xry83(ri{d-qDUHP z0uH{G@wMn;6Gm#4cUwYP5}z#60BQ73Ennm@-+Y@C)D=`?s^)qk=&n1PKAp6iN3#E*X*H#2&rYv$ToIPuC)+?U1 zSu+a(0(1VE(6Qk}Bd3XcEak~y$1!DqvYz z&|1)eFn88st~l%P#{C!56cD7QxbI@hz&D?C1^T%=k_zF+-0Mg`HY7|LC!eM)GT^!p2=#m0w-gwif5gQ2$qgTK+*uxlpyqgvLFMyEd(v55TdY!XwMYp zTE}#_XG?R@jM{{b+M?l{!ipx;NG@`uE)x4MV*UfpZ7q4AHj$S*$pO5xEsWHWE`$w7 z4BIFYYTS6J0bOO4N;A8}Yw@fw?{r*yo0?IYVl5SRM)F~!>c}J+n9zw;mc^F~tlHr$ zF}H1d%R$SKD$z_@x}(NqwA4i*Jm?^IuLF9kI*Q{2zcOLLDq`s{cd!Gj`D|enmdJy` zAipi4)KMs^_hH&_@lt^tQj;x5OHaE{YGsOIEQU_4iG>8UtkAof(p>M{=Qf3r6`_dU z))eM?Z#sH!B8$PYWw+bX2@DBe%iUt$?pBcr<8EnQ2y9lkO)PCWTzXtnm~%*%YYKBF zHc3tL0LvAd4ij9|dL~4_p-Sq|8|~1_b?&1PGujj29q};t(gV8bo5)!1r3VzzZ>cc$ zb|K^@(JmXgz2c@rd&^IYZGxPZZH_uUcG&7&tiT0ayQ??dnw-NMae4n|`sJwAFJ&5S zDqQ$RObxso)1HiNNE}hU^zXvtQM4PaR`tb#8+tqfUAiYY=H!}rdBel!Gn{6gV&k=5 zUEX)EUp4Ru>qg$s1$A%@Yg!*ciQb!eAwkWMzwCaF+`g09ZAZ$KjKSeuQP@}M@l361 zn+TV;-5TC&93|7@V>LWwUdUnXQjgm>9~^SkYcTY%yL}ts)$N4mu9pa+>q=DAiFyhR z=QwF8(s6l4Z*|gJsFs_CHrFLwk0xBbn{<+pOK{P)=|!$3*2pC`?-=vETP5#ti1-5u z84jBchq*x2M=BTW)SAD&K56+o{sCw0(mbAoVqe4ddZ zoGRVe?rZV^m{oGC_kPg`XVVrAwl{1Wn+~gd(d7HuW(TicUfhZ^ga#+5ggW>@y8g-iP%Usr1b z1|Sz5TX1NEeu`DOzfP?H5r8-Ax( zt9lkDa?&(utW znd_Uat5aRU?PfmZ_fK?>(M<{5zm#MD)r5+q1d548=QC> znV9YFsX7~vFt>no6j4+yWtd|pZ&Im0ta6vbA-K)TwB>O)$Qt_6*-i0Vkc#KSoK8_4 zK&{fV!sBpiu$h|%xX@=@Nq%_M=ShanuWIXZxG*vJ%wfcv%;RuCwQ$McXVK#XK600X z29%F^>KR<}SaeCk3j@@WT#!f)gX4AT6Zvrp^54bwnwH1O?_KmkgHm>7(4q6FPfzCg zhCU}5C+EwCd~?3GG(LyxFbkD>D;6&pxMWkD&WYhc^t@h8s@ZI`s2avZkqe+JL4}hO-1|(f6a9vF4HXx!am2Gr51X~i z<%Gb}qIkun4V~$4V9tcX&6YNNrp7_?Fu3-yz^&VQ?a#o46yrL?`=$;hH*>M54VOE~ zW8O=7f~Y*=7DVHZ-moe-I=+99gYu_>&g;d-%Z-4@VP$oIJc$u-*8Em2F7!B=_L-ax z9ilxKT{l-e5gj9Z&6{{(f>p9H$R2VctjfBX@2(WpgXt&RNqqVP|86rm6Gr(UOpZmn zRg#v385p)o$dk6a8aEP+$>OKhTGhB#6>nf2W38BYXA4|rDePs1V@m!KWl`t`DVO&O zXvvQ!`@o$K#yGl^8a?hekkhKVUgJ)fX(8(!+;-6xyhJ0jStCi`R72zyT4{+WtCiRm zvMzOxEZ-Co-&(%8(-N|_$Gv6eHmt4`i0hM^;i(DXh8EZU;R)D2-pQD%SS+HihmmdAAk44ZI%1yZo0Vw z+e@EO)64K6h*Gm`f}}-tVW1|nW>tyw7*Rn*Y1)8xyp++rq(Htyd(^axgxuDk&qo?X zuWc43rl0lIs=~#xH9`!_UqR=#q@1sp*Vw$rqpNF&D1J1zP)>bsodq7_Mae?Upu~VJ zHwwLE0%8X{#j}NVy98{MxU`0o54k*N>aYZJyk?18Q|-^Af3-hT9_397?z;7x#vJ$& z-uyGHb@(Kd0?oBUGz<2Z8LoSKNm~k+Sa0$>Am>U)q*IJZ${1auFHbd;XBCTN!zR6k z9O&Lt!MYHjOUlB8crse!#^7Yd!fnZa4m@X*ce8p;XW_||qJF1{qM=ct9-^Z)lRj?! zEiTZ7J*MzuG@bI!^5`bv(@F=S8jOI${}LB8g-0#lf%G=e$-8S-RrcVp;22aV-qgGv z$~+^ku#S{&=zb9%fD9I<>WeNc2;&Bj(Ewa|ZGQ^+@`Zhxsd@!ke^3^yx0u=*Qi~ER znK3Tq&PP~Gumf((IbzRU#WncMJ)>7;4|CbZV*Y37Q*<9N#^J#%kc*5 zWMAi@WDK78>zZ!zu1-ijAQ1?B8h}+>=J?_Q z8N!s8tH--V7ui(M;}$#+xSFker})_uPW$(wz`uSKRNHdW%wNUgWO6{S-lQmD!J8GHBOr36yd^?l{ecD7eV{T|#K1PGM)q&bEWR=S%Es$z$t$L~#k3BxRTRG)$gDrIicN zqp=Z2af5Y^>}+sLpuX?_#t1U^t_pt-<2SfmPdd8j8pgYo+2IGM)T&#i^~Mov-<2-d zg4KaV`i{q)IBb!=qZL@8XU@0btu^mJn5<%q=S#dblLe*eA$yN4OkIb=;tGdhGA-Sf zH~1Y55_+^hgC^-sFpaRof~5Vd5XI+;1rVp5FW>N-+ym>rJFleqPq_5gqq+a>BM2O(kv(&7ygPP zh3khAi6H0a9wz*qfDV$wMN=)af!vaCJ|!!0CBGRVk@T|d+`JHiIjGI6?Re3(zXm&M zeGcr(tOHApz?hwc1cE#Tw-^A1D6B%jWEx#OG20Jz))X|Zt;D~*RIjt7WJgN&Fp(q!d?1N0=FJuX=Qw%PreFyaIbP9idfQ=H) z5g#1$uU|2UzVWMYx_-(r-+CaZW-N2X9>M|2{F9N-(J3$8ITmZ!DwcoqkMX#<7FsVQ z^l_q}6T0w!(UxvZfG-ep=mI?ZWk`{R5|NDX07b~(6aghi9PN5sk8650L|Vw|?frr~ zT=!ztE@CfkQA)cmY{htL29em}IXL!mflzfP71gUjF$^IQpzz>)Clr7XKmtI+Poa9K zs2+XiadZ9t?7@f*}p*79g5Tr>8)@ zB@37^d+Q=d>>aA3j^U#o>U8ZM5i7mn>pwcC|1rz&6??xRLEE2U{p=laZ%BHauA=6Jwg6JciXNkA#b%X3w=lpvq`WVm>Mv2=2 zEn(E6fk{$JKIcq^fY&_u6lh=rc<6!;(Gms+U>3WaY6*Dig7urV1m-&|E7LL!0r7Kl z8)Wvx682-8rX}zpbg)4tVk~Qm2$a+o5y`_5M~UgR;t`Vjps6;9XbH?m6|9$8W6Q=M zrX@6O#54p5HA75GXe?q-)L6tI2FpoasiP$fXbBtB5Dj5t8xnG937gasE7B4+rXgCw zO$!9H{ASw1J=c=gT%}=LaV>enRr))k{kYQKZk0mZY{fPpFSf!v{;KN{`WJCg>Sy8! z11B@|NaB4IYCgIStJvh%dWDv9YlM4;SZJ3|5$0yW-4gkAO3%kxVD%Qw8#vv;mEBv0 zYvM73G&#ib0io7r+`o62=l8VQZh)|lM@TGqbe<$jP44gEAK@i65GjW8DJFa0)8pcc zcwV%H`uOGj>qzF#VbveM2AT(cfyZ^Rr?`w19=A9m1Wu+qk~9wd#UDPfw^J3p4- zBRN6u<#DwiP0}=2@Ms}kU2H=dV1bhXMNAR_Z{lF$FdfE~-}IXzEg6PxY4@6ad-ltG zR4<@a9e{`!v-iD!+|zYx`M!@iumJgmj9&?p7a9>B^x<8cgpCUaYYNQMzpUU8dlRB_ zu&#t`;b~0k1MJAaO5%iCR$G3zLFhWbEp0IwN>BeQ-w(K9>sT08U8z6Okcoi8qQky`)eNPy~KhS7fHeukH59k%IxhuTaRXlXBdvg5zqg-XL#ja zNW3b9tiqmIfRKbVvQ*_QlOL)JMtRbDNT%=_`9yK0Gu3noV{0Z#S{ZE+tMY3&P(}DP z5|UUloD}*xkqD$St+9#=wEIMtyeSfiXTnoLwCa5)K@dYVN!6J(<%_dABs<2E&9kY* zgggIsz8xE^_kq2DWABOJ8p0pWx6^z1v4lJ3_D?q;UQ*8gJU{fZLHf;TFhUS$#r$`P-8E+|pjk#&EcUq;^_{Ji*VW^7~*GclQK8 zpUm&04A={N-6Rmm@?)IXe?TH1%Wbl4ler_MT}GU1o9ib2`z~30dVe5|&tsqd83XCv zviPLDLacJvG(NvGi%-lg)Ugvy(Sf`!$xAq&&nJB#)Cw`QGkpLP7Ma#Q_lKUqmc(!yBER_UxygCh`#dqiR(GF@_i&<548WJ-4z-T4Ajt^Vk zs^D{0{oC1fkX*-yKW-=E`2*Q?5XwD?P%^ui;O?m?WLi=~a-Y9qP8Rz57zw@u%+%5n zRNdr*aeJR5nC!PmN#hF1D8Q^|h5MWrK#`vrX~4{9&f0EA&(t(ONS=1QVf{N&Csq#6 zU@_;#Av$&+<_-%=&G_lBw&8$xjRoF{r{U)~`@^;h@+@KN3D+_`1dk?h7>;8>yn|Tc zq}Ji}zu-o`r5_NJ3Q-)fvc<%_!gdwIw=qx^KQdyVM0CTHn}pzW5#$Rj%NHX zW?1BU9Cy4b(s)_pq_3I+@oUrv%=)9mgRzSSZ86sR_{P0o);w-;*zT$%5UG1#;}k|| z4Jc#eXhv_Z5xiE!Q%y#=N9Lm&2(=CFX#oH?I}lb8%TADu8*hLR8REGNu2613HHoy+ z!J4@L=;0&$@d#6%N00jaW57SKZSd&PA^$+?s7H^GDC*Iphe&3E<818a^`Tje|GobM Dvr3l+ From 68ed78a9f9de571a3b54a07dacd145657acb4043 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 16:23:46 -0700 Subject: [PATCH 09/18] UNIXUTILS: moved PROCESS-COMMAND and SLASHIT from GITFNS and PSEUDOHOST resp. PROCESS-COMMAND executes a command in process-stream, like ShellCommand, but returns a completion code and not what happens in the shell. SLASHIT is an approximation (doesn't deal with versions) of converting a Medley file name to its Unix equivalent, to use in commands --- library/UNIXUTILS | 76 +++++++++++++++++++++++++++++++++------- library/UNIXUTILS.DFASL | Bin 2671 -> 3617 bytes 2 files changed, 64 insertions(+), 12 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index d841eb58..89140a37 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,21 +1,30 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;7 5091 +(FILECREATED "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7 7943 - :CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen) - (VARS UNIXUTILSCOMS) - (FUNCTIONS ShellWhich) + :EDIT-BY rmk - :PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1 -) + :CHANGES-TO (FNS SLASHIT) + + :PREVIOUS-DATE "22-Sep-2023 15:28:19" {WMEDLEY}UNIXUTILS.;6) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse))) +(RPAQQ UNIXUTILSCOMS + ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") + (FILES (FROM LOADUPS) + EXPORTS.ALL)) + (GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT) + (PROPS (UNIXUTILS FILETYPE)))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -106,8 +115,51 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) + +(PROCESS-COMMAND + [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") + + (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") + + (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) + (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) + of PS)) + 0))) DO (BLOCK) FINALLY (RETURN CODE]) + +(SLASHIT + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + + (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") + + (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") + + (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") + + (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CHARCODE /)) + (/ (SETQ LASTDIRPOS I) + C) + C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (OR (EQ DIRPOS 1) + NOHOST) + SLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))]) ) + +(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 ( -ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066))))) + (FILEMAP (NIL (902 1275 (ShellCommand 902 . 1275)) (1277 1676 (ShellWhich 1277 . 1676)) (1677 7865 ( +ShellBrowser 1687 . 4210) (ShellBrowse 4212 . 5204) (PROCESS-COMMAND 5206 . 5819) (SLASHIT 5821 . 7863 +))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index a54d15618cebee43dd29a9284e9e2eea91636473..e4054f2c91bcabc25700afb1f4b3b3cf68a664d8 100644 GIT binary patch delta 1507 zcmZuxO-vg{6rP#&A3r6gp(;YOxIgL-VhuKNT0xY0Suc3;de`-?gAqw7B&G(N5?oRR z5oD;4TD6vlvjpv=L@M_dk*bjp38B|WJ@!COJyhzo9D3;~eKWXK6-8RjyqWjj_r87a z&HJ-uyZz=nbt6e7rYWP#=c>c+YT;hd%v}}3J>lL!DAL#4(-%HlKPZ`6U~0OU3tTSc zCKhs60_McRwbGS|#jXI@fx|*>b~0BAFt@InUnF$z(S2O@IJVolUGc>fS(DOAAIOc$ z1xbs_Mlz*p3fCFBB^#+x#}?p-JK56jR89}hl>(`>AuFaSf_YNXV<#r=LGUykn}DTj zFl{7Z_iBa|%cM*Y8;e z1#=$@WR0ej2FJ$E25~Aa&&$y5%BxHNrLj0YS(+#LfE-k@yeQEX3`3a313AR3We?aE*Zz|zg-em z?SA(wSg}Xl7RWp9ju*2SxYk`vS?PF2Pn_AJLHjp%6bJ2qXY+I%11eSj2X@AO>`4QY zc5hGn7-$jKuHZ&`3A^Y=2$45w7SoUIy!Wrj{1;&G6%Age!6Ka>r@<5rN;KFF5k01r zP8lYvR|ET7aY(Tg{X#pvVOM=s9J1f2+g3w_g%?=iAgLcv2KNnJT&=%O#n0&cC^)<1 zxMW#$K0;f%=+fH^SrcW+R9>P>e(tbN=&bFopDb_Du(K(2MC$+rO*a$#DMB4{?9hS= ze9w!1L|8uDQcoxnAqYg0G7;MaIT@qj=Mef92w_5HL|%3_NpF5{y68=N80_Pg|=L_yT8ZtZTZWd!^A;<@8-|1HD62IBeS4gEo}y8>c2 z6OE=-qv=4~(2{RGTubKLF7D~&!mp2Ze~x=!!2GZGrD|d&|D%{tpA?QB3>OldI9ClP z3P(K9rD}4GQ{tz6wQvkKD+ASGf3%<$o^X$0u7kRHAvstk9=553O@n%PoK{R_eMX2= z{`a{mFfI61H zpD6G69fo3N2B5`NeTXR>P?TZ+n%m!FSF2oHzj1Oi1uhM;q016XvzTJO&d$0Ohwe_Z z3ol(lgt^&H1z1+_GP>(*qDG#bS{FGLe<-jpcU3IrKF<{cQ*)(Ra6pVWUcnyr>U^n; e#fKEaFdhWjO3y+cHP+^-$R-xL!@?Xqefke@d%&9j delta 554 zcmZ1|^Il|vhLTILcdboEer~E=T2W$Nwq0h9U2bYhPHLrHI+UJhsOfEJq3e~Hr)y+j zWUOFhU}bD(WoW?V<{0dwkd~Q~s*qfinpl#Wq7a^%l9yVXl31yuU}&KL)KQvPR0-5z zWUK?#W@Nf?*;YnImdUr7!eg0dOzmNI^9!CS0%ULpXQbxjI2GlW7pHR1n9Mk13e$`p z5o{Ju?J=(=?Ci-KnZ+69C!b`F0g`Gg&x{ObOzIKP3iS*3^mEY-2=Whcbq>**X~@FB zz&K+<54*FEe{g7!E68Rb>S1;_Gn{P4>da^|xrxFH~-%r=a-`UYe z*WG`n;p9iGA&jPz&DrFITo{3#;fx6g3GxW_^ER0?Q( Date: Sat, 23 Sep 2023 16:30:47 -0700 Subject: [PATCH 10/18] GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR The other PR will be cleaned out --- lispusers/GITFNS | 324 +++++++++++++++++++++++++----------------- lispusers/GITFNS.LCOM | Bin 48971 -> 49899 bytes 2 files changed, 195 insertions(+), 129 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 0dbc6b1b..af78e808 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}GITFNS.;469 119763 +(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}GITFNS.;483 124031 - :CHANGES-TO (FNS GIT-MAKE-PROJECT) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}GITFNS.;468) + :CHANGES-TO (FNS CDGITDIR) + + :PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}GITFNS.;482) (PRETTYCOMPRINT GITFNSCOMS) @@ -47,6 +49,7 @@ (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) + (FNS PRC-COMMAND) (* ;; "") @@ -65,7 +68,7 @@ (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY - GIT-FETCH) + GIT-FETCH GIT-PR-BRANCHES) (* ;; "Differences") @@ -77,8 +80,8 @@ (* ;; "Branches") (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES - GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME - GIT-LONG-NAME) + GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS + GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES) (* ;; "My branches") @@ -98,7 +101,7 @@ (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN - GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES) + GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE) (INITVARS (FROMGITN 0)) (* ;; "") @@ -106,8 +109,8 @@ (* ;; "Utilities") - (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND - GIT-RESULT-TO-LINES STRIPLOCAL) + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES + STRIPLOCAL) (PROPS (GITFNS FILETYPE)))) @@ -314,7 +317,8 @@ PROJECT))]) (GIT-PUT-PROJECT-FIELD - [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk") + [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk") + (* ; "Edited 11-Mar-2023 23:00 by rmk") (* ; "Edited 7-Jul-2022 11:25 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 9-May-2022 20:02 by rmk") @@ -322,24 +326,17 @@ (* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings") - (CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT) - THEN PROJECT - ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) - GIT-DEFAULT-PROJECT) - GIT-PROJECTS)) - ELSEIF NOERROR - THEN NIL - ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) - (SELECTQ FIELD - (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) - (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) - (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) - (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) - (DEFAULTSUBDIRS - (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) - (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) - (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) - PROJECT))]) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (SELECTQ FIELD + (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) + (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) + (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) + (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) + (DEFAULTSUBDIRS + (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) + (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) + (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) + PROJECT]) (GIT-PROJECT-PATH [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") @@ -478,29 +475,7 @@ (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") - (LET ((RB REMOTEBRANCH) - (DR DRAFTS) - (PRS)) - (IF PROJECT - THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - ELSEIF (GIT-GET-PROJECT RB NIL T) - THEN (SETQ PROJECT RB) - (SETQ RB NIL) - ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) - THEN (SETQ PROJECT DRAFTS) - (SETQ DRFTS NIL)) - (CL:WHEN (MEMB (U-CASE RB) - '(DRAFT DRAFTS)) - (SETQ RB NIL) - (SETQ DR T)) - (GIT-FETCH PROJECT) - (SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT)) - (IF PRS - THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS) - "Pull requests"))) - (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) - RB NIL PROJECT)) - ELSE "No open pull requests"))) + (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) @@ -553,6 +528,46 @@ (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) (OR SUBDIR ""))) T)) +(DEFINEQ + +(PRC-COMMAND + [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk") + (LET (PRS PRMENU) + (IF PROJECT + THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T) + THEN (SETQ PROJECT REMOTEBRANCH) + (SETQ REMOTEBRANCH NIL) + ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) + THEN (SETQ PROJECT DRAFTS) + (SETQ DRAFTS NIL)) + (CL:WHEN (MEMB (U-CASE REMOTEBRANCH) + '(DRAFT DRAFTS)) + (SETQ REMOTEBRANCH NIL) + (SETQ DRAFTS T)) + (GIT-FETCH PROJECT) + (SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT)) + (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu)) + (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY) + (STRPOS REMOTEBRANCH (fetch PRNAME of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY)) collect PR + finally (CL:WHEN $$VAL (SETQ PRS $$VAL)) + (SETQ REMOTEBRANCH NIL))) + (IF PRS + THEN (CL:UNLESS REMOTEBRANCH + (SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS)) + (SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests") + NIL)) + (SETQ REMOTEBRANCH (MENU PRMENU))) + (if (EQ 'PinMenu REMOTEBRANCH) + then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests"))) + elseif REMOTEBRANCH + then (GIT-PR-COMPARE REMOTEBRANCH PROJECT)) + ELSE "No open pull requests"]) +) @@ -1004,6 +1019,35 @@ (GIT-FETCH [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk") (GIT-COMMAND "git fetch" T NIL PROJECT]) + +(GIT-PR-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1321,41 +1365,24 @@ THEN (ERROR "Unknown branch" BRANCH]) (GIT-PICK-BRANCH - [LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk") - (CL:WHEN (MKLIST BRANCHES) - (MENU (CREATE MENU - TITLE _ (OR TITLE 'Branches) - ITEMS _ BRANCHES - MENUFONT _ DEFAULTFONT)))]) + [LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches"]) -(GIT-PRC-MENU - [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") - (* ; "Edited 4-Aug-2022 18:55 by rmk") - (* ; "Edited 9-Jul-2022 19:01 by rmk") - (* ; "Edited 16-May-2022 19:44 by rmk") - (CL:UNLESS PRS - (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) - (CL:WHEN PRS - (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) - NIL T PROJECT))) - (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) - (EQUALS _ (CADR RELATIONS)) IN PRS - COLLECT (SETQ PRNAME (fetch PRNAME of PR)) - (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) - " " - (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] - THEN (CONCAT PRNAME " > " REL) - ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] - THEN (CONCAT PRNAME " = " REL) - ELSE PRNAME))) - (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) - (CONCAT LABEL " (draft)") - LABEL) - (GITORIGIN PRNAME) - (CONCAT " " (FETCH PRDESCRIPTION OF PR) - " #" - (FETCH PRNUMBER OF PR] - T)))]) +(GIT-BRANCH-MENU + [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES)) + (CL:WHEN PIN? + [SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu]) + (CREATE MENU + TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches")) + ITEMS _ BRANCHES + MENUFONT _ DEFAULTFONT))]) (GIT-PULL-REQUESTS [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") @@ -1402,6 +1429,35 @@ (* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz") (FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) + +(GIT-PRC-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1664,7 +1720,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk") + (* ; "Edited 12-Sep-2022 14:41 by rmk") (* ; "Edited 20-Jul-2022 21:18 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk") (* ; "Edited 9-May-2022 15:14 by rmk") @@ -1683,10 +1740,11 @@ (SETQ MAPPINGS (CADDR DIRS)) (IF DIRS THEN (TERPRI T) - (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) + [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) (CADR DIRS) '(> < ~= -* *-) - '*>*.*)) + '*>*.* + (GIT-GET-PROJECT PROJECT 'EXCLUSIONS] (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.") @@ -1754,6 +1812,10 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 17-Jun-2023 22:54 by rmk") + + (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") (* ;; "Edited 25-Jun-2022 21:37 by rmk") @@ -1793,7 +1855,13 @@ (GITSUBDIR SUBDIR T PROJECT) (OR SELECT '(> < ~= -* *-)) NIL - (FETCH EXCLUSIONS OF PROJECT) + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + 'DIRECTORY) + 1 NIL T T FILEDIRCASEARRAY)) + (CL:IF DPOS + (SUBSTRING E (ADD1 DPOS)) + E)) NIL NIL NIL FIXDIRECTORYDATES)) [FOR CDE IN (FETCH CDENTRIES OF CDVAL) DO (CL:WHEN (FETCH INFO1 OF CDE) @@ -2067,6 +2135,11 @@ " " FILE) (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2) " " FILE]) + +(GIT-PR-COMPARE + [LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk") + (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) + RB NIL PROJECT]) ) (RPAQ? FROMGITN 0) @@ -2083,11 +2156,13 @@ (DEFINEQ (CDGITDIR - [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk") + (* ; "Edited 8-Jul-2022 10:34 by rmk") (* ; "Edited 7-Jul-2022 09:36 by rmk") (* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 2-Nov-2021 21:12 by rmk:") - (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT] + (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT)) + NIL T) " && "]) (GIT-COMMAND @@ -2198,16 +2273,6 @@ (ERROR (CONCAT "Command failed: " CMD))) NIL]) -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - (GIT-RESULT-TO-LINES [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") @@ -2234,32 +2299,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . -13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 - . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 - . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS -28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) -(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR -34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME - 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE -38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH -40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( -GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( -GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( -GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 -) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT -60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . -66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) - (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) -) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( -GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE -75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR -79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( -GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . -106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( -GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND -111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE -114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL -119031 . 119694))))) + (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 . +13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133 + . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613 + . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 ( +ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 ( +TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES +34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587 + . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580 + (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629 +52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727 + . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 . +46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) ( +GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) ( +52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS +59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) ( +GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) ( +GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) ( +GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) ( +GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP +76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 ( +GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873) + (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) ( +GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 . +111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) ( +GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR + 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 . +119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299 + . 123962))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 70a03829d00b118f34c2abc5a07bf8e489c6c231..2cd16571189cb902aa72f57dcb5414f1d7517575 100644 GIT binary patch delta 3805 zcmaJ^TWlN073D5v8>TH=54v^~S-zrel@v^7ALK5{1PYhrQlvz3X+Er|P0dOsZ3?pW zw9^C$z&7Y3{U{oBk*0=|6n26ph$UAFL)2($Z-IXFqaOkKKnwJvD3GEk@?)bY8nl4Z zJF`oXa)R<>cjnIA*}0E%?&WVDupfWR{_>Pl5WR)!l2_ma5qL4o31L34Hvd>XD0;x* z+OdjD{;-l3-LA<8m=R_XDYCKi+MyFxr(maG?NhLe37Q96b z+>S)Huze#BgmZcIOiC*iym34nT!PSHvJmEiXxG~F$Jn6I_%)L~SoeVK+culc9@&de z+pJBgTp)vcKQt+e}%c z$L7|rzu}zWc?mK~DjUr!*;o=nGQ`qaR?R8JB*;OCs|lr)E*45r3_<}U9@M8|=~5x3 zp)33W!005kLJ@=zOwj@Fhg@EpP-Dfcl2Ot9jjMfYyXv`o%p21(86_Ksa6IU6=Rm@Z zkOLlH88utNA&0{Pq(EpLfny%xc_mRKVh-|ZMk}h;RTCfsi7j3%rW8~qpI4?mz#QJg z*zCQ)M4N{qwYh!7!|xrcM`pW>+N^DJ$n<@evDvR!tFJ0_jWx`;ED{X|dAy1W#@sAx zM5)r85~Zg-6={}|H@0j)jWj(vMf`pR4P*ky7!Qy8cvk#6kW~UNjLXrY6DMyFu{Il z^Ou>CUu=F7sk{;;pQzh<=-n{tg3OVqd2@LZkerfN0rMUT#e7aHfFSU#Aumgy#N#wJ zyv$Q2)Ae3cCP@&}vN5Fyd_aP5^K&BnS%h%!FFRT$N<}QYH!k8A@J~0^m27$5mn;O+u2GXzf97r;Hc% z<%Rw_kEiA47Bba^E5Q3P9nCT3EC^`3E4v7bOVtHfx^nR%a?|pa>gwfH7w`xI*Jp%+ z@L8cGfSYEomBSv7LrJGwSZV~0>>b{RVQ87$C>FoTHpW7!0YVjkVPhjov+w_;3`W!P zw%~6&yXEUp%he&v(H=)Ol}76jqb`_TnOQhjtF9tNl62^dY`B{sl;SXzeG>HLf=60r z5mu3k{msf+ZD7{+el_}fq@C^vl&|7_ZO8DwoiNhhFO1bO=>kIQE*K&!Q}D`9E4iGS zjSJ}Vpxojbl08W^9ZzHl0magJ3}q%)1W|w&y6j}NIGt0Ezd+*Tmpd&1J_K&J3+NA{ z370Umu0C*|E+K7f$JgU&{PqmjwV!a(4&Up)yV=)petDzExw@ORb;V5d?v6C=FK#hO z{SWgm9slDT6;3jfEJMwwsEyGl#d7y9{qn^d^$)0|HZWk}u7y6)q+rV% zA_6ZKkLI`RjV&P%XzdZOI;G7_7dRP;D!K-v#1YMmf>atLAt#vDKe^o9&tpv^ zq3uY0{raVkDghBHbLY=jSE>u=s;eN1!HzisCb&(%LP!A9Ljnjv$r|%GHt8T1_okJo zn#NEO#I(kINYd}D57!lr!@Kbq#g3xE%L0s!jrvAO{6r}TZm#3=s~(ggY#x^J0dU8# zIha|gLZMpqpocgN{dsH_5R!sFh!grF69UDVg~~yE2_ga+Tn;2QLI3XJ8!-t?{9(Bf z0#Hm9)0h~jgDyOyq{$EokXAb~=1@%5F|p!=9*K`ZpI*Afi6%W|)cm;GBGLjR07LX} zQ6f@7A6|Zh6-E8E`4e6C(omOPS^oGiGiFRZabt^-GBm61^m5&iEoMMJzarM#Db;(r zUmLVHo!U?z)__pp*&=0gKT+l^KH#FQU+u5pB1K;acb@g%e>AqYK57jdPfY+jok(FWAoJ( z_p|oqhnll|z{ocDX$NWpXTP%b;6K`dk+WM5=vjxfQJq~C>I2#-d(-|Mrpy_duQ}A8 zITtZZ7#S0l`Fm(TOAXkveQN)S<}3S++Dn>`!MEmP%RYl*Cqw~}lxps;zpW1rx5j~cm+~y7FnPoQ5_UoskszDkDmF3O#3EtyLWza0AWyhVd*>D|pgh3Ijp?ub zVJ9nNpoo`nTjQ? zN(wr6Gk(mBoZ0eG?c9zoPJj94ai8_6b_w=?dlVjj99)^_I+_!3lbbvA4{x5-|8-M2 zjQ{6wPJE2Lsdq}tPZsm43VLQe&N%e7b*H{{>4<)JeOUi=eV1-u8vMaVOrQAvqx#v6 vfrBmctj1S=cH=lIUE6T!cQ<4l?YecWaq`w%d%8P3h2PFK2OGZINB8^>tE;Ty delta 3325 zcmZu!YitzP72cU8HY{L_G1y%Q93~FkbyzZwo!Ljy#IrNA_Tt^0WoC@yCc!oAg56M? zcuQV_xT38ZrBVvIRfzyK6{<=}RAhUx)TW}_O0B92Rh6o!s#LWSN~EfaTG3xs`Xlt* zJ3DJb>L0Un&bf0Q-#y>C*B^f~eEU=W{CKY-CQ4KD30agC5HndZolT}MyzscKW#SMK z|AgzOuso7!oQ&ieI5E)MZL69e-_G_SG0P3`wB zxI`DUbiR*EzQSL{R18b6Kp?rl8# zR3S?86WgNC@?3}?3SS$lE_>6_o0Tuo()Z{qohQh5CZ0Olvw_N(RXPnNt2~COsF@%b zRg73gGhfC4n2&?qQL1<#Cm}aKHG6EjRtHIiGwZ^1r8iNr9yx;!;%rANj*+11#-$_Q z;2YI14z44=Ioi_@r+(7id!mC6tut8Yqa8yl;d4veljPqozR`DkhABt6QJ!PF#z5Re zuFPNMeoLON_fIMcZC2YU3>V6vAcRG$Jd7AAVg?K|=h)+}<$$av!LZAQPLoxFHL{d} zB10Ucj0&EG1re4rq5?4k2|YDm1GiR-W5sC@;5ZVzE`Y3PD6l^&h$u|WR`Dt0 zE(#z-K$b-E!RhbIBKXY(2t)?Ff>*TYYZ}2htQYC4x@HC9Ym$|hZm8&n5!iBut%QO7 zp*xmK$*5wfu9p}uS!U6iKp4==m~Ya^jh6@3@&D})lRv%uabM`e=D2uuDfE{T+x=Tx z#mz%Yp(gqBE6NNd7&l$58k?DIvUgFfa$C7Bdsmg`mbdYoy^H6#8Ak5@CJMOx9sj4= zR&V3OE4S_5$*yL3Wux6S9X;~=(!DXeYu}Njdu8fwi@lrt;Z=E|*M{&)_*>lMK+_gh zc5f>klbe1^HV;-`xO;Vp<5@>8h3Vk`9A|Z zOP>j?O7=DF0efFzbUGSkJ_{#88`FHz3PqTT@ZUy|{eH-{mSo-uM<`!ci*HhTsE!t=q zB_N81eZ0ybO_N%uLSd>km7WGw!*1|trK+jGM>3rXxRh-3u2{gal$51ly^>PE#fBIu zc&v@b%56!ODC-(q&uripQrPutd8c778*`^#eH5NdfTpBrhvP3M-RgJ^XJf!b4QIdu zjMKzb#;KW9(7f}klvh`w-vQoo2DLgKKrlrW8vx8wx zRY=$CdtD8uj36LDGLp)tUIf%+2BqK+tx0NaaZzQ&q+CRuN{Q*0G&6ew6-h~JoO}Hr zJC7SCR)ixTvSvCGD}WeOi)Y*bwu?U|@r>bEgRMSTtI>v{)13m=8i%XffYf$9r%=HY zgnZ$0luI|Bx%{7vortDkxh^?*Ini0cc!q6~x32A4kf6eN4LGc{6owZ$KE!S94xQ{g z)IsC?uJ`O|ekJ_nXR0%I-)^p_s^;QH{s}XEY+ZApgQKaW;knXb)*f;Oaz)!1MPMbI zJ|5m8O6>e-r9j6?NiUmpI?6kI1o9LCnup})K@MDzQxB~7SK`3(m*D7P-%#+3l8Ko= z#v^b;8%XN<;4E%~QOx3D>ss_+3v$B|_<&b`MyudocIZus!jx#Ija!)2bGGAw-;&I_ zwgOrjxzp$+Z(Z+bOkew?gLv{xe1#qIM^eNcW+$b$l=BPJ*<@x0X##@LOzc- zCGy=xm#N1`3dTsHbyOG^|{%)5O3Y!$Up1- zNNouKY(Yf8+`ftR zBesN&WNUCYf7tm%(efY`b8--Itdi|ne$5!zbij1lb~9xqrV~ z;{YAuZU~jrI5OvJFP^T|zgic_;`^T;VJWS--?F?61ib}+Ao~F0e=g-Ym^)RQg;V$W MiZ_1$^WB~Q1DwlL7ytkO From 9ed64485918da24cf046851856e46beffef377bd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 16:32:03 -0700 Subject: [PATCH 11/18] PSEUDOHOSTS: Moved SLASHIT to UNIXUTILS, also includes minor change in previous (unexamined) PR, to be removed --- lispusers/PSEUDOHOSTS | 97 +++++++++++++++---------------------- lispusers/PSEUDOHOSTS.LCOM | Bin 8570 -> 8250 bytes 2 files changed, 40 insertions(+), 57 deletions(-) diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 981afb63..ad69e0ed 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}PSEUDOHOSTS.;153 27674 +(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}PSEUDOHOSTS.;158 26638 :EDIT-BY rmk - :CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) - (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) + :CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH) (VARS PSEUDOHOSTSCOMS) - :PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}PSEUDOHOSTS.;152) + :PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}PSEUDOHOSTS.;155) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -21,7 +20,7 @@ (* ;; "Internals") - (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH) + (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH) (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) @@ -42,6 +41,8 @@ (PSEUDOHOST [LAMBDA (HOST PREFIX) + (* ;; "Edited 22-Sep-2023 15:29 by rmk") + (* ;; "Edited 25-Jun-2022 17:00 by rmk") (* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") @@ -81,7 +82,7 @@ (SELECTQ TARGETHOST ((DSK CORE) (SETQ PREFIX (UNSLASHIT PREFIX))) - (UNIX (SETQ PREFIX (SLASHIT PREFIX))) + (UNIX (SETQ PREFIX (SLASHIT PREFIX))) NIL) (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) @@ -153,26 +154,32 @@ (FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))]) (TRUEFILENAME - [LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk") + (* ; "Edited 26-Jan-2022 23:33 by rmk") (* ; "Edited 25-Jan-2022 08:47 by rmk") - (LET (FILENAME DEVICE) - (IF (STREAMP FILE) - THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) - (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) - ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) - (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) - (CL:IF (TYPE? PHDEVICE DEVICE) - (EXPAND.PH FILENAME DEVICE) - FILENAME)]) + (if (LISTP FILE) + then (for F in FILE collect (TRUEFILENAME F)) + else (LET (FILENAME DEVICE) + (IF (STREAMP FILE) + THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) + (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) + ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME)]) (PSEUDOFILENAME - [LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jan-2022 23:08 by rmk") (* ; "Edited 28-Jan-2022 09:06 by rmk") - (FOR D PN (FILENAME _ (IF (STREAMP FILE) - THEN (FETCH (STREAM FULLFILENAME) OF FILE) - ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES - WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) - DO (RETURN PN) FINALLY (RETURN FILENAME]) + (if (LISTP FILE) + then (for F in FILE collect (PSEUDOFILENAME F)) + else (FOR D PN (FILENAME _ (IF (STREAMP FILE) + THEN (FETCH (STREAM FULLFILENAME) OF FILE) + ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES + WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) + DO (RETURN PN) FINALLY (RETURN FILENAME]) ) @@ -209,6 +216,8 @@ (CONTRACT.PH [LAMBDA (NAME PHDEV) + (* ;; "Edited 22-Sep-2023 14:30 by rmk") + (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") @@ -234,7 +243,7 @@ (SETQ CONNECTOR (CADDR PM)) [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) + THEN (SLASHIT SUFFIX) ELSE (UNSLASHIT SUFFIX]) (RETURN (PACK* '{ (CADR PM) "}" @@ -244,31 +253,6 @@ (RETURN NAME)))]) -(SLASHIT - [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") - (* ; "Edited 3-Jan-2022 11:44 by rmk") - (* ; "Edited 22-Dec-2021 20:18 by rmk") - (* ; "Edited 2-Nov-2021 22:54 by rmk:") - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (EQ DIRPOS 1) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - (UNSLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") (* ; "Edited 22-Dec-2021 20:18 by rmk") @@ -527,13 +511,12 @@ EXPORTS.ALL) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844) -(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 ( -EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709) -(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375 -) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) ( -DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) ( -REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) ( -SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) ( -RENAMEFILE.PH 24078 . 25019))))) + (FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808) +(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 ( +EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 . +15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH +17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287 +) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) ( +GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) ( +NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 1560bf8fc0806e974871bbd164b002cb48e9fd20..2a4c82ce9a98ba9aabd8e65b586f9979219cb67d 100644 GIT binary patch delta 859 zcma))O=#0#7{`;=*_!D{p>#60^)WDM4=ruJ`f)K?^0v)PlhCA_Xq`-3a5%M8MPXp^ z?8Wg4-b6hLLRl$(;LX!+UOapEw3{FveA5r;V1hY>=gt3l-sk!K^ZZ`@tUTX{@_fo| zwNreC7a%JY`9e|3?A?~S`6Mvh5iwg7#A2qv!HrJq=Dj=Z?VVN=T94bE`zu9oTvXTX zitT!^eHXY=-85mkI-O2)(A;`JN{+iWD|1OEQ8G-V)sX5TJqAacPbS-43FU#8Wg(9@ z=|!$&xznv(Q*|qb2byhpHC6M{P6dCb6EV_KPOUxM8DsK3iICgdU7@9ZA@DBTl|V=9 zhK9fa5&SVMwdx-PD1iZ);in`}TPG=sR)YInL$RUOFYz^m2KWP0Lfo`(|Q0y#TQ0*S}3XSr4m z9E;G&pp&=sFJQu+hlYRO$Q+kA&uBSqXmbR_r>)vWdS*NHF-@vWb`C^E89S_$q!BUn0?qcp0bflST4UuI>>#C_} XcGV%)0D~K#;2zE5_Yfn=U*W@Fa?8^R delta 887 zcmZvb%WD%+6vk(gV&n9|1f!IaHpgg70!^BEQX$HnI06fQ zqX*gr;Io;mh-c_99*k%w8K;aUR9m;pZqk)YW5}J9O}tIVdj6s31c~Dt^bGz^pP~6( zzwdcqg98;!8VUjjQs5C-auI>i+Qfl6@1rO>2z359MV=R-{4wwSG4QGtF!!68N+W-% znH3-E2IJMSI!ndU89)_Bw$!AfgP4M8!q}Xu;YB9k6GVKqBLq1pyF`A`Azp|X&`1gJ z>DD1|8T_;(Dhc3Ngp~)Ctla;^pn(X}o{;8*vL~U9rf3%rb@pWZx___DVCl;(&PPUd zya75@e^Ov|UuEY96%$85u`RbGE3QY(^B&%*%pp7>*Tmz5-Th9(-&Z!}vTnE_sW~R* zKo%52ClDJwQk-CO;q3rL`IbFP@{M_W{+kP5gQtCZP;SR}*f2eXAG3*}bMt$L! zV4+H5uUU-}w||Ug@aKqtKlKZ}48&BVm~sh`zX6dum{;tgL%IQnBY9Fd9T~)TBQO5| Dc^uyj From bf2e34841b8076067f32d3a9578914e94f516e18 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 22:56:54 -0700 Subject: [PATCH 12/18] PDFSTREAM: wrapped FULLNAME around TRUEFILENAME --- library/PDFSTREAM | 14 +++++++------- library/PDFSTREAM.LCOM | Bin 4189 -> 4201 bytes 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 8d882dd8..9ec59d23 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48 10752 +(FILECREATED "23-Sep-2023 22:54:26" {WMEDLEY}PDFSTREAM.;49 10763 :EDIT-BY rmk - :CHANGES-TO (FNS OPEN-PDF-STREAM PS-TO-PDF) + :CHANGES-TO (FNS PS-TO-PDF OPEN-PDF-STREAM) - :PREVIOUS-DATE "23-Sep-2023 15:31:33" {WMEDLEY}PDFSTREAM.;47) + :PREVIOUS-DATE "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -154,7 +154,7 @@ PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 15:30 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 22:54 by rmk") (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") @@ -166,7 +166,7 @@ (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") - (SETQ PSFILE (TRUEFILENAME PSFILE)) + (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) (SETQ PDFFILE (if PDFFILE then (TRUEFILENAME PDFFILE) else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) @@ -211,6 +211,6 @@ PDFFILE]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3630 10729 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 - . 10727))))) + (FILEMAP (NIL (3630 10740 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 + . 10738))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index ba009eae5b2a9602d4822a9e6fbe44635eea02e4..78e86fb0fceb4ca18f4e5b00d85ca718d47ab46c 100644 GIT binary patch delta 642 zcmZ8f%WB&|6tx7UsnK@_X-gEBU;x}&I4LIKy-ahvi7mgJzzP{eBwQZDL zr`h7Cxo1D2AAvc6@3wC&>~tciT2?EytxY52vi)L>T4wDne_0n>kB1L>y{*IT9<62h z@R>CiFwI0}c_FK~l;C~{*)*yF7yKV`1EjK8X~21eV`)}6uQCPBd=Q{*P1r$FC@r%C zaL4WLut;?0EDTXMDv?^-i7Lx^T%};4i$qmPY>HePupoq<91#Zd1C-;~sFEPZq{`21 zDle;3FwcQ5Vtta+4cFbY!8p4onfD**@Qxf)ZyN!G40W80yFf(rHw7>3j8f$d4f)O{ zMbUoiKYz+SP?X2!glzEk^ONBmOprd!$lcu7N0~Sv|9^BBaY6fjy42Q6m_erNdXhFdxQvnMCQEHq8cU@QGdv^=9tqSZsns=jC^2lx(*dnl%?R8N zVXD*|m((HRbsL;VE7D8W$wV%>c7A^G4rgQcp?|9<0`A`T_n2^>`gb>jWcIcH GW# Date: Mon, 25 Sep 2023 20:32:17 -0700 Subject: [PATCH 13/18] Restore POSTSCRIPTSTREAM --- library/POSTSCRIPTSTREAM | 4423 +++++++++++++++++++++++++++++++++ library/POSTSCRIPTSTREAM.LCOM | Bin 0 -> 91396 bytes 2 files changed, 4423 insertions(+) create mode 100644 library/POSTSCRIPTSTREAM create mode 100644 library/POSTSCRIPTSTREAM.LCOM diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM new file mode 100644 index 00000000..6d5a1729 --- /dev/null +++ b/library/POSTSCRIPTSTREAM @@ -0,0 +1,4423 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") +(FILECREATED "21-Jun-2021 20:29:32"  +{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;11 259283 + + previous date%: "12-Jun-2021 19:14:50" +{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;10) + + +(* ; " +Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. +") + +(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) + +(RPAQQ POSTSCRIPTSTREAMCOMS + [ + (* ;; "PostScript printer support for Medley") + + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) + (INITRECORDS \POSTSCRIPTDATA) + (FNS POSTSCRIPT.INIT) + (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) + (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD))) + + (* ;; "Font-reading code") + + (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE + PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES + POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS + POSTSCRIPT.FONTSAVAILABLE) + (COMS + (* ;; "Until macro in FONT is exported") + + (MACROS \FSETCHARWIDTH)) + (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) + (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY)) + (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE) + (FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR + POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE + POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK + \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC + \SWITCHFONTS.PSC \TERPRI.PSC) + + (* ;; "DIG operations: ") + + (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC + \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC + \DSPBOTTOMMARGIN.PSC \DSPCLIPPINGREGION.PSC \DSPCOLOR.PSC \DSPFONT.PSC + \DSPLEFTMARGIN.PSC \DSPLINEFEED.PSC \DSPPUSHSTATE.PSC \DSPPOPSTATE.PSC \DSPRESET.PSC + \DSPRIGHTMARGIN.PSC \DSPROTATE.PSC \DSPSCALE.PSC \DSPSCALE2.PSC \DSPSPACEFACTOR.PSC + \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC + \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) + (COMS + (* ;; "Character-output, plus special-cases:") + + (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG + \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN + \POSTSCRIPT.ACCENTPAIR) + + (* ;; + "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + + (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) + + (* ;; + "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + + (FNS \POSTSCRIPT.NSHASH) + (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) + *POSTSCRIPT-NS-TRANSLATIONS*) + (GLOBALVARS *POSTSCRIPT-NS-HASH*)) + (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \POSTSCRIPT.FRACTION)) + (VARS (\POSTSCRIPT.ORIENTATION.MENU (create MENU ITEMS _ '(("Landscape" T + "Print this file/document/image in Landscape Orientation" + ) + ("Portrait" 'NIL + "Print this file/document/image in Portrait Orientation" + )) + TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ + (create POSITION XCOORD _ -1 YCOORD _ 0) + CHANGEOFFSETFLG _ 'Y)) + (\POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" T + "Default printing to Landscape Orientation" + ) + ("Portrait" 'NIL + "Default printing to Portrait Orientation" + )) + TITLE _ "Default Orientation" CENTERFLG _ + T)) + PS.BITMAPARRAY \POSTSCRIPT.JOB.SETUP SlopeMenuItems WeightMenuItems) + [ADDVARS (BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + (MENU + \POSTSCRIPT.ORIENTATION.OPTIONS.MENU + )) + + "Select the default Orientation for PostScript output" + (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + 'ASK) + + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" '(SETQ + POSTSCRIPT.PREFER.LANDSCAPE + T) + + "Default printing to Landscape Orientation" + ) + ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + NIL) + + "Default printing to Portrait Orientation" + ] + (VARS (BackgroundMenu NIL)) + (CONSTANTS (GOLDEN.RATIO 1.618034) + (\PS.SCALE0 100) + (\PS.TEMPARRAYLEN 20)) + (INITVARS (POSTSCRIPT.BITMAP.SCALE 1) + (POSTSCRIPT.EOL 'CR) + (POSTSCRIPT.IMAGESIZEFACTOR 1) + (POSTSCRIPT.PREFER.LANDSCAPE NIL) + (POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) + (POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) + (POSTSCRIPT.TEXTURE.SCALE 4) + [POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>"] + (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) + [COMS (FNS POSTSCRIPTSEND) + (ADDVARS (PRINTERTYPES ((POSTSCRIPT) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR + REGION ROTATION TITLE] + [ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) + [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT] + (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) + + (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") + + [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2] + (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST + POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE + POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE + \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE + POSTSCRIPT.PAGEREGIONS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (POSTSCRIPT.INIT))) + (PROP (FILETYPE MAKEFILE-ENVIRONMENT) + POSTSCRIPTSTREAM) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA + POSTSCRIPT.PUTCOMMAND + ]) + + + +(* ;; "PostScript printer support for Medley") + +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RECORD FONTID (FONTIDNAME FONTXFACTOR FONTOBLIQUEFACTOR)) + +(RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) + +(DATATYPE \POSTSCRIPTDATA + ((POSTSCRIPTACCENTED FLAG) (* ; + "T if we're to do NS-to-PS translations on characters in the current font.") + POSTSCRIPTFONT (* ; + "The fontdescriptor of the current font") + POSTSCRIPTX (* ; "The current X") + POSTSCRIPTY (* ; "... and Y") + POSTSCRIPTLEFTMARGIN (* ; "The margins") + POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING + (* ; "Line to line spacing") + POSTSCRIPTCOLOR (* ; + "Color (or grey shade) in effect; 0.0=black, 1.0=white.") + POSTSCRIPTSCALE (* ; "Scale of the stream") + POSTSCRIPTOPERATION (* ; + "Default operation (PAINT, REPLACE, ...)") + POSTSCRIPTCLIPPINGREGION (* ; + "The current region available to be written into") + POSTSCRIPTPAGENUM (* ; "Current page number") + POSTSCRIPTHEADING (* ; "The heading") + POSTSCRIPTHEADINGFONT (* ; "Font for the heading") + POSTSCRIPTSPACEFACTOR (* ; + "Expansion factor for spaces (see DSPSPACEFACTOR)") + POSTSCRIPTSPACEWIDTH (* ; + "The width of a space in the current font") + POSTSCRIPTLANDSCAPE (* ; + "non-NIL for paper in 'landscape' mode") + POSTSCRIPTCHARSTOSHOW (* ; + "non-NIL if the string (PostScript-type string) of chars has already been started") + POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") + POSTSCRIPTMOVEFLG (* ; "Need to move") + POSTSCRIPTWIDTHS (* ; + "The widths vector of the current font") + POSTSCRIPTTRANSX (* ; "Translation in X") + POSTSCRIPTTRANSY (* ; "... and Y") + POSTSCRIPTPENDINGXFORM (* ; + "A userspace to devicespace transform is pending") + POSTSCRIPTPAGEREGION (* ; "The whole page") + POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") + POSTSCRIPTSCALEHACK (* ; + "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") + POSTSCRIPTTEMPARRAY (* ; + "For converting FIXP to string of digit chars") + POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") + POSTSCRIPTROTATION (* ; + "Rotation value currently in effect.") + POSTSCRIPTPENDINGROTATION (* ; + "Rotation to take effect at next SETXFORM.") + POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") + (POSTSCRIPTNSCHARSET BYTE) (* ; + "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") + (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; + "Width of the space in the current font, used to compute the scaled space width.") + ) + POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 + POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY + _ (ARRAY \PS.TEMPARRAYLEN 'BYTE 0 0) + POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) + +(RECORD POSTSCRIPTXFORM ( + (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") + + PSXCLIP (* ; "Clipping region") + PSXPAGE (* ; "Page region") + PSXX (* ; "X position?") + PSXY (* ; "Y position?") + PSXLEFT (* ; "Left margin") + PSXRIGHT (* ; "Right margin") + PSXTOP (* ; "Top margin") + PSXBOTTOM (* ; "Bottom Margin") + PSXTRANX (* ; "X-translation in effect") + PSXTRANY (* ; "Y-translation in effect") + PSXLAND (* ; "Landscape?") + PSXXFORMPEND (* ; "Are there transforms pending? ") + )) +) + +(/DECLAREDATATYPE '\POSTSCRIPTDATA + '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + BYTE WORD) + '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) + (\POSTSCRIPTDATA 0 POINTER) + (\POSTSCRIPTDATA 2 POINTER) + (\POSTSCRIPTDATA 4 POINTER) + (\POSTSCRIPTDATA 6 POINTER) + (\POSTSCRIPTDATA 8 POINTER) + (\POSTSCRIPTDATA 10 POINTER) + (\POSTSCRIPTDATA 12 POINTER) + (\POSTSCRIPTDATA 14 POINTER) + (\POSTSCRIPTDATA 16 POINTER) + (\POSTSCRIPTDATA 18 POINTER) + (\POSTSCRIPTDATA 20 POINTER) + (\POSTSCRIPTDATA 22 POINTER) + (\POSTSCRIPTDATA 24 POINTER) + (\POSTSCRIPTDATA 26 POINTER) + (\POSTSCRIPTDATA 28 POINTER) + (\POSTSCRIPTDATA 30 POINTER) + (\POSTSCRIPTDATA 32 POINTER) + (\POSTSCRIPTDATA 34 POINTER) + (\POSTSCRIPTDATA 36 POINTER) + (\POSTSCRIPTDATA 38 POINTER) + (\POSTSCRIPTDATA 40 POINTER) + (\POSTSCRIPTDATA 42 POINTER) + (\POSTSCRIPTDATA 44 POINTER) + (\POSTSCRIPTDATA 46 POINTER) + (\POSTSCRIPTDATA 48 POINTER) + (\POSTSCRIPTDATA 50 POINTER) + (\POSTSCRIPTDATA 52 POINTER) + (\POSTSCRIPTDATA 54 POINTER) + (\POSTSCRIPTDATA 56 POINTER) + (\POSTSCRIPTDATA 58 POINTER) + (\POSTSCRIPTDATA 60 POINTER) + (\POSTSCRIPTDATA 62 POINTER) + (\POSTSCRIPTDATA 64 POINTER) + (\POSTSCRIPTDATA 66 (BITS . 7)) + (\POSTSCRIPTDATA 67 (BITS . 15))) + '68) +) + +(/DECLAREDATATYPE '\POSTSCRIPTDATA + '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + BYTE WORD) + '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) + (\POSTSCRIPTDATA 0 POINTER) + (\POSTSCRIPTDATA 2 POINTER) + (\POSTSCRIPTDATA 4 POINTER) + (\POSTSCRIPTDATA 6 POINTER) + (\POSTSCRIPTDATA 8 POINTER) + (\POSTSCRIPTDATA 10 POINTER) + (\POSTSCRIPTDATA 12 POINTER) + (\POSTSCRIPTDATA 14 POINTER) + (\POSTSCRIPTDATA 16 POINTER) + (\POSTSCRIPTDATA 18 POINTER) + (\POSTSCRIPTDATA 20 POINTER) + (\POSTSCRIPTDATA 22 POINTER) + (\POSTSCRIPTDATA 24 POINTER) + (\POSTSCRIPTDATA 26 POINTER) + (\POSTSCRIPTDATA 28 POINTER) + (\POSTSCRIPTDATA 30 POINTER) + (\POSTSCRIPTDATA 32 POINTER) + (\POSTSCRIPTDATA 34 POINTER) + (\POSTSCRIPTDATA 36 POINTER) + (\POSTSCRIPTDATA 38 POINTER) + (\POSTSCRIPTDATA 40 POINTER) + (\POSTSCRIPTDATA 42 POINTER) + (\POSTSCRIPTDATA 44 POINTER) + (\POSTSCRIPTDATA 46 POINTER) + (\POSTSCRIPTDATA 48 POINTER) + (\POSTSCRIPTDATA 50 POINTER) + (\POSTSCRIPTDATA 52 POINTER) + (\POSTSCRIPTDATA 54 POINTER) + (\POSTSCRIPTDATA 56 POINTER) + (\POSTSCRIPTDATA 58 POINTER) + (\POSTSCRIPTDATA 60 POINTER) + (\POSTSCRIPTDATA 62 POINTER) + (\POSTSCRIPTDATA 64 POINTER) + (\POSTSCRIPTDATA 66 (BITS . 7)) + (\POSTSCRIPTDATA 67 (BITS . 15))) + '68) +(DEFINEQ + +(POSTSCRIPT.INIT + [LAMBDA NIL (* ; "Edited 14-May-2018 10:48 by rmk:") + (* ; "Edited 4-Feb-93 21:08 by jds") + (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE)) + + (* ;; "Add POSTSCRIPT font descriptions to the active font profile.") + + [MAPC + [CL:REMOVE-DUPLICATES (NCONC (for FD in FONTDEFS + join (for FP in (CDR (ASSOC 'FONTPROFILE + (CDR FD))) + collect (CAR FP))) + '(FONT7 FONT6 FONT5 FONT4 FONT3 FONT2 FONT1 BOLDFONT LITTLEFONT + BIGFONT PRETTYCOMFONT COMMENTFONT USERFONT SYSTEMFONT + CLISPFONT LAMBDAFONT CHANGEFONT DEFAULTFONT] + (FUNCTION (LAMBDA (CLASS) + (LET + (COPYFD OLDPSCFD) + (if (BOUNDP CLASS) + then + (SETQ CLASS (EVALV CLASS)) + (if (TYPEP CLASS 'FONTCLASS) + then (SETQ COPYFD (OR (fetch (FONTCLASS INTERPRESSFD) of CLASS) + (fetch (FONTCLASS PRESSFD) of CLASS) + (fetch (FONTCLASS DISPLAYFD) of CLASS))) + (if (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch (FONTCLASS + OTHERFDS) + of CLASS))) + then [if (NOT (CDR OLDPSCFD)) + then (RPLACD OLDPSCFD (if (LISTP COPYFD) + then COPYFD + else (FONTUNPARSE + COPYFD] + else (push (fetch (FONTCLASS OTHERFDS) of CLASS) + (CONS 'POSTSCRIPT (if (LISTP COPYFD) + then COPYFD + else (FONTUNPARSE COPYFD] + [FOR FD IN FONTDEFS + DO (FOR FP IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) + DO (COND + ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP)) + + (* ;; "There's already a postscript spec, so leave it be.") + + ) + (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP) + (CL:FOURTH FP) + (CL:THIRD FP] + + (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.") + + (FOR FD IN (FONTSAVAILABLE '* '* '* '* 'POSTSCRIPT) + DO (APPLY (FUNCTION SETFONTDESCRIPTOR) + FD)) + (SETQ POSTSCRIPTFONTCACHE NIL) + (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T)) + + (* ;; "\POSTSCRIPT.OUTCHARFN uses this array to quickly determine whether a character needs any special processing -- T means yes") + + (for x from (CHARCODE SP) to 126 unless (FMEMB x (CHARCODE (%( %) \))) + do (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE x) + NIL)) + + (* ;; "RMK: Maybe the following is equivalent to alot of the stuff above??") + + (FONTPROFILE.ADDDEVICE 'POSTSCRIPT 'INTERPRESS) + (SETQ \POSTSCRIPTIMAGEOPS (create IMAGEOPS + IMAGETYPE _ 'POSTSCRIPT + IMCLOSEFN _ (FUNCTION CLOSEPOSTSCRIPTSTREAM) + IMXPOSITION _ (FUNCTION \DSPXPOSITION.PSC) + IMYPOSITION _ (FUNCTION \DSPYPOSITION.PSC) + IMMOVETO _ (FUNCTION \MOVETO.PSC) + IMFONT _ (FUNCTION \DSPFONT.PSC) + IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.PSC) + IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.PSC) + IMLINEFEED _ (FUNCTION \DSPLINEFEED.PSC) + IMDRAWLINE _ (FUNCTION \DRAWLINE.PSC) + IMDRAWCURVE _ (FUNCTION \DRAWCURVE.PSC) + IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.PSC) + IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.PSC) + IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.PSC) + IMBLTSHADE _ (FUNCTION \BLTSHADE.PSC) + IMBITBLT _ (FUNCTION \BITBLT.PSC) + IMSCALEDBITBLT _ (FUNCTION \SCALEDBITBLT.PSC) + IMNEWPAGE _ (FUNCTION \NEWPAGE.PSC) + IMSCALE _ (FUNCTION \DSPSCALE.PSC) + IMSCALE2 _ (FUNCTION \DSPSCALE2.PSC) + IMCOLOR _ (FUNCTION \DSPCOLOR.PSC) + IMTERPRI _ (FUNCTION \TERPRI.PSC) + IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.PSC) + IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.PSC) + IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.PSC) + IMFONTCREATE _ 'POSTSCRIPT + IMCLIPPINGREGION _ (FUNCTION \DSPCLIPPINGREGION.PSC) + IMRESET _ (FUNCTION \DSPRESET.PSC) + IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.PSC) + IMFILLPOLYGON _ (FUNCTION \FILLPOLYGON.PSC) + IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.PSC) + IMCHARWIDTH _ (FUNCTION \CHARWIDTH.PSC) + IMDRAWARC _ (FUNCTION \DRAWARC.PSC) + IMROTATE _ (FUNCTION \DSPROTATE.PSC) + IMTRANSLATE _ (FUNCTION \DSPTRANSLATE.PSC) + IMDRAWPOINT _ (FUNCTION \DRAWPOINT.PSC) + IMPUSHSTATE _ (FUNCTION \DSPPUSHSTATE.PSC) + IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC))) + (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255)) + (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) +) + +(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) + +(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD)) + + + +(* ;; "Font-reading code") + +(DEFINEQ + +(PSCFONT.READFONT + [LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:") + (* ; "Edited 1-Sep-89 10:55 by jds") + + (* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.") + + (LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T] + (PF (create PSCFONT))) + [replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"] + + (* ;; "Read until we hit a 255 byte, marking the end of the font-id section.") + + (CL:DO NIL + ((EQ (BIN S) + 255)) + + (* ;; "Body of the loop is empty, the test does all of the work") + + ) + (replace (PSCFONT IL-FONTID) of PF with (CAR FID)) + (replace (PSCFONT FIRSTCHAR) of PF with (\WIN S)) + (replace (PSCFONT LASTCHAR) of PF with (\WIN S)) + (replace (PSCFONT ASCENT) of PF with (\WIN S)) + (replace (PSCFONT DESCENT) of PF with (\WIN S)) + (replace (PSCFONT WIDTHS) of PF with (SETQ W (ARRAY 256 'SMALLPOSP 0 0))) + (for C from 0 to 255 do (SETA W C (\WIN S))) + (CLOSEF S) + + (* ;; + "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.") + + (replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) + OF PF))) + (PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME)) + (CREATE PSCFONT USING PF))) + PF]) + +(PSCFONT.SPELLFILE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 22:15 by rmk:") + (* ; "Edited 5-Oct-92 15:23 by jds") + + (* ;; + "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.") + + (CL:WHEN POSTSCRIPTFONTDIRECTORIES + (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST)) + FAMILY) + SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES '(PSCFONT PF PSC)))]) + +(PSCFONT.COERCEFILE + [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) + (* ; "Edited 5-Oct-93 16:28 by rmk:") + + (* ;; +"This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching file.") + + (COND + ((AND (NEQ EXPANSION 'REGULAR) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) + ROTATION DEVICE]) + +(PSCFONTFROMCACHE.SPELLFILE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 17:54 by rmk:") + (* ; "Edited 5-Oct-92 15:23 by jds") + + (* ;; "Tries to find postscript font information in the cache, indexed by the name-field of the fontfile. ") + + (LET [(CACHE (CDR (ASSOC (L-CASE (FILENAMEFIELD (\FONTFILENAME (OR (CDR (FASSOC FAMILY + POSTSCRIPT.FONT.ALIST + )) + FAMILY) + SIZE FACE 'PSCFONT 0) + 'NAME)) + POSTSCRIPTFONTCACHE] + (IF CACHE + THEN (CREATE PSCFONT USING CACHE]) + +(PSCFONTFROMCACHE.COERCEFILE + [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) + (* ; "Edited 5-Oct-93 17:00 by rmk:") + + (* ;; "This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching font in the cache.") + + (COND + ((AND (NEQ EXPANSION 'REGULAR) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) + ROTATION DEVICE]) + +(PSCFONT.WRITEFONT + [LAMBDA (FONTFILENAME PF) (* ; + "Edited 5-Aug-93 16:28 by sybalskY:MV:ENVOS") + + (* ;; "Given a PSCFONT data structure, write it out as a properly-named xxx.PSCFONT file, for later reading.") + + NIL + (LET ([S (OPENSTREAM FONTFILENAME 'OUTPUT NIL '((TYPE BINARY) + (SEQUENTIAL T] + (W (fetch (PSCFONT WIDTHS) of PF)) + (*READTABLE* (FIND-READTABLE "INTERLISP"))) + (PRIN3 (fetch (PSCFONT FID) of PF) + S) + (BOUT S 0) + (BOUT S 255) + (\WOUT S (fetch (PSCFONT FIRSTCHAR) of PF)) + (\WOUT S (fetch (PSCFONT LASTCHAR) of PF)) + (\WOUT S (fetch (PSCFONT ASCENT) of PF)) + (\WOUT S (fetch (PSCFONT DESCENT) of PF)) + (for C from 0 to 255 do (\WOUT S (ELT W C))) + (CLOSEF S) + FONTFILENAME]) + +(READ-AFM-FILE + [LAMBDA (FILE BOLDNESS ITALICNESS) (* ; + "Edited 5-Aug-93 16:37 by sybalskY:MV:ENVOS") + + (* ;; + "Read an Adobe-version-3 AFM file, and extract the metrics from it for making a PSCFONT file.") + + (LET ((IFILE (OPENSTREAM FILE 'INPUT)) + (PSCFONT (create PSCFONT)) + (FCHAR 1000) + (LCHAR 0) + (W (ARRAY 256 'SMALLPOSP 0 0)) + TOKEN WEIGHT SLOPE HEIGHT CMCOUNT FBBOX) + (with PSCFONT PSCFONT (repeatuntil (STRING-EQUAL "FontName" (RSTRING IFILE)) + do (READCCODE IFILE)) + (repeatwhile (STRING-EQUAL "" (SETQ TOKEN (RSTRING IFILE))) + do (READCCODE IFILE)) + [COND + ((NOT (AND (BOUNDP 'WeightMenu) + (type? MENU WeightMenu))) + (SETQ WeightMenu (create MENU + ITEMS _ WeightMenuItems + MENUFONT _ (FONTCREATE 'HELVETICA 12] + [COND + ((NOT (AND (BOUNDP 'SlopeMenu) + (type? MENU SlopeMenu))) + (SETQ SlopeMenu (create MENU + ITEMS _ SlopeMenuItems + MENUFONT _ (FONTCREATE 'HELVETICA 12] + (OR (SETQ WEIGHT BOLDNESS) + (printout T T "Font WEIGHT for " PSCFONT ": " (SETQ WEIGHT (MENU WeightMenu)) + T)) + (OR (SETQ SLOPE ITALICNESS) + (printout T T "Font SLOPE for " PSCFONT ": " (SETQ SLOPE (MENU SlopeMenu)) + T)) + (SETQ FID (LIST TOKEN WEIGHT SLOPE 'REGULAR)) + [SETQ IL-FONTID (COND + ((AND (EQ SLOPE 'REGULAR) + (EQ WEIGHT 'MEDIUM)) + TOKEN) + (T (POSTSCRIPT.GETFONTID FID WEIGHT SLOPE 'REGULAR] + [repeatuntil (STRING-EQUAL "StartCharMetrics" TOKEN) + do (SETQ TOKEN (RSTRING IFILE)) + (COND + [(STRING-EQUAL "FontBBox" TOKEN) + (SETQ FBBOX (LIST (READ IFILE) + (READ IFILE) + (READ IFILE) + (READ IFILE))) + + (* ;; "The Ascender and Descender properties from the AFM file are currently ignored, and the values from the FontBBox are used, SCALED to the height of the font.") + + (SETQ DESCENT (IABS (CADR FBBOX))) + (SETQ ASCENT (CADDDR FBBOX)) + (SETQ HEIGHT (IPLUS ASCENT DESCENT)) + [SETQ DESCENT (FIXR (FTIMES DESCENT (/ 1000 HEIGHT] + (SETQ ASCENT (FIXR (FTIMES ASCENT (/ 1000 HEIGHT] + (T (READCCODE IFILE] + (SETQ CMCOUNT (RATOM IFILE)) + (repeatuntil (EQ (CHARCODE EOL) + (READCCODE IFILE)) do) + (SETQ WIDTHS W) + (for CC from 1 to CMCOUNT + do (LET (CCODE) + (repeatuntil (EQ 'C (RATOM IFILE)) do) + (SETQ CCODE (READ IFILE)) + (RATOMS 'WX IFILE) + (SETQ CWIDTH (READ IFILE)) + [COND + ((CL:PLUSP CCODE) (* ; + "This character appears in the standard encoding, so just use the charcode.") + (COND + ((ILESSP CCODE FCHAR) + (SETQ FCHAR CCODE))) + (COND + ((IGREATERP CCODE LCHAR) + (SETQ LCHAR CCODE))) + (SETA W CCODE CWIDTH)) + (T (* ; "A character not in the standard encoding; look it up to see if it's one we need (eth & thorn are brought into the CS-0 codespace for UToronto's work).") + (repeatuntil (EQ 'N (RATOM IFILE)) do + + (* ;; + "Skip to the N entry, which gives the Adobe-standard name.") +) + (SETQ CNAME (RATOM IFILE)) + (* ; "GET THE NAME") + (SETQ CCODE (LISTGET *POSTSCRIPT-EXTRA-CHARACTERS* CNAME)) + (COND + (CCODE (COND + ((ILESSP CCODE FCHAR) + (SETQ FCHAR CCODE))) + (COND + ((IGREATERP CCODE LCHAR) + (SETQ LCHAR CCODE))) + (SETA W CCODE CWIDTH] + (repeatuntil (EQ (CHARCODE EOL) + (READCCODE IFILE)) do))) + (SETQ FIRSTCHAR FCHAR) + (SETQ LASTCHAR LCHAR)) + (CLOSEF IFILE) + PSCFONT]) + +(CONVERT-AFM-FILES + [LAMBDA (FILE-LIST) (* ; + "Edited 5-Aug-93 16:47 by sybalskY:MV:ENVOS") + (for FL in FILE-LIST do (LET ((FNAME (pop FL)) + FONT FILENAME) + (for AFM-FILE in FL as WEIGHT + in '(MEDIUM MEDIUM BOLD BOLD) as SLOPE + in '(REGULAR ITALIC REGULAR ITALIC) + do (SETQ FONT (READ-AFM-FILE AFM-FILE WEIGHT + SLOPE)) + (SETQ FILENAME (\FONTFILENAME + FNAME 1 (LIST WEIGHT SLOPE + 'REGULAR) + 'PSCFONT 0)) + (PSCFONT.WRITEFONT FILENAME FONT]) + +(POSTSCRIPT.GETFONTID + [LAMBDA (FID WEIGHT SLOPE EXPANSION) (* ; + "Edited 20-Nov-92 15:04 by sybalsky:mv:envos") + (LET (FONTID) + (SETQ FONTID (create FONTID + FONTIDNAME _ (CAR FID) + FONTXFACTOR _ 1.0 + FONTOBLIQUEFACTOR _ 0.0)) + [if (AND (NEQ (CADDR FID) + SLOPE) + (EQ SLOPE 'ITALIC)) + then (replace (FONTID FONTOBLIQUEFACTOR) of FONTID + with (CONSTANT (TAN 7.0] + (if (AND (NEQ (CADR FID) + WEIGHT) + (EQ WEIGHT 'BOLD)) + then (* ; "Fake bold by slight expansion.") + (replace (FONTID FONTXFACTOR) of FONTID with 1.1)) + [if (NEQ EXPANSION 'REGULAR) + then (replace (FONTID FONTXFACTOR) of FONTID + with (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (if (EQ EXPANSION 'COMPRESSED) + then (CONSTANT (QUOTIENT 1.0 GOLDEN.RATIO)) + else GOLDEN.RATIO] + FONTID]) + +(POSTSCRIPT.FONTCREATE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 29-Oct-93 16:39 by rmk:") + (* ; "Edited 3-Feb-93 17:22 by jds") + (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD + FACECHANGED (WEIGHT (CAR FACE)) + (SLOPE (CADR FACE)) + (EXPANSION (CADDR FACE))) + + (* ;; + "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") + + [COND + [(EQ SIZE 1) + + (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") + + (COND + ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + + (* ;; "Check in-core cache for exact match first") + + (SETQ FACECHANGED NIL)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + + (* ;; "Check file for exact match next") + + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED NIL)) + ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION + ROTATION DEVICE)) + + (* ;; "Then check cache for coerced match") + + (SETQ FACECHANGED T)) + ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION + DEVICE)) + + (* ;; "Check file for coerced match") + + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED T))) + (COND + (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) + 0.1))) + (COND + (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD + with (POSTSCRIPT.GETFONTID (fetch (PSCFONT + FID) + of PSCFD) + WEIGHT SLOPE EXPANSION] + ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) + (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) + 'PSCFONT)) + + (* ;; "Scale the ASCENT and DESCENT") + + (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) + 0.1))) + (SETQ SCALEFONTP T)) + (T + (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") + + (COND + ([SETQ PSCFD (COND + ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION + DEVICE)) + (PSCFONT.READFONT FULLNAME] + (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) + (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) + (SETQ SCALEFONTP NIL] + (COND + (PSCFD + (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") + + (SETQ FD + (create FONTDESCRIPTOR + OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) + FONTSCALE _ 100 + FONTDEVICE _ DEVICE + FONTFAMILY _ FAMILY + FONTSIZE _ SIZE + FONTFACE _ FACE + ROTATION _ 0 + \SFHeight _ (IPLUS ASCENT DESCENT) + \SFAscent _ ASCENT + \SFDescent _ DESCENT)) + (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO 0 FD))) + (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) + [COND + [SCALEFONTP (for CH from 0 to 255 + do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE + (ELT FIXPWIDTHS + CH) + 0.1] + (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH + (ELT FIXPWIDTHS CH] + (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) + + (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") + + (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH + (\FGETWIDTH WIDTHSBLOCK CH))) + [LET [(TMP (COND + (FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE)) + (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] + + (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") + + (COND + ((AND TMP (NEQ FAMILY (CAR TMP))) + (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) + SIZE + (COPY FACE) + 0 DEVICE] + [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION + DEVICE)) + (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD + ROTATION DEVICE))) + + (* ;; + "Now run thru the mapping table, filling in the new font from whatever source is specified:") + + [MAPHASH *POSTSCRIPT-NS-HASH* + (FUNCTION (LAMBDA (MAPPING CODE) + (DESTRUCTURING-BIND + (KIND CODE2 BASECHAR) + MAPPING + + (* ;; + "Depending on what kind of item it is, process it:") + + (SELECTQ KIND + (NIL + (* ;; + "Translating an NS character to a PSC char in CS 0.") + + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + (\CHAR8CODE + CODE2)))) + (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH + FD CODE (ELT SYMWIDTHS + (\CHAR8CODE + CODE2]) + (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH + FD CODE (ELT DINGWIDTHS + (\CHAR8CODE + CODE2]) + (FUNCTION + (* ;; + "This is fake and only works for the fractions. Need a better case.") + + [\FSETCHARWIDTH + FD CODE + (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) + (FIXR (FTIMES 1.3 + (\FGETWIDTH + PSCWIDTHSBLOCK + (CHARCODE 1]) + (ACCENT (* ; + "CODE2 is the rendering character but width comes from width of basechar") + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + BASECHAR))) + (ACCENTPAIR + + (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent") + + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + CODE2))) + (PROGN + + (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else") + + NIL] + + (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") + + (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) + (CL:WHEN (EQ (CAR MAPPING) + 'APPLY*) + (\FSETCHARWIDTH + FD CODE (APPLY* (CADDDR + MAPPING + ) + FD + (CADR MAPPING)) + ))] + FD) + (T NIL]) + +(\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS + [LAMBDA (TYPE FD ROTATION DEVICE) (* ; "Edited 5-Oct-93 18:21 by rmk:") + + (* ;; "Returns the scaled widths for a unit font of type TYPE (SYMBOL or ZAPFDINGBATS) compatible with FD. A separate function so that the unit widths can be easily cached.") + + (LET [TYPEFONT WIDTHS NEWWIDTHS (SIZE (FETCH FONTSIZE OF FD)) + (FONTFILE (OR (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR FONTFACE) + OF FD) + ROTATION DEVICE) + (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE] + [SETQ TYPEFONT (COND + ((PSCFONTFROMCACHE.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR + FONTFACE) + OF FD) + ROTATION DEVICE)) + ((SETQ FONTFILE (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR + FONTFACE) + OF FD) + ROTATION DEVICE)) + (PSCFONT.READFONT FONTFILE)) + ((PSCFONTFROMCACHE.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE)) + ((SETQ FONTFILE (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE)) + (PSCFONT.READFONT FONTFILE] + (CL:WHEN (AND TYPEFONT (SETQ WIDTHS (FETCH (PSCFONT WIDTHS) OF TYPEFONT))) + (SETQ NEWWIDTHS (ARRAY 256 'SMALLPOSP 0 0)) + + (* ;; "Have to copy because of scaling") + + [FOR CH FROM 0 TO 255 DO (SETA NEWWIDTHS CH + (FIXR (TIMES SIZE (ELT WIDTHS CH) + 0.1] + NEWWIDTHS)]) + +(POSTSCRIPT.FONTSAVAILABLE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 12-Jan-88 13:04 by Matt Heffron") + + (* ;; "the filtering code was borrowed from Richard Burton's \SEARCHINTERPRESSFONTS. Note that without it [HELVETICA * (MEDIUM REGULAR REGULAR)] would pick up [HELVETICA-NARROW * (MEDIUM REGULAR REGULAR)] as well.") + + (LET + ((PATTERN (\FONTFILENAME (OR (CDR (ASSOC FAMILY POSTSCRIPT.FONT.ALIST)) + FAMILY) + SIZE FACE 'PSCFONT)) + [INVERSE.ALIST (for PAIR in POSTSCRIPT.FONT.ALIST collect (CONS (CDR PAIR) + (CAR PAIR] + FONTSAVAILABLE) + (SETQ FONTSAVAILABLE + (for FD in [for DIRECTORY in POSTSCRIPTFONTDIRECTORIES + join (for FILE in (DIRECTORY (CONCAT DIRECTORY PATTERN)) + collect (LET* ((RAWFD (\FONTINFOFROMFILENAME FILE DEVICE) + ) + (RAWNAME (CAR RAWFD))) + (RPLACA RAWFD + (OR (CDR (ASSOC RAWNAME + INVERSE.ALIST)) + RAWNAME] + when (AND (OR (EQ FAMILY '*) + (EQ FAMILY (CAR FD))) + (OR (EQ SIZE '*) + (EQ SIZE (CADR FD)) + (EQ (CADR FD) + 1)) + (OR (EQ FACE '*) + (EQUAL FACE (CADDR FD)) + (EQUAL [CDR (ASSOC FACE '((MRR MEDIUM REGULAR REGULAR) + (STANDARD MEDIUM REGULAR REGULAR) + (MIR MEDIUM ITALIC REGULAR) + (ITALIC MEDIUM ITALIC REGULAR) + (BRR BOLD REGULAR REGULAR) + (BOLD BOLD REGULAR REGULAR) + (BIR BOLD ITALIC REGULAR) + (BOLDITALIC BOLD ITALIC REGULAR] + (CADDR FD))) + (NOT (MEMBER FD $$VAL))) collect FD)) + (if (EQ SIZE '*) + then + +(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)") + + (for FD in FONTSAVAILABLE + join (if (EQ 1 (CADR FD)) + then (CONS FD (for NF + in (for S from 2 to + \POSTSCRIPT.MAX.WILD.FONTSIZE + collect (LET ((NFD (COPY FD))) + (RPLACA (CDR NFD) + S) + NFD)) + unless (MEMBER NF FONTSAVAILABLE) collect + NF)) + else (LIST FD))) + else FONTSAVAILABLE]) +) + + + +(* ;; "Until macro in FONT is exported") + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) + (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) + of (\GETCHARSETINFO (\CHARSET CHARCODE) + FONTDESC)) + (\CHAR8CODE CHARCODE) + WIDTH))) +) +(DEFINEQ + +(OPENPOSTSCRIPTSTREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") + (* ; + "Edited 31-May-93 12:42 by sybalsky:mv:envos") + (* ; "Edited 23-Dec-92 01:17 by jds") + + (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") + + (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) + 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) + (SEQUENTIAL T] + (IMAGEDATA (create \POSTSCRIPTDATA)) + PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX] + (replace (STREAM IMAGEDATA) of STREAM with IMAGEDATA) + (replace (STREAM IMAGEOPS) of STREAM with \POSTSCRIPTIMAGEOPS) + (replace (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION BOUT)) + + (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") + + (printout STREAM "%%!PS-Adobe-2.0" T %# (CL:WHEN BBOX + (PRINTOUT STREAM "%%%%BoundingBox: " + (CL:FLOOR (CAR BBOX) + \PS.SCALE0) + " " + (CL:FLOOR (CADR BBOX) + \PS.SCALE0) + " " + (CL:CEILING (CADDR BBOX) + \PS.SCALE0) + " " + (CL:CEILING (CADDDR BBOX) + \PS.SCALE0) + T)) + "%%%%Title: " + (MKSTRING (OR (LISTGET OPTIONS 'DOCUMENT.NAME) + FILE)) + T "%%%%Creator: PostScript Driver Copyright (C) 1988-1992 Venue and others" T + "%%%%CreationDate: " (DATE) + T %# (COND + ((EQ 'LPT (FILENAMEFIELD STREAM 'HOST)) + + (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") + + (PRINTOUT NIL "%%%%For: " (MKSTRING USERNAME) + T))) + "%%%%EndComments" T) + (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR STREAM X) + (\BOUTEOL STREAM)) + (SETQ PAPER (OR (CDR (CL:ASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE) + (LISTGET OPTIONS 'PAPERTYPE) + POSTSCRIPT.PAGETYPE)) + POSTSCRIPT.PAGEREGIONS :TEST #'STRING-EQUAL)) + (ERROR "Unknown PostScript page type" PAPER))) + + (* ;; "Set the paper size:") + + (PRINTOUT STREAM (L-CASE (OR (LISTGET OPTIONS 'PAGETYPE) + (LISTGET OPTIONS 'PAPERTYPE) + POSTSCRIPT.PAGETYPE)) + T) + (COND + ((NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR] + (CL:PLUSP IMAGESIZEFACTOR))) + (SETQ IMAGESIZEFACTOR 1))) + [COND + ((AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR) + (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR)) + (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR] + (printout STREAM "/imagesizefactor " IMAGESIZEFACTOR " def" T) + (printout STREAM "%%%%EndSetup" T) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with \PS.SCALE0) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA + with (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) + IMAGESIZEFACTOR) + (CAR PAPER))) + + (* ;; + "Initial clipping region can be specified separately from the page size, default is to page size.") + + [replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA + with (SETQ CLIP (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) + IMAGESIZEFACTOR) + (OR (CADR PAPER) + (CAR PAPER] + + (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") + + (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) + (INTERSECTREGIONS REG CLIP)) + (CREATEREGION 3600 3600 54000 72000))) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with (fetch (REGION LEFT) of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA + with (fetch (REGION BOTTOM) of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA + with (PLUS (fetch (REGION BOTTOM) of REG) + (fetch (REGION HEIGHT) of REG) + -1)) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with (PLUS (fetch (REGION LEFT) of REG) + (fetch (REGION WIDTH) of REG) + -1)) + (\DSPFONT.PSC STREAM (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS] + DEFAULTFONT) + NIL NIL NIL STREAM)) + (\SWITCHFONTS.PSC STREAM IMAGEDATA) + [COND + ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA + with (LISTGET OPTIONS 'HEADING)) + (replace (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) of IMAGEDATA + with (COND + ((LISTGET OPTIONS 'HEADINGFONT) + (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) + NIL NIL NIL STREAM)) + (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] + + (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") + + (COND + ([COND + ((CL:GETF OPTIONS 'LANDSCAPE NIL)) + ((EQL (CL:GETF OPTIONS 'ROTATION 'DEFAULT) + 'DEFAULT) + (COND + ((EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + (MENU \POSTSCRIPT.ORIENTATION.MENU)) + (T POSTSCRIPT.PREFER.LANDSCAPE))) + (T (CL:GETF OPTIONS 'ROTATION] + (POSTSCRIPT.SET-FAKE-LANDSCAPE STREAM 90))) + + (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") + + (\EXTERNALFORMAT STREAM (CREATE EXTERNALFORMAT + NAME _ 'POSTSCRIPT + OUTCHARFN _ (FUNCTION \POSTSCRIPT.OUTCHARFN) + EOL _ (FETCH (STREAM EOLCONVENTION) OF STREAM))) + (POSTSCRIPT.STARTPAGE STREAM) + STREAM]) + +(CLOSEPOSTSCRIPTSTREAM + [LAMBDA (STREAM) (* ; "Edited 8-Mar-93 10:31 by jds") + (POSTSCRIPT.ENDPAGE STREAM) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL) + (* BOUT STREAM (CHARCODE ^D)) + ]) +) + +(RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) +(DEFINEQ + +(POSTSCRIPT.HARDCOPYW + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (ALLOW.BUTTON.EVENTS) + (LET* ((STREAM (OPENPOSTSCRIPTSTREAM FILE (LIST 'DOCUMENT.NAME TITLE 'ROTATION Landscape? + 'IMAGESIZEFACTOR SCALEFACTOR))) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (SCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) + SCALE) + [COND + [REGION (SETQ REGION (COPY REGION)) (* ; "In case we need to change it.") + [COND + ((< (fetch BITMAPWIDTH of BITMAP) + (+ (fetch (REGION LEFT) of REGION) + (fetch (REGION WIDTH) of REGION))) + (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH + of BITMAP) + (fetch (REGION + LEFT) + of REGION] + (COND + ((< (fetch BITMAPHEIGHT of BITMAP) + (+ (fetch (REGION BOTTOM) of REGION) + (fetch (REGION HEIGHT) of REGION))) + (replace (REGION HEIGHT) of REGION + with (- (fetch BITMAPHEIGHT of BITMAP) + (fetch (REGION BOTTOM) of REGION] + (T (SETQ REGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch BITMAPWIDTH of BITMAP) + HEIGHT _ (fetch BITMAPHEIGHT of BITMAP] + (SETQ SCALE (TIMES POSTSCRIPT.BITMAP.SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) + of IMAGEDATA))) + (BITBLT BITMAP (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + STREAM + (PLUS (fetch (REGION LEFT) of SCLIP) + (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of SCLIP) + (TIMES SCALE (fetch (REGION WIDTH) of REGION))) + 2)) + (PLUS (fetch (REGION BOTTOM) of SCLIP) + (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of SCLIP) + (TIMES SCALE (fetch (REGION HEIGHT) of REGION))) + 2)) + (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + 'INPUT + 'REPLACE) + (CLOSEF STREAM) + (FULLNAME STREAM]) + +(POSTSCRIPT.TEDIT + [LAMBDA (FILE PFILE) (* ; "Edited 18-Sep-91 18:16 by jds") + + (* ;; "Make a PS file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.") + + [COND + ((STRINGP FILE) + (SETQ FILE (MKATOM FILE] + (SETQ FILE (OPENTEXTSTREAM FILE)) + (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT) + (CLOSEF? FILE) + PFILE]) + +(POSTSCRIPT.TEXT + [LAMBDA (FILE PSCFILE FONTS HEADING TABS) (* ; "Edited 23-Apr-89 11:31 by TAL") + (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS + `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE]) + +(POSTSCRIPTFILEP + [LAMBDA (FILE) (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PS" "PSC" "PSF") + :TEST + (FUNCTION STRING-EQUAL)) + (PROGN (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE !))) + (SETFILEPTR FILE 0]) + +(MAKEEPSFILE + [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Apr-94 14:48 by rmk:") + + (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") + + (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT)) + (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) + IMAGEOBJ STREAM)) + (BOUNDINGBOX (LIST 0 0 (FETCH XSIZE OF IMAGEBOX) + (FETCH YSIZE OF IMAGEBOX] + [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT + `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) + ,(FETCH YSIZE OF IMAGEBOX] + (MOVETO (FETCH XKERN OF IMAGEBOX) + (FETCH YDESC OF IMAGEBOX) + STREAM) + (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) + IMAGEOBJ STREAM) + (CLOSEF STREAM]) +) +(DEFINEQ + +(POSTSCRIPT.BITMAPSCALE + [LAMBDA (WIDTH HEIGHT) (* ; "Edited 29-Apr-98 08:46 by rmk:") + (* ; + "Edited 20-Nov-92 14:52 by sybalsky:mv:envos") + (LET* ([PAGEREGION (\PS.SCALEREGION (/ 72 POSTSCRIPT.BITMAP.SCALE) + (CADR (FASSOC POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS] + (LONGEDGE (MAX (fetch (REGION WIDTH) of PAGEREGION) + (fetch (REGION HEIGHT) of PAGEREGION))) + (SHORTEDGE (MIN (fetch (REGION WIDTH) of PAGEREGION) + (fetch (REGION HEIGHT) of PAGEREGION))) + [MINDIMP (MIN (FQUOTIENT LONGEDGE (SETQ HEIGHT (TIMES HEIGHT POSTSCRIPT.BITMAP.SCALE))) + (FQUOTIENT SHORTEDGE (SETQ WIDTH (TIMES WIDTH POSTSCRIPT.BITMAP.SCALE] + (MINDIML (MIN (FQUOTIENT SHORTEDGE HEIGHT) + (FQUOTIENT LONGEDGE WIDTH))) + (PPL (if (EQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + then (MENU \POSTSCRIPT.ORIENTATION.MENU) + else POSTSCRIPT.PREFER.LANDSCAPE)) + MINDIM OTHERDIM SF1 SF2) + (if PPL + then (SETQ MINDIM MINDIML) + (SETQ OTHERDIM MINDIMP) + else (SETQ MINDIM MINDIMP) + (SETQ OTHERDIM MINDIML)) + (SETQ SF1 (if (GREATERP MINDIM 1) + then 1 + elseif (GREATERP MINDIM 0.75) + then 0.75 + elseif (GREATERP MINDIM 0.5) + then 0.5 + elseif (GREATERP MINDIM 0.25) + then 0.25 + else MINDIM)) + (SETQ SF2 (if (GREATERP OTHERDIM 1) + then 1 + elseif (GREATERP OTHERDIM 0.75) + then 0.75 + elseif (GREATERP OTHERDIM 0.5) + then 0.5 + elseif (GREATERP OTHERDIM 0.25) + then 0.25 + else OTHERDIM)) + (if (AND (LESSP SF1 1) + (LESSP SF1 SF2)) + then (CONS SF2 (NOT PPL)) + else (CONS SF1 PPL]) + +(POSTSCRIPT.CLOSESTRING + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM ") ") + (replace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL) + T) + (T NIL]) + +(POSTSCRIPT.ENDPAGE + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) + (COND + ((NOT (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA) + (POSTSCRIPT.PUTCOMMAND STREAM "grestore savepage restore "))) + (POSTSCRIPT.PUTCOMMAND STREAM "showpage" :EOL))) + + (* ;; +"Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of IMAGEDATA with NIL]) + +(POSTSCRIPT.OUTSTR + [LAMBDA (STREAM X) (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") + (DECLARE (LOCALVARS . T)) + (COND + ((FIXP X) (* ; "Common case, speed helps") + (\PS.BOUTFIXP STREAM X)) + [(STRINGP X) (* ; "Other common case") + (COND + [(ffetch (STRINGP FATSTRINGP) of X) + (for c infatstring X do (BOUT STREAM (\CHAR8CODE c] + (T (\BOUTS STREAM (ffetch (STRINGP BASE) of X) + (ffetch (STRINGP OFFST) of X) + (ffetch (STRINGP LENGTH) of X] + [(LITATOM X) + (for c inatom X do (BOUT STREAM (\CHAR8CODE c] + ((ZEROP X) + (BOUT STREAM (CHARCODE 0))) + (T [COND + ((TYPEP X 'RATIO) + (SETQ X (FLOAT X] + (for c in (CHCON X) do (BOUT STREAM (\CHAR8CODE c]) + +(POSTSCRIPT.PUTBITMAPBYTES + [LAMBDA (STREAM BITMAP DELIMFLG) + (DECLARE (GLOBALVARS PS.BITMAPARRAY) + (LOCALVARS . T)) (* ; "Edited 12-Jun-2021 15:17 by rmk:") + (LET* + ((WIDTH (fetch BITMAPWIDTH of BITMAP)) + (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) + (BMBASE (fetch BITMAPBASE of BITMAP)) + (BYTESPERROW (LRSH (IPLUS WIDTH 7) + 3)) + (BYTEOFFSETPERROW (LSH (fetch BITMAPRASTERWIDTH of BITMAP) + 1)) + (PS.BITMAPARRAYBASE (fetch (ARRAYP BASE) of PS.BITMAPARRAY))) + (COND + (DELIMFLG (LET ((POS 0) + BYTE) + (BOUT STREAM (CHARCODE SPACE)) + (BOUT STREAM (CHARCODE <)) + (\BOUTEOL STREAM) + (for R from (SUB1 HEIGHT) to 0 by -1 as ROWOFFSET + from (ITIMES (SUB1 HEIGHT) + BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) + do (for B from 1 to BYTESPERROW as BYTEOFFSET + from ROWOFFSET by 1 + do (COND + ((IGEQ POS 254) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 BYTE))) + (SETQ POS (IPLUS POS 2))) + (\BOUTEOL STREAM) + (SETQ POS 0)) + (BOUT STREAM (CHARCODE SPACE)) + (BOUT STREAM (CHARCODE >)) + (\BOUTEOL STREAM))) + (T + (LET* + ((PRVBM (BITMAPCREATE WIDTH 1)) + (PRVBASE (fetch BITMAPBASE of PRVBM))) + (for R from 0 to (SUB1 HEIGHT) as ROWOFFSET + from (ITIMES (SUB1 HEIGHT) + BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) + do + (LET ((POS 0) + (BYTEOFFSET ROWOFFSET) + (B 1) + (PRVO 0) + BYTE REPC) + [while (ILEQ B BYTESPERROW) + do (SETQ REPC + (for BB from B to BYTESPERROW as BO from BYTEOFFSET + by 1 as PO from PRVO by 1 + while (EQ (\GETBASEBYTE BMBASE BO) + (\GETBASEBYTE PRVBASE PO)) count T)) + (COND + [(IGEQ REPC 3) + (SETQ B (IPLUS B REPC)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) + (SETQ PRVO (IPLUS PRVO REPC)) + (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) + do (COND + ((IGEQ POS 251) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 3)) + [COND + ((IGEQ REPC 256) + (BOUT STREAM (CHARCODE F)) + (BOUT STREAM (CHARCODE F))) + (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH REPC 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 REPC] + (SETQ REPC (IDIFFERENCE REPC 256)) + (SETQ POS (IPLUS POS 4] + (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + (SETQ REPC + (for BB from B to BYTESPERROW as BO from + BYTEOFFSET + by 1 while (EQ (\GETBASEBYTE BMBASE BO) + BYTE) count T)) + (COND + [(IGEQ REPC 3) + (SETQ B (IPLUS B REPC)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) + (SETQ PRVO (IPLUS PRVO REPC)) + (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) + do (COND + ((IGEQ POS 249) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 2)) + [COND + ((IGEQ REPC 256) + (BOUT STREAM (CHARCODE F)) + (BOUT STREAM (CHARCODE F))) + (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH REPC 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 REPC] + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 BYTE))) + (SETQ REPC (IDIFFERENCE REPC 256)) + (SETQ POS (IPLUS POS 4] + (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + (COND + ((IGEQ POS 251) + (\BOUTEOL STREAM) + (SETQ POS 0))) + [COND + ((FMEMB BYTE '(178 179 180)) + + (* ;; "BYTE is B2, B3, or B4; quote it") + + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 4)) + (SETQ POS (IPLUS POS 2] + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE (LOGAND 15 BYTE) + )) + (SETQ B (IPLUS B 1)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET 1)) + (SETQ PRVO (IPLUS PRVO 1)) + (SETQ POS (IPLUS POS 2] + (\BOUTEOL STREAM)) + (\MOVEBYTES BMBASE ROWOFFSET PRVBASE 0 BYTESPERROW]) + +(POSTSCRIPT.PUTCOMMAND + [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") + (LET* ((STREAM (ARG S.STRS 1)) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + S#S) + (freplace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with NIL) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (POSTSCRIPT.SHOWACCUM STREAM))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (for STR# from 2 to S.STRS do (COND + ((EQ (SETQ S#S (ARG S.STRS STR#)) + :EOL) + (\BOUTEOL STREAM)) + (T (POSTSCRIPT.OUTSTR STREAM S#S]) + +(POSTSCRIPT.SET-FAKE-LANDSCAPE + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + + (* ;; "Set up for (or disable) fake landscaping") + + (* ;; + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLAND (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + 90) + (T 0))) + LAND C0 P0 C P ML MB MR MT) + (COND + ((AND ROTATION (NEQ (SETQ LAND (NOT (ZEROP ROTATION))) + (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\DSPTRANSLATE.PSC STREAM 0 0) + (SETQ C0 (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) + (SETQ P0 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) + (SETQ C (create REGION + WIDTH _ (fetch (REGION HEIGHT) of C0) + HEIGHT _ (fetch (REGION WIDTH) of C0))) + (SETQ P (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch (REGION HEIGHT) of P0) + HEIGHT _ (fetch (REGION WIDTH) of P0))) + [COND + (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) + of C0)) + [replace (REGION BOTTOM) of C with + (- (fetch (REGION WIDTH) + of P0) + (+ (fetch (REGION LEFT) + of C0) + (fetch (REGION WIDTH) + of C0] + (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + ) + (SETQ MB (- (fetch (REGION WIDTH) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of + IMAGEDATA + ) + 1)) + (SETQ MR (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA)) + (SETQ MT (- (fetch (REGION WIDTH) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + ) + 1))) + (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) + of P0) + (+ (fetch (REGION BOTTOM) + of C0) + (fetch (REGION HEIGHT) + of C0] + (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) + of C0)) + (SETQ ML (- (fetch (REGION HEIGHT) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + 1)) + (SETQ MB (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA)) + (SETQ MR (- (fetch (REGION HEIGHT) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + 1)) + (SETQ MT (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA] + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with + C) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with P) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with ML) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with MB) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with MR) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with MT) + (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA with LAND) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\DSPRESET.PSC STREAM))) + OLAND]) + +(POSTSCRIPT.SHOWACCUM + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") + + (* ;; + "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") + + (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") + + (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") + + (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") + + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM)) + KERN) + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (SETQ KERN (STREAMPROP STREAM 'KERN)) + [COND + [(EQP (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA) + 1) + (COND + (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT ") " KERN " 0 3 -1 roll ashow"))) + (T (POSTSCRIPT.OUTSTR STREAM ") S"] + (T (POSTSCRIPT.OUTSTR STREAM ") ") + (POSTSCRIPT.OUTSTR STREAM (DIFFERENCE (ffetch (\POSTSCRIPTDATA + POSTSCRIPTSPACEWIDTH) + of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA + POSTSCRIPTNATURALSPACEWIDTH + ) of IMAGEDATA))) + (COND + (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT " 0 " (CHARCODE SPACE) + " " KERN " 0 " + " 6 -1 roll awidthshow"))) + (T (POSTSCRIPT.OUTSTR STREAM (CONSTANT (CONCAT " 0 " (CHARCODE SPACE) + " 4 -1 roll widthshow"] + (\BOUTEOL STREAM) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL]) + +(POSTSCRIPT.STARTPAGE + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") + + (* ;; "Start up a new page in a Postscript document.") + + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + NEW-PAGE) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) + (* ; "shouldnt need this") + (SETQ NEW-PAGE (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGENUM) of IMAGEDATA))) + (* ; "Page number goes up by 1") + + (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") + + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Page: " NEW-PAGE " " NEW-PAGE :EOL + "%%%%BeginPageSetup" :EOL "/savepage save def" :EOL (FQUOTIENT 1 \PS.SCALE0) + " imagesizefactor mul dup scale" :EOL "%%%%EndPageSetup" :EOL) + (\SETXFORM.PSC STREAM IMAGEDATA T) + + (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with T) + (* ; "nothing printed yet...") + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA) + + (* ;; "Here we handle headings.") + + (LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) + of IMAGEDATA] + (\DSPRESET.PSC STREAM) + (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) + of IMAGEDATA)) + (RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0)) + 0 STREAM) (* ; "Skip an inch before page number") + (POSTSCRIPT.OUTSTR STREAM "Page ") + (POSTSCRIPT.OUTSTR STREAM NEW-PAGE) + (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") + (\TERPRI.PSC STREAM) + (\DSPFONT.PSC STREAM FONT))) + (T (\DSPRESET.PSC STREAM]) + +(\POSTSCRIPTTAB + [LAMBDA (POSTSCRIPTDATA) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of POSTSCRIPTDATA] + (IDIFFERENCE TABSPACE (IREMAINDER (IDIFFERENCE (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of POSTSCRIPTDATA) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) + of POSTSCRIPTDATA)) + TABSPACE]) + +(\PS.BOUTFIXP + [LAMBDA (STREAM N) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + + (* ;; "BOUT the decimal representation of N to STREAM using temp storage from the imagedata. Done this way for speed.") + + (DECLARE (LOCALVARS . T)) + [COND + ((MINUSP N) + (BOUT STREAM (CHARCODE -)) + (SETQ N (IMINUS N] + (COND + [(LESSP N 10) + (BOUT STREAM (IPLUS N (CHARCODE 0] + [(LESSP N 1000000000) + (LET ([BASE (fetch (ARRAYP BASE) of (fetch (\POSTSCRIPTDATA POSTSCRIPTTEMPARRAY) + of (fetch (STREAM IMAGEDATA) + of STREAM] + (i (SUB1 \PS.TEMPARRAYLEN))) + [for old i by -1 do (\PUTBASEBYTE BASE i (IPLUS (IREMAINDER N 10) + (CHARCODE 0))) + repeatwhile (NEQ 0 (SETQ N (IQUOTIENT N 10] + (\BOUTS STREAM BASE i (IDIFFERENCE \PS.TEMPARRAYLEN i] + (T (* ; "Just in case we get a bignum") + (for c in (CHCON N) do (BOUT STREAM (\CHAR8CODE c]) + +(\PS.SCALEHACK + [LAMBDA (STREAM SCALEFACTOR) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA)) + FACTOR) + (COND + ((AND (NUMBERP SCALEFACTOR) + (NOT (EQP OLDSCALE SCALEFACTOR))) + (POSTSCRIPT.SHOWACCUM STREAM) + (SETQ FACTOR (/ OLDSCALE SCALEFACTOR)) + [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) + of IMAGEDATA)) + do (change (fetch (REGION LEFT) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION BOTTOM) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION WIDTH) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION HEIGHT) of REG) + (FIXR (CL:* DATUM FACTOR] + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with + SCALEFACTOR) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T))) + OLDSCALE]) + +(\PS.SCALEREGION + [LAMBDA (SCALE REGION) (* ; "Edited 5-Apr-89 16:15 by TAL") + (* ; "Scales a region") + (create REGION + LEFT _ (FIXR (TIMES SCALE (fetch (REGION LEFT) of REGION))) + BOTTOM _ (FIXR (TIMES SCALE (fetch (REGION BOTTOM) of REGION))) + WIDTH _ (FIXR (TIMES SCALE (fetch (REGION WIDTH) of REGION))) + HEIGHT _ (FIXR (TIMES SCALE (fetch (REGION HEIGHT) of REGION]) + +(\SCALEDBITBLT.PSC + [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT + SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM + SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") + (* ; "Edited 8-May-2018 15:05 by rmk:") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") + + (OR (NUMBERP SCALE) + (SETQ SCALE 1)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (SCALE1 (TIMES SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA))) + (SCALE2 (TIMES SCALE1 (OR (NUMBERP POSTSCRIPT.BITMAP.SCALE) + 1))) + DESTREGION + (BITMAPWIDTH (fetch BITMAPWIDTH of SOURCEBITMAP)) + (BITMAPHEIGHT (fetch BITMAPHEIGHT of SOURCEBITMAP)) + TEMPBM) + [COND + ((NULL DESTINATIONLEFT) + (SETQ DESTINATIONLEFT (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA] + [COND + ((NULL DESTINATIONBOTTOM) + (SETQ DESTINATIONBOTTOM (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] + (COND + ((OR (NULL WIDTH) + (NULL HEIGHT)) + (SETQ WIDTH BITMAPWIDTH) + (SETQ HEIGHT BITMAPHEIGHT))) + (COND + ((GREATERP WIDTH BITMAPWIDTH) + (SETQ WIDTH BITMAPWIDTH))) + (COND + ((GREATERP HEIGHT BITMAPHEIGHT) + (SETQ HEIGHT BITMAPHEIGHT))) + [SETQ DESTREGION (INTERSECTREGIONS (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM (TIMES SCALE1 WIDTH + ) + (TIMES SCALE1 HEIGHT] + (COND + ((AND DESTREGION (OR (NULL CLIPPINGREGION) + (REGIONSINTERSECTP DESTREGION CLIPPINGREGION))) + [COND + ((AND (EQ SOURCELEFT 0) + (EQ SOURCEBOTTOM 0) + (EQP WIDTH BITMAPWIDTH) + (EQP HEIGHT BITMAPHEIGHT)) (* ; + "Avoid copy if sending entire bitmap") + (SETQ TEMPBM SOURCEBITMAP)) + (T (SETQ TEMPBM (BITMAPCREATE WIDTH HEIGHT 1)) + (BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM TEMPBM 0 0 WIDTH HEIGHT SOURCETYPE + 'REPLACE] + (POSTSCRIPT.PUTCOMMAND STREAM "/bitbltsave save def " DESTINATIONLEFT " " + DESTINATIONBOTTOM " translate " (TIMES SCALE2 WIDTH) + " " + (TIMES SCALE2 HEIGHT) + " scale " WIDTH " " HEIGHT (COND + ((EQ OPERATION 'PAINT) + " true") + (T + (* ;; + "RMK: For REPLACE, was %"false%", but then white was black.") + + " true")) + " thebitimage" :EOL) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEMPBM NIL) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "bitbltsave restore" :EOL) + (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) + T) + (T NIL]) + +(\SETPOS.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + " " + (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + " M ") + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) + +(\SETXFORM.PSC +(LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") (* ;; "Write transforms into the PS file to make what it prints match what we think it should print.") (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) (COND ((NOT NORESTORE) (POSTSCRIPT.OUTSTR STREAM "grestore "))) (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) (* ;; "Scaling") (COND ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) 1)) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) " dup scale" :EOL))) (* ;; "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) (* ;; "Any rotation that is in effect.") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) " rotate " :EOL) (* ;; "Any translations that are in effect.") (COND ((NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA)))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) " " (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) " translate" :EOL))) (* ;; "Clipping region:") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) " " (fetch (REGION WIDTH) of CLIP) " " (fetch (REGION LEFT) of CLIP) " " (fetch (REGION BOTTOM) of CLIP) " CLP" :EOL) (* ;; "And force recaching of location and font.") (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) +) + +(\STRINGWIDTH.PSC + [LAMBDA (STREAM STR RDTBL) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) + (\STRINGWIDTH.GENERIC STR (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) + RDTBL + (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA]) + +(\SWITCHFONTS.PSC + [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") + (* ; "Edited 11-May-93 02:11 by jds") + + (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") + + (LET* [(FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of POSTSCRIPTDATA)) + (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR + OTHERDEVICEFONTPROPS + ) of FONT) + 'PSCFONT] + [COND + [(LISTP FONTID) + [COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of POSTSCRIPTDATA))) + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*)) + (T + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + + (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of + FONTID) + " /" + (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) + "-Acnt") + " encodefont" :EOL) + (CL:PUSH (fetch (FONTID FONTIDNAME) of FONTID) + (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF POSTSCRIPTDATA] + (COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*) + (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA + WITH NIL) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) + " findfont [" + (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 " + (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " " + (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 0] makefont setfont" :EOL)) + (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA + WITH T) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) + of FONTID) + "-Acnt") + " findfont [" + (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 " + (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " " + (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 0] makefont setfont" :EOL] + (T [COND + ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of + POSTSCRIPTDATA + ))) + ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*)) + (T + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + + (POSTSCRIPT.PUTCOMMAND STREAM "/" FONTID " /" (CONCAT FONTID "-Acnt") + " encodefont" :EOL) + (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF + POSTSCRIPTDATA + ] + (COND + ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*) + (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA + with NIL) + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) + of FONT) + 100) + " /" FONTID " F" :EOL)) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA + with T) + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) + of FONT) + 100) + " /" + (CONCAT FONTID "-Acnt") + " F" :EOL] + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with + NIL]) + +(\TERPRI.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (NEWY (PLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of IMAGEDATA] + (COND + ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of + IMAGEDATA + ) + (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch + (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] + (DSPNEWPAGE STREAM)) + (T (replace (STREAM CHARPOSITION) of STREAM with 0) + (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) + of IMAGEDATA) + NEWY))) + NIL]) +) + + + +(* ;; "DIG operations: ") + +(DEFINEQ + +(\BITBLT.PSC + [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT + SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM) + (* ; "Edited 7-Apr-89 19:53 by TAL") + (\SCALEDBITBLT.PSC SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT + DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION + CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM 1]) + +(\BLTSHADE.PSC + [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "Maybe we should do something with OPERATION") + + (LET ((RGN (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT)) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + TEXTUREBM TEXTUREWIDTH LEFT BOTTOM WIDTH HEIGHT) + [COND + [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch ( + \POSTSCRIPTDATA + + POSTSCRIPTCLIPPINGREGION + ) of + IMAGEDATA] + (T (SETQ RGN (INTERSECTREGIONS RGN (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA] + (COND + (RGN (SETQ LEFT (fetch (REGION LEFT) of RGN)) + (SETQ BOTTOM (fetch (REGION BOTTOM) of RGN)) + (SETQ WIDTH (CL:1- (fetch (REGION WIDTH) of RGN))) + (SETQ HEIGHT (CL:1- (fetch (REGION HEIGHT) of RGN))) + [COND + ((FIXP TEXTURE) + (SETQ TEXTURE (SELECT TEXTURE ((BLACKSHADE -1) + 0.0) + (WHITESHADE 1.0) + TEXTURE] + [COND + ((AND (FLOATP TEXTURE) + (<= 0.0 TEXTURE 1.0)) + (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " + TEXTURE " R" :EOL)) + ((OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM)) + ((BITMAPP TEXTURE) + (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE] + (COND + (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") + (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) + " " + (QUOTIENT BOTTOM 100.0) + " M " + (SETQ WIDTH (QUOTIENT WIDTH 100.0)) + " 0 rlineto 0 " + (QUOTIENT HEIGHT 100.0) + " rlineto " + (MINUS WIDTH) + " 0 rlineto closepath" :EOL) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " + (LSH (fetch BITMAPRASTERWIDTH of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" + :EOL))) + (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) + T) + (T NIL]) + +(\CHARWIDTH.PSC + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") + (COND + ((EQ CHARCODE (CHARCODE SPACE)) + (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) + of STREAM))) + ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM + IMAGEDATA + ) + of STREAM)) + CHARCODE]) + +(\CREATECHARSET.PSC + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?) + (* ; "Edited 8-May-93 22:55 by rmk:") + (LET* ((CSINFO (CREATE CHARSETINFO + OFFSETS _ NIL)) + (WIDTHS (FETCH (CHARSETINFO WIDTHS) OF CSINFO))) + (REPLACE (CHARSETINFO IMAGEWIDTHS) OF CSINFO WITH WIDTHS) + + (* ;; "Make imagewidths point to widths. Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc. But...") + + (CL:UNLESS (EQ CHARSET 0) + + (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width. We know that the AVGCHARWIDTH field of the FONTDESC will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in. However, we do know that charset 0 is all set up before any other characters are dealt with.") + + (FOR I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A) + FONTDESC)) FROM 0 TO 255 + FIRST (CL:WHEN (EQ 0 AVGCHARWIDTH) + + (* ;; + "This is what \AVGCHARWIDTH in FONT does, but we don't have it here. Just to be extremely safe.") + + [SETQ AVGCHARWIDTH (MAX 1 (FIXR (FTIMES 0.6 (FONTPROP FONTDESC + 'HEIGHT]) + DO (\FSETWIDTH WIDTHS I AVGCHARWIDTH))) + CSINFO]) + +(\DRAWARC.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWARC.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH big trouble!") + (printout T T + "[In \DRAWARC.PSC: Functional BRUSH not supported.] +[Using ROUND 1 point BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) + (* ; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + )) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) + " arc stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWCIRCLE.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWCIRCLE.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH big trouble!") + (printout T T + "[In \DRAWCIRCLE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) + (* ; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + )) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWCURVE.PSC + [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH SHAPE COLOR PSPLINE XA YA DXA DYA N PREVX PREVY PREV-DX3 PREV-DY3) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH) + (SETQ SHAPE 'ROUND)) + ((LISTP BRUSH) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T + (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") + + (printout T T + "[In \DRAWCURVE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + (SETQ SHAPE 'ROUND] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + + (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") + + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (SETQ PSPLINE (PARAMETRICSPLINE KNOTS CLOSED NIL)) + (SETQ N (pop PSPLINE)) + (SETQ XA (pop PSPLINE)) + (SETQ YA (pop PSPLINE)) + (SETQ DXA (pop PSPLINE)) + (SETQ DYA (pop PSPLINE)) + (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") + WIDTH " setlinewidth " (SETQ PREVX (ELT XA 1)) + " " + (SETQ PREVY (ELT YA 1)) + " M" :EOL) + (SETQ PREV-DX3 (FQUOTIENT (ELT DXA 1) + 3.0)) + (SETQ PREV-DY3 (FQUOTIENT (ELT DYA 1) + 3.0)) + (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND + STREAM + (FPLUS PREVX PREV-DX3) + " " + (FPLUS PREVY PREV-DY3) + " " + (FDIFFERENCE (SETQ PREVX (ELT XA C)) + (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) + 3.0))) + " " + (FDIFFERENCE (SETQ PREVY (ELT YA C)) + (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) + 3.0))) + " " PREVX " " PREVY " curveto" :EOL)) + (POSTSCRIPT.PUTCOMMAND STREAM "stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM PREVX PREVY)) + NIL]) + +(\DRAWELLIPSE.PSC + [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWELLIPSE.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH, big trouble!") + (printout T T + "[In \DRAWELLIPSE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION + " 0 360 ellipse stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWLINE.PSC + [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "DRAWLINE method for postscript streams.") + + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + [COND + ((NOT (NUMBERP WIDTH)) + + (* ;; "The WIDTH = NIL should have been handled before here, but just in case!") + + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + [COND + ((NOT (ZEROP WIDTH)) + (COND + ((LESSP X2 X1) + + (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") + + (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) + ((NOT (OR (FLOATP COLOR) + (LISTP DASHING))) (* ; "Simple case, no dash or gray") + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) + (T (* ; + "COLOR is interpreted as gray factor") + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " + (OR (FLOATP COLOR) + "0") + " [") + (for D in (LISTP DASHING) do + + (* ;; + "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") + + (POSTSCRIPT.PUTCOMMAND STREAM + (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] + (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) + (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) + +(\DRAWPOINT.PSC + [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") + + (* ;; "draw a point on the stream ") + + (if (BITMAPP BRUSH) + then (LET ((WIDTH (fetch BITMAPWIDTH of BRUSH)) + (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) + (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) + (- Y (IQUOTIENT HEIGHT 2)) + WIDTH HEIGHT OPERATION)) + else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) + +(\DRAWPOLYGON.PSC + [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING)(* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + (LET ((LASTPOINT (CAR (LAST POINTS))) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH SHAPE COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH) + (SETQ SHAPE 'ROUND)) + ((LISTP BRUSH) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T + (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") + + (printout T T + "[In \DRAWPOLYGON.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + (SETQ SHAPE 'ROUND] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + + (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") + + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") + WIDTH " setlinewidth " (fetch (POSITION XCOORD) of (CAR POINTS)) + " " + (fetch (POSITION YCOORD) of (CAR POINTS)) + " M" :EOL) + (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM + (fetch (POSITION XCOORD) of P) + " " + (fetch (POSITION YCOORD) of P) + " lineto" :EOL)) + (COND + (CLOSED (POSTSCRIPT.PUTCOMMAND STREAM " closepath"))) + (POSTSCRIPT.PUTCOMMAND STREAM " stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) + (fetch (POSITION YCOORD) of LASTPOINT]) + +(\DSPBOTTOMMARGIN.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) + of (fetch (STREAM IMAGEDATA) of STREAM) with YPOSITION))))]) + +(\DSPCLIPPINGREGION.PSC + [LAMBDA (STREAM REGION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) + (COND + ([AND REGION (NOT (AND (EQP (fetch (REGION LEFT) of OLDCLIP) + (fetch (REGION LEFT) of REGION)) + (EQP (fetch (REGION BOTTOM) of OLDCLIP) + (fetch (REGION BOTTOM) of REGION)) + (EQP (fetch (REGION WIDTH) of OLDCLIP) + (fetch (REGION WIDTH) of REGION)) + (EQP (fetch (REGION HEIGHT) of OLDCLIP) + (fetch (REGION HEIGHT) of REGION] + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with + REGION) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))) + OLDCLIP]) + +(\DSPCOLOR.PSC + [LAMBDA (STREAM COLOR) (* ; "Edited 14-Jan-93 17:14 by jds") + + (* ;; + "Postscript %"color%" setter -- really sets gray shade for now. 0.0 = black, 1.0 = white.") + + (POSTSCRIPT.SHOWACCUM STREAM) + (PROG1 (FETCH (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) + OF STREAM)) + (COND + ((AND (NUMBERP COLOR) + (<= 0 COLOR 1)) + (REPLACE (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) + OF STREAM) WITH COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL COLOR " setgray ")) + (COLOR (\ILLEGAL.ARG COLOR))))]) + +(\DSPFONT.PSC + [LAMBDA (STREAM FONT) (* ; + "Edited 26-May-93 01:06 by sybalsky:mv:envos") + (* ; "Edited 11-May-93 02:11 by jds") + (* ; "Edited 19-Jan-93 17:17 by jds") + + (* ;; "Change fonts on the PostScript stream STREAM to be FONT.") + + (* ;; "Doesn't actually write the font-change command to the stream (it saves doing that until the font is actually needed, so that multiple font changes don't yield larger PS files).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) + NEWFONT FONTID) + (COND + ((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM) + (FONTCOPY OLDFONT FONT))) + (type? FONTDESCRIPTOR NEWFONT) + (NEQ NEWFONT OLDFONT)) + + (* ;; "OK, it's a good font.") + + (POSTSCRIPT.SHOWACCUM STREAM) (* ; + " Write out any accumulated characters.") + + (* ;; "Change the font in the Lisp stream:") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA with NEWFONT) + + (* ;; "and now update all font-dependent fields in the imagedata, EXCEPT POSTSCRIPTSPACEWIDTH and POSTSCRIPTNATURALSPACEWIDTH. These latter 2 must stay as-is up thru the actual writing of characters by SHOWACCUM, so") + + (\POSTSCRIPT.CHANGECHARSET IMAGEDATA 0) + (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of + NEWFONT))) + [replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA + with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) + of IMAGEDATA) + (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA with (\FGETWIDTH (fetch + (\POSTSCRIPTDATA + POSTSCRIPTWIDTHS) + of IMAGEDATA) + (CHARCODE SPACE] + (\FIXLINELENGTH.PSC STREAM IMAGEDATA) + [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR + + OTHERDEVICEFONTPROPS + ) of + NEWFONT + ) + 'PSCFONT] + (COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*) + (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF IMAGEDATA WITH NIL)) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with + T))) + + (* ;; "Remember to actually write a change command") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with + T))) + OLDFONT]) + +(\DSPLEFTMARGIN.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (COND + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with XPOSITION) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) + +(\DSPLINEFEED.PSC + [LAMBDA (STREAM LINELEADING) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) + of (fetch (STREAM IMAGEDATA) of STREAM) with LINELEADING)) + ))]) + +(\DSPPUSHSTATE.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (push (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA) + (create POSTSCRIPTXFORM + PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA)) + PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of + IMAGEDATA)) + PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + ) + PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of + IMAGEDATA + ) + PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) + of IMAGEDATA]) + +(\DSPPOPSTATE.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (XFORM (pop (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA] + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXCLIP) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXPAGE) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXBOTTOM) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXTOP) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXLEFT) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXRIGHT) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXLAND) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXXFORMPEND) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with + (fetch ( + POSTSCRIPTXFORM + PSXTRANX) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with + (fetch ( + POSTSCRIPTXFORM + PSXTRANY) + of XFORM]) + +(\DSPRESET.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (replace (STREAM CHARPOSITION) of STREAM with 0) + (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + (FONTPROP (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) + 'ASCENT]) + +(\DSPRIGHTMARGIN.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + (COND + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with XPOSITION) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) + +(\DSPROTATE.PSC + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "rotate the postscript stream by ROTATION") + + (* ;; + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OROT (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA)) + LAND C0 P0 C P ML MB MR MT) + (COND + ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) + of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA with ROTATION) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\DSPRESET.PSC STREAM))) + OROT]) + +(\DSPSCALE.PSC + [LAMBDA (STREAM SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + NSCALE) + (COND + ((AND NIL + + (* ;; "Changing SCALE is not implemented. According to IRM.") + + (NUMBERP SCALE) + (CL:PLUSP SCALE)) + (SETQ NSCALE (QUOTIENT SCALE OSCALE)) + + (* ;; + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + + (POSTSCRIPT.PUTCOMMAND STREAM " " NSCALE " " NSCALE " scale" :EOL) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with SCALE))) + OSCALE]) + +(\DSPSCALE2.PSC + [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "SETS X AND Y SCALE ") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + NSCALE) + (COND + ((AND X-SCALE (NUMBERP X-SCALE) + (CL:PLUSP X-SCALE)) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + + (* ;; + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + + (POSTSCRIPT.PUTCOMMAND STREAM " " X-SCALE " " Y-SCALE " scale" :EOL))) + T]) + +(\DSPSPACEFACTOR.PSC + [LAMBDA (STREAM FACTOR) (* ; + "Edited 26-May-93 01:18 by sybalsky:mv:envos") + (DECLARE (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFACTOR (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA))) + [COND + ((AND (NUMBERP FACTOR) + (NOT (EQUAL FACTOR OLDFACTOR))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA with FACTOR) + (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA + with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA + POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA] + OLDFACTOR]) + +(\DSPTOPMARGIN.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch + (STREAM IMAGEDATA) + of STREAM) + with YPOSITION))))]) + +(\DSPTRANSLATE.PSC + [LAMBDA (STREAM TX TY) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (MDX (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + TX)) + (MDY (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + TY))) + (COND + ((NOT (AND (ZEROP MDX) + (ZEROP MDY))) + (POSTSCRIPT.SHOWACCUM STREAM) + (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) + of IMAGEDATA)) do (CL:INCF (fetch (REGION + LEFT) + of REG) + MDX) + (CL:INCF (fetch (REGION + BOTTOM) + of REG) + MDY)) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + MDY) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + MDY) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + MDY) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with TX) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with TY) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T]) + +(\DSPXPOSITION.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + OLDX) + (PROG1 (SETQ OLDX (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + [COND + ((AND XPOSITION (NOT (EQUAL XPOSITION OLDX))) + (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) + of IMAGEDATA])]) + +(\DSPYPOSITION.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + OLDY) + (PROG1 (SETQ OLDY (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA)) + (COND + ((AND YPOSITION (NOT (EQUAL YPOSITION OLDY))) + (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + YPOSITION))))]) + +(\FILLCIRCLE.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") + (LET (TEXTUREBM TEXTUREWIDTH) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (if (FIXP TEXTURE) + then (if (ZEROP TEXTURE) + then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") + )) + (if (FLOATP TEXTURE) + then + + (* ;; + "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") + + (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") + elseif (OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM) + elseif (BITMAPP TEXTURE) + then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) + (if TEXTUREBM + then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch + BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" :EOL) + else (POSTSCRIPT.PUTCOMMAND STREAM " eofill" :EOL "grestore" :EOL)) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\FILLPOLYGON.PSC + [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) + (* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + (DECLARE (SPECVARS FILL.WRULE)) + + (* ;; "OPERATION is ignored here") + + (LET ((LASTPOINT (CAR (LAST KNOTS))) + TEXTUREBM TEXTUREWIDTH) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (if (NOT (OR (ZEROP WINDNUMBER) + (EQL WINDNUMBER 1))) + then (SETQ WINDNUMBER FILL.WRULE)) + (if (FIXP TEXTURE) + then (if (ZEROP TEXTURE) + then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") + )) + (if (FLOATP TEXTURE) + then + + (* ;; + "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") + + (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") + elseif (OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM) + elseif (BITMAPP TEXTURE) + then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) + " " + (fetch (POSITION YCOORD) of (CAR KNOTS)) + " M" :EOL) + (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch + (POSITION XCOORD) + of K) + " " + (fetch (POSITION YCOORD) of K) + " lineto" :EOL)) + (POSTSCRIPT.PUTCOMMAND STREAM " closepath" :EOL) + (if TEXTUREBM + then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch + BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern")) + (POSTSCRIPT.PUTCOMMAND STREAM (if (ZEROP WINDNUMBER) + then " fill" + else " eofill") + :EOL "grestore" :EOL) + (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) + (fetch (POSITION YCOORD) of LASTPOINT]) + +(\FIXLINELENGTH.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "Called by margin, font or rotation change to update the LINELENGTH field in the stream.") + + (LET [(TMP (MIN MAX.SMALLP (FIX (QUOTIENT (DIFFERENCE (fetch (\POSTSCRIPTDATA + POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA + POSTSCRIPTLEFTMARGIN) + of IMAGEDATA)) + (fetch FONTAVGCHARWIDTH of (ffetch + (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] + (replace (STREAM LINELENGTH) of STREAM with (COND + ((GREATERP TMP 1) + TMP) + (T 10]) + +(\MOVETO.PSC + [LAMBDA (STREAM X Y) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) + (COND + ([NOT (AND (EQP X (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + (EQP Y (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] + (POSTSCRIPT.SHOWACCUM STREAM) + (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X) + (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y) + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T]) + +(\NEWPAGE.PSC + [LAMBDA (STREAM) (* ; "Edited 5-Apr-89 17:31 by TAL") + (POSTSCRIPT.ENDPAGE STREAM) + (POSTSCRIPT.STARTPAGE STREAM]) +) + + + +(* ;; "Character-output, plus special-cases:") + +(DEFINEQ + +(\POSTSCRIPT.CHANGECHARSET + [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") + + (* ;; +"Called when the character set information cached in a display stream doesn't correspond to CHARSET") + + (PROG* ((FONT (ffetch POSTSCRIPTFONT of PSDATA)) + (CSINFO (\GETCHARSETINFO CHARSET FONT))) + + (* ;; "since the call to \getcharsetinfo has NOSLUG? = NIL, we know that we will get a reasonable character set back") + + (UNINTERRUPTABLY + (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) + of CSINFO)) + (freplace POSTSCRIPTNSCHARSET of PSDATA with CHARSET))]) + +(\POSTSCRIPT.OUTCHARFN + [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Output a character to be printed.") + +(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") + +(* ;;; "This is called a lot, so the code is unrolled for efficiency.") + + (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE) + (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (XPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) + CHARWID NEWXPOS MAPPING) + (CL:UNLESS (EQ (\CHARSET CHAR) + (ffetch POSTSCRIPTNSCHARSET of IMAGEDATA)) + + (* ;; "Switch character set so that we get the right char width.") + + (\POSTSCRIPT.CHANGECHARSET IMAGEDATA (\CHARSET CHAR))) + [SETQ CHARWID (SELCHARQ CHAR + (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of + IMAGEDATA + )) + (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of + IMAGEDATA + ) + (\CHAR8CODE CHAR] + + (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") + + [COND + [[OR (NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA)) + (AND (ILEQ CHAR 254) + (NOT (CL:AREF \POSTSCRIPT.CHARTYPE CHAR] + + (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") + + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + CHARWID] + (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with + T)) + (COND + [(ILESSP CHAR (CHARCODE " ")) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + [(IGEQ CHAR 127) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (T (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM (CHARCODE \)) + (BOUT STREAM CHAR)) + (BOUT STREAM CHAR] + [(SETQ MAPPING (GETHASH CHAR *POSTSCRIPT-NS-HASH*)) + (* ; + "Special character that's taken care of by the NS mapping.") + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + CHARWID] + (SELECTQ (CAR MAPPING) + (NIL + (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") + + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING))) + (SYMBOL + (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") + + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) + 'SYMBOL)) + (ACCENT (* ; "Special accent mapping we did") + (\POSTSCRIPT.ACCENTFN STREAM (CADR MAPPING))) + (ACCENTPAIR (* ; + "Given base char & accent, overlap them.") + (\POSTSCRIPT.ACCENTPAIR STREAM (CADR MAPPING) + (CADDR MAPPING) + (CADDDR MAPPING))) + (DINGBAT (* ; "A Zapf dingbat") + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) + 'ZAPFDINGBATS)) + (APPLY* (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + + (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") + + [freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA + with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF + IMAGEDATA + ) + (APPLY* (CADDR MAPPING) + STREAM + (CADR MAPPING)))]) + (FUNCTION (* ; "Done as special PS code.") + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM (CADR MAPPING))) + (\ILLEGAL.ARG (CAR MAPPING] + (T (* ; "Special char") + (SELCHARQ CHAR + ((EOL LF) + (\TERPRI.PSC STREAM) + + (* ;; + "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") + + (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) + (FF (DSPNEWPAGE STREAM) + (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) + (TAB (SETQ NEWXPOS (IPLUS XPOS (\POSTSCRIPTTAB IMAGEDATA))) + [COND + ((IGREATERP NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + (\POSTSCRIPTTAB IMAGEDATA] + (\MOVETO.PSC STREAM NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) + of IMAGEDATA))) + ("357,140" (* ; " Ballot box, checked") + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + CHARWID] + (LET ((OLDFONT (\DSPFONT.PSC STREAM))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch + (FONTDESCRIPTOR + FONTSIZE) + of OLDFONT) + (fetch (FONTDESCRIPTOR + FONTFACE) + of OLDFONT))) + (\UPDATE.PSC STREAM IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM " bboxchk ") + (\DSPFONT.PSC STREAM OLDFONT))) + (PROGN [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + CHARWID] + (COND + ((IGEQ CHAR 255) + + (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") + + (\POSTSCRIPT.PRINTSLUG STREAM CHAR)) + (T (SETQ CHAR (\CHAR8CODE CHAR)) + (COND + ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) + of IMAGEDATA)) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) + of IMAGEDATA with T))) + (BOUT STREAM (CHARCODE \)) + (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM CHAR)) + (PROGN [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with NEWXPOS) + CHAR]) + +(\POSTSCRIPT.PRINTSLUG + [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") + + (DECLARE (LOCALVARS . T)) + (LET ((IMAGEDATA (FETCH (STREAM IMAGEDATA) OF STREAM))) + (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF + IMAGEDATA + ) + (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) + (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) OF IMAGEDATA) + (\CHAR8CODE CHAR)) + (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA + POSTSCRIPTFONT) + OF IMAGEDATA)) + 'PAINT) + (\MOVETO.PSC STREAM (IPLUS (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) + (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) + OF IMAGEDATA) + (\CHAR8CODE CHAR))) + (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA]) + +(\POSTSCRIPT.SPECIALOUTCHARFN + [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") + + (DECLARE (LOCALVARS . T)) + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (AND FAMILY (\DSPFONT.PSC STREAM] + (CL:WHEN OLDFONT + (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of + OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) + (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T)) + [COND + [(ILESSP CHAR (CHARCODE " ")) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + [(IGEQ CHAR 127) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (T (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM (CHARCODE \)) + (BOUT STREAM CHAR)) + (BOUT STREAM CHAR] + (CL:WHEN OLDFONT (\DSPFONT.PSC STREAM OLDFONT)) + CHAR]) + +(\UPDATE.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "Make any outstanding font, scale, location updates, prepatory to something that might depend heavily on it. (e.g. before starting to output characters, or making a scale change)") + (* ; + "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA]) + +(\POSTSCRIPT.ACCENTFN + [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") + (* ; "Edited 3-Feb-93 01:05 by jds") + +(* ;;; "Output an accented character to be printed. .") + +(* ;;;; "Need to inc CHARPOSITION of STREAM") + + (DECLARE (LOCALVARS . T)) + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (COND + ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA)) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T))) + (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) + -3) do (BOUT STREAM CH)) + CHAR]) + +(\POSTSCRIPT.ACCENTPAIR + [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; + "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") + (* ; "Edited 3-Feb-93 01:29 by jds") + +(* ;;; "Output an accented character to be printed. .") + +(* ;;;; "Prints the character as \xxx, with 3 octal digits, to avoid tripping up on EOLs and other postscript-special characters.") + + (DECLARE (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) + -3) do (BOUT STREAM CH)) + (BOUT STREAM (CHARCODE %))) + (BOUT STREAM (CHARCODE %()) + (for ACCENT inside ACCENTS do (BOUT STREAM (CHARCODE "\")) + (for CH + instring (SUBSTRING (CONCAT "000" + (OCTALSTRING + ACCENT)) + -3) + do (BOUT STREAM CH))) + (POSTSCRIPT.PUTCOMMAND STREAM ") (") + (for ACCENT inside UNDER-ACCENTS + do (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT)) + -3) do (BOUT STREAM CH))) + (BOUT STREAM (CHARCODE %))) + (COND + (NIL (OR (IEQP ACCENT (CHARCODE "0,313")) + (IEQP ACCENT (CHARCODE "0,316"))) (* ; + "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") + (POSTSCRIPT.PUTCOMMAND STREAM " 0 ")) + ((ILESSP CHAR (CHARCODE a)) (* ; + "upper case, so adjust offset for accent") + (POSTSCRIPT.PUTCOMMAND STREAM " " (/ (fetch \SFAscent of FONT) + 3.0) + " ")) + (T (POSTSCRIPT.PUTCOMMAND STREAM " 0 "))) + (POSTSCRIPT.PUTCOMMAND STREAM " " (FONTPROP FONT 'SIZE) + " ") + (POSTSCRIPT.PUTCOMMAND STREAM " accentor ") + CHAR]) +) + + + +(* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + +(DEFINEQ + +(\PSC.SPACEDISP + [LAMBDA (STREAM WIDTH) (* ; "Edited 28-Sep-93 13:50 by jds") + (POSTSCRIPT.PUTCOMMAND STREAM (\PSC.SPACEWID (DSPFONT NIL STREAM) + WIDTH) + " 0 rmoveto "]) + +(\PSC.SPACEWID + [LAMBDA (FONTDESC CHAR) (* ; "Edited 28-Sep-93 13:41 by jds") + + (* ;; "Spacing character with a special width (e.g. M space, thin (1/5-M) space...") + + (* ;; "If CHAR is a list, it's (CHARCODE FACTOR), and we return a width of FACTOR * (CHARWIDTH CHARCODE). Otherwise, we just return the width of CHARCODE.") + + (COND + [(LISTP CHAR) + (FIXR (FTIMES (CADR CHAR) + (CHARWIDTH (CHARCODE.DECODE (CAR CHAR)) + FONTDESC] + (T (CHARWIDTH (CHARCODE.DECODE CHAR) + FONTDESC]) + +(\PSC.SYMBOLS + [LAMBDA (STREAM CHAR) (* ; "Edited 2-Nov-94 17:01 by jds") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (\DSPFONT.PSC STREAM))) + (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch (FONTDESCRIPTOR FONTSIZE) + of OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (COND + ((EQUAL CHAR "0,161") + (POSTSCRIPT.OUTSTR STREAM " bboxchk "))) + (\DSPFONT.PSC STREAM OLDFONT]) +) + + + +(* ;; "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + +(DEFINEQ + +(\POSTSCRIPT.NSHASH + [LAMBDA (MAPPING-LIST) (* ; + "Edited 30-Jul-93 14:46 by sybalskY:MV:ENVOS") + (* ; "Edited 4-May-93 02:21 by jds") + (* ; "Edited 3-Feb-93 00:33 by jds") + (for MAPPING in MAPPING-LIST unless (EQ (CAR MAPPING) + '*) + do (* ; + "Skip comments in the mapping list.") + (LET [(CHARCODE (CHARCODE.DECODE (CAR MAPPING] + + (* ;; "Fill in the translation entry for this character:") + + (PUTHASH CHARCODE + [DESTRUCTURING-BIND + (KIND CODE2 BASECHAR UNDERACCENTS) + (SETQ MAPPING (CDR MAPPING)) + (CONS KIND (SELECTQ KIND + ((SYMBOL NIL DINGBAT) + (CONS (CHARCODE.DECODE CODE2))) + (FUNCTION (CONS CODE2)) + ((ACCENT ACCENTPAIR) + (LIST (CHARCODE.DECODE CODE2) + (CHARCODE.DECODE BASECHAR) + (AND UNDERACCENTS (CHARCODE.DECODE UNDERACCENTS)) + )) + (APPLY* (* ; + "Apply setup function to coerce argument data") + + (* ;; "MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN SETUPFN) PRINTFN gets applied to stream and result of applying SETUPFN to DATA. WIDTHFN gets applied to coerced data and fontdescriptor") + + (LIST (APPLY* (OR (CAR (CDDDDR MAPPING)) + (FUNCTION CL:IDENTITY)) + (CADR MAPPING)) + (CADDR MAPPING) + (CADDDR MAPPING))) + (ERROR "UNRECOGNIZED POSTSCRIPT CHARACTER TYPE" MAPPING] + *POSTSCRIPT-NS-HASH*) + + (* ;; "If this character is in the lower 127, we need to mark it for special handling in \POSTSCRIPT.CHARTYPE, by putting a T in the array at the charcode's position:") + + (CL:WHEN (<= CHARCODE 254) + (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE CHARCODE) + T))]) +) + +(RPAQQ *POSTSCRIPT-UNACCENTED-FONTS* (Dancer ZapfDingbats "Dancer" "ZapfDingbats")) + +(RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* + ( + (* ;; "Mapping of NS characters to Postscript renderings.") + + + (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") + + ("^S" NIL "2,320") + (* ; "pressfont em dash") + ("^V" NIL "2,261") + (* ; "pressfont en dash") + ("^G" NIL "0,140") + ("0,244" NIL "2,250") + (* ; "generic currency symbol") + ("0,251" NIL "2,140") + (* ; "left single quote") + ("0,254" SYMBOL "2,254") + (* ; "left arrow") + ("0,255" SYMBOL "2,255") + (* ; "uparrow") + ("0,256" SYMBOL "2,256") + (* ; "right arrow") + ("0,257" SYMBOL "2,257") + (* ; "down arrow") + ("0,260" SYMBOL "2,260") + (* ; "degree") + ("0,261" SYMBOL "2,261") + (* ; "+/-") + ("0,264" SYMBOL "2,264") + (* ; "times") + ("0,267" NIL "2,264") + (* ; "Center-dot") + ("0,270" SYMBOL "2,270") + (* ; "divide") + ("0,271" NIL "2,047") + (* ; "right single quote") + ("0,274" FUNCTION " f14 ") + (* ; "1/4") + ("0,275" FUNCTION " f12 ") + (* ; "1/2") + ("0,276" FUNCTION " f34 ") + (* ; "3/4") + ("0,322" SYMBOL "2,342") + (* ; "registered") + ("0,323" SYMBOL "2,343") + (* ; "copyright") + ("0,324" SYMBOL "2,344") + (* ; "tm") + ("0,334" FUNCTION " f18 ") + (* ; "1/8") + ("0,335" FUNCTION " f38 ") + (* ; "3/8") + ("0,336" FUNCTION " f58 ") + (* ; "5/8") + ("0,337" FUNCTION " f78 ") + (* ; "7/8") + ("0,342" NIL "2,235") + (* ; "Eth (slashed D?)") + ("0,354" NIL "2,237") + (* ; "Thorn") + ("0,363" NIL "2,236") + (* ; "eth") + ("0,374" NIL "2,240") + (* ; "thorn") + ("41,172" DINGBAT "0,110") + (* ; "filled star") + ("42,42" DINGBAT "0,161") + (* ; "ballot-box") + ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) + (* ; "Checked ballot-box") + ("357,44" NIL "2,261") + (* ; "n dash") + ("357,45" NIL "2,320") + (* ; "m dash") + ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "M quad") + ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "N quad") + ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "FIGURE quad") + ("357,57" APPLY* ("M" 0.2) + \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "This space (1/5M)") + ("357,60" NIL "2,262") + (* ; "dagger") + ("357,61" NIL "2,263") + (* ; "double dagger") + ("357,062" SYMBOL "2,361") + (* ; "angleright") + ("357,063" SYMBOL "2,341") + (* ; "angleleft") + ("357,70" SYMBOL "2,315") + (* ; "perpendicular") + ("357,101" NIL "2,275") + (* ; "per mil o/oo") + ("357,104" ACCENTPAIR "<" NIL "/") + (* ; "not less than") + ("357,105" ACCENTPAIR ">" "/") + (* ; "not greater than") + ("357,110" SYMBOL "2,312") + (* ; "parallel") + ("357,111" SYMBOL "2,315") + (* ; "not parallel") + ("357,112" SYMBOL "2,316") + (* ; "element") + ("357,113" SYMBOL "2,317") + (* ; "notelement") + ("357,114" SYMBOL "2,047") + (* ; "suchthat") + ("357,115" SYMBOL "2,334") + (* ; "implied by, double arrow left") + ("357,116" SYMBOL "2,333") + (* ; "iff, double arrow") + ("357,117" SYMBOL "2,336") + (* ; "implies, double arrow right") + ("357,120" SYMBOL "2,253") + (* ; "double arrow") + ("357,121" SYMBOL "2,333") + (* ; "double arrow") + ("357,122" SYMBOL "2,333") + (* ; "l/r arrow") + ("357,126" SYMBOL "2,307") + (* ; "intersection") + ("357,127" SYMBOL "2,310") + (* ; "union") + ("357,130" SYMBOL "2,312") + (* ; "reflexsuperset") + ("357,131" SYMBOL "2,315") + (* ; "reflexsubset") + ("357,132" SYMBOL "2,311") + (* ; "propersuperset") + ("357,133" SYMBOL "2,314") + (* ; "propersubset") + ("357,137" SYMBOL "2,313") + (* ; "notsubset") + ("357,141" SYMBOL "2,306") + (* ; "emptyset") + ("357,142" SYMBOL "2,305") + (* ; "circleplus") + ("357,144" SYMBOL "2,304") + (* ; "circlemultiply") + ("357,146" NIL "2,267") + (* ; "bullet") + ("357,147" SYMBOL "2,260") + (* ; + "center circle (composition), lowered degree") + ("357,152" SYMBOL "2,330") + (* ; "logicalnot") + ("357,154" SYMBOL "2,320") + (* ; "angle") + ("357,160" SYMBOL "2,136") + (* ; "perpendicular") + ("357,161" SYMBOL "2,265") + (* ; "proportional") + ("357,162" SYMBOL "2,272") + (* ; "equivalence") + ("357,165" SYMBOL "2,362") + (* ; "integral") + ("357,167" SYMBOL "2,273") + (* ; "approxequal") + ("357,170" SYMBOL "2,100") + (* ; "congruent") + ("357,172" SYMBOL "2,345") + (* ; "summation") + ("357,173" SYMBOL "2,325") + (* ; "product") + ("357,174" SYMBOL "2,326") + (* ; "radical") + ("357,242" SYMBOL "2,246") + (* ; "florin") + ("357,260" SYMBOL "2,351") + (* ; "Ceiling, left ") + ("357,261" SYMBOL "2,371") + (* ; "Ceiling, right") + ("357,262" SYMBOL "2,353") + (* ; "Floor, left ") + ("357,263" SYMBOL "2,373") + (* ; "Floor, right") + ("357,264" SYMBOL "2,44") + (* ; "exists") + ("357,265" SYMBOL "2,42") + (* ; "forall") + ("357,266" SYMBOL "2,331") + (* ; "logicaland") + ("357,267" SYMBOL "2,332") + (* ; "logicalor") + ("357,271" SYMBOL "2,321") + (* ; "gradient") + ("357,272" SYMBOL "2,266") + (* ; "partialdiff") + ("357,313" SYMBOL "2,252") + (* ; "spade") + ("357,317" DINGBAT "0,63") + (* ; "check") + ("357,375" FUNCTION " f13 ") + (* ; "1/3") + ("357,376" FUNCTION " f23 ") + (* ; "2/3") + ("361,041" ACCENT "0,4" A) + ("361,042" ACCENT "0,1" A) + ("361,043" ACCENT "0,2" A) + ("361,044" ACCENT "0,6" A) + ("361,045" ACCENTPAIR A "0,305") + (* ; "A-macron") + ("361,046" ACCENTPAIR A "0,306") + (* ; "A-breve") + ("361,047" ACCENT "0,3" A) + ("361,050" ACCENT "0,5" A) + ("361,055" ACCENT "0,7" C) + ("361,060" ACCENT "0,13" E) + ("361,061" ACCENT "0,10" E) + ("361,062" ACCENT "0,11" E) + ("361,063" ACCENTPAIR E "0,305") + (* ; "E-macron") + ("361,065" ACCENT "0,12" E) + ("361,066" ACCENTPAIR E NIL "0,316") + (* ; "E-ogonek") + ("361,076" ACCENT "0,17" I) + ("361,077" ACCENT "0,14" I) + ("361,100" ACCENT "0,15" I) + ("361,102" ACCENTPAIR I "0,305") + (* ; "I-macron") + ("361,104" ACCENT "0,16" I) + ("361,114" ACCENT "0,20" N) + ("361,117" ACCENT "0,24" O) + ("361,120" ACCENT "0,21" O) + ("361,121" ACCENT "0,22" O) + ("361,122" ACCENT "0,25" O) + ("361,123" ACCENTPAIR O "0,305") + (* ; "O-macron") + ("361,124" ACCENT "0,23" O) + ("361,134" ACCENT "0,26" S) + ("361,137" ACCENT "0,32" U) + ("361,140" ACCENT "0,27" U) + ("361,141" ACCENT "0,30" U) + ("361,143" ACCENTPAIR U "0,305") + (* ; "U-macron") + ("361,145" ACCENT "0,31" U) + ("361,155" ACCENT "0,33" Y) + ("361,160" ACCENT "0,34" Z) + ("361,165" ACCENTPAIR Y "0,305") + (* ; "Y-macron") + ("361,166" ACCENTPAIR "0,341" "0,305") + (* ; "AE-macron") + ("361,167" ACCENTPAIR "0,352" "0,305") + (* ; "OE-macron") + ("361,241" ACCENT "0,204" a) + ("361,242" ACCENT "0,201" a) + ("361,243" ACCENT "0,202" a) + ("361,244" ACCENT "0,206" a) + ("361,245" ACCENTPAIR a "0,305") + (* ; "a-macron") + ("361,246" ACCENTPAIR a "0,306") + (* ; "a-breve") + ("361,247" ACCENT "0,203" a) + ("361,250" ACCENT "0,205" a) + ("361,255" ACCENT "0,207" c) + ("361,260" ACCENT "0,213" e) + ("361,261" ACCENT "0,210" e) + ("361,262" ACCENT "0,211" e) + ("361,263" ACCENTPAIR e "0,305") + (* ; "e-macron") + ("361,265" ACCENT "0,212" e) + ("361,266" ACCENTPAIR e NIL "0,316") + (* ; "e-ogonek") + ("361,267" ACCENTPAIR e "0,317") + (* ; "e-caron") + ("361,276" ACCENT "0,217" i) + ("361,277" ACCENT "0,214" i) + ("361,300" ACCENT "0,215" i) + ("361,302" ACCENTPAIR "0,365" "0,305") + (* ; "i-macron") + ("361,304" ACCENT "0,216" i) + ("361,314" ACCENT "0,220" n) + ("361,317" ACCENT "0,224" o) + ("361,320" ACCENT "0,221" o) + ("361,321" ACCENT "0,222" o) + ("361,322" ACCENT "0,225" o) + ("361,323" ACCENTPAIR o "0,305") + (* ; "o-macron") + ("361,324" ACCENT "0,223" o) + ("361,334" ACCENT "0,226" s) + ("361,337" ACCENT "0,232" u) + ("361,340" ACCENT "0,227" u) + ("361,341" ACCENT "0,230" u) + ("361,343" ACCENTPAIR u "0,305") + (* ; "u-macron") + ("361,344" ACCENTPAIR u "0,306") + (* ; "u-breve") + ("361,345" ACCENT "0,231" u) + ("361,355" ACCENT "0,233" y) + ("361,360" ACCENT "0,234" z) + ("361,365" ACCENTPAIR y "0,305") + (* ; "y-macron") + ("361,366" ACCENTPAIR "0,361" "0,305") + (* ; "ae-macron") + ("361,367" ACCENTPAIR "0,372" "0,305") + (* ; "oe-macron") + ("361,371" ACCENTPAIR a "0,317") + (* ; "a-caron") + ("361,375" ACCENTPAIR g "0,317") + (* ; "g-caron") + + (* ;; "Special code assignments for Dictionary of Old English, UToronto:") + + ("361,370" ACCENTPAIR a ("0,305" "0,306")) + (* ; "a - breve-macron") + ("361,372" ACCENTPAIR e "0,306") + (* ; "e-breve") + ("361,373" ACCENTPAIR e "0,305" "0,56") + (* ; "e macron underdot") + ("361,374" ACCENTPAIR e ("0,305" "0,306")) + (* ; "e - breve-macron") + ("361,376" ACCENTPAIR "0,365" "0,306") + (* ; "i-breve") + ("362,242" ACCENTPAIR "0,365" "0,317") + (* ; "i-caron") + ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) + (* ; " i - breve-macron") + ("362,243" ACCENTPAIR n "0,305") + (* ; "n-macron") + ("362,244" ACCENTPAIR m "0,305") + (* ; "m-macron") + ("362,245" ACCENTPAIR o "0,317") + (* ; "o-caron") + ("362,246" ACCENTPAIR o "0,306") + (* ; "o-breve") + ("362,247" ACCENTPAIR o ("0,305" "0,306")) + (* ; "o - breve-macron") + ("362,250" ACCENTPAIR o "0,305" "0,56") + (* ; "o-macron underdot") + ("362,251" ACCENTPAIR o "0,316") + (* ; "o-ogonek") + ("362,252" ACCENTPAIR u "0,317") + (* ; "u-caron") + ("362,253" ACCENTPAIR u ("0,305" "0,306")) + (* ; "u - breve-macron") + ("362,254" ACCENTPAIR y "0,306") + (* ; "y-breve") + ("362,256" ACCENTPAIR y "0,317") + (* ; "y-caron") + ("362,255" ACCENTPAIR y ("0,305" "0,306")) + (* ; "y - breve-macron") + (* ; "235 = Eth") + (* ; "236 = eth") + (* ; "237 = Thorn") + (* ; "240 = thorn") + + (* ;; "NS Greek characters") + + ("46,101" SYMBOL "2,101") + (* ; "Alpha") + ("46,102" SYMBOL "2,102") + (* ; "Beta") + ("46,103" SYMBOL 0) + (* ; "--empty--") + ("46,104" SYMBOL "2,107") + (* ; "Gamma") + ("46,105" SYMBOL "2,104") + (* ; "Delta") + ("46,106" SYMBOL "2,105") + (* ; "Epsilon") + ("46,107" SYMBOL 0) + (* ; "Stigma") + ("46,110" SYMBOL 0) + (* ; "Digamma") + ("46,111" SYMBOL "2,132") + (* ; "Zeta") + ("46,112" SYMBOL "2,110") + (* ; "Eta") + ("46,113" SYMBOL "2,121") + (* ; "Theta") + ("46,114" SYMBOL "2,111") + (* ; "Iota") + ("46,115" SYMBOL "2,113") + (* ; "Kappa") + ("46,116" SYMBOL "2,114") + (* ; "Lambda") + ("46,117" SYMBOL "2,115") + (* ; "Mu") + ("46,120" SYMBOL "2,116") + (* ; "Nu") + ("46,121" SYMBOL "2,130") + (* ; "Xi") + ("46,122" SYMBOL "2,117") + (* ; "Omicron") + ("46,123" SYMBOL "2,120") + (* ; "Pi") + ("46,124" SYMBOL 0) + (* ; "Koppa") + ("46,125" SYMBOL "2,122") + (* ; "Rho") + ("46,126" SYMBOL "2,123") + (* ; "Sigma") + ("46,127" SYMBOL 0) + (* ; "--empty--") + ("46,130" SYMBOL "2,124") + (* ; "Tau") + ("46,131" SYMBOL "2,125") + (* ; "Upsilon") + ("46,132" SYMBOL "2,106") + (* ; "Phi") + ("46,133" SYMBOL "2,103") + (* ; "Chi") + ("46,134" SYMBOL "2,131") + (* ; "Psi") + ("46,135" SYMBOL "2,132") + (* ; "Omega") + ("46,141" SYMBOL "2,141") + (* ; "alpha") + ("46,142" SYMBOL "2,142") + (* ; "beta") + ("46,143" SYMBOL 0) + (* ; "(md beta)") + ("46,144" SYMBOL "2,147") + (* ; "gamma") + ("46,145" SYMBOL "2,144") + (* ; "delta") + ("46,146" SYMBOL "2,145") + (* ; "epsilon") + ("46,147" SYMBOL "2,126") + (* ; "stigma") + ("46,150" SYMBOL 0) + (* ; "digamma") + ("46,151" SYMBOL "2,172") + (* ; "zeta") + ("46,152" SYMBOL "2,150") + (* ; "eta") + ("46,153" SYMBOL "2,161") + (* ; "theta") + ("46,154" SYMBOL "2,151") + (* ; "iota") + ("46,155" SYMBOL "2,153") + (* ; "kappa") + ("46,156" SYMBOL "2,154") + (* ; "lambda") + ("46,157" SYMBOL "2,155") + (* ; "mu") + ("46,160" SYMBOL "2,156") + (* ; "nu") + ("46,161" SYMBOL "2,170") + (* ; "xi") + ("46,162" SYMBOL "2,157") + (* ; "omicron") + ("46,163" SYMBOL "2,160") + (* ; "pi") + ("46,164" SYMBOL 0) + (* ; "(koppa)") + ("46,165" SYMBOL "2,162") + (* ; "rho") + ("46,166" SYMBOL "2,163") + (* ; "sigma") + ("46,167" SYMBOL "2,126") + (* ; "(fl sigma)") + ("46,170" SYMBOL "2,164") + (* ; "tau") + ("46,171" SYMBOL "2.165") + (* ; "upsilon") + ("46,172" SYMBOL "2,146") + (* ; "phi") + ("46,173" SYMBOL "2,143") + (* ; "chi") + ("46,174" SYMBOL "2,171") + (* ; "psi") + ("46,175" SYMBOL "2,167") + (* ; "omega") + + (* ;; "NS Miscellaneous symbols") + + ("041,142" SYMBOL "2,271") + (* ; "notequal") + ("041,145" SYMBOL "2,243") + (* ; "lessequal") + ("041,146" SYMBOL "2,263") + (* ; "greaterequal") + ("041,147" SYMBOL "2,245") + (* ; "infinity") + ("041,150" SYMBOL "2,134") + (* ; "therefore") + ("041,155" SYMBOL "2,262") + (* ; "second") + ("356,055" SYMBOL "2,055") + (* ; "minus") + ("356,106" SYMBOL "2,340") + (* ; "lozenge") + ("356,163" SYMBOL "2,351") + (* ; "topleftbracket") + ("356,164" SYMBOL "2,353") + (* ; "bottomleftbracket") + ("356,165" SYMBOL "2,352") + (* ; "centerbracket") + ("356,166" SYMBOL "2,371") + (* ; "toprightbracket") + ("356,167" SYMBOL "2,373") + (* ; "bottomrightbracket") + ("356,176" SYMBOL "2,176") + (* ; "similar") + ("356,314" SYMBOL "2,251") + (* ; "heart") + ("356,340" SYMBOL "2,374") + (* ; "toprightbracce") + ("356,341" SYMBOL "2,357") + (* ; "braceextend") + ("356,342" SYMBOL "2,375") + (* ; "centerrightbracce") + ("356,343" SYMBOL "2,376") + (* ; "bottomrightbracce") + ("356,344" SYMBOL "2,354") + (* ; "topleftbracce") + ("356,345" SYMBOL "2,356") + (* ; "bottomleftbracce") + ("356,346" SYMBOL "2,355") + (* ; "centerleftbracce") + ("356,355" SYMBOL "2,363") + (* ; "integraltop") + ("356,356" SYMBOL "2,365") + (* ; "integralbottom") + ("356,357" SYMBOL "2,364") + (* ; "integralcenter"))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *POSTSCRIPT-NS-HASH*) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) + + (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") + + (POSTSCRIPT.SHOWACCUM STREAM) + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch POSTSCRIPTRIGHTMARGIN + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX + of IMAGEDATA) + CHARWID] + [COND + ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of + IMAGEDATA)) + (COND + ((ffetch POSTSCRIPTPENDINGXFORM of + IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTFONTCHANGEDFLG + of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA] + (POSTSCRIPT.OUTSTR STREAM STRING))) +) +) + +(RPAQ \POSTSCRIPT.ORIENTATION.MENU + (create MENU ITEMS _ '(("Landscape" T "Print this file/document/image in Landscape Orientation" + ) + ("Portrait" 'NIL + "Print this file/document/image in Portrait Orientation")) + TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ + (create POSITION XCOORD _ -1 YCOORD _ 0) + CHANGEOFFSETFLG _ 'Y)) + +(RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" T + "Default printing to Landscape Orientation" + ) + ("Portrait" 'NIL + "Default printing to Portrait Orientation" + )) + TITLE _ "Default Orientation" CENTERFLG _ T)) + +(RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 +66 67 68 69 70 NIL)))) + + +(RPAQQ \POSTSCRIPT.JOB.SETUP + ("/bdef {bind def} bind def" "/ldef {load def} bdef" "/S /show ldef" "/M /moveto ldef" + "/DR {transform round exch round exch itransform} bdef" + "/L {gsave newpath setlinewidth 0 setlinecap" + " M lineto currentpoint stroke grestore M} bdef" + "/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" + " M lineto currentpoint stroke grestore M} bdef" + "/F {findfont exch scalefont setfont} bdef" + "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" + " neg 0 rlineto closepath clip newpath} bdef" + "/R {gsave setgray newpath M dup 0 rlineto exch 0 exch" + " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" + "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" + " /startangle exch def" " /orientation exch def" " /minorrad exch def" + " /majorrad exch def" " /y exch def" " /x exch def" + " /savematrix mtrx currentmatrix def" " x y translate" " orientation rotate" + " majorrad minorrad scale" " 0 0 1 startangle endangle arc" " savematrix setmatrix" + " end } bdef" "/concatprocs" " {/proc2 exch cvlit def" " /proc1 exch cvlit def" + " /newproc proc1 length proc2 length add array def" " newproc 0 proc1 putinterval" + " newproc proc1 length proc2 putinterval" " newproc cvx" " } bdef" + "/resmatrix matrix def" "/findresolution" " {72 0 resmatrix defaultmatrix dtransform" + " /yres exch def /xres exch def" " xres dup mul yres dup mul add sqrt" " } bdef" + "/thebitimage" " {/maskp exch def" " /bihgt exch def" " /biwid exch def" + " /byte 1 string def" " /strbufl biwid 8 div ceiling cvi def" + " /strbuf strbufl string def" + " maskp not{{1 exch sub} currenttransfer concatprocs settransfer} if" " biwid bihgt" + " maskp { true } { 1 } ifelse" " [biwid 0 0 bihgt 0 0]" " {/col 0 def" + " {currentfile byte readhexstring pop 0 get" " dup 16#B2 eq {pop" + " currentfile byte readhexstring pop 0 get 1 add" + " currentfile byte readhexstring pop pop /nbyte byte 0 get def" + " { strbuf col nbyte put /col col 1 add def} repeat}" + " {dup 16#B3 eq {pop /col col" " currentfile byte readhexstring pop" + " 0 get add 1 add def}" " {16#B4 eq {currentfile byte readhexstring pop pop} if" + " strbuf col byte 0 get put /col col 1 add def} ifelse" " } ifelse" + " col strbufl ge { exit } if } loop" " strbuf }" + " maskp { imagemask } { image } ifelse" " } bdef" "/setuserscreendict 22 dict def" + "setuserscreendict begin" " /tempctm matrix def" " /temprot matrix def" + " /tempscale matrix def" "end" "/setuserscreen" " {setuserscreendict begin" + " /spotfunction exch def" " /screenangle exch def" " /cellsize exch def" + " /m tempctm currentmatrix def" " /rm screenangle temprot rotate def" + " /sm cellsize dup tempscale scale def" + " sm rm m m concatmatrix m concatmatrix pop" + " 1 0 m dtransform /y1 exch def /x1 exch def" + " /veclength x1 dup mul y1 dup mul add sqrt def" + " /frequency findresolution veclength div def" " /newscreenangle y1 x1 atan def" + " m 2 get m 1 get mul m 0 get m 3 get mul sub" + " 0 gt { { neg } /spotfunction load concatprocs" + " /spotfunction exch def } if" + " frequency newscreenangle /spotfunction load setscreen" " end" " } bdef" + "/setpatterndict 18 dict def" "setpatterndict begin" " /bitison" + " {/ybit exch def /xbit exch def" + " /bytevalue bstring ybit bwidth mul xbit 8 idiv add get def" + " /mask 1 7 xbit 8 mod sub bitshift def" " bytevalue mask and 0 ne" " } bdef" + "end" "/bitpatternspotfunction" " {setpatterndict begin" " /y exch def /x exch def" + " /xindex x 1 add 2 div bpside mul 1 sub cvi def" + " /yindex y 1 add 2 div bpside mul 1 sub cvi def" " xindex yindex bitison" + " {/onbits onbits 1 add def 1}" " {/offbits offbits 1 add def 0} ifelse" " end" + " } bdef" "/setpattern" " {setpatterndict begin" " /cellsz exch def" + " /angle exch def" " /bwidth exch def" " /bpside exch def" " /bstring exch def" + " /onbits 0 def /offbits 0 def" + " cellsz angle /bitpatternspotfunction load setuserscreen" " {} settransfer" + " offbits offbits onbits add div setgray" " end" " } bdef" + "%% - - - - - Fraction-setting code, to support NS fonts better - - - - -" + "/fractiondict 20 dict def" "/fractionshow " "{ fractiondict begin" "/denom exch def " + "/num exch def " "/regfont currentfont def" + "/fractfont currentfont [.65 0 0 .6 0 0] makefont def " "gsave newpath 0 0 moveto " + "(1) true charpath flattenpath pathbbox " "/height exch def pop pop pop" " grestore" + "0 .4 height mul rmoveto" "fractfont setfont num show" + "0 .4 height mul neg rmoveto regfont setfont (\244) show" + "fractfont setfont denom show regfont setfont end } bdef" + "/f14 { (1) (4) fractionshow } bdef" "/f12 { (1) (2) fractionshow } bdef" + "/f34 { (3) (4) fractionshow } bdef" "/f18 { (1) (8) fractionshow } bdef" + "/f38 { (3) (8) fractionshow } bdef" "/f58 { (5) (8) fractionshow } bdef" + "/f78 { (7) (8) fractionshow } bdef" "/f13 { (1) (3) fractionshow } bdef" + "/f23 { (2) (3) fractionshow } bdef" "/bboxdict 20 dict def" + "/bboxchk { bboxdict begin" "/regfont currentfont def" + "/chkfont currentfont [1.25 0 0 1.25 0 0] makefont def " "gsave newpath 0 0 moveto " + "(\161) true charpath flattenpath pathbbox " "/height exch def pop pop pop " + " grestore " " currentpoint " " .2 height mul .3 height mul rmoveto" + "chkfont setfont (\063) show" " moveto" " regfont setfont" "(\161) show end } bdef" + "/rencdict 15 dict def" "/encodefont { rencdict begin" "/newname exch def" + "/oldfont exch def" "/newcodes [" "8#001 /Aacute" "8#002 /Acircumflex" + "8#003 /Adieresis" "8#004 /Agrave" "8#005 /Aring" "8#006 /Atilde" "8#007 /Ccedilla" + "8#010 /Eacute" "8#011 /Ecircumflex" "8#012 /Edieresis" "8#013 /Egrave" "8#014 /Iacute" + "8#015 /Icircumflex" "8#016 /Idieresis" "8#017 /Igrave" "8#020 /Ntilde" "8#021 /Oacute" + "8#022 /Ocircumflex" "8#023 /Odieresis" "8#024 /Ograve" "8#025 /Otilde" "8#026 /Scaron" + "8#027 /Uacute" "8#030 /Ucircumflex" "8#031 /Udieresis" "8#032 /Ugrave" + "8#033 /Ydieresis" "8#034 /Zcaron" "8#177 /periodinferior" "8#201 /aacute" + "8#202 /acircumflex" "8#203 /adieresis" "8#204 /agrave" "8#205 /aring" "8#206 /atilde" + "8#207 /ccedilla" "8#210 /eacute" "8#211 /ecircumflex" "8#212 /edieresis" + "8#213 /egrave" "8#214 /iacute" "8#215 /icircumflex" "8#216 /idieresis" "8#217 /igrave" + "8#220 /ntilde" "8#221 /oacute" "8#222 /ocircumflex" "8#223 /odieresis" "8#224 /ograve" + "8#225 /otilde" "8#226 /scaron" "8#227 /uacute" "8#230 /ucircumflex" "8#231 /udieresis" + "8#232 /ugrave" "8#233 /ydieresis" "8#234 /zcaron" "8#235 /Eth" "8#236 /eth" + "8#237 /Thorn" "8#240 /thorn" " ] def" + "/olddict oldfont findfont def /newfont olddict maxlength dict def" + "olddict { exch dup /FID ne { dup /Encoding eq" + "{ exch dup length array copy newfont 3 1 roll put }" + "{ exch newfont 3 1 roll put } ifelse }" " { pop pop } ifelse } forall" + "newfont /FontName newname put" "newcodes aload pop" + "newcodes length 2 idiv { newfont /Encoding get 3 1 roll put } repeat " + "newname newfont definefont pop end } def" " /accentdict 10 dict def " + " /accentor { accentdict begin /scaler exch def /delta exch def " + "/unders exch def /accents exch def /mainch exch def /scrt (X) def" + " /w1 mainch stringwidth pop def " " currentpoint mainch show currentpoint 4 2 roll " + "accents { /ch exch def 2 copy moveto " " scrt 0 ch put " + " /w2 scrt stringwidth pop def " + " w1 w2 sub 2 div delta rmoveto scrt show " + " /delta delta 150 scaler mul 9 div add def" " } forall " + "unders { /ch exch def 2 copy moveto " " scrt 0 ch put " + " /w2 scrt stringwidth pop def " + " ch 46 eq { w1 w2 sub 2 div -175 scaler mul 9 div rmoveto scrt show 0 175 rmoveto }" + " { w1 w2 sub 2 div 0 rmoveto scrt show } ifelse " " } forall " + " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) + +(RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") + (Regular 'REGULAR "This is a Regular Slope font"))) + +(RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") + (Medium 'MEDIUM "This is a Medium Weight font") + (Light 'LIGHT "This is a Light Weight font"))) + +(ADDTOVAR BackgroundMenuCommands + ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU + \POSTSCRIPT.ORIENTATION.OPTIONS.MENU + )) + "Select the default Orientation for PostScript output" + (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + "Always ask whether to print in Landscape or Portrait Orientation") + ("Landscape" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE T) + "Default printing to Landscape Orientation") + ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE NIL) + "Default printing to Portrait Orientation")))) + +(RPAQQ BackgroundMenu NIL) +(DECLARE%: EVAL@COMPILE + +(RPAQQ GOLDEN.RATIO 1.618034) + +(RPAQQ \PS.SCALE0 100) + +(RPAQQ \PS.TEMPARRAYLEN 20) + + +(CONSTANTS (GOLDEN.RATIO 1.618034) + (\PS.SCALE0 100) + (\PS.TEMPARRAYLEN 20)) +) + +(RPAQ? POSTSCRIPT.BITMAP.SCALE 1) + +(RPAQ? POSTSCRIPT.EOL 'CR) + +(RPAQ? POSTSCRIPT.IMAGESIZEFACTOR 1) + +(RPAQ? POSTSCRIPT.PREFER.LANDSCAPE NIL) + +(RPAQ? POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) + +(RPAQ? POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) + +(RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) + +(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>")))) + +(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) +(DEFINEQ + +(POSTSCRIPTSEND + + [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ") + + (* ; "Edited 20-Nov-95 11:26 by ") + + + + (* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).") + + + + (SELECTQ (MKATOM (UNIX-GETPARM "ARCH")) + + (dos (DOSPRINT HOST FILE PRINTOPTIONS)) + + (UnixPrint HOST FILE PRINTOPTIONS]) +) + +(ADDTOVAR PRINTERTYPES ((POSTSCRIPT) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) + +(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) + +(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + +(RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) + + + +(* ;; +"NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk" +) + + +(APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST + POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE + POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE + \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(POSTSCRIPT.INIT) +) + +(PUTPROPS POSTSCRIPTSTREAM FILETYPE :TCOMPL) + +(PUTPROPS POSTSCRIPTSTREAM MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) +) +(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT ( +"Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" + 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (22629 29733 (POSTSCRIPT.INIT 22639 . 29731)) (30777 65561 (PSCFONT.READFONT 30787 . +32695) (PSCFONT.SPELLFILE 32697 . 33275) (PSCFONT.COERCEFILE 33277 . 34849) ( +PSCFONTFROMCACHE.SPELLFILE 34851 . 35836) (PSCFONTFROMCACHE.COERCEFILE 35838 . 37490) ( +PSCFONT.WRITEFONT 37492 . 38507) (READ-AFM-FILE 38509 . 44380) (CONVERT-AFM-FILES 44382 . 45594) ( +POSTSCRIPT.GETFONTID 45596 . 46991) (POSTSCRIPT.FONTCREATE 46993 . 59392) ( +\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59394 . 61791) (POSTSCRIPT.FONTSAVAILABLE 61793 . 65559)) (66110 +75256 (OPENPOSTSCRIPTSTREAM 66120 . 74922) (CLOSEPOSTSCRIPTSTREAM 74924 . 75254)) (75301 81122 ( +POSTSCRIPT.HARDCOPYW 75311 . 78660) (POSTSCRIPT.TEDIT 78662 . 79142) (POSTSCRIPT.TEXT 79144 . 79435) ( +POSTSCRIPTFILEP 79437 . 80073) (MAKEEPSFILE 80075 . 81120)) (81123 126009 (POSTSCRIPT.BITMAPSCALE +81133 . 83589) (POSTSCRIPT.CLOSESTRING 83591 . 84125) (POSTSCRIPT.ENDPAGE 84127 . 84998) ( +POSTSCRIPT.OUTSTR 85000 . 86021) (POSTSCRIPT.PUTBITMAPBYTES 86023 . 94494) (POSTSCRIPT.PUTCOMMAND +94496 . 95545) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95547 . 100995) (POSTSCRIPT.SHOWACCUM 100997 . 103235) ( +POSTSCRIPT.STARTPAGE 103237 . 105816) (\POSTSCRIPTTAB 105818 . 106689) (\PS.BOUTFIXP 106691 . 108041) +(\PS.SCALEHACK 108043 . 110872) (\PS.SCALEREGION 110874 . 111434) (\SCALEDBITBLT.PSC 111436 . 115736) +(\SETPOS.PSC 115738 . 116200) (\SETXFORM.PSC 116202 . 118021) (\STRINGWIDTH.PSC 118023 . 118477) ( +\SWITCHFONTS.PSC 118479 . 124636) (\TERPRI.PSC 124638 . 126007)) (126044 181764 (\BITBLT.PSC 126054 . +126607) (\BLTSHADE.PSC 126609 . 130891) (\CHARWIDTH.PSC 130893 . 131660) (\CREATECHARSET.PSC 131662 . +133360) (\DRAWARC.PSC 133362 . 135842) (\DRAWCIRCLE.PSC 135844 . 138253) (\DRAWCURVE.PSC 138255 . +142276) (\DRAWELLIPSE.PSC 142278 . 144755) (\DRAWLINE.PSC 144757 . 147107) (\DRAWPOINT.PSC 147109 . +147697) (\DRAWPOLYGON.PSC 147699 . 150813) (\DSPBOTTOMMARGIN.PSC 150815 . 151380) ( +\DSPCLIPPINGREGION.PSC 151382 . 152825) (\DSPCOLOR.PSC 152827 . 153668) (\DSPFONT.PSC 153670 . 157880) + (\DSPLEFTMARGIN.PSC 157882 . 158451) (\DSPLINEFEED.PSC 158453 . 159029) (\DSPPUSHSTATE.PSC 159031 . +160794) (\DSPPOPSTATE.PSC 160796 . 163305) (\DSPRESET.PSC 163307 . 163953) (\DSPRIGHTMARGIN.PSC 163955 + . 164527) (\DSPROTATE.PSC 164529 . 165552) (\DSPSCALE.PSC 165554 . 166485) (\DSPSCALE2.PSC 166487 . +167306) (\DSPSPACEFACTOR.PSC 167308 . 168280) (\DSPTOPMARGIN.PSC 168282 . 168999) (\DSPTRANSLATE.PSC +169001 . 171575) (\DSPXPOSITION.PSC 171577 . 172176) (\DSPYPOSITION.PSC 172178 . 172750) ( +\FILLCIRCLE.PSC 172752 . 175398) (\FILLPOLYGON.PSC 175400 . 179316) (\FIXLINELENGTH.PSC 179318 . +180812) (\MOVETO.PSC 180814 . 181565) (\NEWPAGE.PSC 181567 . 181762)) (181820 204972 ( +\POSTSCRIPT.CHANGECHARSET 181830 . 182634) (\POSTSCRIPT.OUTCHARFN 182636 . 195493) ( +\POSTSCRIPT.PRINTSLUG 195495 . 197462) (\POSTSCRIPT.SPECIALOUTCHARFN 197464 . 199896) (\UPDATE.PSC +199898 . 201121) (\POSTSCRIPT.ACCENTFN 201123 . 202065) (\POSTSCRIPT.ACCENTPAIR 202067 . 204970)) ( +205070 206715 (\PSC.SPACEDISP 205080 . 205359) (\PSC.SPACEWID 205361 . 205980) (\PSC.SYMBOLS 205982 . +206713)) (206824 209815 (\POSTSCRIPT.NSHASH 206834 . 209813)) (254855 255569 (POSTSCRIPTSEND 254865 . +255567))))) +STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..f41c947a45e2183f232c47ac0eea3d28cc179820 GIT binary patch literal 91396 zcmeFa3v^uPeIGb8ph$`qAOM768m8&1F-3z6F~U3mf{ZNB#moRRz|7nc1|SKF5)5)6 z;V}YO5b~pGwziu`vuB$g+x0VXb7Cj$xPY`$D(~>Pc8Sw`eRWm z)_*2;`piHyZ1sjOuRM8Wp*mNwR+g=>b>Jt`eYvqX0KFdmmkWnT%N5y z^yFNnI``ptWZ7nYvrPbNh4?k3L%9G{PM6NVhp2Q0akspsnkNe*lJ$)vT zI1}&3J67l1m(G3Y%Ieko&sZ1BnaT4b&O{+nDyOUk3}s|0pSR3GM__^AR&3yOY$$GBS)Kd9!pc)ud35-g1L0`Qn{13Pnm99n5C4(PZU6BD z-i$|b#oVOb-=7$;&ZLJ9^yaLXmChA1#d6LmS~)9f4d*5cb_vOTOP1%j6_^eL0xiRp zC-4*4`K8)?@&KjmyXo&M?Yre~TKj09U8PQ=JNT>sGX146QkCtQ)(31 zOl~wgX`PB%=`xnu#-<&NtFm*s^kmi=IOP>32K~(v{a#rt=4%!mbc>F+_Qv}y^`=3K zyG7pd*1AcP`6^k_0n6@>o*J@{OmOlvCF7htMah`;A^PdJMoRcSZ8`Zg20xOtbi;`Ib-TwvJ>kOxKX{^|8(sT3KFXUZZP)FYxbl_U-Hc9$nsdx6{TMU%VFhs7lVX z{Yz@Jam8udONs5hTirUjXX`CG8JcOY@nCeu{_dGhx2BY|S6Vi@*WVu6JnD2hc=#25 z*W1^-__xPx+0(VZb`S$@`Pj8vRebFff35!1_4m=^0qL?UME|-sPdHshMsVw1hf0E5 z`{*|~-_tYS!=KIl{{B4m{u|t&Qju-mdKZ1%dYADkZa_8v)BNS|axlR47v4hk-bR0_ z|3lU42;JixsyN*@zj!V9t%F>H|8U#)Q>}MN|6PHaN`!P`k525>2}>vT>%;+_xJM`2 zbfR4+I(4E;C%SdwkWTdI#9^IC>%iC;D~bs7@TyiC&#Jp%W){;z6BwNGFmy zF{~3Yok-|JUMI$MqNo$+bz(v%CUxR5ow%qI7j)vRPGogrL?_PZ#E?!5>O`a_YkQ0L zB&W|E<#cyiqxmZj&#Z(L^Q#ze0mh6dg2Do0T>*pwd z*~QFRJAXC`fCl8?Ocm1rV+jke3xIi$UObU0IA=3`>8VmamjeAzCV;Kp07!Zo5Yzm$ z6h3Hjx|FeohGO-gj6V7VzPjIRkt=|RaY|)tXfS3Kfheq@fw)Q}5-JfNFyN(u<%VK| zss=t)8ut%L;?!x(c_EWN7a7h^(x|Lcr}1LWIq!^&fXc8=4dGKbXIkf+!ju3Vl`x`7 zd@a);r+}6?bE=#*at9K~ov_c998h3V5r~&6YM8B>$AJNnJK=aeV!64kJ&}@@v}`m= z#!!-l)w&2Iohy!-nfM0mkbKF>Pmel9t~q!bpCKbLGBN-B)(pN>s-2S0Nab^-5_+A; zi~^}h(O|-uU~6zdzM~8pGc#hRCY=eX1|&><4m*>RPN4v7o>T4P^gZ}+r)1{F@KK;m zOA|S19>o`-R?5li4uMB0hp~T5Dq$nKS)2pP3L7qSu7r&u86dPSa+5UZ87!~lp2B*V z&x7~~6ymI8Py3Lip;aMF?IL0N@q zK$INO1(FM5iJG1F=O#du6+exUdVNIPvmeI-ogrE@XXpDe`3xw~Nh>}WwXhY13K9;%nE(ijo5P6X zq@S>2pc%b>t=OP%s4*No>P5jyD;68zXQ8;F{Unos@aYoY@n>WCJT zs+b?+30v8C!bUcpt9ol^<8O1JvEZRxD3rDS zJZs&cl$rFU{SP5csx4OdrH>q{-dgMk-Brln-0U7NNPkSl)e1{5J-Ys#gIRt(y&<&R z@|XM@3ch?uhR>st3c*|m|L6bYkNT^B+~1J;z@D=`m+#4e6N>c@TKT?|&8QgLQcd7U zE|X7#C5X#O1rsoEnof!hz5|R0(+2}li_RR-4G!}-R{bs}lAaDH`L{c?)snP_7t@RU$jjfl zAJqbwCxX88m3o(9(7=}-K%o3|ZX!c?DF=cCWQnP7!l%qf^Cw&vq5#ZN*bJuuTJ1Qx}ReWl`9REpVz$p=DTW1 zn|n+(cKI237l>WmH{LIm8^^iecG+7qM!*&MkH7yjs_*%oryo$gBY9M{eEJ>gMcmRi ze%c(srW$g2yE6t-u`xG#8rw!eIj?RMII&4CNRh@|&=8H8padE+X^(H1KxtJDR7uZt01I&od#L#pSz(SP+_v=h|1o&zfkBm$>1qS>PZ>p6P z>dgZU5``Ftnhvi*DuKCRFmRU-its*Jlq17w4_ZIm9qI@MvXzZ^FdM@E`9Jxi{^}q1 zSA%WZYo|55#x(lDbqu5rjY{Xz`kz*S*WGl06HNhA^J)9<5Qi7|zZh|j7T2w`aqQ58P^GIj)9G~SDoDCjm@;l7xz)|jDl$0P zp3OOj`Sml0YBSx=A>9y3x1nPhMt4})PnIdW?EZTW-E6)NfX2(6(*6r)^SxiY68v09>jK~c;~DIO2h zgV!pzHuvOJYMStxx_RK>J*?N4IS*-AAB`Gvq|5~CFqRMQ3$z%FRUJnN_G__@ee2k| zSNO9UA0pD@?<*>lHOfw7r?Kge!~#h|8Vs zE?1uJO5qRJ7AwpD@D|gdJva;%=TO&y+T~-?TJ_#r*L#0`?-0E^J#W}Mby;p&qFNmu%Su%tmHQS<*ospgyV*$CI}(=qI2Z6 zFFHs55q@8#*W#b(a?}HH;P@B30mvswm4UtEwDUW^!=I$;b7`=l@TX-sGQ)bPw}vHm zrc-@MwRLCX|Catk`9n3QbEzZL;e;LQ<|nQNKH1UUDfMMSHom7?AC(OvuwM0a`9#e* zx_I;RW6sgnHu{~T7uNflwY_|@b}n}AK_?7Y9EPgwAVxYSpFMs^YLM_@2w+n|;UVZw34{r_8Uoa1X~QXq^CoNvb|Du> z1xY~?OjWH@pi?*t@_&F=$phq&YJ-65UXOziqN{w!^r1sIQ_dAiFkBF6b{}L7kTVQI z+-9^%kf`bW1XRGRb~tnY{SR1!P`pZJKPgntaOMEu7r%Z0rIJ9YN@y_&B;vchHvy(; zLPlaGpv&-JRb*7elaP3kq*El|eYl?7H$rJ%o%R1AU~)i#C}%mU#nCrOXP2#<6%QJOYlj-(`t)Gz;=s(3X|j$L!AP;E@Ia}2y)&!1qp2m zva3O~6gD^EalZ-l;bvn-bUFs~t^}4eTUiLnMvAbrpp}J6!6}r8*fUl9n8udGro z5V90w3rMk|8o0cbba&yf1^FQt7H6NF3m<>n2}{wM3T7F2b7DN zvSI55C8Y$NAzKXz$S#>GAkt$bFS0&V>m#8X#C<;r_!~^F50Mrj#4~ZM6b4{69+sY`$gdEe8*hrhR+9JqX}SWUSN4knVbJiPA1A;)LS( z9~l$OSPZ>T2tA(fMNZY(1-2 z31QR^N$zpp^6BG5MD^;Os{|(gM-nZ%>J|giDAofLiDL}NLvmG9o)~lGiBY{q%zotX z(g3KWz@CowKvFmio?gPI=aUs6$KjpL?wS&{eGak@EMFt2WVCe z3>_pmU@|r<40(W-Xt$0-n2ba}XMtKq7E|gpkuZlMWhjVQXn4p{hlP7g0GEgJPHG%k zfFkATg5=R7ES9uZwhT4LNB8dm@7H1P$p)XvhAsr39Rnkm+lrrSx6gHsgIoH>i-C@o zeTD5K#c%)FH?{*?Zz+DeFwYx%J3zeLH=MSw2b{KcMM1pxT-Vbi`HfHqUDN^Z@H^@v zS5cijR6EyAy#)S}dg*?1z34vp3ts#cUj1{OFGhu?y7A^l60LDJ`8PKUPd~t|#_zNh zq;=R%7X=a0ZU9YV#mPFspA{Pb<5`!*{32+NC|L;j%SdBLOl*{Nz5XHq3Mv6U^cP^u z$I+vmNvm)Py@y)8j0_|{lPOU z*=p0R46=#9!*ELw8#5@Y`SeiPP7=)wpj-wFsD`rlwsm&2gtFU5a%x}ZzMa+kGDrJz z?CXIs(2hXX4WBqDHYg`B++BvL4=Aimz2ibB(>zT$o~NzJ0@>2R1R|BCUyL5QB&;Fy zmaKdP;^ALFK(Y%|=MptpWbenh27%T6qMLhgc1ldTs03~?V`?p4=lfVIrniZ^sR0v$A*K$fY-D*-)^^;cEB(F zDzrVRv_ej`p#Qg9}vWoy_&TK=uErufoNxkz(bG z*Fqm+zDeM@V)|-D%2QIRS0uB&=Ja3`Unz!)LA*vdyK8|@OZWV$jpPzWxX{W5fsbsx z*BIT_TaAZ{m4C*q9>eQ{f5UGA-dFDg;-6oCNNftbd85AP1)Ix)ulNTkxgmdcdu`#- zT9KjUFTJ1U;a%KE5lC=Gm}#)})k+uG_B0vaCA(mFXM;Jf40r9VRTjVg7A7-pfaR<> zN4^e2JAh)?-8t=Fzq?kwwRA%m;u%N-9INX{ZRSvA`v^hsMdy&56d8J8rdvJ;+-qlH zV~9m+oz77wd~>tc>2{8O!-lovQHJB@cYQqoh7gR~(e-a0Tt9BMdIz_18+jG~!@=sU zYRiqK8{d+Zf*cQuZS}6VJ6(7eH+?bSwfWx<=C@kMD_@YocKvi(5K8c%b8O@Oq;o8| zvw6fh#HDz!#ddd*m3BQnU0pS?X><;y(!3FPj@_q@&|7)xIag@0x@YGQfXFHEnLxH| z`F0BIl}-4q~1;&ICvt%18i2`(Ym#LQs)L+c>}ww}}nG;DdNrkTNdyN#rF% zkQe}+CP_UF8QBD=+$KVL07pN62O|O9hud+~XS`*QmQk>rJRZcJ-w6g&*Mnz3UAKhc6Icomy;dBwG5y9ss?u*1{3HK@y~OYF);rqqiWH{7 zG7f{aoQna$oifs76h`CY-AEXW5-byDlZ^K&`m+(qrp?ng_IsVNa~iJa5wkJF~F~Sk#70?6xSG-nphgB)L$h z;54WoCOV0S^Y3JGzNpKAy^N}jQ&(43pFw+^Op$mm1N>;tSu@4z_c&;{=;N2QF z5S@k*v^ox0i6U98;q~N+0lHJjNSsF|CrR9SPLX;fOSI2PJ}o#jB}_ajGoxudi44wo zjaXGdv;wnHF*qXnv1Cs|Y)9@kKL|M({Lk+KIoN34z<9SK*}|B0y}J^8Bs3oE`Q6;s zzU+L@g^y;BJp;kXcgH$A!u#MHBDE?cfZ5;C{}!h`&l{czhV>t(Y&a|^BA}zq=?Q{Z zg4O!r0_?K(IEN2)c9Q(1YwK>ObG~P$`(sY$F-Yj~hJWpJD}Ry`%Ae#5c&B~PInuHP zfq3U*HlI-tu)!$CQM?xTYkn#Dmi%wQnPWB4`s{p}iH?nPs`_u)&aqH%=PUGgX=fv; zZI60}krN7j@3)5;kaUOSapPUiF~{Oh+U#2Z8Nc&(~s_A=&pYz zQgcp%Ks&kqvJ*Qt(~s_)2)_7;lW5s`n={ziBknarYC1kO2HDkv0$(t;2WQUIoT05w z=L|X-GCe?;+ zjWegJ;qatc1w;jLe+}`ol9mEdH|hC)IHaXVi4}DN!g*YA%4|$iJ+0X!1d4t zr7}6VGK@mvsRtSbU8Jhu#YPnvKT19*36>`Z}Kni>*L8UsWDX3p2BeaoG2?R70Dfi=FX1S7DdGg7*D$Y87I)_&K#YH@mj5vYdt&F%?8Hey@NkmsYN>l`pR@Tv@Zys|z2PTeVUvS3bN- zh7(qA3WUq)p`pI$X)tJKVMj4%%`U@ndTk!w(%}Oz;f9eljb?ITttu}7g%QU8;2J?c z5OmWItUbBf@XAxmm4)Repai1Ppz!|t?<z>3iPDun_#v4d}~V}#3xb+22Ogihk1TJ zcNk(GKCV4n#F+hEmBp?HYgKUsRmT4vFz&46x`t|kq55S)yqF)0xrnUbiSt}_!iFOJpRMb zr*?F2@F4fFZZjb^<{T1uD*b)!o{q}W&gR=Ii#wmHja6IM4^~4v8(m1LTGa!RAWhlt zsWEP~>%>0p`ceMNulL5la}?TYH9YV+q`O_o(8Twyth9u9^1F zLqXWat+oy>x3yQ6|LqRHlD~SUT{?2wgI#-dG8F7O;H8~*@Q%Tkp1k!^*F8EnNSTti ze@wlp((0RF zw~FU_UU}i#>%S@Ww*y^=^+w!$P#W=yGQY~HosGl1+FJ4RR&ht=CHxunn$M0^FYwrE zV_f%LQW+lBDzUfb?miIu6{qVD106N_DA@}@a;HgD<(+VlUlUMoAOgkde&|ME=S5Tn zgMU$B`8QIaCxu?ES*tb8s9 z2TsZ@v!~l2xMiP%+#rlFj79^%1kxU0kE9m^z`5+j1~nl-80D1#fT6c3l|{s;E5Z<; zEFj4CWB?$wp}ZeGtMUZ!s=`%lMIuNIcur>m^C(OQ5u!@rlO+`gs#X!A^|WC z8j=x&(2>B2n9ssl_Lw1QM>9MlbZ8U<6uU`MSBVe={*#{J2l3bxmqe2?K+NO^tPsZ# zq?abAfv!ln2CI%Cp9mA1=M;(7{9B4}1zZx@cuC8phDg9`ekJ^YiXyX$$le0sVwcCQ zAz)vl9yHe@nTd$88L_eo1Hn(&Ov6@2zm435y(Xvpe$0#|Phrxt5cq;-q78{zB3n=M z*~e>18yqWD2ck@zByXHtKB(k}5MP2kYbXWD)R0GJ4t2c@kh5uh9yXcY`J~>gD^B>` zJ9#h(+G+LmKnT{O`#4d79;_fRLF)&z7LbWVXQ(IIF1iQ=uh7NHKr9X==ovVilNuMT z{JrU89Isngw>K=P_ad^Ta$iIS`)WtVh#xk39&?5xpq!>aNr9rTKPXX%kJa{%;yd`5 zk?>u07A5y$uQQ$!a%?ABP*;IHlum-^Wm7E@PJ=Onh1KvhjJv>%W9u9J(7da?5AekE z1~H!=2MPR04@zf6T+l$iIq7L4i3ecDcPiG8J(WQ3OlN{PF3+t!bp<3Q4laV|%sq}I z)D__e7M`4aV(#j~-=BMY_VSuo8&Q?1<)!774=$VJ@D)_F);@e?4rFsQegHB)ya7_Y zdOPU@%{`Bm;#%{j5GIEMWH7{tM#w$J+>G5knvd8l9|D5;HaWxsq4)&}8JNFe8$bey z`4U(dwa#RmJdwxr%d$yDcu%g*BIMC3tfah^ivTF4N#=4+lh?42V zlak>HN%P-fwwmpca3&qmmaItP`={l%`}+K|sjZ(}tcYCxMJ1_!v4xvm+AAbNPAYf4 z@`#-Zra&W)1;;?|jHmGDm6xlbZ@vUW7UW2l&ZAQN7Ygz~_>YjLSzbW-+s7G&13*?t&5#*598%vQGQ(Jh9Q=t) zDNkOnufU+{VO*qdz!Xfi8dNGpNJlC4r4fnAvuSim7hz2kLX0jUI4W!>%9*Z15#k)T#}ZI zf((qj4>q!(Yw#9G4~Y(Rj}j;kUW-WpDh&Zi9Klw`&_ZyWixQn#NYLHs!n5ySQfoba zNI2|a@^Xl~=#$PB(}{edNXlq_phfa9ukVP$_YndXf=)06KNcYGLLr-B-N2tKLZbK6 zH_z|je`E_URu}Z`^ugz`k9cAD=+Z_qUqt0pV9*;tx8AC;{VNfwCU~p+bZTGHpYAT$ zLl}~BuxDc3gPS~X2A*5*OfGU^(yHFS^YlLa+_$5$YWM)`c@h>-{~!=SZJJL^nJcL? zb{9pC@u<6qtQsF2wSo$Di3ow`f~TP4KINmuPtPQ?)llx< zwvLWHi3L38pIe#vSa;^S&W|%l1USp`vp{F=@jCT5c5j<9_s8r;u@y9E z!UXE^L3RrhZFui;SPv2k5uoBybvi&f`YJAZ*_KOH~5-h0HYk)ij$f0wEJfuTdS$Qbo z0s6(PGXXdN=8)Z&9J1u%2O;96?8(G#O(#_?R?%~t!KJF<5+M9a*q6rbA)~^m|P() z)Y8pQ)|S@$`6S-_H2$3u~W9`R67fI6dIBM;>x z`Rfs#(b880ykHc0uozUW2@V-bGx6)oHM=4J69cyGkKoJ^ODqZS>HQI8fH2@+u;~2} zu*oDEmISzRsS5g1B~)E-%iIQBF;^uCJ0*NbiI2B{LJhstL1*kuJ6p~)fYM1AYzLEy zSR?CrNgjRrZAsn|yxk>pzU$}$))91wF+U*t(HFiHjHa<@{GukDAR|@;;pC|S#fw0k zzM(5p`3;9%s2jGRem%~9^%V)@8)};e<%z*4!^xVipPa{c0azK|Wzh2A&YBna_X8lz zIoQ-r(YH0>!~y)6s z>}#Q)t)_Q2CTy}QH%mVHV$0I2&-$~r1J8|Tt9!W18y9NhOE(@Fd+ig~0{=cw*3-`< z$&{B1*Z(5vd(B6;1ODe1TWr-&N7o*;st06?CZB^D=y-Kc9VffS_uD-NDR{TgCr*p0JW;mAj$XtL3=0;q{a+h95R$t7CLU6 zd(hNa2%L9PjbF$RqGh_CGRd0zBIFI^F#w|;LR*8@{r9sZt51c1BQU44s2)tenHZV0 zaQJO0FgLIMp*jG$b6unQ3ZHj~d4M)J_&X&%Gam3zMb4n%*| z3|YrV_iLW(8A)shu4k+JZhY%o-+ES+gqHr}bBq*aUj&{XhOx)|;yi46Ur1KPDkE8a zke5>+olm8abX6KiaV0GN0ZA<8mR`mG^MBmY@)lUWc9DPO*T$Ee?v551sW^vjZa!6g zz4+Q@{LS|J!kBaTs~BLi;I!dWzE!>VFTSeYjU4Z(SPk8H!Rdj$2XHw%x7XJH@xeF! zHm3_}1ke&r_hSClmu9+a*KWlRdUNwoK-};G9&F!`8q=O z=~bFDnXoPpEgzq6Uv#>c7CVl1IEUdcdM)&C$0Z=;V#i(Gu$nn~bMxew)B9CuOHO=s zXTySV%Z-_nHRl+<`B=^A#ZPa|If0)Owe>%8PIkhArrP3!37%X>PvIM4DuiE5(Ghw^ z$jk83t25!nn;ZY6`nS%Z*ER>+!}id5s0fDIqs`_aT zTS13nv|=zI#j1O5px2dm<$j#00m=pV|W9@9b-AP~$5-|F~ zSNGSP7=B{4^*?bE=Ewi(8+|;KH~+NyH$Q^UkNpszkLj@*rpLPN^bD)%`N5aYv8o$8 zzk$D-J731%r=gKDRx=@=gY^i}dc5HX4`VUN8Vx_R!|;O*rW#-S{>eAFwGNKK7`}aR zT-0smjtv^k^nA}1Sk$kz-CGkVD=;d{*Dtv6a!OIzyy*avuMs5gioC$ zK-NkE#J@_YE(eKVlq}Mja4G@TKv0HKwN z)E9)^pk)=O%;e>}nH4U-yNq8Y#$(zOG=Lrpi;+pH05^_a!5iAu(48wJI*SqV@=83$fSOi&Q*z))T z{9_{+oq1IKfnIE8wMNk2iu_&+LhGj-BCC4!vKCUn!*dcd4rZ8aTZXK{Fn(Z3NkR*- zlK3C_rjyl63G6N8Oey+-B9`Z$;X@^?dBfp2Es5QSoWevv-AL! zBF2W4?#Fycve4D7QpK*AN;z$C*OFqV9RX5QvJ(~zD%sU_k4lbpg;i>ytG}jZ@Y?I2 zC0Q-DA!6jR_M2@9piZESx`555bS&a-Nph=K90h3aIBjWf=kigG1Hd%oHDONU)Kh(1 zfXjxwCR~1;LPyuPg;`)j9$2FKJmM!B@`z8W>yKb~Lmp(h4S7IM^?76(+>qDg9qfx= z_g-SK>aw61sn2=?IR`~G?}Lfpkl%gQTSg5TtZ_2aCz#8ER$f8#EC>Egh=esb#vS@x z9A%H{rwxhkG`wepD&Mej8*devM~)9ApV;-hWUZ%7;Yc#OZDn6fy)2|rZsR^FtXkYq znsZW|D}UP8me0!_^Hf>Lk%(7j-)4rzMi4Gv@MRB@Lp&(v;y|w6dgyWxAdQ(6=tbH9 zO=lhkAl2BKMBRkTVGyLiImB~3^$B4=z;J=1D38 zl{1=$0lIb3tgoz}+md2h3@piBm3j*!s13`%U}HhQWf*A!_4A9ouH+45yGfEV^JW## z+DUC6SWAzGa?B(dGIaW1Kn5&*6vxJQ7f z&K9ln@?mQ+$$Q+`oyi<;X;q&Il%)8cv`Zd#A`ymuC>(?JfX|{U22#$993LZ^RqUl0 zY?Iwa;~tDb3DG1M)-V&9ywbEpVbs!C2caqIh7={r-HgH>B{@3i4DV_pqWz7oJhG2= zJK3mtg$!HBRHPvfw0}b$B%lp>P-Qpd;d6y70vP55JkimnB@Gr47b%SE< zfJ@A&aW>S_lo*{)im4MWkqHQ$GNhH!HDxK=k|@abuvKqR^5j!htMb$p3-%CINLE>t z4unj0+Yh*sRZ6f`$^i@XpV&svJ+ZKC^p0s{3u>HadNq~6X8QO6#0?Ce}vtQW< zf^X5j`OlNpJ^|;8_N$jdwdw);=I4`kwf_d^w)2U!Z*DxIi9;cKhU6zuJ=oD1%I56q zfj>o)e^W!^PcDTPcfOp1DCwE?|Cr3?s$IEPJN78^)om@7y*{2tJjgv`ZS8L)EsY|U zmmmN@Sdo^3_?8^u>_FB~oC^^&!mvt{-zo|@NaaRa0e-Ya=%{>cQg$}kJ9 zu~ss$6$}6*RP|#0B1AS>g+l#XkB-3`QNF5bqUYcfu#fRbZ4F4b2cMb0ZpYgplpM>6 znEeyig6~sgpvt+f09?2Fje$yDPm`FrWxNs`lNbnxYU3f$x5g75{m+!)<&a$ZdFfI0 z8&Zv7P43Izqx1Lp^Y`j}P3)?E_Un92?yCF)I$u-7D*qmxuW4eHe^Te4^uITv^CK$X zhMByy0S!&z;@aB04D6@j)N-+$VDUpa#a%8JDeb|3Q52KO%m99lAw)7{SYC@ z2|zFY1+;RFY<&RTBjErIL1PdV-o#uc4kJ4Q76@fdQU*UDfK_25Z5apTs;?JoVh73E zg}VMo!`RTa$@pT>r#93h1Xtf*6Gc_5iD@SsQ5xDZLaXa9N`X`B^O~G!qSWf^H6g>H zN3E}Qd&=B^2TK3Xq!bwexb^^mtaRJ~S1CMxC}{`fEGBK3p9wiZVRF5sPBWW}eF{o~ zHxclf>@Kz4Pvn^aXSp_KDnLGL*a40-S9;duL(mM$Hxr3B&i1MiL=R$!?USU8w_KUO?IP9;mP zbl7_ZO}@D2IhAO6e*T5@uc-#1OZ#gX{jlfKf!fF?M%%uUzjRNnaH*{}lE3*$N{_Y` zZhn$7RIBcECO7g*ZnW(cHjHAt{78jay6w^KFH}amIg2xX7dpy~!^8OVwhS(!;)RC2q)fB1h7H&bd1MY6whH(U%ZU-o zs65_EL1QvMgvTNQog$3W$}pBDNN1W}`$)nET3luJb~lXuWZ>YfhkxB*Qfrdt)5YgT zeczx6ayD`QhzXzWcjdC+U3CP=zEIlZ{^8#$Ofyj#Tf8}CpJA{Q2S zHV4M;YWa-#$!#9jZ$HUh>1sy5+@tyk*u1I0U1a^nm9pwbJqi#pzH_0gS2_jrPY{Db z<PhfDq(^+`NPcJ8fOTe66yypon(6v;eL$N|e?B-58n1t8p3$dVsrVUQRB<9#oUw zz@3t#NBvo+uuKhkI8g#cU_v5^Mrjne_%^g8FY5Z>KkOmT|NI_S@?hntia&Iw#t+Uu&otAD!dbYyJlC!+XJw| z7MLk74{+5}SFn~z<32!!5NLp31C;fE>u(`xZZKdgf*>#qIV@vPItExK^DU#9VrC+j z0jrGNgBNf4{fF;M|635CPgrh%g&At6C5e+S0UV3t1U^NgMl9B)ZbB!{LiA?d4XM!uoVD@AobkmEJ4f#a=u0kOxg1ahEXoSsAzO<4j= zCIhtu$q}&g%|L9>X4PfIAqV8@aR?DPLAHN&mFVio`YaH{^;xH9j&PrSd3g}7WQKz2L8MK9ic0&R0?dTI zq*l}0|3BgV14n>X+Bg<$hB@TX&e5*X?$JY|Jxi_k63!vS3*w1|B8E7|6V&)_@KyW3 z6=v|YITYOxdxC`9bS*KGxWJlZCM2OD-z$hmw8(~TX5b8#@R)oA(GnA*6t+#mq=bVG(&3Q%2LSswqBOvn)?uWqJ{$$|DUk&_QT~Y!vu*U z`};dSabUD<<6w5QO<4eS^ZxuNS^dc9y zX7jMw1k^@agX|Kf%ON6oYS5+ zkLczweHnunmU!R@X68?>jlpbw%jWS&hNNYL-!#T4X&L`FAL9b`O;WO0e3>()^H$oG zHG537q%~WGHxal2+h?v?&CZKzfuFu923Av{{CK1K1WC>x9#v}}?7 zRz)xn0#2}<1IPnrs=$n)kGZuK>vDDFDtuPf=BbEeF1i5E(8+K=pfZT%^BPfyaS&~) zG%-MOCKA?AFcOssnH$j(Bt%p>B+@~W9$i@#X^X;7u=Htp4lXro^Jo)=b!OO_pahKw zzZ9N;eg{s|n0*KUcg~V-9wtK~cS`{nsAXvbV zUA1;T4?a+c1gqUm2AEzrVyjsAwigTEhUW?VSop-&MS}*0Z^Ga2#xcs)roll5XY#Qy zLOna`ehV-cHYwvT{x&fgO+kP<;xK|LI_3P-D8&@;=v6$xl2N)w`UeR<8u&;1frH*p zaOz!^c_=M?k;YXNtw61_<30tqw*$`#03Yw#lYty-1aWq&w%F_Ak_e{_@^gzp;D`Xw z1K(jK&T~t!P+j^+9>#%)$@`n*MZN)}#^HBgqZJ`W`8?hLJ(Kk$3+CbVP(HZY9BfN+Sv^wvM?r!0cEGvTw>GRs&$1!uj>m z2MWzs&O%DT%Q8GMRnGF76w{f}i40tFXi?aX2p1c$<2}UIhz&DECFmYrmzjxar11@$ zK996V+XnB4zI(qAtB_*c7aFO=+dnbAe!OMt?=`vRO=T$_wDXzV;tpIm{vAY+pA!ir zp1xt26){q(K@Rzg$uV9r$rx>G*;o=xFIaZ8ZGE&7WL$}$@wMIGJQ4~%GXh%V`ufkX zVm&#Y6FkWsAB3*_I|c(wUb$eCnk{LjtF|VeW-UO6&|1vEEL^ zxf`}bXg?Fn7;H7&T`9~7AQvP%9Qr8=Ag(h36Ak>N4W#`7P@_L+N{s480mVyFf>q!u z)jL42yb*7aEP_FMG$- zqt2sv55>U`6PHVV^E|>QR%btq6sVR4EJX;e@y#PoEng-)JX^KyOM+b zEqzA{zV-+Q0dmeWin%iw1C6Za*W!a4WFlb@lTmXD2xS^l~-9+%_;0DNY6K+6YLPTX8@WTf^ zNHL24#YiSZzZ3&igNHkU7NkI}gBH>ila20~^-kFj0WgR_{XqbR`SLr48ND*!(c|^- zVrt^74_rVz$oC6_$RmOT_+uh-wl6)61euS>(|LX({FFI6O$ESoNS;R$H`U`W?nauX z$gUt<&eQLp#g79PKY_5p1d07{$hY1w+}4nPtg>+4M51b^QIOu@|tz%)(-j&SNi za->@}vL;|kuip=llL}s^cva7?|2jdPwxn~oo_P7I2I9pY788w&@Vj}ATxRI^dH(wX z|0N$AE^DtP$5cp>&xj~yUEd;RL@|*fF8D45Bx(0$ zz?ZU_DBleqfF(^bm8(vN$URoiW5a$0Zx_v3O!Q6 zk#Rca07dZOSa7|x)_=;33&DMg+yz$gq+`OUM8ZW9*a4#W4RA~`IhzCB1n8e#O294i zMLuvF;9uBU&~F^RF#JpY3iOP3@$YSfB+^q1VgahjfF9Rc7c$UIrqo&4T>wI{2bvF& zuMF`ph70$7QVxSG^m}C(1>mb)deIF44lu6hMICY!^x^>YDGcrtklsiF0t-%%eTrZL zSQ3?SRWD2~$UtAgCQU>_sm`^4K%@k$*X^jv0q9r^>_GP`g*8E$V3Y34Ppy6cA`8ee z*fE2Cg|4JKnBp8`kmLp=>lotaII9yNgCH#e{ud`f1y!W0dH9#@Y6`$H5VSF_5knf2 zGDRVYYJ~VCf|V##rbOvMC{$D-c|=TOsU}rG#Ih9Uc7!hE9SxXEDdWYdg%J%626V8Z zOtDMrDN}qS=FUTN8abS?erQCK$-~?Rx0(C^l<98VuMtiN5I=!yzs8&im+eIe;2bP_ z+~+%BgWvrlV1xhE#1er&XuuMG_t;=DBot;?%n9p>S@!Pn5wqmnXh2W8g|aySib25J zyyX95Ot7})!EqH3_JcFQ;PDM`MG<5)F*{eSE?l{aXh8q1*F z9wIbNumg1mXiUHHH0V{AvV@Y3#c_?gIjxXOSkrK`hhFYH{lu(kX!}5Wo~IvAsuuXq z&=}wC5}v_81{TQoXm0n?0hXHms|=)O8K$!!HTxYqb#tRTnM&KkqSS2Vl52r4jJDm? zvKb$3Z`q6_O}UjR&oU0L(wfb^L0#%~Yaf$J{HIk^RCvw$+lV?1CUcoLl&r}YrMg1d zG$K1`qfK~4G(Yz-V9w?xgu`|z0R`2(grY8y+{0aDAau`@nnP@O4cWepE=%MSOcH-} zly6I3#6Y%zDa=Pnc0^|tztCd|^G2ox{m1}8!v%`2h%$$Ye8rKnl>#*cnHje7NPtS> z2JFuU0g{qRk+_I$R_UWk4s=-lt?POWsF;S>aU8wT)gYUEkw|>~vfe-jyYj9St4lwT z+G>YrlW&9FM?`YFh|>3nCH;#nkjtkQD@hx{AO7U!;T-+V=F+k$K}197;HmbYwK5k1 zlpx4st@(0wVA}Hm#Y$pTa`Mxo2$gFP20C~Gol~+G65%);1r&c6bNR!1H9K8h#k0oq z;+<)8Rt#>DtNPi+;1igMyTswm^QDdLxdX0I>CHQ@GyZ&bj1GA4AQ1lN#QqjfcQw!h zdEy#Hv+Qz>qkgXOC?wsf;IqUvJ||q`UCF}O8=lLg(roYCh7lBbyd4bk@wbCwht1=c zRj%3VVS)sElSQdhG^_A-A$j}18*XB^%-uBdVcB3dq^0Tc2A6`}n5{VZL3^Bx!J1H1 zvt3F+{5LPD^VKzai$XHKOB-T$yb)+#YByJ19P!=W4(38LQ($eB+zt>!m?;RaR2D8L z!hWWc1VKB4syJ+@1ZF|9FA0zj3W~umNAXkuv6`n+^#NYE7LKgqshZdyYqKM~k?(^r zs1%Br59UG9C2p-+Of!xxFoiZGq@x$P4!x40_rZ4WWcWWM4A6P~!SSb;U*A$R0n9E|Q~?2U`LpdDms(Z&P0 zP!JA!@(|7e1d@}UJRZa&KdX$*qskRmC=%NZ_QJthvfPLqP6-KLgbtW!1_XE>oy_ug zU~d@5+w%y8Ll5~2KpMer1Gvo@PuQ~f!9k%*M(bw{0*Lx7?5g@KLouf2mJppcrL3)0 zl&G=d=Xu4MF4VN8tb02GfVOWWYVa7}#O+>7xE{Rbt6}2~D#1TOHHwa+-QIXz&>e;B zCeW12=QE>rK7w6n?FtQjaN3Q-j!%gv7iJ6YbOUgp+z^lA9{eII&WD_fP;lzv9 z#jmGodGSu|vS3dtZKR8B*JS^Z;1m~pDocj-Ka*X;-`bMvaD5Cx3oqjYU{ABzG&##P zISOPP!$uN7t#sN-TX*nl8FcE>#143{s(+6CB-TV+yhgcuJV1W#r)P>*3B2#QS zM-V;MpAa(M0a?h483mrBgkiZ&O09+_kT*2sH34iKKg>Js%o*U=*1drub<|bDgw<8L zlcP;WqxDd|5lo(M4&zUdZIQbJ-N?>+?Ts!C>BzuXHU!Qv&{N}@Vv3>Fum74m8oRmp z+RE4x;K}z787B(f)lD!`TO&ql`;lR!5{zMB`ZDR`@%;zifSy0+v*Om#m((fiW~izj zV*D^)QIC7o?|${G8F?Ls?WD?&sNb;q?PvFKij+qGROXqU>8>+`ipYuxx52==o`2~a zG+U)60k@j?kCA0c-EM_Gp+1ZB&~>%Q9K9|Jr>!BYvHK>WW12)3xRXs*!gWUViwOA& zUG>o*tTC4JMM!KtF3kS>{4Ml5PYL6rZPc9&_7(+=gSCo zsU@aB94J*AfS>TF_JKT74dkgcH}a6FLYTXm!7jB`+?-JG0E^QD8Q%aFsG6gyZ@jf%3)Kp(UdGZJEx2Xu>;7UaUrJ7BZgmikNnQTA)6Q;*r+X zx|3tThWH+x%hCSDINybPz_PGu@a973|4t1-8Ucu=yD@g5rMbhH_ZBijEy`QS{KC;m z{}F_wyH843-0h~_fmwkvxyie)F?VsQghi0833%j9x_{LaV{-dNu-I8l1rh@YB;kO#Gpm`yHAO0B zlsA36NGgz&I~iCd@)`4Xtfn@$k37ROk!#O=Z&S~N>`5D!2CEc;IJ(sS`YU{^1(W2E zs_ycEO^h#_A&Exl+^{_+ol-rNdUG;}dm1UedwygTpFgCkLKcwf+x_fQ3MmgKp-h0F zo|9lB=*}0aK(b}1?kLGdOt`QONpLM>>qJRdHIbncC1DamzLp5WNFqkEa-v*pFjzTJ zCgg#zbfOf!i(bX|q{G^YQq=tb1t`HU?juXHp%i|}N~-=`O^T>~(l4tIR=Uj7`?DtT1ZO&mS-cQB%swd}2*M2UBS&$STpw2tglN0Vbz{Q=; zQ7OKMiVvzM=UCT0DCQDdlU~DJicAL%SZF7EATY$uPL)NZv9^;2%^*pD(Rh=%3>258 z9^#Y0wjmF@vLO$R>+{|?%^4SCS;H{?Oo z(~w8txbD4o#+NkXdm6vL0aUp>vj>fFQb`usc+Q}r#n75aQTv+1>Cm*j(QW6x_uJ5b z$=2EUcLlw@2-wyOT7{eX6Dw$k1g)}S{gV1 ze1ZA)PqW@>y(>+=sb5Z$YpPO%UD}U2Nilli*;s!(%}u_THhfEex7z+pT0|=ABO=aA zrZ?Uz^Z25Ql<{KAv)9KfxFW7LHm#gWe>c5Y$u3rMjZUSFB#!9u4P{$)W5Lw?>3F&| z<-4L@Zg`4{?2$iJd5Vf<=lh9l;_P}I92-oozf)dQU#JWvJ!cm(ur_u%d+vFM+aK|3 zH~YyLsAbUALN^jv@^>H_V(~8}yKR4|zJ>QTHu2z>T_toBe4TWt{7XsH@A{XLsNPo! zrIqVmx~qRIR8|@T>}HtHr(Ze8#C33UU6*%YXnWZtQhAb?a-6oMEO%obth=(&o zvs6}$V7&N}=(zIcY|z#L%o3O~)N~q7Ayzn(W_8fY1z+sQ-_JT&&!*rU?xj?BZ4vk~ z<06vYmf;=%Tcag92jiiUM9xi2@h!~%5|MYbr2!NR4NwhUk8dT2_Gt!BUr8_ReCaHr z6Ao)=H{1a2h8fxoo6v3#K|AqxQ_yZ$pxv+m?VhQ&UmuqE+Ag#k-gvJVG`zS+{kA;! zY`!uMXg7XALAz&$0qWpI-vrtT^+zMsTa>>UbZr%ww-tSW4Cw7e&#~}3Dr49MM>&vgn z5?uzN!7TVp56l9J`%3|uTsRxub->X1xs&M4Clvq9N8}nuBmkBfT$1s&KwQ7cz8}!W zu|Nt?(xnvwnc)m932@hv06fy5ml#0>dSTD4+VYi6>fRoRMRl%V0fM~}dPlk8WA+SC zn*gzoU^U7|Kh9xp{0{tNc}_61(Q`k}@U$M_!f+d?PkGB@F$k2B2fY|K5C&?5xG=L1 zn@;@XkruXG8xA&01srDM46@;Xa2bFYMikVWX-7^D&ixkj3gkbJ-CA!i!4SA!+s~9q`SI*Ws|TjP zeh``!4#ta#(E8>E@os}~4r_*i8Yj1@6dEEhhVFhwJ#eZq0$hmoai2#VIJrJ^vs-cC zHY_EFVJV4ViNbsO?TTDoIw^(7)BvYPnHn^(TQX)9ILKold{(GL@df48@)yjD{|tH; zQ25T8y1~_pmt&kmztUID6o$t!HzuY^h?1`&u9H-qXH08|X>g@7F{BWX{TRfB2#_Bj z`;YA-_Md%YJFs=Y&Wg9wGac=rWNtgqbpp2Me>l94_;k{6_(B~t9Ug46=ykY_+S_K7 zfmf@D4acpPIE0IyaBf!X3_{P$Kk}Si`F8ee!~1rAt(LXFEs9kN?(j(j_4~Q(_6ZfW z;X?LnfdEj)+w4m9b-Kpzx8xRQ`+q_Dmvdt`9?5R+f9)4#+H2YE(AbSP0EQ?WH!|x`&G;TmC}g{nL%6lvmwnW_VB8@ve~F zZdZGE{)JsVzVj<~_2SMidL7#9f1I?}U$Ger@=Gov+|6G%A8kIk)tbyJ`|4EhnA{TJ4*KU1CSI5+RaDhjbBEo{_Dq z*2q@2_fSXAQ;*e90T-fo?YVZVmB+HPp`=`Hb*d$!dHp;2Aa`}`^*^(#tvg@AnjP5L z=+-aL9P%UAUjM!7Jv$q3)vG3qe+c>iGn(AJvk|T3vfPs_??#udxgApZ&nCxl>Un0a zy}r8q*YDris5GBnY5IcxNdAhV5;dsby`(@^n?dRLePmEkecyrRZ>Zj~U;7tHTPl73 zFKFlD3W?k7LU*Uo4*Ct+L0_RA^u=r6|3K2d_WgejSsCO*e7D0X2!&Jv2-^_CpYltA zB4pS&NpVH2QzQ=)^G1eOrvQq4m!X^@v225td!?#(Ou<%*GVDU-_Cc@IFwK@1uKyNCn`MfB?l za(Zi01fUuRQD(Mj=#)%yZ(o7LiN-ddxPiDlISVHYP#kJkaXcuDlzBk8OayGDBtV@= z0xQf>v-t$&#-mr(#nS}&o99# z!Mp~?IMTbL*udj;mP?@5w2EF`PDMc!H9A!wSdn@A85p+i1NnlRr4$tQD&J690%k!O z(3Uf(Hxk@ymV_V#NF`AF#x(F+HPhsRJmJ{yP^Z-`KO&{ncK`~zA*;!j&}0YGnBEdK z9!EWybcIbJm!F0pp`LJIzame^+7TRndcPo$>5U`FVdaIOnD%W0ecT4<6X~&W#s&Rv zit1Ruz%jHj~88QHf0RRXjfWAQzSY1hA zDJ6mBk_6BWCxBP@7Z9C)Nu^;x5txPe-bP^Ecsn)~gmHDd1faPt$FH<7y64pW%WO}ZXbabw{(rJV)D+?I3> z{3cGNM>sW8;5-4W$A(c z@4ugK;q4yL9%k8^nb z+3RCl;|3+1dM>}!^08}yKhssKv-WFG0*=1 zFpI9p=YIf5LuV)ekN~sbL4XA0q6!2gz@YeGfJQJ07aD*i(7l=CAaS5?93=766?q&K zn_Fk7aZs#GZyZD(s&T|&>tc?B?t>8^w5!64E*sOgq;d38nzh)jZf;~p!#$FwMiKy& zl7KW-57hj`D4|hvsvAMAH}x9S!m82*wcr*ssD<~d32N0?fDGj;{rnW>#n>G#I|UFt zNV3A*1;iu4M%x{I!ybhE;ASsho?Bj9Sw(V?ecbTNu5I{bPc@Rh5;Mo395gzd$Oxz- z0G@J$!zQFKB5u4pARk-|+lyA9xi$PRr$8XW+$^0dmqe09w1W0RcV$^tpoi#$bja22I`4LYWPO+s8L+JKCyNSM6(474xM$#D$xQdx&3pnf^ zuO7ajuAV{F(3df9RMt8_whW;WHZiWCejute=JkSU7b5r)F43Z>+m+7t;Z-qd{GQ)C zRy1w+V!A%YASdbC5@Ubj+<}6yNC)qc3l{d9QODiG*lzy5XlaeUiB$C>x=!RuxbO&$ zn(k`poLC)$>v1k5;WyYpGK~uNpM)Nyj#eqcO&e@HZwydTY*hy+gd|(lVW%TWR(0f9 zPh^%g4xK7eY{7>TGOD8mhe(5s>SAa}A;bvy@fwj`9TPvA;vqM2>JP^oI$6CR@PJz( zz-de1R2VBux-XxDSFIJ?2hn&i*#RTfmaRSW?ZIgseDssGYk}{`cBN}ObD`;u*#r3? zh?;z8rZWg~#_0^rv;|)v6S?P|E+wt}^~&ceD)|eDk;R*PzGwXd%*gJ1%4x^Lf}_H5 z{kq$1<6XLPk((4MPw!W4adqgBwBER%oE<~Kt$qA_9d40JWB0a^LnM1al92F!k%FF1eGH?(U=4YY+0^I3%b-3B*tsqX+mdjMN$XM#!WN8kn#wcinsH#LTpFU0 z+$4BpKvN}9iDF9|#4=qaB9BbYyCN81C@p0Hlc?k;sCxqAfeH&SZ>l%}s54pwPQc!D z1(G~|I|b2|MPtO)_sYu9m}oGK9ZND#r$iDTiZDP9bsU+u-^!vl0LSB4pB7#+UTyv( zi~U(Q-mIHoudb=(g%6chDd;DpsA-4%2>{5jScP$$t|vH+Q;|F02h3WsCkpr!K+4L> zRr)3zT>#T8#@h=M_sPj=Sk_2$WBlxzi-Iz0O_c11A2vQ*^d?kj_4b~ye*DLAQ}fEz zwescFg)3{;6&lsts*aRuJr3Mhn5$IhK1^5*@H=l$WbQv>WzO39B)yvEqBRXT%GW9y%BGQx z*i-pQS{hnT0t{Afscc19VU3y?iTN;shhf}mIWa9|j7cI^tC#2P6x9bRo*)FCx2O5i zrM@DMj$h9WU7Y4)G&oxGjrIn5r9=ZW;6M-naNzr#!zs|&mlisM1Cuz*CcJ6nwT!9 zviV^ePcemplAXsro(RwvfoKfRleq$7PUHK^cp!Nwj%+c72-AH9&?-{}6kVVJnnjdH zeYN`Jr^rknr)88KHG->R`c~&=D->auE~cT~Lu;ruL^Oy6Yan@uN1h zjlE3DQN|KJ#$JiesaS3qNHh84>yQe|*b})tX;m>Jate9MTEkPzYYSD}$#Z#i#adYA z6J#x1wdOt~A&Y4S3wCP4DZ{z~G7Bt~P*^nUG_|l`DtZHzV{Wx_kd*ptw4ehdN5_QB zG$|}h!JdA2%9+gQL!w{e^%TMT({$+1`3~kJHV$YqZ^FoE!+54Qlz_m;GnrDE9@OZK z7Gi=Sc82De=TA|h7^AvUZyWE3D1ytV1dJ%%inWc|twBW_4KTxfBN%00-Y(L;;}p-- z`zViEGczZF?@IP40HOiFNU7wzC7vGmeWKZq!=2GPgQQL8`BwVSa@+&_&D;B<~n<^W@!9d`ep`ZB4iXur`Aqd zSE^54wXR;7ySy-4?YlgCb?)jJjR}k+;#cDNXh@u7+Io;;n`g>UTAAH6s4q=+%d9Ar zWPPU|xv7szYq)%6_A+o--(~%20K$EL@2T0!No#KHa^$!*yIip@%~q=`YkknKq2Ao( zCF>Xh;Ts=qJ+30cU-dp-^Xf!VwAS(N!pRH2>kVaceh%2-$`wMXE04p=&vFNK)dELP zRNPge;#TLDD|4Xap169_y0n4|Rc5bZpq8CqxVpw8re|v&Vf5E#FI8RS?3-fY{_y%n zEYWcLq(&CK>DlGWpdK&GUU@u?*I$}lyK03cGi50o2uGeJCL%k0fpN(WD+ps*$DvsYfP2`Qs(jfqb61JB)CokwT_8W%XVLDTB+C z`Jol01Zd|O_nUjed29kW8eYM@2a}+tnXq4*2kwT^;M@b1mCH{(2`SS9eAy|XcDKIe ztS+F00Wob2P~xk&t9b!;__Zqh3;Va@chaYB>F*LB2*wHo)QlB2-vzpWuMZi?kD_Rj zzf8&J@L}q6F=66jb3WyOs7J*IY{(j17Es$@<{@9B#>8rR~q0i+^^(yELB`%(S}(v}Ud0^xWgK zPgNEFLnjP9x>fvh>RTprm74d`d<5pg=y&@T$hSVI4XRjOF3uV+ACMe#h9jU?rb<@1 z3dCNRTYf6HHuvOJ>)hPJ6Z32CGj^EEFb&UMUV376<*DTg6{l97e3CXXwp|!plW!#I z6MOLnlaB-pMktwyh({mw^7+{9B$n5 zUV!viwn=Z;+#E7KA7R%pKp|;q8_|sZ$TyO2rfxfuN&0@h?!0r~{GPjm4<_KT%Zql~ zmZ+~lVyl0PSkf6Vei3%2U}ONE;hdK#MmS_8Y=#GM&u2V=_AX7^4`B`91ZMzhLYOgO zPa{$nBs27$R*wlWfV0r)>Z&%}bI@y)Wnd_yW;r!MT^MDodMDAp^53SWw_OAVt!59z zst`+J?CFL&O3)A?I$x3Oy{)pZa91CEiuum~?oov$bwB_Z>JO2Qd z=K*FqAMoCRdsD&qWB30=x;*}q58@3a`sVUOUX_OkH=~w$lneIx$hllT9pU~+!E!1_ zb%cdw*4|~0NPdQ*Ru|Z?fC_vzBr_y+^4>%p*hP_Fnc2vvC^A!JYjR?WSVU3^q63-~ zED6a+SV(8AuX?HM9$_B6_bAZG*=Q@3=(Ek)H#k}@l3G?Pw^Ex*Ex8-lg0U;j7R`nC zz3x=-bVY1gM^|108H$@myH@uhU01>a8VEgDR>Tje?qyPSoomX5SW1MNqmY%@sMD$n zkp%%>xtt?eSiO)4g#`%fCrB*i4v1PnWI~c4GY?`@1ZB7L$o9H!%{!wcS~4pV)GyEw zwCD*PV$S$`bW3FM4xmX_Tf|#ARLAY8rig*6mCy!%B3qJ#I#N<6 zeTeXL6Bz}B7PN+~5R4RXvPF8*WH2OTQKFS*@)it>&W92Zd0)ZXKyp!~mCukX2r>l= z{u0#naoTkz^TgxH&hr4NaUvK-(Kl!~f$7D<@m5tbC!8hg$+_9(t00^f*1)8}k7Pku z43Mu^XP=xS*5L|BTZn`g{{CFVveGNd?^&~!mRCLq>g&Udy}@Cie0A;#k|$UnoLfcU zb7FrUUzn@(^{qa+6mG?rK(G(EAmp|&Gaeu%c*i5Odi$Zg8;aoWNdR#gV{c!7Bx>=W zp$PnAq7eo@9Ny5Y-5LcrZB{)Y)p4Z^=Hia}rhQ~^AFT@P^FD8(StdOPAC%wtUBqk{L$VD@^5y0O%idyl->u_n@ROy zo=0Q)sR&&uLSiIuBiIN94TrG*4u4zkwBiq34|DpaM)am%wCf8q3M(FYf=XN_O4~*{K@lzcIJ`cL6NbOF06kc zX}NbVyxnjB=x*2498tqdZ#N<~tI@-4_!f3e(53bLvUlvRg|`_I!bab2NNfkTTfZD; zVAn!(jv77&HWa&0J`~xz7jj^#U0zDpE#I!GIi&g-gi-o!UTTi0;bUNHx_eXjAm66& zHX~|T#jO|{VQt^*engt%I>mA8k6LqF&lBKNpg0CqtjTv|{Lq@? zCW>PiGfc7JXT5S0=p8CgtCxsv;Mw7{Efh9I4|YvZ#FCD711Uzu?5y|k$04Af2LTQB z0do1S=T_0l9w+&EFBvYHg}togLRGilG9xpxiY>K0{x|Ev zNMdDVWLz0}M}(HCYTmQ>Yqp^+vl5Q?ox@bUm0>rv_iU@tRvlmB*$1{rzR%X+e&ZE>7|ql(SiVMDUQqxfpdmBq3Gs#W7wSIq_p$CW$( z_JJ%WihsT;WU5~b?%|efpw1Q7Y?Dp8YVIUYFz7D+`S%Ds;59d4B?Dd<;BP!|kC)<( z1U3FOI66u=j#Gn|)dD9i6Nk)nICYt9-D*1@H#4@uTE|E>!xah047eafh;UY2fO%~C z%_{fnrdi7wj8s4~;TjX_;3Zh3R;rAa%jSJVew@P|D{QaWT<4G{Ipm2#7EA6BLys2i zX%2iEfv3&;MS`V(koh?S#!r>*v_edp$QQ(J`7&Dgukt?Y2(p~{6Jfqbi4|+wPlN-7 zL8=H#6I*+PC;tCg;ux= z%*Z0{ekn8wVyGyB^$3T&K}tiv97IB)pa=&rrpZ>YVMI3^46GD~M^azp!`1f++*i|r zi*2-xY?V3iFk+lE*IQvNG>@bpIcSpUdaf`-%dxP6+jUA~zkC?sEX!oYfDH{;i(_2Z zj@XVp7!7PVgs!b*@NzW5ohEb;g(`3`j2)pk!{O(_YKD_ec$6o9{alGezY_2sI~kf# zK3-on%Y_1+K!9py!_;MP12`u${v3@ZZ4R_oDH za2^frkrNATx=K1|R$z9kaAQ*Z6@S~~X zoYJGJO`W6;J{?_NR^CVi3e*!y3>b#0YMnM4oakdT%b*W|$hhBO(rPi{7?hj=aUas~ z(;zfFf_GH>0?wf*Y9{xwc&8F+!LH#oZX(o^%`BKVu_Jn0V(>IV_X=(@&T$21_j4`uqnAQY#EhW>4nZYS z>?pR{Os>G9MGe^`SVU4%o%M=(em%p!ts8Ie;m)xblgthvVxx3Cvdl3g3#>0L@|uPt zbeW!QH*xQq#eJ2m&D<{gnCKa@k(ElxE^IA+>=mM(L9U+R?G*xit{nqEE0<~J6M#?P z*9|v^Q9*@VqF&*28$05O{Q=lF@Maj;EHc1h;*PK$Xva8DC0dyGbdS+}pzY9g`gn@G}!{jN4SG@OhT&S5f*YJR=m zX2f%dG=e--CxTu#sh5*k#d~K-HXP3^cp}_GBV^aQzMjbycdyzbSaV%Fd~8GnkwwU%2$EH4%EaaAMa+a-*POG{G&nzTL_OPx-Y+|3ShWe$y- zeL8EJWw!}PC2JyTs0bC>4P>%G_f(3i8!Tc{&!ycNAwo=X9)gD{7>W&>t??*v8F~(` zHyP;6q=rLdt^vGRCTNJvP%*@yqV&R0r@X;uU~^TTBvoQAz!TOf#>eDAhWQ|mXQUA~ zCWm2x${vHXnc1?yO!?%_X{2C?DV6Kl6%$_WMWp>wbR))uh(Y<%ih%)@vw;Gh^zR+g zH~Xm+UkXBba{g6d8i_J6oXQ9Y6rl)qk%|bHiikueXT%6POcCh!MK2k=sP`2ihSA64 z{nLGUBoTUr&_D!fsuyY`(SLP+ysX{@_ahY`%+x%|ltr^Jgv}jOMq(n>vX+Td0|y_% zcwXsZ6Gm#4*H%JV5}z#60BQqvqfrf28?a)T}x)0rRQAY3yG zJ-gprHjC=5wu2B$o=XZdLH40l7D^c%udN8mOj+bwID6LOtXDj1vt||o z1m^rRp<}~|Mots?4$70kj$_II$+uIUewk64LP(#5z9J`&rVJFDvPeIP!8l;cptYa_ zVeY)eTyfsvjr%XADIiEqao@$1fp5On3iNY#Bo)Gsxi^u1Y)F_gPCiXp#vA9GrmRK( zn>PJ#I`m`MG)-|Xn$YE)22*OsH+O;lyxWk~A0z#=WzU<4@rO1UKXk}|x3x87|A@Y; z?La#H20>-AnykRdSgYcBry}B@V-b)vfD9yvDxfULz-|jciz$RCY$4h+g}K%-9q!rE zTr{ILp`*5FIH$0p2{n?79I1=M{)?FZ0NbD$d7w6tmpjP;yt6Hg)R8Vk1V?z z%aAJ3Oj^35#$>eAMIk)sAa}0=daF8$;}pL#VZkb5=`eS&1FZRMVHB3ggTf%cEuqv= zD602i+HmnwfgDnkEk{dFyHILniee0!POXWB1huTtyPDEm@7(7$g^?AZh~Cx|=6Y{B zdT%0&!Lnty+tLXP317?IV&3jnkqP5&Xd+hQ(8_i0qY)0;6W|^3F!#~}y6J6XEcem_is-jg7<;=AvQ4zh zMsBazc4%+;X|YX^)3VJ`r^gOky^9sNfNOX4rdyM9cq1kMs#pHWm%Mj&qt&XuTyR5=N1#jh1jn3QGcUJ1d_Ko%<{36#>($jg_vUp2 zkFaj!XGK5p58{2(N zJ^-^yZuQ2N5T*7>*y_a)x4+ApX05)VSf$qaDm?Mob!gu_wq z@9+Zk8=UaJHSbV~wpSdT_(Ptw{lzmM72;R3>#Grec{r%c!lnI>udB5IgOUOm9~6NA zDF6O_*&4p@?+-|;P=m#mwr;-}&F2OkWNG2j4%Cxs=9>*{Kus1fZTOvCuj*Nt$Vt=a zF*$`85!UskY1JGo1ty@9C-r4UT7II`Pg_&Pk5(X@tQx}1S;CnS8zXFq${%#nemK!I)Z_AoLcPk2$Q&ZY2D6Uf4VUvvi!LeP^(cufKQ-!`{p>d_ z^X5#~a$(MAUS1_}aNcN|Jxp9YwoplElnAI$USF;RSKuK@PQa4j&ga!-vZ4IwsE?nD zZj|{Nv&}A=z;6W{+s?p2JTMVOd@$$zv-Rk6RuRvYpDOjut)bYVJsX^O8=08x?x{K( zk1)4@bQDokEoE?NZk1sU7go8;;Sk(rW!myM9ApiB>FlQXEl9=lVNR#04xm=)S>bUw zHQ3Be16=4ct|ULa>hmN+=U26LIb4_+eC9CXZRT+}pjxdpo$8;T|J^Q`@ccH*-O6ZCsBzR6%Ea zfY5J|*-gvb^E0}>IUc(!TB^@FpJ0Yd=4iLpHt$hF1A+>5Du>F${x$Mb@b6 zkx5Xmz%1xRy_!_B*=SKU40j?IKv#kaCnvb~nOrCAjdu+d7q4-|vr7+~waev%z|x|4 z#ib3M>2F}pgu>01HhiYWLGm!T_OZaN+j{NKz=ag!I>h^?4kb5pv8WA~JIQ0-OL>B* zJmMBaSm2QVWx$wcW~Q9TksN%%w~-weNzpQS7@arqO4Y8Ta=eEqx#M& zM0I;@t4L!rdn;vn;Ko|c(7rl(pBRRYEJD-!5Ri8gT0YoucSPGza4!Z^BN-KWPfnR# z-`}|K^2W|mc+G&zjOiV_jo%{gKQ&5>{OHDQiNRBRe3h4fN>H5e_K(*@v2yw}&f9`q z+!7Qgi@D-@_Q`*6V4NV)R&*T1A^qx!PYuDCkrF5v z(Pi~97~hkAj@O|2mK3qNkst)G=#YF0&*c!A8R2q~#~1J4kc|;RX?uu~jJy*_6M?|? z2&+yDjQ!+qnLg9&>Vu*j<1vfdjcWu6!@oW_{TH^t%9)hSnvs^_H^0AfCEmNdcP!`D zcKO1UA!xV%RFqG?cRR$1THvM2a_%IG58_1PwUha09Rbj+qI&Ljm#fjc$}Ot**CX7G z$F({pihN&B@#9c`B9;{>aqdOPA{kz{tgjpR3clHC-d4OkyF%!6gvGKA^xG{6Qoh8A znI=EdCY}}i-bRb^soOD)rhoNADIgXXoGc#!p(*}t2z>nfrQ0d@FWhu<4Yrp)S*Dla zVGyMz&;&_~>e4_>X3eS+=`mP>iqfs5t|WotwamcN3|ZAm#_FK@7Uk4ING4gvaTZlRp|-Z=|A#*31Lm_dmFTW%D3$ppj> zc8X^U>vjp)C~;{GCm(Wo&eUNE=6KB#x2D>kNB?Snraa1R3+|@%o5mdY5#IbWtabP# zlmg9-L!b)wml>{mdr4agmsoG|J0RyuN2F7XNy->FqAyQ1lxG!-B)TTOh8*bLQ^C3r zpi9cagm^MqF%e&hluR@M)#PPz^@F;eUw>n!=-&??HMS=;YlEt15eNSa1xg6K`r>4`rV0R#->2 zHgvxT4?xBNQ}sm`7KE_{WHbO*-q@c)zIQ_u{4XH(mmCP8Ia_1u~ zCfEUYex0mv~S}*P<4MZ}6GzZ(9Tjq=hi_Vv;$!$#T5GI@#BGD9L~) z{<@}{ysHyZ4@d+8-$vwV!=iDw3nsDJj6bMz_QK+w<78fRfcpJ|t2w^7K!z~oT)-zk3bgwy`LDDbae1l6vbG&6jT_Ud+_2Qu^_-Vi__3KJS{2|mB4#0oV19|g+ zuze@2@{=^k3Ln7RHC~W>@VxA3Yvg69yu>orgR zg#Qe0hW*XT zS8r03u;9%K&k+!mQr;3FX8ynoa7DK~4qPRIAYM<_a~<*2O65D8e)hd^@>$${Uclul z2Fk1*UefZzvi9-Bd4&lXXu2*!a|0w55Oa?7t zf|E@@z8MoQS92Geq16)7bMF6CH|GEdr2L=vD(ctspQ+pS(Yf&eFgk9G;K5Y^B|LWe z;SIffSK+ya3|%NwXN@}gPxafD`imv@wdApNKBBmUO!BSEd>SUtq0-6)=+W2+qqxC3 zN8&ZOB~ah@e`5rhdsl_Ohw&R+t|uK`bPeO($?Wh0RBF{N(|Y5GweLz7Y{BZlB7Mi> zP8_yK-_r`L&@<=T@Yb4lAWT*<#`7iKnt6cI^pL&B7N)MlVR41SFqxL_$}N6JgM=RK z&!9S`87F9e6MI*~AmvM$Us8%NwjWsvFEJy?3TV zdgsR2K%U}m3^>Ik0EEY}-S^+Eue7~mCA#a-PN)e^l1>~ZE6swkapA8xQn-E?kqB~e z;bFqx3Ft66Tr|}(8^|pQ=Tov0SMr+?5=k%H&dm!Un1kB9+Kv}p`)jbH*5|;k%sQ~t z2#ncDNFc~laEk$8h{7raOs3Jr6SMnZXH7xl+DiP}OP*Ft)dLL|dV-)M$v*f~mL9j&YCShVkHz533m1n`_n;j~n@fOl#f;_VOZBmoAKOO|dIuOEMP9 z_5q-GE(6!jT~4b-Gmq**M<~k0Ci@_h_)A$r>lA~_Y2N{TJDtLx9$=${bHoQH{OcDC zqHp~woUWg8%(os0s>#S)aezpFGXG>yb9BlpcY(zkwuNX%!h4>9<@c1K807CEv0G)mWNEjR{RcQ1!2Ju)4s2~9{c?%FtrqffP-jW5(g}rkT zB=!!~QOEF64|TeBk6@JE@bw=Z)Bl*|_lkp`k$dgWuzvQAxHlv{PFGQW!S1l6 z3P5o#&FR~Mp-9a*P$IyPRIuLw=K~P^1Tr4}@<#`7&I$3$1BSxUV^4uZ@MdubVXnEytMvHKe(6oGGMS+NZC~7QX5QF6;uhh{J2DF5YX^4ifu?-2iw1iD+i4|!H8`BUiVcP-$Ex(zz zaL={mHCJgES6oZpaFza!Xg{v>w_BwUH(Rj{$cwG;j=$)7g#JZbl=_)?!obN4J(74I zg_@6U!YVfTwO*m6+#2EDAr{)@Q-rx$aJNK$oze4g7Fhj?<_(%a5gyE7T3`gS#)&Kk%Ubz<%uL>cn zuxAz^B-e~ARe8(g`|6TWp0pnFB)mbYP+aLuHJ!rPnu(HDvKqvy{2C5a5q^zaBbE#& zg}zQC0+~u{tl|RgK8Gc5ibUd>%ajnUde0>YVyGrrIJ2gFaaM<9$5^s?qLi3R=ig4H zV?*OUuorObJrTyZ{iCULdapi~OUK;)>E`Ksk_M}C)1#(})o)AL*wtPLew3iYs9PJ^gopB-0-Ser`J($JaJ$KJ1Q}-wX z_5xowzXKBZ7$^20kfXbv5Eh_OM;%>AIQ-2*k^XeKzg?XJt<`n ztK2n1&+kmo6VnED>_oF~AZ1JP63(aUNgoLH67=0UQx9`kM4$7iR6S|@{S#C6n7ko* z&K_Dx%H3?~%u9kgUY~`~;`>wfXa_ay#)K(44GGD5V6>7r$A_(NRq*Mk{_Vs$$eZKC zAGh=D{DH(d2<4u1C`nsPaQ9Rck|?Pmxi4Nb-3onuj0E2SX4Ys4s%}!fxPvbcO!ix3 zn{kCCWne@3X!Hzeqe@9lt%HbI-=DavW$L_=2VL_?M zJpI)+9PqBOz+3S&`~qix*j7ObC2T$6TBe8K(IgJTaV&^;5KElYI=ucD+(@PLJz`QJ ziX&FGn3z}Cu44E$2CCvmMhujQZkTfOkZFa80@ZxX7;nVUjQ_>tiCmB4j#ot*uWFq1 zRZ}2-gZhA3f0TGIcG;jU##$e5-TP(D;}(bQu1W%ty7x6sVU*T@GDePO^!6ITYehWO zWQ2QUKDvQW+u)uS0C2MdVHL6L1lhRp1_+TMp3C40 Date: Sun, 1 Oct 2023 23:52:40 -0700 Subject: [PATCH 14/18] UNIXUTILS: Added UNIX-FILE-NAME Produces a Unix filename corresponding to a Medley file name (slashes, version number). For use in ShellCommand an PROCESS-COMMAND. --- library/UNIXUTILS | 56 +++++++++++++++++++++++++++++++++++----- library/UNIXUTILS.DFASL | Bin 3617 -> 4894 bytes 2 files changed, 49 insertions(+), 7 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 89140a37..6eb41003 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7 7943 +(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9 10573 :EDIT-BY rmk - :CHANGES-TO (FNS SLASHIT) + :CHANGES-TO (FNS UNIX-FILE-NAME) + (VARS UNIXUTILSCOMS) - :PREVIOUS-DATE "22-Sep-2023 15:28:19" {WMEDLEY}UNIXUTILS.;6) + :PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -18,7 +19,7 @@ (GLOBALVARS ShellBrowser) (INITVARS (ShellBrowser)) (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -155,11 +156,52 @@ SLASHED (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) SLASHED))]) + +(UNIX-FILE-NAME + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + + (CL:WHEN (\GETSTREAM FILE ACCESS T) + (SETQ FILE (OR (FULLNAME FILE) + FILE))) (* ; "Might catch NODIRCORE") + (CL:WHEN FILE + (SETQ FILE (TRUEFILENAME FILE)) + (CL:UNLESS (STREAMP FILE) + [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS + (OUTPUT 'NEW) + (INPUT 'OLD) + (NIL (SETQ ACCESS 'INPUT) + 'OLD) + (\ILLEGAL.ARG ACCESS]) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) + (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] + (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) + (CL:IF (AND VERSION (IGREATERP VERSION 1)) + (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + "." + "") + "~" VERSION "~") + FILE))) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) + "-" + (IDATE) + "-" + (RAND) + (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) + "")))))])]) ) (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (902 1275 (ShellCommand 902 . 1275)) (1277 1676 (ShellWhich 1277 . 1676)) (1677 7865 ( -ShellBrowser 1687 . 4210) (ShellBrowse 4212 . 5204) (PROCESS-COMMAND 5206 . 5819) (SLASHIT 5821 . 7863 -))))) + (FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 ( +ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924 +) (UNIX-FILE-NAME 7926 . 10493))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index e4054f2c91bcabc25700afb1f4b3b3cf68a664d8..22cbcae65f7748ed6f87b60492e8d91a30190992 100644 GIT binary patch delta 1940 zcmZuyU2GIp6ux(6|GL|jMKO{M!lFVW=@hz4Ly8f1*qz-DOlQ`eS=vpiq%Erj3MC6o zK#E&X6Jj<}9J|gfNTM-5n26FE;}6ncVj{-qix0*Z6B82?UmzM^@tiX)KgR6lo^!wR z-E+>p=iEE*thuytCiiS_)Sj5EjaHM-?;o!wM{CvLW7U1hWVd3C9#c|VQt4!B%l4ks z_Eb8WS8d~dnmu`V-|&gfWOowS6C>3ckW=Z-r6oN*SKe<(JmjY3Z7XLR?PXIRRPwr^ zDW=-5x%=gghyO3mY-8>Djz@U!!Z&h(r}Ew#jrgXrIiQ<4rC72YE$eI&`2b_wn`wlz zhGmyan&)!-H{?Qhue&3d<+^(&sIJ?!jPs*B431h&%Tx?2s~Sqd5_$Kxpu=~$+d}Jj z#T^L!@u1GZt+=yFE~L8MQuyUHLx3~Fr+KS*jt9hE#-ztZg^OYLR`~Ds+8H366O(Qwxa}l|PvgXljTTPe+dn<*2AtyxB$|+ow8?sP%|donop3kdUEdRa<*V zOvP!zj3f@b&FGArN~PT=V##*j&qeUVC6RLnV(R(}vP|4Lp-a+#@=i&L78@vpOw%FyJwo}s00vbHu z@EXzQ5jjoj%#@F~=h_~vPcaECuGfH?HTWrZQEc^^5y1GGjJiJtHuiR=1;ya`zUj;e zTg<$Bg)<)-VPsi&I-|aTl$%WwA9vh8U9C1%A~wi8A}x}PGFE2{JuXin2&p&cGUK6x zKLdfWc%Ki=SMQ;%BEUoa(NA@YeL$d}rpKb+Z#ld4)zC>P#oSEr@tL z6W{sPQtGfWQC_(|aG0@mL|MfSk{nawWAI~A0GoDGNwYO4ZA*<{_Iw6R{<6cw7 zXm1v&(fs=`zkwz+6sac?iLpeYNSz1DGl@}Y(KnO`BTfX|u)CV?uud&LznX9#B7_FN zP20k_kN|RaAk)4`N}S1zvcI}vY-U@9JF*VS!Ol>5M64EqEm_x`fadE@;loXtHhBN z&>cbeG!#rfw;Q2Jcxv{-Q`6N4LtWVcqmuR-51hneo!Wft(2>oDs{6*PCzJ$!A)tSt zYI{_ptT9NMN4zEr(^7&K@o<_aPB$h-ZS$qx;N38Tgim12OEu5 zN4|S+&5>6dPPOUOWHqH&&O=2_s3|$A&7=}DYC1HpTZO-AR<*g&s8zROOdvBs(^+3} z8Zwu~j&xeGx918V(YTnQkHzTN|Ey_Glp)jqE@t73>Fv6s(~HHWd~r@$D3@&0u&2?a z327WudQCDQN86GPdHPK{2PXX~*^_yX!c&NNZC5f1CCh|>*Ks9%wp6wW5w2i`)`otZ z$^jvOoXd|ZW|Nob?cwJW%M2$z&OGoY1n?G9UBn9D9r}Ct*GT;tBfP-)CdSvWz8j3f zc7H0U!{w{UJFjqSC$x#mBdp)>Ub_J!r`tBxH5`j!Yl Date: Sun, 1 Oct 2023 23:54:23 -0700 Subject: [PATCH 15/18] PDF-STREAM: added SEE-PDF A little stub that (on a mac) does a shell command to open Preview on the Unix-named file corresponding to a medley name (Also added back some key functions that got lost in a bad edit) --- library/PDFSTREAM | 94 +++++++++++++++++++++++++++++++++-------- library/PDFSTREAM.LCOM | Bin 4201 -> 5191 bytes 2 files changed, 77 insertions(+), 17 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 9ec59d23..1534669e 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 22:54:26" {WMEDLEY}PDFSTREAM.;49 10763 +(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}PDFSTREAM.;54 13917 :EDIT-BY rmk - :CHANGES-TO (FNS PS-TO-PDF OPEN-PDF-STREAM) + :CHANGES-TO (FNS SEE-PDF) - :PREVIOUS-DATE "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48) + :PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}PDFSTREAM.;53) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -15,7 +15,7 @@ ((FILES (SYSLOAD) POSTSCRIPTSTREAM) [COMS (* ; "Hook into hardcopy interface") - (ADDVARS [PRINTERTYPES ((PDF) + [ADDVARS [PRINTERTYPES ((PDF) (CANPRINT (PDF)) (STATUS TRUE) (PROPERTIES NILL) @@ -29,10 +29,10 @@ (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) - (VARS (DEFAULTPRINTERTYPE 'PDF)) - (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) - (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + (CREATECHARSET \CREATECHARSET.PSC] + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] (* ;; "") @@ -43,7 +43,8 @@ (* ; "Mac with ghostscript?") (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) - (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF))) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (FNS SEE-PDF))) (FILESLOAD (SYSLOAD) POSTSCRIPTSTREAM) @@ -70,11 +71,56 @@ (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC))) -(ADDTOVAR VARS (DEFAULTPRINTERTYPE 'PDF)) +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DEFINEQ -(ADDTOVAR FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) -(ADDTOVAR P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)) +(PDF.HARDCOPYW + [LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE))) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE) + PDFFILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk") + (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT) @@ -154,7 +200,8 @@ PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 22:54 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk") + (* ; "Edited 23-Sep-2023 22:54 by rmk") (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") @@ -167,11 +214,11 @@ (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) + (CL:UNLESS (INFILEP PSFILE) + (ERROR "NO PS FILE TO CONVERT")) (SETQ PDFFILE (if PDFFILE then (TRUEFILENAME PDFFILE) else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) - (CL:UNLESS (INFILEP PSFILE) - (ERROR "NO PS FILE TO CONVERT")) (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) COMPLETIONCODE) @@ -210,7 +257,20 @@ (ERROR "Cannot create PDF file for " PDFFILE)) PDFFILE]) ) +(DEFINEQ + +(SEE-PDF + [LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk") + (* ; "Edited 26-Sep-2023 16:52 by rmk") + + (* ;; "Good for Mac, not sure about Windows etc.") + + (ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION + 'PDF) + 'INPUT]) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3630 10740 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 - . 10738))))) + (FILEMAP (NIL (3078 5692 (PDFFILEP 3088 . 4002) (PDF.HARDCOPYW 4004 . 4602) (PDF.TEXT 4604 . 5321) ( +PDF.TEDIT 5323 . 5690)) (6136 13355 (OPEN-PDF-STREAM 6146 . 8324) (CLOSE-PDF-STREAM 8326 . 9613) ( +PS-TO-PDF 9615 . 13353)) (13356 13894 (SEE-PDF 13366 . 13892))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 78e86fb0fceb4ca18f4e5b00d85ca718d47ab46c..12da811e8efa8c3c6eefca52341c9e2ffa8b2f75 100644 GIT binary patch delta 1567 zcmZuxO^@4D6t$;nXPUOOBf+K%xH76psO_nb*m)I@q8eqZODd+z-QertaB=v}b% z{NROdo3;bC>3fcEdf$I}ukzd$G_=)KtK&PKZ`&F?IU63F9*>Vk!vPGx9-lqG<3mZQ z&Y~EOPC$$MX$q@H4a3l2u>S)0zxB?J)@n54B&A_N38xWgZ^bpar+%>ExnMaR>%nAK z1%3W%3w&14-6ZdqdW09io4^q@Vt2&x%5z!`#3>$Q;79F7GXWFCv;_)R6h#fbz*cF9 z=2SFtDx2$K`pOBeivIj=@JwzBV0348{vLL0cK!}_(d>L3yLdL=@cNe0Y@4VMkCO_Y zS;Z5+E8+2-ecgH5T<^Q_PVqH%Y=T$Ncd2|%SewJxGl-HP%PUMM{umuojyr1 zbl`JZa`1pY<}@plJi~2ZdC=65uhx>ZjcS_|QJAy6M>Tnd-S{E_Cx~4?2JpSc$+_>DQb& ze!2*Cs%#guEJvrwj0c`Wm}k4R;8=hzD%heZ%$}>e*X!sROf8RJ+n|yNZhv^^JZmCzH8E2&^(9^%Kf4ug7!N|@I Z%x%oDhH&J+hvt$dnp8LMPky~Q{SRk6VcGxy delta 466 zcmX@E@ls(zxQLOlZg6UWu91O}v4WA2m8pr9k=ev-eNPihO$9C`WLZNaD?<}2V*@3H zq@vX1{M>@foYWMB)QWKx?i7~<-pfMOTSC6gC2%5#`lDi|7=n;B0IVN|e3*yA7I>Ibq=H#h`ngs-N8 zRX~tyn5Tbeu&xWxL{tL}O|6VAtV~To1~QpgY&K%8WoCEW%G|V(;os!@9HJsgOb(n3 zK(HzwM1q<7ff6?vMK|x{RAyANRB#On@()rlu~6{z1Gzgu!Nfozz|q+o#PM_Vb)Ec= zYlfh)iGq{AOQeF4r9weUnu3wZvOMw9S9`1sOL>3#u~lJG!`p_=hg2vo From 877c6fbf17c588a74c39b31875a93b8ded8fd571 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Mon, 2 Oct 2023 12:36:39 -0700 Subject: [PATCH 16/18] Pick up master changes --- library/UNIXUTILS | 120 ++++------------------------------------ library/UNIXUTILS.DFASL | Bin 4894 -> 2667 bytes 2 files changed, 12 insertions(+), 108 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 6eb41003..ab7a4619 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,31 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9 10573 +(FILECREATED "16-Jun-2023 13:30:18" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;11 4989 - :EDIT-BY rmk + :CHANGES-TO (FUNCTIONS ShellWhich) - :CHANGES-TO (FNS UNIX-FILE-NAME) - (VARS UNIXUTILSCOMS) - - :PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7) + :PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;8 +) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS - ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") - (FILES (FROM LOADUPS) - EXPORTS.ALL)) - (GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) - (PROPS (UNIXUTILS FILETYPE)))) -(DECLARE%: EVAL@COMPILE DONTCOPY - -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) -) +(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -44,14 +32,14 @@ (CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH") [CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH)) - (ShellCommand (CONCAT "which " Cmd) + (ShellCommand (CONCAT "command -v " Cmd) S) (COND ((EQ (GETEOFPTR S) 0) NIL) (T (SETFILEPTR S 0) - (MKSTRING (READ S]) + (RSTRING S]) (DEFINEQ (ShellBrowser @@ -116,92 +104,8 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) - -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - -(SLASHIT - [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") - - (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") - - (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") - - (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") - - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (OR (EQ DIRPOS 1) - NOHOST) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - -(UNIX-FILE-NAME - [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") - - (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") - - (CL:WHEN (\GETSTREAM FILE ACCESS T) - (SETQ FILE (OR (FULLNAME FILE) - FILE))) (* ; "Might catch NODIRCORE") - (CL:WHEN FILE - (SETQ FILE (TRUEFILENAME FILE)) - (CL:UNLESS (STREAMP FILE) - [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS - (OUTPUT 'NEW) - (INPUT 'OLD) - (NIL (SETQ ACCESS 'INPUT) - 'OLD) - (\ILLEGAL.ARG ACCESS]) - [SELECTQ (FILENAMEFIELD FILE 'HOST) - (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) - (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] - (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) - (CL:IF (AND VERSION (IGREATERP VERSION 1)) - (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - "." - "") - "~" VERSION "~") - FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) - (RESETLST - (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") - [RESETSAVE (GETFILEPTR FILE) - `(PROGN (SETFILEPTR ,FILE OLDVALUE]) - (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) - "-" - (IDATE) - "-" - (RAND) - (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) - "")))))])]) ) - -(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 ( -ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924 -) (UNIX-FILE-NAME 7926 . 10493))))) + (FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 ( +ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 22cbcae65f7748ed6f87b60492e8d91a30190992..98d669df6bdcd66023b1dd50ed0be00ebe277f64 100644 GIT binary patch delta 680 zcma)1O=}ZT6rDH8Bu(NX)<~>S^RQ}5+bNk$Qeu$cIGKDj(@DroT7&_K$s`8z0nwCJ z5kEk1G0@g$Wv&#V_zPSp_!GKx)1TnRg&P;HtZ%9t!G(_t_uR{Q=brQS%Gb!w+{K(; zest~5uy1ACqsHKFw%g10tya(4%69(rUEz!=2tj=~9yKl8?)EI)99fO~RtpQu{K|O1 zC*lba3t~o$XM}VxFX`&vwEU>sYHTf1I;M0ByL>vGd=Q2A2Okjfk|TBr<`q@lhul@Ag{AybJC4U&0rWd3pwQM*#Wa^ z)QWYjoZJUY#=h$alaD?LY2=6RGMXY6{85tePd-i}hC$#;x@CI`V%lG%(xEj;tt&dO zmUQDP)$^OHYc5W@xTYJml2%xtIH)T|zN9Mj+IjbEK{1p{o=&GB7N85CT+w97U=S4# zHHZCvW6;9<24?1**UV&b>5%O(^c4@iA-9JaC{Rbti6a^kO2`WYSLp}u#$}_AR&EpVSEG)nVw4MexA$AYUo79n*6RYLlNy)q5?TI(;-RH;0zW{cQ(HQ^$ literal 4894 zcmahNTWlOxb!PVI^&{)BrO{H_O`9~xWY)DE14)b7+1;^s?Ae*^%xq#8m(-58S=;M} z);3N^jGT~)f<`os6EnBCh$18qQj2R43Q1biKa3Fk^rPj655yNA7**l}359dcUB{a= z0?WE{9`|wH=iXfr!h;z-k(rsA9j}zCiJ67@*@gMU%QMx)+{{AtOeyg)&=VI<<<+dN z4lO-b86T~VRL}Pm4Q;UKXu6$z_ISjun|h{N8ksMRB@!L7d1hYje5SK2(fQ1Y?#>gP zU6EeJ*7=UR)9i)mv61sf6CDYdJu?a-;EJQQCEeYTyKi`F(o-`6{GGiwG$Pd6DiXN? zk*FYv-VL{9eq5G^_S%hAQK}u)Nod!j68kpc+ymEC`xK2eu3X*pSsM zl@?0}yj7%x3QA@`=~F$oK{FiH(lxt)6G6PJqonl*8UD0ls}a$2gBOg2N@Ym^)rBwY zX-(Ra>RSXpii&T&gd~g76 zNmpkU=StP5fe9^J6( zbKHfS0n%Y=WO@wn2$|(ndHhTn)w<#OdJWtS&Z{#Rp!*(_8HBTS#m;FCa9hwkJcbM< zuX14mXna(N9e^oeRL>bIsEr_-cU|(_*uzrjhWq&cPDWv!$q+WDrUl`No27}5ua_#) z$KGT`ilF`jX_p4JZ%;*cN85W*rY-tVQ4+V^HJWlknKPM^E9Ogo47xzstAFq~O5qiB!wh09B1^ZfjdcaWXmCQk|k@$d1{@dO^HsThTZLIe?No zklH}?3xbH5ozYFZXn`X|{C9nQ9mjoX&^1!9Ak{M&GfPoVsZLl2FdJ>vK`&z&@jVWN zX4S}=z1$vVVIR{XV8)Q6^rg-0kaz^#*bKT%3$vsKCUv|rGBr9jk{F*(JSdz9qOty6 ziNrZE1S&KcrXfQiRCKw|WW5jp(o=A7w3dijxuyu^@NmJgaz$gHGYu#2-?eaV+fQc2 z<6AP7(#W*DFiS;q4vrM)$Yrq!BoE+bs^|v;1(Y--Bb?U5hVI+@*g8wX?$4s%22&7% zd!8jF|8EdN2qsBYEM(mH5Pl-2WCY7Hx2CiYaDUo#auEO;FBm3N=ZtBoOHvmcZ}W(* z#Rq80<778*CU&lu%khoJ0iU>^Lvcj|k0XpCLP0F;eh>KiIy=I7FiRs;zM^W&Q2w1B zkR~*oKZ)>hfW!F#5Lh$%j-kBR7(Nd`q!uXPk2s(WeX66Hy@0hcxd8~ljA=l`3L^H3 zMJ!GU;d2l785^#568oCyXQ#m}hrlgtWF0Emnsgbw_|{7>2sde5$wgbEytR^kx|wN->B@7hpuTGFW!$Db?CZA2rb^|u48OI)f)Bf;a^=JAVj0MyR4Pt`>zmT zKW}e>gmpWd$!80Slk23$AF5$21}REi&bN%c_Fm(?6hS@LSQS67vgA3Itgz~7mMpNO z!jkQ1R&YhZw6PU6Qo%;M8z&!QOFmrmQx*%c81#)M#NPB=|9o|!gz!~>6LKkm@V7iS zaBjX-otgt;<^1%yv!2_OSS*do@+fuJ7oc369iJcY-0-=vv+~SrY5FTr3jY#IF|>`#zHupXj>&VZIt26lnVjM{tlG_DN7=o| zu1aiLRDcn%bE>X~rabphqNk^QermS8uK!l$#gXdt`1IL1`Ou-{{JHtE=ZZ&0Jy%K` zF%i@VJP0N)&(F`!ooH{5fXNXC5X{->t@)ndRvK@W#JZ-!dtX_u=^0R->Fn%+Yvm1B zD%f0Gh&v%jUvuSn z`Al%DuB7-RvceC1KKj1SG)by2@=#(rC7D&QNCeVQ<_DnYzeaHk9aa$b!MQC3a`E%E z8txNnTZ*+UhXoM5R>Z?lA0(^~Vj~+`XHY4_=(bxth$yTES8~e}lOMJo^p$Ux@08!w zT3bUYgIK3q-rV?-*;09K=XCU%8NC8v&(3w@cBS0~upL3O<&xR*u6|w5KYiy)z8oLE zX-t0b-o|fpp=Oan>Xx!Huw34h2egkSKfK*PIY43)tAAkfLptZhl{_y8gx%66cYv~- zUg?jfCbh|rXhlEqz-b{cjhK<}>LzMbHzIH=bD$eQrb~F2{;u1viG43<*v6M1S zmUx4QHTo?DWg_+CcSM1cMtK(h@+&EYLS$!+J{w2wM-M1#3OT?f_Nc^LHW?T(L!4@=`Rl`KDAjoK^~`>bi@ZMfO-*dP)-7af&iqXD06gE?r{yvm(a zEgNpQ6drzjy-;ujl?*;ts2ce3g69j62XC=s0r3+-@*eTtrST2~Ni(|e?>rX%2rh2M z9q^UVtEqYxnZIUT_<0AIP57kToq)tO+UI=)dGu_~aLNeI9)=FKJKG?Frt4~-q9@_z zeHbsB{JK=Y+h~(x72!~Rcq0(tHLU9>i64*%?!{;C!_)o+v;e)Q5!(i=K^=s4iS|Lt z&w&CLuYD1hSeay(w3pabCf_!()7Gc2Of9IDQH z5Z{o(ee(d3>nKF#0ooh__4xCH_NuSyyad1J<0bfJt;*kFn&5k&x*wyf#`jnSjr9tf z!p}138phZ|S6yJ$8CK<{dVi3N@;*L{{T95NGXMlMe4`&H&eg*}h}1#?Zj)i6{w`3W z@9%B?iLu#zc$tSsPoKdX&~|VEO3Y~}G07YZat{t&p1c17I%o=ljE1Q-91-%ck#df|wCII`O8yN__$C5>*#-U#5+LCNAS6ZH z)z60T2a+c80vQ>fD4+Og2iENV>VaJ#T>I6-#@q9%j~!rN1Z|sY4 Date: Mon, 2 Oct 2023 12:56:57 -0700 Subject: [PATCH 17/18] UNIXUTILS: Add UNIX-FILE-NAME etc on top of previous ShellWhich update--should resynch --- library/UNIXUTILS | 113 ++++++++++++++++++++++++++++++++++++---- library/UNIXUTILS.DFASL | Bin 2667 -> 4896 bytes 2 files changed, 104 insertions(+), 9 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index ab7a4619..0758f19f 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,19 +1,30 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Jun-2023 13:30:18" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;11 4989 +(FILECREATED " 2-Oct-2023 12:54:58" {WMEDLEY}UNIXUTILS.;10 10535 + + :EDIT-BY rmk :CHANGES-TO (FUNCTIONS ShellWhich) - :PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;8 -) + :PREVIOUS-DATE " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse))) +(RPAQQ UNIXUTILSCOMS + ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") + (FILES (FROM LOADUPS) + EXPORTS.ALL)) + (GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) + (PROPS (UNIXUTILS FILETYPE)))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -104,8 +115,92 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) + +(PROCESS-COMMAND + [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") + + (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") + + (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) + (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) + of PS)) + 0))) DO (BLOCK) FINALLY (RETURN CODE]) + +(SLASHIT + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + + (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") + + (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") + + (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") + + (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CHARCODE /)) + (/ (SETQ LASTDIRPOS I) + C) + C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (OR (EQ DIRPOS 1) + NOHOST) + SLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))]) + +(UNIX-FILE-NAME + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + + (CL:WHEN (\GETSTREAM FILE ACCESS T) + (SETQ FILE (OR (FULLNAME FILE) + FILE))) (* ; "Might catch NODIRCORE") + (CL:WHEN FILE + (SETQ FILE (TRUEFILENAME FILE)) + (CL:UNLESS (STREAMP FILE) + [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS + (OUTPUT 'NEW) + (INPUT 'OLD) + (NIL (SETQ ACCESS 'INPUT) + 'OLD) + (\ILLEGAL.ARG ACCESS]) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) + (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] + (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) + (CL:IF (AND VERSION (IGREATERP VERSION 1)) + (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + "." + "") + "~" VERSION "~") + FILE))) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) + "-" + (IDATE) + "-" + (RAND) + (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) + "")))))])]) ) + +(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 ( -ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964))))) + (FILEMAP (NIL (927 1300 (ShellCommand 927 . 1300)) (1302 1699 (ShellWhich 1302 . 1699)) (1700 10457 ( +ShellBrowser 1710 . 4233) (ShellBrowse 4235 . 5227) (PROCESS-COMMAND 5229 . 5842) (SLASHIT 5844 . 7886 +) (UNIX-FILE-NAME 7888 . 10455))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 98d669df6bdcd66023b1dd50ed0be00ebe277f64..e9cb27338f7ba39d2606d35dfbdcd0bd0f7fceb3 100644 GIT binary patch delta 2816 zcmaJ@U5p!76~1@IfBPG6yAhGKG%g}7gxH(?qah8!v-WsByW^RuXPnq*VYQn$^~O%! z-6qgz8@z#_R$!63lPq(?7PW|{N|a>zQOMsmZv-KD=|c(+JRo@K%OVwC%Q`PWsJ^(cJimPQaM938MMu-^JddxrOmvh=_<)g!%3S~*>h!> z^1b+b)@wbUZ7j#Ff|*urI|0k{ijnb`1hb%Nd#(g41KEO^hcT?1N~UPpK=!C5%Pcr{ zQqj5YHl(8v#pRZqHEc16V!K+Y*C&@7-+rkA(;bhx09&@M*g4GsX+LHsf&LPPl2?77 zK~Mott|WHBk_bwjvZeNTF83};UTg4?41S4Hc)7KE<^Lz2t&4Mn~Lhfi&0Le+Lvk?LHIyET|NN4$$uecRyC<5M0-+ zCP-{b)?$C&ha zQRZUa{d)MLiKXwtg4aayWs$6lr8$wbL{bsSVelBToq}cBSj8Sn-jwR7#*rcMiu=7t zn~%6VyWY-@Na$Y1azYkU0?qwUoIT(DvPirnmdc^=dPMyv?hB&sAg9 zW1-EHss2q0CCX%p!u*LW(|AQ_lJrQ@$EAd*$1t=>-AvE$uy>IXs498Jc7Wr4>v^>Q zTo3-iB>~Z%`Ie-DslJ&aIxT-5+>Tu3oR+ zs@~QH2Er+WM05RbUp-*<*AH#YMc*)^7l1sxb;-C{A8r9TjHKCr-t51vU()kW-MWyk z#%8Y@&D#5SuD+KG_i@_w4W&J^THQ#@Xdl$>-<+<^P~aq*o~hj@N8f1YFHlG{yP?&# zfU`Q;o{pw!TI~bUm?jz2Eey%wX$em-*CcEZ-EcUajD{eSB(M44xT+bdambf2>8eB%TKZkR}$pN$r$OwxSCZU?^wIIqCKL;&f z+%Fp+N-2w!i#L62W9d>0Y%}$E! zFH_7(-^!fp9|Lg-4;aqqj?b8}!e^ z#vXzj{j4V8Cl;&5Viq9}i05L*q)m$i1>zA&jrt+wTcjhfv5VN-IK=i*+7|}@j2L8V zdxM8=jQGDJ`|bF8r{mue8g%MUUaw#7#eMup)N%N}IEBM1>^6b`#A>aGrG{AYlXbU5 zX}OCJn?M2HJ!v3wP&9S`I`F+RW%#$z zz0euxHFMBwk~#P#4&!gkYdyAtwK_L^`qYcVrz*$mm9vQ$z78NlC>p%jiYkMcdBj^| zVM=9`iCM;A|DD^1!+GqXqgOPJYDPw6VT-uUe}IecAn~^c#9tr;WV{cIBuBFWQGOFF z_fjD!&r#;Jq9gIsjTaO3%C{=@_=(2yDbQiqviT~<8zEv9zv$3ojB$7s$zqpy2KL+A Qd0f)Fja@-cTOWV?Umt7@Qvd(} delta 551 zcma)$Uu)A~6vlIsw6S#;Lo0fr9BfC(+53mctZ=#>T8?OZMcD@}d2wn&W4(FWbJiq77<*$Xks~4SM>G6#_ zgN@ki4%?e|&0gQ!h&%mw*IfVAN3^g?^TA+yxE7OcuOE}OVcfnKcL<%+7PmLG;%reT zRG-&p=V>`#wF38VS#{X!w0CE?oN#$e#(F*-Kj`%E-3I`feG->JV%Mc}&dHQP`btcb z!oU3Ylk%hg%ABFX0jlh?6oJYN`Adp8%iB!|)*sY8WB{s@fs_}adTcB{G3D5U5*S9TKtNBRTw@e5It7g?x4y5}@E^36$ zddpiX9Ux&3vNwUSkJ-`b5^x&+G2@UjiiUf!HL&n)bpdGpOqx7Hvj+t From 1e847ec274fc5e3bd799128f79b4f38a6c126f94 Mon Sep 17 00:00:00 2001 From: Frank Halasz Date: Sun, 8 Oct 2023 19:34:43 -0700 Subject: [PATCH 18/18] Add ShellOpen (and ShellOpener) to UNIXUTILS; fix small bug in UNIX-FILE-NAME (#1341) * Add ShellOpener and ShellOpen to UNIXUTILS - used to open a file using the generic opener on this machine. Adapted ShellBrowse and ShellBrowser accordingly; fixed bug in UNIX-FILE-NAME where it fails if file does not exist and COPY is non-NIL and access is INPUT * Add return of error strings to ShellOpen --- library/UNIXUTILS | 189 +++++++++++++++++++++++++++++----------- library/UNIXUTILS.DFASL | Bin 4896 -> 6443 bytes 2 files changed, 137 insertions(+), 52 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 0758f19f..2150c55e 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Oct-2023 12:54:58" {WMEDLEY}UNIXUTILS.;10 10535 +(FILECREATED " 8-Oct-2023 15:06:52" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;15 14696 - :EDIT-BY rmk + :CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener) + (VARS UNIXUTILSCOMS) - :CHANGES-TO (FUNCTIONS ShellWhich) - - :PREVIOUS-DATE " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9) + :PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;14 +) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -15,10 +15,11 @@ ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") (FILES (FROM LOADUPS) EXPORTS.ALL)) - (GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) + (GLOBALVARS ShellBrowser ShellOpener) + (INITVARS (ShellBrowser) + (ShellOpener)) (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) + (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -27,11 +28,13 @@ ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS ShellBrowser) +(GLOBALVARS ShellBrowser ShellOpener) ) (RPAQ? ShellBrowser ) +(RPAQ? ShellOpener ) + (CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T)) (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd)) (CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) @@ -55,50 +58,44 @@ (ShellBrowser [LAMBDA NIL (* ; "Edited 18-Jan-2023 20:30 by FGH") - (OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH) - (if (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE") - (UNIX-GETENV "PATH"))) - then - (* ;; " MacOS") - "open" - elseif (SETQ CMDPATH (ShellWhich "wslview")) - then - (* ;; "windows with WSL") + (* ;; "Figure out the browser to use for the ShellOpen/ShellBrowse functions. ") - CMDPATH - elseif (SETQ CMDPATH (ShellWhich "xdg-open")) - then - (* ;; "Linux systems with xdg-utils installed ") + (* ;; " Ordinarily, this would be the same as the generic ShellOpener.") - CMDPATH - elseif (SETQ CMDPATH (ShellWhich "git")) - then - (* ;; " Systems with git installed") + (* ;; " But if a generic ShellOpener is not found, then there are some additional") - (CONCAT CMDPATH " web--browse") - (* ; "") - elseif (SETQ CMDPATH (ShellWhich "lynx")) - then - (* ;; " Systems with lynx installed") + (* ;; " possibilities that will work for http/https URLs. If one of these exists return it.") - (LET (CMDPATH2) - (if (SETQ CMDPATH2 (ShellWhich "xterm")) - then (CONCAT CMDPATH2 " -e " CMDPATH) - else (LIST CMDPATH))) - else - (* ;; - " Out of ideas - just return a dummy function") + (OR ShellBrowser (SETQ ShellBrowser + (if (NOT (STREQUAL (ShellOpener) + "true")) + then ShellOpener + else (LET (CMDPATH) + (if (SETQ CMDPATH (ShellWhich "git")) + then + (* ;; " Systems with git installed") - "true"]) + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "lynx")) + then + (* ;; " Systems with lynx installed") + + (LET (CMDPATH2) + (if (SETQ CMDPATH2 (ShellWhich "xterm")) + then (CONCAT CMDPATH2 " -e " CMDPATH) + else (LIST CMDPATH))) + else + (* ;; " Out of ideas - just return a dummy function") + + "true"]) (ShellBrowse [LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:32 by FGH") (* ;; " Open the web page specified by URL using an external browser via shell call") - (* ;; - " URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.") + (* ;; " URL must start with http:// or https:// or file:/// (case ireelevant) or this function will just return NIL.") (* ;; " Returns T otherwise.") @@ -106,15 +103,102 @@ (if (OR (EQ (STRPOS "http://" (L-CASE URL)) 1) (EQ (STRPOS "https://" (L-CASE URL)) + 1) + (EQ (STRPOS "file:///" (L-CASE URL)) + 1)) + then (ShellOpen URL) + else NIL]) + +(ShellOpener + [LAMBDA NIL + + (* ;; "Find an %"opener%" that will open files (and URLs) using the appropriate/default app on this machine") + + (OR ShellOpener (SETQ ShellOpener (LET (CMDPATH) + (if (SETQ CMDPATH (ShellWhich "wslview")) + then + (* ;; "windows with WSL") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "cygstart")) + then + (* ;; "windows with cygwin") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "xdg-open")) + then + (* ;; "Linux systems with xdg-utils installed ") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "open")) + then + (* ;; " MacOS open") + + CMDPATH + else + (* ;; + " Out of ideas - just return a dummy function") + + "true"]) + +(ShellOpen + [LAMBDA (FilenameOrURL) + + (* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.") + + (* ;; " If FilenameOrURL starts with %"http://%" or %"https://%" or %"file:///%", then we use (ShellBrowser) as") + + (* ;; " the %"opener%" (which includes some browsers on a machine without a generic opener).") + + (* ;; + " Otherwise FilenameOrURL is assumed to be a filename and will be opened using (ShellOpener).") + + (* ;; " Returns T is all goes well; returns an error string if all does not go well") + + (SETQ FilenameOrURL (MKSTRING FilenameOrURL)) + (if (OR (EQ (STRPOS "http://" (L-CASE FilenameOrURL)) + 1) + (EQ (STRPOS "https://" (L-CASE FilenameOrURL)) + 1) + (EQ (STRPOS "file://" (L-CASE FilenameOrURL)) 1)) then (LET ((BROWSER (ShellBrowser))) - (if (LISTP BROWSER) - then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER) - " '" URL "'")) - else (ShellCommand (CONCAT BROWSER " '" URL "'" - " >>/tmp/ShellBrowser-warnings-$$.txt"))) - T) - else NIL]) + (if (NOT (STREQUAL BROWSER "true")) + then (if (LISTP BROWSER) + then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER) + " '" FilenameOrURL "'")) + else (ShellCommand (CONCAT BROWSER " '" FilenameOrURL "'" + " >>/tmp/ShellBrowser-warnings-$$.txt")) + T) + else (CONCAT "Unable to find a browser to open: " FilenameOrURL))) + else + (LET ((OPENER (ShellOpener)) + (UNIXFILE (UNIX-FILE-NAME FilenameOrURL 'INPUT T))) + (if (NOT UNIXFILE) + then (CONCAT "File not found: " FilenameOrURL) + elseif (NOT (STREQUAL OPENER "true")) + then (CL:WITH-OPEN-STREAM + (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND)) + 'BOTH)) + (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" + " >>/tmp/ShellOpener-warnings-$$.txt") + SHELLSTREAM) + (if (EQ (GETFILEPTR SHELLSTREAM) + 0) + then T + else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) + " "))) + (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING + 'OUTPUT)) + (SETFILEPTR SHELLSTREAM 0) + (CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP + #'(CL:LAMBDA (s) + (GO OUT] + (CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM) + STRINGSTREAM)) + OUT)) + OUTSTRING))) + else (CONCAT "Unable to find a file opener to open: " FilenameOrURL]) (PROCESS-COMMAND [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") @@ -183,7 +267,8 @@ "") "~" VERSION "~") FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT) + FILE) (RESETLST (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") [RESETSAVE (GETFILEPTR FILE) @@ -200,7 +285,7 @@ (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (927 1300 (ShellCommand 927 . 1300)) (1302 1699 (ShellWhich 1302 . 1699)) (1700 10457 ( -ShellBrowser 1710 . 4233) (ShellBrowse 4235 . 5227) (PROCESS-COMMAND 5229 . 5842) (SLASHIT 5844 . 7886 -) (UNIX-FILE-NAME 7888 . 10455))))) + (FILEMAP (NIL (1144 1517 (ShellCommand 1144 . 1517)) (1519 1916 (ShellWhich 1519 . 1916)) (1917 14618 +(ShellBrowser 1927 . 3675) (ShellBrowse 3677 . 4362) (ShellOpener 4364 . 6052) (ShellOpen 6054 . 9357) + (PROCESS-COMMAND 9359 . 9972) (SLASHIT 9974 . 12016) (UNIX-FILE-NAME 12018 . 14616))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index e9cb27338f7ba39d2606d35dfbdcd0bd0f7fceb3..8cfdae7d1b4ad2fefc52a2506d71c8d3a74f770c 100644 GIT binary patch delta 3294 zcma(TZERE5_1*XU6+0nLFv*g!?rorCUhFh|CY1Xyd`lFpTQQ99xY>TF8(zc1bO|*mZYgDV)Iro`R z2tR6B_uO;tx##-)6fli$eX=hEHNg;effcXqaWEEA~PZs^bKybU<7U~LgbcKTM{;;M#$fh01O{I=+ zm3PR%ou5b-WW2GJU+L@$?0o%agb;=Pf&}RwNF!;d?~{!k6=CzD;n6bb+1dD^bS_=k z3AiH`?^R-b?aa3guu6W~TgV?hoG!GmHS1U%eN23FqXcK}0X5zmR=*WaXsnL;Oo~L8 z5>s>}nUnzU9Wk`Y1!So|228NA)L8=I&PAhQSw9_+dUiFSjDAIp>SLo(4+t@z7fr+W zs4!eKcAWT9p|yvEMb=9HE{&5`8nS&9RLl#8_wi(GH#q7aO~mzRM1PzqHbEffbA~gb z#4-f-R61`DH;vq*lf%Rbf+}P2m|u-Y!m58D&J_BoT_+>7-_cY% zPSC&cQ9Uu3j19LhvH(5m=ph06mScXkN_uO9Ku_CogehN5XVaayj$`^vZ@BuXrEd zyEw!V#e>Xelni~*RZ)F*KVtQ`cm+|UmtBpeItef)L9U;MNL45?J(^GzZS=Gw$%+Fk z(8&UuSb!%{(-YBM$*@|@e70FuH^Y2RRtGiV*l!xPV&OB&K|sl{`ppt7c3@k#tW>F3n`gU z*>({Fk1m*0WD#}-&c4T&C6>kA$`8R?c&7BM0XKj5y`)>eAc-DvlL>0^|*>PpL**nU6qXn6C3=$bE}^U7I{)!xej zVJDam94O}i%(nHhK!^oeSfHK-Bn_kNBg|(XDM#-KfO+`31KYr|V^cGJMApH6^7zc* zVyaNAH4W#{!?WMXrjJ6T+sy?BM1(ZZs})VVzkH~#O!5k>A)-}EJTWhD<9qntJ0x9^ zXTWkHGjzdSCwhlyqxI=5u2GKJ{pZh6C&o= z*_(*()}jesNLBri;#_Jj9WP)>wL4dq)FR}j4kNjm6|ux_u`Gg*EbIf2XiJ1+r9LG7 z%_9DpokHv?>qPJ?=0orbYen#q#qxc;7a0ueNPC7Ar&)0?JEgKZtB%igTSfU`#XeN9 zoaF}+O1M#C2N1piV(m(7G^roLorY2I!U3r=4KMmC=ki5)IuBE(OGdigT(IHA(-`wT zOBxTe&R4!v+2K$~@YF0Nc;z3s^?Wwdc)8cYIG0=a3UH0x&*I?cK4B>ft4M$1s4p!k zna0edd+9*WswFPND@YahOeQA!_Z|38!mffGSx;N z@}$$&&vtdQL?_cKSwU)MdOcHXS(5n81)*y2Z80aD<(7B_(`cMc%}q?D8$!_>ZOv zxomFcu)n!^Tk%+N74U9!nT9BD6vy0L7go&Y^aD>r$&^SrUr!3+@}zUYq!V${A>(z^ zSal*2Pef1ha)iJm^{=MUlFX$hpd^cVcmw68$HER+@M*3JtT-i4M0&N3gFhHk0;dSqptNb0PYVo03*eUv1p8m-b zY_BXA5^J}oVLQD2q z-v=I;*1>ts{vlFM^X>VkEDC+GYCX0H;hZ2Mpr!$@DubMa;nHa?xPV4vdcEqa#76&H z^~BdUeXdw=dIv?`HBbJ>;#Ae~gUSPbGLn9sy{>-hY7e{cjxUakWpk zuJv(n_nQ_L!oyf}_co5c#^skcWs_$j_f>`Gr)kM87z^N(@xs*8g=_B4l|X%_IYLbds5(hp2Zf!08~*cR9k3hoGXxMOlU zA-*)0%Zdkz*}=)|u-KCyA09l^A_hdT&JSgaBK2rtE}EO}rMS zkW1B6g95ly2(5AeBE&Shd&aDMAR_)y2%`r4t57dK<}7E-rkRIMZExjDM8c}AA4&LA z+i!uGb=vf7>DBsxk(5m7h7vKhkeH3*kafy*MiP3uH>Fq@(Vr=F1={cpdjzSNcgRh< z@8f6!IU!J$rfX6{kH`tBOD8cr9E>U5@P@MO9=!vXKFfY6thQd3U>5626%qmiCyQa0iNo)*KotP!sb|KqBkb<m+^cnFwi5C%X71b_SrfstLT9(SE zKo+H}NaYijX`i0V77tDUm^(B+Jz|+v;#9V8NRo!w9o+|Q9vPeLwoKRb@Q9RuH9Nl3 zGM!Tsx!1?CQz3Ap&<0rPVd^c@p{I>ZQmFxHc(6D%HV#*;ZMiMS@!HC!PA@A)m^Fq~ z^Od_xJuYCwRU@PdOY26cJgTCy9s5>Mh}HAvVv~w5Rj!$Z(JGg&Go|;Xl@!N8DTLls zg0%7U1_>61A5X%Bp7dRE=$Lz&NE4)x0XthHE*l0Zgow9=%rw(_CZvd*R_e%%hdIo# zvFquEGOJn_lEK8Djw^|T^Ppv}7oW!`JnMX;mWi5&ERz?Tbtfk9aKAA4_gFchMWB8STAL2ShqeXw|Vb;{AhTHyBYrY zGUBku`?KqPnRWRt{>vLgF}$fR?f;ep?dX3jZ?KHl+4mZ-e1fw116Y1u*NEEjcXds* zw^j%)<(c6v{CC}81#OwCC3_7#;M=_FDz!Qfm@N)hlq&Pg_A0*Mduscge%KN8MATs5 z?I>G*dakU6=%%Lh(HGpI_Zkq>0TGY~|LOZ=_QrA}z7cq4evPP{@JQRXu{nH?NfXoT+*x{*yZ7$>3ms+|umAu6