From 1ae08139c9ed9ccf1117294e8c8c01bb487acc5e Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 16:20:30 -0700 Subject: [PATCH] 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+