(FILECREATED "30-Jun-86 16:48:03" {ERIS}<LISPCORE>SOURCES>HARDCOPY.;110 127029
changes to: (VARS HARDCOPYCOMS)
(FNS PRINTER.SCRATCH.FILE)
previous date: "24-Jun-86 10:44:28" {ERIS}<LISPCORE>SOURCES>HARDCOPY.;109)
(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HARDCOPYCOMS)
(RPAQQ HARDCOPYCOMS
[(COMS (* exported functionality)
(FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER
HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER \STRINGWIDTH.HCPYDISPLAYAUX
COPY.WINDOW.TO.BITMAP)
(* user interface jazz)
(INITVARS (ChangeDefaultPrinter))
(FNS MakeMenuOfPrinters MakeMenuOfImageTypes GetNewPrinterFromUser
PopUpWindowAndGetAtom NewPrinter GetPrinterName GetImageFile FetchDefaultPrinter)
(* filename diddlers)
(FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
(COMS (* Interface for PRINTERS and IMAGEFILES)
(FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS
HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE
PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTFILEPROP PRINTFILETYPE
SEND.FILE.TO.PRINTER)
(FNS PRINTERDEVICE)
[DECLARE: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE (QUOTE LPT]
(P (* for backward compatibility)
(MOVD? (QUOTE NILL)
(QUOTE PRINTERMODE)))
(INITVARS (DEFAULTPRINTINGHOST)
(DEFAULTPRINTERTYPE (QUOTE PRESS))
(EMPRESS.SCRATCH)
(EMPRESS#SIDES T))
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES
PRINTFILETYPES))
(COMS (* Converting text files to imagestreams)
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
(* TEXTDEFAULTTABS Hack, mica equivalent of 8 inches)
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
(COMS (FNS \BLTSHADE.GENERICPRINTER)
(* hack for printers that can't really BLTSHADE))
[COMS (* stuff to support hardcopy streams on the display.)
(FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
\DSPFONT.HDCPYDISPLAY \DSPRIGHTMARGIN.HDCPYDISPLAY \DSPXPOSITION.HDCPYDISPLAY
\DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \HDCPYBLTCHAR
\HDCPYDISPLAY.FIX.XPOS \HDCPYDISPLAY.FIX.YPOS \HDCPYDISPLAYINIT \HDCPYDSPPRINTCHAR
\SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY)
[DECLARE: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
(IHALFMICASPERPT 17)
(IMICASPERPT 35]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
(COMS (* Stuff to support MICA-unit hardcopy streams on the display)
(FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE
\BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE
\DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE
\DRAWCURVE.HCPYMODE \DRAWCIRCLE.HCPYMODE \DRAWELLIPSE.HCPYMODE \DSPFONT.HCPYMODE
\DSPLEFTMARGIN.HCPYMODE \DSPLINEFEED.HCPYMODE \DSPRIGHTMARGIN.HCPYMODE
\DSPXPOSITION.HCPYMODE \DSPYPOSITION.HCPYMODE \MOVETO.HCPYMODE
\FONTCREATE.HCPYMODE.PRESS \CREATECHARSET.HCPYMODE.PRESS
\FONTCREATE.HCPYMODE.INTERPRESS \CREATECHARSET.HCPYMODE.INTERPRESS
\STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR \HCPYMODEDISPLAYINIT \HCPYMODEDSPPRINTCHAR
\SLOWHCPYMODEBLTCHAR \SFFixY.HCPYMODE)
[ADDVARS (IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\HCPYMODEDISPLAYINIT])
(* exported functionality)
(DEFINEQ
(HARDCOPY.SOMEHOW
[LAMBDA (WINDOW FILE PRINTERTYPE IMAGETYPE) (* bvm: "17-Sep-85 15:20")
(* * "either run window's HARDCOPYFN or run HARDCOPYW")
(LET [(HARDCOPYFN (WINDOWPROP WINDOW (QUOTE HARDCOPYFN]
(ALLOW.BUTTON.EVENTS)
(COND
((NULL HARDCOPYFN)
(HARDCOPYW WINDOW FILE NIL NIL NIL PRINTERTYPE)
(* knows how to default)
)
(T (LET [(IMAGESTR (OPENIMAGESTREAM FILE (OR IMAGETYPE PRINTERTYPE]
(APPLY* HARDCOPYFN WINDOW IMAGESTR)
(CLOSEF? IMAGESTR])
(HARDCOPYIMAGEW
[LAMBDA (W) (* hdj "14-Feb-85 16:21")
(* * "hardcopy this window to the DEFAULTPRINTINGHOST")
(HARDCOPY.SOMEHOW W])
(HARDCOPYIMAGEW.TOFILE
[LAMBDA (W) (* hdj "14-Feb-85 15:00")
(LET ((FILE&TYPE (GetImageFile)))
(if FILE&TYPE
then (HARDCOPY.SOMEHOW W (CAR FILE&TYPE)
(CDR FILE&TYPE])
(HARDCOPYIMAGEW.TOPRINTER
[LAMBDA (W) (* bvm: "17-Sep-85 15:21")
(LET ((PRINTERCHOICE (GetPrinterName)))
(COND
(PRINTERCHOICE (HARDCOPY.SOMEHOW W (PACK* (QUOTE {LPT})
PRINTERCHOICE)
(CAR (PRINTERPROP (PRINTERTYPE PRINTERCHOICE)
(QUOTE CANPRINT])
(HARDCOPYREGION.TOFILE
[LAMBDA NIL (* hdj " 9-Oct-85 15:33")
(LET ((FILE&TYPE (GetImageFile)))
(if FILE&TYPE
then (PROG (REGION)
(SPAWN.MOUSE)
(PROMPTPRINT "Select a region")
(SETQ REGION (GETREGION))
(CLRPROMPT)
(HARDCOPYW REGION (CAR FILE&TYPE)
NIL NIL NIL (CDR FILE&TYPE])
(HARDCOPYREGION.TOPRINTER
[LAMBDA NIL (* hdj " 9-Oct-85 15:33")
(LET ((PRINTERCHOICE (GetPrinterName)))
(if PRINTERCHOICE
then (PROG (REGION)
(SPAWN.MOUSE)
(PROMPTPRINT "Select a region")
(SETQ REGION (GETREGION))
(CLRPROMPT)
(HARDCOPYW REGION (PACK* (QUOTE {LPT})
PRINTERCHOICE)
NIL NIL NIL (PRINTERTYPE PRINTERCHOICE])
(\STRINGWIDTH.HCPYDISPLAYAUX
[LAMBDA (STR FONT RDTBL SPACEWIDTH) (* bvm: "27-Mar-86 18:43")
(* * Returns the width of STR with SPACEWIDTH for the width of spaces.
RDTBL has already been coerced, so no FLG is needed)
(* * This is a clone of \STRINGWIDTH.GENERIC so edit that fn, not this one)
(DECLARE (SPECVARS FONT SPACEWIDTH)) (* Used in \MAPPNAME)
(LET ((CSVECTOR (ffetch FONTCHARSETVECTOR of FONT)))
(DECLARE (SPECVARS CSVECTOR))
(SELECTC (NTYPX STR)
(\LITATOM (IPLUS [for C WIDTHSBASE CSET inatom STR
sum [COND
((NEQ CSET (\CHARSET C))
(SETQ CSET (\CHARSET C))
(SETQ WIDTHSBASE (ffetch (CHARSETINFO IMAGEWIDTHS)
of (\GETCHARSETINFO CSET FONT]
(COND
((EQ C (CHARCODE SPACE))
SPACEWIDTH)
(T (\FGETIMAGEWIDTH WIDTHSBASE (\CHAR8CODE C]
(COND
(RDTBL (* Include escapes)
(\SYMBOL.ESCAPE.COUNT STR RDTBL NIL
(\FGETCHARIMAGEWIDTH FONT (fetch (READTABLEP
ESCAPECHAR)
of RDTBL)
CSVECTOR)
(\FGETCHARIMAGEWIDTH FONT (fetch (READTABLEP
MULTESCAPECHAR
) of RDTBL)
CSVECTOR)))
(T 0))))
(\STRINGP (LET ((TOTAL 0)
ESC ESCWIDTH WIDTHSBASE CSET)
[COND
(RDTBL (* Count delimiting quotes and
internal escapes)
(SETQ TOTAL (UNFOLD (\FGETCHARIMAGEWIDTH FONT (CHARCODE %"))
2))
(SETQ ESC (fetch (READTABLEP ESCAPECHAR) of RDTBL))
(SETQ ESCWIDTH (\FGETCHARIMAGEWIDTH FONT ESC]
[for C instring STR
do [COND
((NEQ (\CHARSET C)
CSET) (* Get the widths vector for this
character set)
(SETQ CSET (\CHARSET C))
(SETQ WIDTHSBASE (ffetch (CHARSETINFO IMAGEWIDTHS)
of (\GETCHARSETINFO CSET FONT]
(add TOTAL (COND
((EQ C (CHARCODE SPACE))
SPACEWIDTH)
(T (IPLUS (\FGETIMAGEWIDTH WIDTHSBASE (\CHAR8CODE
C))
(COND
((AND RDTBL (OR (EQ C (CHARCODE %"))
(EQ C ESC)))
(* String char must be escaped)
ESCWIDTH)
(T 0]
TOTAL))
(LET ((S 0)
WIDTHSBASE CSET)
(DECLARE (SPECVARS S CSET WIDTHSBASE))
(\MAPPNAME [FUNCTION (LAMBDA (DUMMY CC)
(DECLARE (USEDFREE WIDTHSBASE CSET S FONT SPACEWIDTH))
(add S (COND
((EQ CC (CHARCODE SPACE))
SPACEWIDTH)
((EQ CSET (\CHARSET CC))
(\FGETIMAGEWIDTH WIDTHSBASE (\CHAR8CODE CC)))
(T (SETQ CSET (\CHARSET CC))
(SETQ WIDTHSBASE (ffetch (CHARSETINFO
IMAGEWIDTHS)
of (\GETCHARSETINFO CSET
FONT)))
(\FGETIMAGEWIDTH WIDTHSBASE (\CHAR8CODE CC]
STR RDTBL RDTBL)
S])
(COPY.WINDOW.TO.BITMAP
(LAMBDA (WINDOW) (* kbr:
"26-Feb-86 01:02")
(* * copies contents of window (including title and border) into a
bitmap)
(COND
((OPENWP WINDOW)
(PROG (REGION SCREEN LEFT BOTTOM WIDTH HEIGHT BITMAP)
(SETQ REGION (WINDOWPROP WINDOW (QUOTE REGION)))
(SETQ SCREEN (WINDOWPROP WINDOW (QUOTE SCREEN)))
(SETQ LEFT (fetch (REGION LEFT) of REGION))
(SETQ BOTTOM (fetch (REGION BOTTOM) of REGION))
(SETQ WIDTH (fetch (REGION WIDTH) of REGION))
(SETQ HEIGHT (fetch (REGION HEIGHT) of REGION))
(SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL WINDOW)))
(.WHILE.TOP.DS. WINDOW (BITBLT (SCREENBITMAP SCREEN)
LEFT BOTTOM BITMAP 0 0 WIDTH HEIGHT))
(RETURN BITMAP)))
(T (BITMAPCOPY (WINDOWPROP WINDOW (QUOTE IMAGECOVERED)))))))
)
(* user interface jazz)
(RPAQ? ChangeDefaultPrinter )
(DEFINEQ
(MakeMenuOfPrinters
[LAMBDA (MENUTITLE) (* bvm: "17-Sep-85 19:14")
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
(create MENU
ITEMS ←(APPEND (for P inside DEFAULTPRINTINGHOST collect (COND
((LISTP P)
(CADR P))
(T P)))
(LIST (LIST "Other..." (KWOTE (QUOTE OTHER))
"You will be prompted for a printer")))
TITLE ← MENUTITLE])
(MakeMenuOfImageTypes
(LAMBDA (MENUTITLE) (* kbr:
"18-Feb-86 17:14")
(* *
"type selection; elements of \DISPLAYSTREAMTYPES are temporarily disallowed")
(DECLARE (GLOBALVARS IMAGESTREAMTYPES))
(create MENU
ITEMS ←(for IMAGETYPE in IMAGESTREAMTYPES bind IMAGETYPENAME
collect (PROGN (SETQ IMAGETYPENAME (CAR IMAGETYPE))
(LIST (L-CASE IMAGETYPENAME T)
(KWOTE IMAGETYPENAME)))
when (AND (ASSOC (QUOTE OPENSTREAM)
(CDR IMAGETYPE))
(NOT (FMEMB (CAR IMAGETYPE)
\DISPLAYSTREAMTYPES))))
TITLE ← MENUTITLE)))
(GetNewPrinterFromUser
[LAMBDA (PROMPTSTRING) (* hdj "13-Feb-85 22:22")
(PopUpWindowAndGetAtom PROMPTSTRING])
(PopUpWindowAndGetAtom
[LAMBDA (PROMPTSTRING CANDIDATE) (* bvm: " 9-Apr-86 16:23")
(RESETLST (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(LET* ((FONT (DEFAULTFONT))
[WIDTH (WIDTHIFWINDOW (IPLUS (STRINGWIDTH PROMPTSTRING FONT)
(ITIMES 40 (CHARWIDTH (CHARCODE A)
FONT]
(PROMPTW (CREATEW [CREATEREGION (IMIN LASTMOUSEX (IDIFFERENCE SCREENWIDTH WIDTH))
LASTMOUSEY WIDTH (HEIGHTIFWINDOW (FONTPROP FONT
(QUOTE HEIGHT]
NIL NIL T)))
(RESETSAVE (OPENW PROMPTW)
(LIST (FUNCTION CLOSEW)
PROMPTW))
(LET [(RESPONSE (PROMPTFORWORD PROMPTSTRING CANDIDATE NIL PROMPTW NIL NIL
(CHARCODE (CR]
(AND RESPONSE (PACK* RESPONSE])
(NewPrinter
[LAMBDA (PRINTER PRIMARY?)
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (* bvm: "17-Sep-85 15:41")
(* * Adds PRINTER to list of known printing hosts if it isn't there. In addition, if PRIMARY? is true, moves it to
front)
(for ENTRY in DEFAULTPRINTINGHOST when (STRING-EQUAL (COND
((LISTP ENTRY)
(CADR ENTRY))
(T ENTRY))
PRINTER)
do (* Printer exists. Move to front if primary)
[COND
(PRIMARY? (SETQ DEFAULTPRINTINGHOST (CONS ENTRY (REMOVE ENTRY DEFAULTPRINTINGHOST]
(RETURN)
finally (* Not found)
(SETQ DEFAULTPRINTINGHOST (COND
(PRIMARY? (CONS PRINTER DEFAULTPRINTINGHOST))
(T (APPEND DEFAULTPRINTINGHOST (LIST PRINTER])
(GetPrinterName
[LAMBDA NIL (* rrb "27-Sep-85 18:23")
(DECLARE (GLOBALVARS ChangeDefaultPrinter))
(PROG ((PRINTERCHOICE (MENU (MakeMenuOfPrinters "Which printer?")))
DEFAULTPRINTER)
[COND
((EQ PRINTERCHOICE (QUOTE OTHER))
(SETQ PRINTERCHOICE (GetNewPrinterFromUser "Printer (CR to abort): "]
[COND
(PRINTERCHOICE (COND
((NEQ PRINTERCHOICE (SETQ DEFAULTPRINTER (FetchDefaultPrinter)))
(NewPrinter PRINTERCHOICE
(AND DEFAULTPRINTER
(MENU (OR ChangeDefaultPrinter
(SETQ ChangeDefaultPrinter
(create MENU
TITLE ←
"Make this the new default?"
ITEMS ←(QUOTE (("Yes" T
"Yes, make this the new default printer")
("No" NIL
"No, don't change it")))
MENUROWS ← 1
CENTERFLG ← T]
(RETURN PRINTERCHOICE])
(GetImageFile
(LAMBDA NIL (* hdj
"14-Feb-85 13:07")
(PROG (FILE PRINTFILETYPE FILETYPEMENU EXTENSIONSUPPLIED EXTENSIONFORTYPE)
(SETQ FILE (PopUpWindowAndGetAtom "File name (CR to abort): "))
(COND
((NULL FILE)
(RETURN)))
(SETQ FILETYPEMENU (MakeMenuOfImageTypes "File type?"))
(COND
((SETQ PRINTFILETYPE (PRINTFILETYPE.FROM.EXTENSION FILE))
(RETURN (CONS FILE PRINTFILETYPE)))
(T (SETQ PRINTFILETYPE (MENU FILETYPEMENU))
(COND
((NULL PRINTFILETYPE)
(RETURN))
(T (RETURN (CONS FILE PRINTFILETYPE)))))))))
(FetchDefaultPrinter
[LAMBDA NIL (* bvm: "17-Sep-85 15:34")
(LET ((P (DEFAULTPRINTER)))
(COND
((LISTP P)
(CADR P))
(T P])
)
(* filename diddlers)
(DEFINEQ
(ExtensionForPrintFileType
[LAMBDA (TYPE) (* hdj "13-Feb-85 23:15")
(DECLARE (GLOBALVARS PRINTFILETYPES))
(CAADR (ASSOC (QUOTE EXTENSION)
(CDR (ASSOC TYPE PRINTFILETYPES])
(PRINTFILETYPE.FROM.EXTENSION
[LAMBDA (FILE) (* hdj "10-Oct-85 11:07")
(* return the imagestream type corresponding to the
extension)
(bind [EXT ←(U-CASE (FILENAMEFIELD FILE (QUOTE EXTENSION] for TYPE in PRINTFILETYPES
when [FMEMB EXT (CADR (ASSOC (QUOTE EXTENSION)
(CDR TYPE]
do (RETURN (CAR TYPE])
)
(* Interface for PRINTERS and IMAGEFILES)
(DEFINEQ
(DEFAULTPRINTER
[LAMBDA NIL (* bvm: "17-Sep-85 15:17")
(COND
((LISTP DEFAULTPRINTINGHOST)
(CAR DEFAULTPRINTINGHOST))
(T DEFAULTPRINTINGHOST])
(CAN.PRINT.DIRECTLY
[LAMBDA (PRINTERTYPE FILETYPE) (* lmm " 7-OCT-83 12:05")
(FMEMB FILETYPE (PRINTERPROP PRINTERTYPE (QUOTE CANPRINT])
(CONVERT.FILE.TO.TYPE.FOR.PRINTER
[LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* jds "30-Aug-85 11:48")
(SETQ FILETYPE (OR FILETYPE (QUOTE TEXT)))
(PROG [(SCRATCH (CLOSEF (OPENFILE (PRINTER.SCRATCH.FILE FILE PRINTERTYPE)
(QUOTE OUTPUT)
(QUOTE NEW] (* Doing the open & close gets us a guaranteed version
number, so that all files are truly unique.)
(APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE (QUOTE CONVERSION))
FILETYPE)
(for CANPRINT in (PRINTERPROP PRINTERTYPE (QUOTE CANPRINT)) bind CONVERTER
when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT (QUOTE CONVERSION))
FILETYPE))
do (RETURN CONVERTER))
(ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer")
(FULLNAME FILE)))
FILE SCRATCH NIL HEADING)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (SCRATCH)
(CLOSEF? SCRATCH)
(DELFILE SCRATCH])
SCRATCH))
(RETURN SCRATCH])
(EMPRESS
[LAMBDA (FILE #COPIES HOST HEADING #SIDES PRINTOPTIONS) (* lmm " 3-OCT-83 20:21")
(SEND.FILE.TO.PRINTER FILE HOST (NCONC (COND
(HEADING (LIST (QUOTE HEADING)
HEADING)))
(COND
(#COPIES (LIST (QUOTE #COPIES)
#COPIES)))
(COND
(#SIDES (LIST (QUOTE #SIDES)
#SIDES)))
PRINTOPTIONS])
(HARDCOPYW
[LAMBDA (WINDOW/BITMAP/REGION FILE HOST SCALEFACTOR ROTATION PRINTERTYPE HARDCOPYTITLE)
(* rrb "24-Jun-86 10:43")
(* makes a hard copy of a window)
(* WINDOW/BITMAP/REGION can be a
WINDOW, a REGION, a BITMAP, or NIL =
select region)
(* If FILE supplied, output goes
there. If HOST supplied, IT is
printed. If neither FILE nor HOST
supplied, default is to print)
(* if HARDCOPYTITLE is supplied it
will be used as the document title of
the hardcopy file created.
If it isn't, "Window Image" is used.)
(PROG (PRINTHOST BITMAP SCREENREGION REGION FULLFILE)
(SETQ PRINTHOST HOST)
[COND
((WINDOWP WINDOW/BITMAP/REGION)
(SETQ BITMAP (COPY.WINDOW.TO.BITMAP WINDOW/BITMAP/REGION)))
((BITMAPP WINDOW/BITMAP/REGION)
(SETQ BITMAP WINDOW/BITMAP/REGION))
((type? REGION WINDOW/BITMAP/REGION)
(SETQ BITMAP (SCREENBITMAP))
(SETQ REGION WINDOW/BITMAP/REGION))
(T (SETQ SCREENREGION (GETSCREENREGION))
(SETQ BITMAP (SCREENBITMAP (fetch (SCREENREGION SCREEN) of SCREENREGION)))
(SETQ REGION (fetch (SCREENREGION REGION) of SCREENREGION]
RETRY
(COND
[PRINTERTYPE (COND
[PRINTHOST (COND
((NOT (EQ PRINTERTYPE (PRINTERTYPE PRINTHOST)))
(ERROR PRINTHOST (CONCAT "not of printer type "
PRINTERTYPE))
(GO RETRY]
(FILE (* don't need a PRINTHOST if you give
a file))
[(SETQ PRINTHOST (find HOST inside DEFAULTPRINTINGHOST
suchthat (EQ PRINTERTYPE (PRINTERTYPE HOST]
(T (ERROR
"Can't find a printing host in DEFAULTPRINTINGHOST that is of type "
PRINTERTYPE)
(GO RETRY]
(PRINTHOST (SETQ PRINTERTYPE (PRINTERTYPE PRINTHOST)))
[DEFAULTPRINTINGHOST (for X inside DEFAULTPRINTINGHOST
when (PRINTERPROP (SETQ PRINTERTYPE (PRINTERTYPE X))
(QUOTE BITMAPSCALE)) do (RETURN (SETQ PRINTHOST X))
finally (SETQ PRINTERTYPE (PRINTERTYPE (SETQ PRINTHOST (
DEFAULTPRINTER
]
[FILE (COND
((NOT (SETQ PRINTERTYPE (PRINTFILETYPE FILE T)))
(ERROR FILE "Can't tell what kind of print file to produce -- PRINTERTYPE, DEFAULTPRINTERTYPE, DEFAULTPRINTINGHOST all NIL"
)
(GO RETRY]
(T (ERROR "Can't tell where to send window image -- HOST, DEFAULTPRINTINGHOST are NIL")
(GO RETRY)))
[COND
((NOT SCALEFACTOR)
[SETQ SCALEFACTOR (COND
(REGION (PRINTER.BITMAPSCALE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
PRINTERTYPE PRINTHOST))
(T (PRINTER.BITMAPSCALE (fetch (BITMAP BITMAPWIDTH) of BITMAP)
(fetch (BITMAP BITMAPHEIGHT) of BITMAP)
PRINTERTYPE PRINTHOST]
(COND
((LISTP SCALEFACTOR)
(SETQ ROTATION (CDR SCALEFACTOR))
(SETQ SCALEFACTOR (CAR SCALEFACTOR]
(SETQ FULLFILE (PRINTER.BITMAPFILE (OR FILE (PRINTER.SCRATCH.FILE))
PRINTERTYPE BITMAP SCALEFACTOR REGION ROTATION (OR HARDCOPYTITLE
"Window Image")))
[COND
((OR HOST (NULL FILE))
(ADD.PROCESS [BQUOTE (PROGN [(\, (PRINTERPROP PRINTERTYPE (QUOTE SEND)))
[QUOTE (\, (COND ((LISTP PRINTHOST)
(CADR PRINTHOST))
(T PRINTHOST]
(QUOTE (\, FULLFILE))
(QUOTE (DOCUMENT.NAME %, (OR HARDCOPYTITLE "Window Image"]
(\, (AND (NULL FILE)
(BQUOTE (DELFILE (QUOTE (\, FULLFILE]
(QUOTE NAME)
(QUOTE HARDCOPYW]
(RETURN (AND FILE FULLFILE])
(LISTFILES1
[LAMBDA (FILE PRINTOPTIONS) (* rmk: "30-Nov-84 08:51")
(SEND.FILE.TO.PRINTER FILE NIL PRINTOPTIONS])
(PRINTER.BITMAPFILE
[LAMBDA (FILE PRINTERTYPE BITMAP SCALEFACTOR REGION ROTATION TITLE)
(* lmm " 3-OCT-83 21:40")
(* convert a bitmap into a file)
(DECLARE (SPECVARS . T))
(EVAL (PRINTERPROP PRINTERTYPE (QUOTE BITMAPFILE])
(PRINTER.BITMAPSCALE
[LAMBDA (WIDTH HEIGHT PRINTERTYPE HOST) (* lmm " 3-OCT-83 21:32")
(* could ask the host what size paper it has)
(PROG NIL
(RETURN (APPLY* (OR (PRINTERPROP PRINTERTYPE (QUOTE BITMAPSCALE))
(RETURN 1))
WIDTH HEIGHT HOST])
(PRINTER.SCRATCH.FILE
[LAMBDA (FULLFILE) (* lmm "30-Jun-86 16:42")
(QUOTE {SCRATCH}PRINTER-SCRATCH-FILE])
(PRINTERPROP
[LAMBDA (PRINTERTYPE PROP) (* lmm " 5-OCT-83 16:11")
(for X in PRINTERTYPES when (EQMEMB PRINTERTYPE (CAR X))
do (RETURN (CADR (ASSOC PROP (CDR X])
(PRINTERSTATUS
[LAMBDA (PRINTER) (* lmm " 5-OCT-83 15:19")
(PROG [(STATUSFN (PRINTERPROP (PRINTERTYPE PRINTER)
(QUOTE STATUS]
(RETURN (AND STATUSFN (APPLY* STATUSFN PRINTER])
(PRINTERTYPE
[LAMBDA (HOST) (* bvm: "17-Sep-85 15:18")
(SELECTQ HOST
((NIL LPT)
(SETQ HOST (DEFAULTPRINTER)))
NIL)
(COND
[(LISTP HOST) (* Is a pair (type hostname); check that type is one we
know about)
(LET ((ACTUALHOST (CAR HOST)))
(COND
((for X in PRINTERTYPES thereis (EQMEMB ACTUALHOST (CAR X)))
ACTUALHOST)
(T (ERROR "Unrecognized printer " ACTUALHOST]
((NULL HOST)
DEFAULTPRINTERTYPE)
((GETPROP HOST (QUOTE PRINTERTYPE)))
[(for TYPE in PRINTERTYPES bind FN when (AND (SETQ FN (CDR (ASSOC (QUOTE HOSTNAMEP)
TYPE)))
(APPLY* (CAR FN)
HOST))
do (* Try the predicates for each printer type for
recognizing their own host names)
(RETURN (CAAR TYPE]
[(for PRINTER in (DEFAULTPRINTER) do (COND
((AND (LISTP PRINTER)
(STRING-EQUAL (CADR PRINTER)
HOST))
(RETURN (CAR PRINTER]
(T DEFAULTPRINTERTYPE])
(PRINTFILEPROP
[LAMBDA (PRINTFILETYPE PROP) (* rmk: "11-OCT-83 13:00")
(for X in PRINTFILETYPES when (EQMEMB PRINTFILETYPE (CAR X))
do (RETURN (CADR (ASSOC PROP (CDR X])
(PRINTFILETYPE
[LAMBDA (FILE DONTOPEN) (* bvm:
"21-Feb-86 15:14")
(COND
((IMAGESTREAMP FILE)
(IMAGESTREAMTYPE FILE))
(T (LET [(TYPE (GETFILEINFO FILE (QUOTE TYPE]
(COND
((OR (EQ TYPE (QUOTE TEXT))
(AND TYPE (ASSOC TYPE PRINTFILETYPES)))
TYPE)
((PRINTFILETYPE.FROM.EXTENSION FILE))
((NOT DONTOPEN)
(RESETLST [COND
((STRINGP FILE) (* Yecch, OPENP of a
string interprets string
as a string stream!)
(SETQ FILE (MKATOM FILE]
[COND
((NOT (OPENP FILE (QUOTE INPUT))) (* Open file so testers
don't have to repeatedly
open and close it)
(SETQ FILE (OPENFILE FILE (QUOTE INPUT)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
FILE]
(COND
((RANDACCESSP FILE)
(for TYPE in PRINTFILETYPES
when (CAR (NLSETQ (APPLY* (CADR (ASSOC (QUOTE TEST)
(CDR TYPE)))
FILE))) do (RETURN (CAR TYPE])
(SEND.FILE.TO.PRINTER
[LAMBDA (FILE HOST PRINTOPTIONS) (* bvm: "17-Sep-85 15:28")
(* Returns file name if successful, NIL if not.
The RESETLST makes sure the scratch file, if any, is
deleted.)
(RESETLST (PROG (FULLFILE STRM FILETYPE PRINTERTYPE PFILE)
(* Don't re-open it if it was previously open, cause caller (PRINTERDEVICE) really wants us to use the same stream,
which has the BEINGPRINTED property.)
[RESETSAVE NIL (LIST (COND
[(LISTGET PRINTOPTIONS (QUOTE DELETE))
(FUNCTION (LAMBDA (FL)
(CLOSEF? FL)
(DELFILE FL]
(T (FUNCTION CLOSEF?)))
(SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8]
(* Do we need to convert the FILE ?)
(SETQ PFILE (SETQ FULLFILE (FULLNAME FILE)))
(SETQ FILETYPE (PRINTFILETYPE FULLFILE))
RETRY
[COND
[[OR HOST (SETQ HOST (for X on PRINTOPTIONS by (CDDR X)
when (MEMB (U-CASE (CAR X))
(QUOTE (HOST SERVER)))
do (RETURN (CADR X]
(SETQ PRINTERTYPE (PRINTERTYPE HOST))
(COND
((CAN.PRINT.DIRECTLY PRINTERTYPE FILETYPE)
(* IS OK, NO CONVERSION)
)
(T (SETQ PFILE (CONVERT.FILE.TO.TYPE.FOR.PRINTER STRM FILETYPE PRINTERTYPE
(LISTGET PRINTOPTIONS
(QUOTE HEADING))
PRINTOPTIONS]
((NULL DEFAULTPRINTINGHOST)
(ERROR "DEFAULTPRINTINGHOST and HOST arg are NIL; don't know where to print "
FULLFILE)
(GO RETRY))
([AND FILETYPE (for X inside (OR DEFAULTPRINTINGHOST (QUOTE (NIL)))
when (CAN.PRINT.DIRECTLY (SETQ PRINTERTYPE (PRINTERTYPE
X))
FILETYPE)
do (RETURN (SETQ HOST X]
(* no conversion necessary)
)
(T (SETQ PFILE (CONVERT.FILE.TO.TYPE.FOR.PRINTER STRM FILETYPE
[SETQ PRINTERTYPE
(PRINTERTYPE (SETQ HOST
(
DEFAULTPRINTER]
(LISTGET PRINTOPTIONS
(QUOTE HEADING))
PRINTOPTIONS]
(COND
([NLISTP (SETQ PFILE (APPLY* (OR (PRINTERPROP PRINTERTYPE (QUOTE SEND))
(ERROR (CONCAT "Don't know how to send to a "
PRINTERTYPE)
HOST))
(COND
((LISTP HOST)
(CADR HOST))
(T HOST))
PFILE
(APPEND PRINTOPTIONS (QUOTE (#COPIES 1))
(LIST (QUOTE DOCUMENT.NAME)
FULLFILE]
(RETURN FULLFILE))
(T (LISPXPRIN1 (CDR PFILE)
T)
(LISPXTERPRI T)
(RETURN NIL])
)
(DEFINEQ
(PRINTERDEVICE
[LAMBDA (NAME) (* hdj "22-May-86 15:45")
(* This defines an LPT device. An LPT file is a file that gets sent to printer
and deleted when it is closed. This must be defined on a CORE device only
because we have no way of inheriting the previous CLOSEFILE function that this
function is replacing but needs to call internally.
We have \CORE.CLOSEFILE explicit in this code.)
(PROG ((DEV (\CREATECOREDEVICE NAME)))
[replace (FDEV CLOSEFILE) of DEV
with (FUNCTION (LAMBDA (STREAM)
(PROG [(SDEV (fetch (STREAM DEVICE) of STREAM))
(PRINTOPTIONS (STREAMPROP STREAM (QUOTE PRINTOPTIONS]
(* Get PRINTOPTIONS property before
closing the stream, in case the
closing throws them away)
(* If we could save away and get at the previous CLOSEFILE method
(e.g. by an FDEVPROP), this could be replaced by the generic
(FDEVOP (QUOTE CLOSEFILE) SDEV STREAM))
(RETURN
(COND
[(AND (NOT RESETSTATE)
(OPENP STREAM (QUOTE OUTPUT))
(IGREATERP (GETEOFPTR STREAM)
0))
(* Close and send to printer only if open for output.
If open for input, then we must already have started printing.
Don't close until after getting EOF ptr.)
(\CORE.CLOSEFILE STREAM)
(replace (STREAM ACCESS) of STREAM with NIL)
(* Hack, cause this is usually done
later in the generic \CLOSEFILE.)
(* Let SEND.FILE.TO.PRINTER choose the
host if it is the generic printer LPT,
otherwise use the name in the
devicename field.)
(* EVAL.AS.PROCESS (BQUOTE (SEND.FILE.TO.PRINTER
(QUOTE , (fetch FULLNAME of STREAM)) (QUOTE ,
(COND ((NEQ (QUOTE LPT) (fetch DEVICENAME of SDEV))
(fetch DEVICENAME of SDEV)) (T (FILENAMEFIELD
(fetch FULLNAME of STREAM) (QUOTE NAME)))))
(APPEND (QUOTE (DELETE T)) PRINTOPTIONS (QUOTE
(HEADING T))))))
(SEND.FILE.TO.PRINTER
STREAM
[COND
((NEQ (QUOTE LPT)
(fetch (FDEV DEVICENAME) of SDEV))
(fetch (FDEV DEVICENAME) of SDEV))
(T (PROG ((NAME (fetch (STREAM FULLNAME) of STREAM))
POS POS2)
(RETURN (AND (SETQ POS (STRPOS "}" NAME))
(SETQ POS2 (STRPOS "." NAME
(ADD1 POS)))
(SUBATOM NAME (ADD1 POS)
(SUB1 POS2]
(APPEND (QUOTE (DELETE T))
PRINTOPTIONS
(QUOTE (HEADING T]
(T (* Error while creating the file, if
the user had wrapped a RESETLST/CLOSEF
around his code. Presumably, he
doesn't want the file printed)
(\CORE.CLOSEFILE STREAM)
(FDEVOP (QUOTE DELETEFILE)
SDEV STREAM SDEV T]
(\DEFINEDEVICE NAME DEV)
(RETURN NAME])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(PRINTERDEVICE (QUOTE LPT))
)
(* for backward compatibility)
(MOVD? (QUOTE NILL)
(QUOTE PRINTERMODE))
(RPAQ? DEFAULTPRINTINGHOST )
(RPAQ? DEFAULTPRINTERTYPE (QUOTE PRESS))
(RPAQ? EMPRESS.SCRATCH )
(RPAQ? EMPRESS#SIDES T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)
)
(* Converting text files to imagestreams)
(RPAQ? TEXTDEFAULTTABS (LIST 20320))
(RPAQ? TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))
(* TEXTDEFAULTTABS Hack, mica equivalent of 8 inches)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
)
(DEFINEQ
(TEXTTOIMAGEFILE
[LAMBDA (FILE IMAGEFILE IMAGETYPE FONTS HEADING TABS OPTIONS)
(* hdj "19-May-86 19:00")
(* Generic function for converting
PSPOOL format text files into image
files)
(RESETLST (PROG (IMAGESTREAM INPUT-STREAM OUTCHARFN INPUT-FILENAME INEOLC MAXFONT FONTARRAY)
(* FONTARRAY is an array of
font-descriptors)
[RESETSAVE [SETQ INPUT-STREAM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8
(QUOTE ((SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(SETQ INPUT-FILENAME (FULLNAME INPUT-STREAM))
(* Strip off the extension if we are
generating the name from the INFILE,
so that OPENIMAGESTREAM can pack on
the appropriate extension)
[RESETSAVE [SETQ IMAGESTREAM
(OPENIMAGESTREAM
(OR IMAGEFILE (PACKFILENAME (QUOTE EXTENSION)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
INPUT-FILENAME))
IMAGETYPE
(APPEND [AND (NEQ HEADING T)
(LIST (QUOTE HEADING)
(OR HEADING (CONCAT INPUT-FILENAME " "
(GETFILEINFO INPUT-STREAM
(QUOTE CREATIONDATE]
(AND (NOT (LISTGET OPTIONS (QUOTE REGION)))
(LIST (QUOTE REGION)
TEXTDEFAULTPAGEREGION))
(APPEND (LIST (QUOTE DOCUMENT.NAME)
INPUT-FILENAME
(QUOTE TABS)
TABS
(QUOTE FONTS)
FONTS)
OPTIONS]
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
(* Make \BIN return NIL on EOS)
(COPY.TEXT.TO.IMAGE INPUT-STREAM IMAGESTREAM FONTS TABS)
(RETURN (LIST (CLOSEF INPUT-STREAM)
(CLOSEF IMAGESTREAM])
(COPY.TEXT.TO.IMAGE
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* jds
"17-Feb-86 03:37")
(* Copy text to an
image stream, obeying
PSPOOL control
characters)
(LET*((IMAGESTREAM (GETSTREAM IMAGESTREAM (QUOTE OUTPUT)))
C FC (FONTARRAY (FONTMAPARRAY FONTS))
(MAXFONT (ARRAYSIZE FONTARRAY))
(INSTRM (GETSTREAM INFILE (QUOTE INPUT)))
(INEOLC (GETFILEINFO INSTRM (QUOTE EOL)))
(RIGHTMAR (DSPRIGHTMARGIN NIL IMAGESTREAM)))
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION ZERO))
(bind (SHIFTEDCHARSET ←(UNFOLD (ffetch CHARSET of INSTRM)
256))
do (COND
((AND [EQ 0 (LOGAND 255 (SETQ C (\NSIN INSTRM SHIFTEDCHARSET SHIFTEDCHARSET]
(EOFP INSTRM))
(RETURN))
((AND RIGHTMAR (IGREATERP (DSPXPOSITION NIL IMAGESTREAM)
RIGHTMAR)) (* Not to walk off
the right edge of the
paper)
(TERPRI IMAGESTREAM)))
(COND
([IGREATERP C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (↑F CR LF ↑L TAB NULL]
(\OUTCHAR IMAGESTREAM C))
(T (SELCHARQ C
(↑F (* Font shift)
[SELCHARQ (SETQ FC (\NSIN INSTRM SHIFTEDCHARSET SHIFTEDCHARSET))
(↑T (* tab to absolute
pos.)
(COND
((EQ 0 (SETQ FC (\NSIN INSTRM SHIFTEDCHARSET SHIFTEDCHARSET)
))
(\OUTCHAR IMAGESTREAM (CHARCODE ↑F))
(\OUTCHAR IMAGESTREAM (CHARCODE ↑T))
(AND (\EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM FC))
(T
(* TEXTDEFAULTTABS is a hack, since it depends on the units of the
stream. Should really be a property of the stream or imagetype, or defined
in terms of standard scale)
(SETQ FC (OR (CAR (NTH (OR TABS TEXTDEFAULTTABS)
FC))
(ERROR "Undefined absolute tab number" FC)))
(DSPXPOSITION FC IMAGESTREAM))))
(NULL (\OUTCHAR IMAGESTREAM (CHARCODE ↑F))
(AND (\EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM FC) (* EOS after ↑F)
)
(COND
((AND (IGEQ MAXFONT FC)
(NEQ FC 0))
(DSPFONT (ELT FONTARRAY FC)
IMAGESTREAM))
(T (\OUTCHAR IMAGESTREAM (CHARCODE ↑F))
(\OUTCHAR IMAGESTREAM C])
(CR (* Don't call generic
\CHECKEOLC macro,
because we are trying
to disciminate the raw
CR and raw LF cases for
printing)
(* Note: Assumes, as does \CHECKEOLC and \FILEOUTCHARFN that the LF
character will be generated immediately after the CR, independent of the
encoding, perhaps by a file-transfer protocol)
(SELECTQ INEOLC
(CR (TERPRI IMAGESTREAM))
(CRLF (COND
((EQ (CHARCODE LF)
(\PEEKBIN INSTRM T))
(BIN INSTRM)
(TERPRI IMAGESTREAM))
(T (DSPXPOSITION (DSPLEFTMARGIN NIL IMAGESTREAM)
IMAGESTREAM) (* Move to left
margin)
)))
(DSPXPOSITION (DSPLEFTMARGIN NIL IMAGESTREAM)
IMAGESTREAM)))
(TAB (OR (NLSETQ (RELMOVETO (TIMES (CHARWIDTH (CHARCODE SPACE)
IMAGESTREAM)
8)
0 IMAGESTREAM))
(\OUTCHAR IMAGESTREAM C)))
(LF (COND
((EQ INEOLC (QUOTE LF))
(TERPRI IMAGESTREAM))
(T (DSPXPOSITION (PROG1 (DSPXPOSITION NIL IMAGESTREAM)
(TERPRI IMAGESTREAM))
IMAGESTREAM))))
(NULL (AND (EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM C))
(\OUTCHAR IMAGESTREAM C])
)
(DEFINEQ
(\BLTSHADE.GENERICPRINTER
[LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION
SHADESCALE) (* rrb
" 7-Feb-86 19:15")
(PROG (FINALREGION SCRATCHBM BMWIDTH BMHEIGHT) (* do the clipping to
reduce the size of the
scratch bitmap created.
This also keeps Press
from doing the wrong
thing.)
(* don't do anything
if clipped region is
empty)
(OR (SETQ FINALREGION (INTERSECTREGIONS (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM
WIDTH HEIGHT)
(DSPCLIPPINGREGION NIL STREAM)))
(RETURN))
(AND CLIPPINGREGION (OR (SETQ FINALREGION (INTERSECTREGIONS FINALREGION CLIPPINGREGION))
(RETURN)))
(COND
([ZEROP (SETQ BMWIDTH (FIXR (FQUOTIENT (fetch (REGION WIDTH) of FINALREGION)
SHADESCALE]
(RETURN)))
(COND
([ZEROP (SETQ BMHEIGHT (FIXR (FQUOTIENT (fetch (REGION HEIGHT) of FINALREGION)
SHADESCALE]
(RETURN)))
(SETQ SCRATCHBM (BITMAPCREATE BMWIDTH BMHEIGHT))
(\BLTSHADE.BITMAP TEXTURE SCRATCHBM 0 0 NIL NIL (QUOTE REPLACE))
(BITBLT SCRATCHBM 0 0 STREAM (fetch (REGION LEFT) of FINALREGION)
(fetch (REGION BOTTOM) of FINALREGION)
NIL NIL (QUOTE INPUT)
OPERATION])
)
(* hack for printers that can't really BLTSHADE)
(* stuff to support hardcopy streams on the display.)
(DEFINEQ
(MAKEHARDCOPYSTREAM
[LAMBDA (DISPLAYSTREAM IMAGETYPE) (* gbn "11-Oct-85 04:01")
(* * creates a hardcopy stream from a display stream.)
(DECLARE (GLOBALVARS \HDCPYDISPLAYIMAGEOPS))
(PROG [(DS (COND
((DISPLAYSTREAMP DISPLAYSTREAM))
((WINDOWP DISPLAYSTREAM)
(WINDOWPROP DISPLAYSTREAM (QUOTE DSP)))
((NULL DISPLAYSTREAM)
(DSPCREATE))
(T (\ILLEGAL.ARG DISPLAYSTREAM]
(replace (STREAM IMAGEOPS) of DS with \HDCPYDISPLAYIMAGEOPS)
[STREAMPROP DS (QUOTE HARDCOPYIMAGETYPE)
(OR IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
(QUOTE CANPRINT]
(* set the bout fn to one that updates the mica fields
and sets the position from them.)
(replace (STREAM STRMBOUTFN) of DS with (FUNCTION \HDCPYDSPPRINTCHAR))
(replace (STREAM OUTCHARFN) of DS with (FUNCTION \HDCPYDSPPRINTCHAR))
(* set the parameters that are different to initialize
the mica defined fields.)
(DSPFONT (DSPFONT NIL DS)
DS)
(DSPXPOSITION 0 DS)
(DSPYPOSITION 0 DS)
(DSPRIGHTMARGIN (DSPRIGHTMARGIN NIL DS)
DS)
(RETURN DS])
(UNMAKEHARDCOPYSTREAM
[LAMBDA (DISPLAYSTREAM) (* rrb "28-Sep-84 15:26")
(* * returns a hardcopy stream to a display stream.)
(DECLARE (GLOBALVARS \DISPLAYIMAGEOPS))
(PROG [(DS (COND
((DISPLAYSTREAMP DISPLAYSTREAM))
((WINDOWP DISPLAYSTREAM)
(WINDOWPROP DISPLAYSTREAM (QUOTE DSP)))
(T (\ILLEGAL.ARG DISPLAYSTREAM]
(COND
((FMEMB (QUOTE HARDCOPY)
(IMAGESTREAMTYPE DS)))
(T (RETURN DS)))
(replace (STREAM IMAGEOPS) of DS with \DISPLAYIMAGEOPS)
(STREAMPROP DS (QUOTE HARDCOPYIMAGETYPE)
NIL) (* restore the bout fn)
(replace (STREAM STRMBOUTFN) of DS with (FUNCTION \DSPPRINTCHAR))
(replace (STREAM OUTCHARFN) of DS with (FUNCTION \DSPPRINTCHAR))
(RETURN DS])
(HARDCOPYSTREAMTYPE
[LAMBDA (IMAGESTREAM) (* rrb "28-Sep-84 18:41")
(* * returns the type of a hard copy stream which is either PRESS or INTERPRESS.)
(PROG (STREAM)
(RETURN (AND (SETQ STREAM (\OUTSTREAMARG IMAGESTREAM T))
(STREAMPROP STREAM (QUOTE HARDCOPYIMAGETYPE])
(\CHARWIDTH.HDCPYDISPLAY
[LAMBDA (STREAM CHARCODE) (* gbn "11-Oct-85 04:09")
(* gets the width of a character code in a hardcopy
stream. Should be updated for spacefactor)
(IQUOTIENT (IPLUS (\FGETCHARIMAGEWIDTH (FONTCREATE (ffetch (\DISPLAYDATA DDFONT)
of (ffetch IMAGEDATA
of STREAM))
NIL NIL NIL (STREAMPROP STREAM
(QUOTE
HARDCOPYIMAGETYPE)))
CHARCODE)
(CONSTANT IHALFMICASPERPT))
(CONSTANT IMICASPERPT])
(\DSPFONT.HDCPYDISPLAY
[LAMBDA (HDCPYDSTREAM FONT) (* rrb "28-Oct-85 16:37")
(* changes the font of a hardcopy display stream. Does what the display does then puts the hardcopy widths where
they can be found {FOR NOW USE THE DDCHARIMAGEWIDTHS FIELD})
(PROG1 (\DSPFONT.DISPLAY HDCPYDSTREAM FONT)
(AND FONT (PROG [(DD (fetch IMAGEDATA of HDCPYDSTREAM))
(FD (FONTCREATE FONT NIL NIL NIL (STREAMPROP HDCPYDSTREAM
(QUOTE
HARDCOPYIMAGETYPE]
(* For now, use a streamprop instead of a special
field in the dispay data)
(* Scale widths to micas, so we don't have to fetch
the constants to scale by for every char we print)
(replace DDCHARIMAGEWIDTHS of DD
with (PROG (W OLDWIDTH (SCALE (FONTPROP FD (QUOTE SCALE)))
(CSINFO (\GETCHARSETINFO (fetch (STREAM
CHARSET)
of HDCPYDSTREAM)
FD)))
(* set linefeed from scaled height. This may be off by almost half a pixel per line but it is better than not doing
so.)
[freplace DDLINEFEED of DD
with (IMINUS (FIXR (QUOTIENT
(fetch \SFHeight
of FD)
SCALE]
[COND
((EQP SCALE (CONSTANT MICASPERPT))
(RETURN (fetch (CHARSETINFO WIDTHS)
of CSINFO]
(SETQ W (\CREATECSINFOELEMENT))
(SETQ OLDWIDTH (fetch (CHARSETINFO WIDTHS)
of CSINFO))
(SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT)
SCALE))
[for I from 0 to \MAXTHINCHAR
do (\FSETWIDTH W I
(FIXR (FTIMES
(\FGETWIDTH OLDWIDTH
I)
SCALE]
(RETURN W])
(\DSPRIGHTMARGIN.HDCPYDISPLAY
[LAMBDA (DISPLAYSTREAM XPOSITION) (* rrb "21-Aug-84 18:30")
(* * Sets the right margin that determines when a cr is inserted by print for the hardcopy display stream.)
(* mica right margin is kept accurately using 35.27778. Since the updating at each character is done with 35, this
may lead to a small error.)
(PROG1 (\DSPRIGHTMARGIN.DISPLAY DISPLAYSTREAM XPOSITION)
(AND XPOSITION (replace (\DISPLAYDATA DDMICARIGHTMARGIN) of (fetch IMAGEDATA of
DISPLAYSTREAM)
with (FIX (FTIMES XPOSITION (CONSTANT MICASPERPT])
(\DSPXPOSITION.HDCPYDISPLAY
[LAMBDA (HARDCOPYSTREAM XPOSITION) (* rrb "20-Aug-84 17:51")
(* updates the mica xposition too.)
(PROG1 (\DSPXPOSITION.DISPLAY HARDCOPYSTREAM XPOSITION)
(AND XPOSITION (\HDCPYDISPLAY.FIX.XPOS HARDCOPYSTREAM])
(\DSPYPOSITION.HDCPYDISPLAY
[LAMBDA (HARDCOPYSTREAM YPOSITION) (* rrb "20-Aug-84 17:51")
(* updates the mica xposition too.)
(PROG1 (\DSPYPOSITION.DISPLAY HARDCOPYSTREAM YPOSITION)
(AND YPOSITION (\HDCPYDISPLAY.FIX.YPOS HARDCOPYSTREAM])
(\STRINGWIDTH.HDCPYDISPLAY
[LAMBDA (STREAM STR RDTBL) (* gbn "11-Oct-85 04:03")
(* Returns the width of for the current
font/spacefactor in hardcopy stream STREAM.)
(LET [(HARDCOPYFD (FONTCREATE (ffetch (\DISPLAYDATA DDFONT) of (ffetch IMAGEDATA
of STREAM))
NIL NIL NIL (STREAMPROP STREAM (QUOTE HARDCOPYIMAGETYPE]
(IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR HARDCOPYFD RDTBL (\FGETCHARIMAGEWIDTH
HARDCOPYFD
(CHARCODE SPACE)))
(CONSTANT IHALFMICASPERPT))
(CONSTANT IMICASPERPT])
(\HDCPYBLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* rrb "11-Oct-85 17:53")
(* puts a character on a hardcopy display stream. Much of the information needed by the BitBlt microcode is
prestored by the routines that change it. This is kept in the BitBltTable.)
(* knows about the representation of a DisplayStream.)
(DECLARE (LOCALVARS . T))
(PROG (LOCAL1 RIGHT LEFT CURX (CHAR8CODE (\CHAR8CODE CHARCODE))
MICARIGHT)
(COND
((NEQ (ffetch DDCHARSET of DISPLAYDATA)
(\CHARSET CHARCODE))
(\CHANGECHARSET.HDCPYDISPLAY DISPLAYDATA (\CHARSET CHARCODE)
DISPLAYSTREAM)))
[COND
((ffetch (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA)
(RETURN (\SLOWHDCPYBLTCHAR CHARCODE DISPLAYSTREAM]
CRLP(SETQ CURX (ffetch DDXPOSITION of DISPLAYDATA))
[COND
((IGREATERP (SETQ MICARIGHT (IPLUS (ffetch (\DISPLAYDATA DDMICAXPOS)
of DISPLAYDATA)
(\FGETWIDTH (ffetch (\DISPLAYDATA
DDCHARIMAGEWIDTHS)
of DISPLAYDATA)
CHAR8CODE)))
(ffetch (\DISPLAYDATA DDMICARIGHTMARGIN) of DISPLAYDATA))
(* would go past right margin, force a cr)
(COND
((IGREATERP CURX (ffetch DDLeftMargin of DISPLAYDATA))
(* don't bother CR if position is at left margin
anyway. This also serves to break the loop.)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM) (* reuse the code in the test of this conditional
rather than repeat it here.)
(GO CRLP]
(freplace (\DISPLAYDATA DDMICAXPOS) of DISPLAYDATA with MICARIGHT)
(* update the display stream x position.
Make sure that there is at least one point width for
each character.)
[freplace DDXPOSITION of DISPLAYDATA with (IMAX (ADD1 CURX)
(IQUOTIENT (IPLUS
MICARIGHT
(CONSTANT
IHALFMICASPERPT))
(CONSTANT
IMICASPERPT]
(* transforms an x coordinate into the destination
coordinate.)
(SETQ CURX (IPLUS CURX (ffetch DDXOFFSET of DISPLAYDATA)))
(SETQ RIGHT (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DISPLAYDATA)))
(COND
((IGREATERP RIGHT (SETQ LOCAL1 (ffetch DDClippingRight of DISPLAYDATA)))
(* character overlaps right edge of clipping region.)
(SETQ RIGHT LOCAL1)))
(SETQ LEFT (COND
((IGREATERP CURX (SETQ LOCAL1 (ffetch DDClippingLeft of DISPLAYDATA)))
CURX)
(T LOCAL1)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ LOCAL1 (ffetch DDPILOTBBT
of DISPLAYDATA)))
0))
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace PBTDESTBIT of LOCAL1
with LEFT)
(freplace PBTWIDTH of LOCAL1 with (IDIFFERENCE
RIGHT LEFT))
(freplace PBTSOURCEBIT of LOCAL1
with (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET
CHAR8CODE
DISPLAYDATA)
LEFT)
CURX))
(\PILOTBITBLT LOCAL1 0))
T])
(\HDCPYDISPLAY.FIX.XPOS
[LAMBDA (HARDCOPYSTREAM) (* rrb "20-Aug-84 17:47")
(* * updates the mica X position from the x position in the display stream. This is called whenever the X position
changes in a hardcopy stream.)
(PROG ((DD (fetch IMAGEDATA of HARDCOPYSTREAM)))
(replace (\DISPLAYDATA DDMICAXPOS) of DD with (FIX (FTIMES (fetch (\DISPLAYDATA DDXPOSITION)
of DD)
(CONSTANT MICASPERPT])
(\HDCPYDISPLAY.FIX.YPOS
[LAMBDA (HARDCOPYSTREAM) (* rrb "20-Aug-84 17:50")
(* * updates the mica Y position from the Y position in the display stream. This is called whenever the Y position
changes in a hardcopy stream.)
(PROG ((DD (fetch IMAGEDATA of HARDCOPYSTREAM)))
(replace (\DISPLAYDATA DDMICAYPOS) of DD with (FIX (FTIMES (fetch (\DISPLAYDATA DDYPOSITION)
of DD)
(CONSTANT MICASPERPT])
(\HDCPYDISPLAYINIT
[LAMBDA NIL (* rmk: "24-Sep-84 17:04")
(* * Initializes global variables for the hardcopy Display device. This device appears to the user as an INTERPRESS
or PRESS device meaning units in micas but outputs to the screen. Much of this code was borrowed from the display
case.)
(DECLARE (GLOBALVARS \HDCPYDISPLAYIMAGEOPS))
(SETQ \HDCPYDISPLAYIMAGEOPS (create IMAGEOPS using \DISPLAYIMAGEOPS IMAGETYPE ←(QUOTE
(HARDCOPY DISPLAY))
IMFONT ←(FUNCTION \DSPFONT.HDCPYDISPLAY)
IMRIGHTMARGIN ←(FUNCTION
\DSPRIGHTMARGIN.HDCPYDISPLAY)
IMXPOSITION ←(FUNCTION
\DSPXPOSITION.HDCPYDISPLAY)
IMYPOSITION ←(FUNCTION
\DSPYPOSITION.HDCPYDISPLAY)
IMSTRINGWIDTH ←(FUNCTION
\STRINGWIDTH.HDCPYDISPLAY)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.HDCPYDISPLAY]
)
(\HDCPYDSPPRINTCHAR
[LAMBDA (STREAM CHARCODE) (* rrb "21-Aug-84 10:17")
(* * displays a character on a hardcopy display stream. This uses a display font but updates the x position
according to hardcopy widths.)
(PROG ((DD (fetch IMAGEDATA of STREAM)))
(\CHECKCARET STREAM)
(RETURN
(SELECTC
(fetch CCECHO of (\SYNCODE \PRIMTERMSA CHARCODE))
[INDICATE.CCE (PROG ((CC CHARCODE))
(add (fetch CHARPOSITION of STREAM)
(IPLUS (COND
((IGREATERP CC 127)
(* META character)
(\HDCPYBLTCHAR (CHARCODE #)
STREAM DD)
(SETQ CC (LOGAND CC 127))
1)
(T 0))
(COND
((ILESSP CC 32)
(* CONTROL character)
(\HDCPYBLTCHAR (CHARCODE ↑)
STREAM DD)
(SETQ CC (LOGOR CC 64))
1)
(T 0))
(PROGN (\HDCPYBLTCHAR CC STREAM DD)
1]
[SIMULATE.CCE
(SELCHARQ CHARCODE
((EOL CR LF)
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ESCAPE (\HDCPYBLTCHAR (CHARCODE $)
STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1))
[BELL (* make switching of bits uninterruptable but allow
interrupts between flashes.)
(SELECTQ (MACHINETYPE)
[DANDELION (PLAYTUNE (QUOTE ((880 . 2500]
(FLASHWINDOW (WFROMDS STREAM]
[TAB (PROG (TABWIDTH (SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
STREAM)))
(SETQ TABWIDTH (UNFOLD SPACEWIDTH 8))
(COND
((IGREATERP (\DISPLAYSTREAMINCRXPOSITION
(SETQ TABWIDTH
(IDIFFERENCE TABWIDTH
(MOD (IDIFFERENCE (fetch
DDXPOSITION
of DD)
(ffetch
DDLeftMargin
of DD))
TABWIDTH)))
DD)
(ffetch DDRightMargin of DD))
(* tab was past rightmargin, force cr.)
(\DSPPRINTCR/LF (CHARCODE EOL)
STREAM)))
(* return the number of spaces taken.)
(add (fetch CHARPOSITION of STREAM)
(IQUOTIENT TABWIDTH SPACEWIDTH]
(PROGN (* this case was copied from \DSCCOUT.)
(\HDCPYBLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
[REAL.CCE (SELECTC CHARCODE
((CHARCODE (EOL CR LF))
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ERASECHARCODE (DSPBACKUP (CHARWIDTH (CHARCODE A)
STREAM)
STREAM)
(* line buffering routines have already taken care of
backing up the position)
0)
(PROGN (\HDCPYBLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
(IGNORE.CCE)
(SHOULDNT])
(\SLOWHDCPYBLTCHAR
(LAMBDA (CHARCODE DISPLAYSTREAM) (* kbr:
" 1-Feb-86 13:24")
(* * IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH
\SLOWBLTCHAR? KBR 1-FEB-86. *)
(* * THIS HAS BEEN SEPARATED OUT BUT HASN'T BEEN EDITTED TO DO CORRECT
THING WRT UPDATING MICA FIELDS.)
(* case of BLTCHAR where
either font is rotated
or destination is a
color bitmap.
DISPLAYSTREAM is known
to be a hardcopy display
stream.)
(PROG (ROTATION (CHAR8CODE (\CHAR8CODE CHARCODE))
(DD (ffetch (STREAM IMAGEDATA) of DISPLAYSTREAM)))
(SETQ ROTATION (ffetch (FONTDESCRIPTOR ROTATION) of (ffetch (\DISPLAYDATA DDFONT)
of DD)))
(COND
((EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
PILOTBBT DESTBIT WIDTH SOURCEBIT)
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))
(COND
((IGREATERP NEWX (ffetch (\DISPLAYDATA DDRightMargin) of DD))
(* past RIGHT margin,
force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))))
(* update the x
position.)
(freplace (\DISPLAYDATA DDXPOSITION) of DD with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DD))
(SETQ LEFT (IMAX (ffetch (\DISPLAYDATA DDClippingLeft) of DD)
CURX))
(SETQ RIGHT (IMIN (ffetch (\DISPLAYDATA DDClippingRight) of DD)
(\DSPTRANSFORMX NEWX DD)))
(SETQ PILOTBBT (ffetch (\DISPLAYDATA DDPILOTBBT) of DD))
(COND
((AND (ILESSP LEFT RIGHT)
(NEQ (ffetch (PILOTBBT PBTHEIGHT) of PILOTBBT)
0))
(SETQ DESTBIT LEFT)
(SETQ WIDTH (IDIFFERENCE RIGHT LEFT))
(SETQ SOURCEBIT (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DD)
LEFT)
CURX))
(SELECTQ (ffetch (BITMAP BITMAPBITSPERPIXEL) of (ffetch (\DISPLAYDATA
DDDestination)
of DD))
(1)
(4 (SETQ DESTBIT (LLSH DESTBIT 2))
(SETQ WIDTH (LLSH WIDTH 2))
(SETQ SOURCEBIT (LLSH SOURCEBIT 2)))
(8 (SETQ DESTBIT (LLSH DESTBIT 3))
(SETQ WIDTH (LLSH WIDTH 3))
(SETQ SOURCEBIT (LLSH SOURCEBIT 3)))
(SHOULDNT))
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace (PILOTBBT PBTDESTBIT) of PILOTBBT
with DESTBIT)
(freplace (PILOTBBT PBTWIDTH) of PILOTBBT with WIDTH)
(freplace (PILOTBBT PBTSOURCEBIT) of PILOTBBT with SOURCEBIT)
(\PILOTBITBLT PILOTBBT 0))
T))))
(T (* handle rotated fonts)
(PROG (YPOS HEIGHTMOVED CSINFO)
(SETQ YPOS (ffetch (\DISPLAYDATA DDYPOSITION) of DD))
(SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
(SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
(ffetch (\DISPLAYDATA DDFONT) of DD)))
(COND
((EQ ROTATION 90) (* don't force CR for
rotated fonts.)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
(* update the display
stream x position.)
(BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
0
(\DSPGETCHAROFFSET CHAR8CODE DD)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION) of DD)
(ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)))
YPOS
(IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
HEIGHTMOVED))
((EQ ROTATION 270)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED))
(BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
0
(\DSPGETCHAROFFSET CHAR8CODE DD)
DISPLAYSTREAM
(IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION) of DD)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
(ffetch (\DISPLAYDATA DDYPOSITION) of DISPLAYSTREAM)
(IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
HEIGHTMOVED))
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270")))))))))
(\CHANGECHARSET.HDCPYDISPLAY
[LAMBDA (DISPLAYDATA CHARSET HDCPYDSTREAM) (* rrb "11-Oct-85 18:12")
(* Called when the character set information cached in a display stream doesn't correspond to CHARSET Only sets
those field that are different from the regular DISPLAY case and uses the regular display case to get the rest.)
(\CHANGECHARSET.DISPLAY DISPLAYDATA CHARSET)
(PROG [(FD (FONTCREATE (ffetch DDFONT of DISPLAYDATA)
NIL NIL NIL (STREAMPROP HDCPYDSTREAM (QUOTE HARDCOPYIMAGETYPE]
(* For now, use a streamprop instead of a special
field in the dispay data)
(* Scale widths to micas, so we don't have to fetch
the constants to scale by for every char we print)
(replace DDCHARIMAGEWIDTHS of DISPLAYDATA
with (PROG (W OLDWIDTH (SCALE (FONTPROP FD (QUOTE SCALE)))
(CSINFO (\GETCHARSETINFO CHARSET FD)))
(SETQ OLDWIDTH (fetch (CHARSETINFO WIDTHS) of CSINFO))
(COND
((EQP SCALE (CONSTANT MICASPERPT))
(RETURN OLDWIDTH)))
(SETQ W (\CREATECSINFOELEMENT))
(SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT)
SCALE))
[for I from 0 to \MAXTHINCHAR
do (\FSETWIDTH W I (FIXR (FTIMES (\FGETWIDTH OLDWIDTH I)
SCALE]
(RETURN W])
)
(DECLARE: DONTCOPY DOEVAL@COMPILE
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQ MICASPERPT (FQUOTIENT 2540 72))
(RPAQQ IHALFMICASPERPT 17)
(RPAQQ IMICASPERPT 35)
(DECLARE: EVAL@COMPILE
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
(IHALFMICASPERPT 17)
(IMICASPERPT 35))
)
(* END EXPORTED DEFINITIONS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\HDCPYDISPLAYINIT)
)
(* Stuff to support MICA-unit hardcopy streams on the display)
(DEFINEQ
(MAKEHARDCOPYMODESTREAM
[LAMBDA (DISPLAYSTREAM IMAGETYPE) (* AJB " 9-Dec-85 15:29")
(* * Creates a hardcopy-mode display stream from a normal one. That stream operates in units of micas, but displays
on the screen as usual.)
(DECLARE (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
(PROG [(DS (COND
((DISPLAYSTREAMP DISPLAYSTREAM))
((WINDOWP DISPLAYSTREAM)
(WINDOWPROP DISPLAYSTREAM (QUOTE DSP)))
((NULL DISPLAYSTREAM)
(DSPCREATE))
(T (\ILLEGAL.ARG DISPLAYSTREAM]
(SELECTQ [OR IMAGETYPE (SETQ IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
(QUOTE CANPRINT]
(PRESS (* Give the stream PRESS-style imageops, so it will
deal with press fonts right.)
(replace (STREAM IMAGEOPS) of DS with \HCPYMODEDISPLAYIMAGEOPS.PRESS))
(INTERPRESS (* Give the stream INTERPRESS-style operations, so it
will deal with Interpress fonts right.)
(replace (STREAM IMAGEOPS) of DS with
\HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
NIL)
(STREAMPROP DS (QUOTE HARDCOPYIMAGETYPE)
IMAGETYPE) (* set the bout fn to one that updates the mica fields
and sets the position from them.)
(replace (STREAM STRMBOUTFN) of DS with (FUNCTION \HCPYMODEDSPPRINTCHAR))
(* Set the character-printing functions for the stream
to the hardcopy-mode ones.)
(replace (STREAM OUTCHARFN) of DS with (FUNCTION \HCPYMODEDSPPRINTCHAR))
(* * set the parameters that are different to initialize the mica defined fields.)
(DSPFONT (DSPFONT NIL DS)
DS) (* Hardcopy version of the current font...)
(DSPXPOSITION 0 DS) (* Reset the X and Y positions to 0)
(DSPYPOSITION 0 DS)
(STREAMPROP DS (QUOTE DSPRIGHTMARGIN)
(DSPRIGHTMARGIN NIL DS)) (* Stash the right margin in points for later
restoral)
(DSPRIGHTMARGIN (FIXR (FTIMES (OR (DSPRIGHTMARGIN NIL DS)
(fetch WIDTH of (DSPCLIPPINGREGION NIL DS)))
MICASPERPT))
DS) (* And reuse the right margin)
(RETURN DS])
(UNMAKEHARDCOPYMODESTREAM
[LAMBDA (DISPLAYSTREAM) (* AJB " 9-Dec-85 14:55")
(* * returns a hardcopy stream to a display stream.)
(DECLARE (GLOBALVARS \DISPLAYIMAGEOPS))
(PROG [(DS (COND
((DISPLAYSTREAMP DISPLAYSTREAM))
((WINDOWP DISPLAYSTREAM)
(WINDOWPROP DISPLAYSTREAM (QUOTE DSP)))
(T (\ILLEGAL.ARG DISPLAYSTREAM]
(COND
((FMEMB (QUOTE HARDCOPY)
(IMAGESTREAMTYPE DS)) (* Make sure the stream really WAS a hardcopy-mode
stream.)
)
(T (* It wasn't a hardcopy-mode stream.
Don't make any changes)
(RETURN DS)))
(replace (STREAM IMAGEOPS) of DS with \DISPLAYIMAGEOPS)
(* Give it back the usual operations)
(STREAMPROP DS (QUOTE HARDCOPYIMAGETYPE)
NIL) (* restore the bout fn)
(replace (STREAM STRMBOUTFN) of DS with (FUNCTION \DSPPRINTCHAR))
(replace (STREAM OUTCHARFN) of DS with (FUNCTION \DSPPRINTCHAR))
(DSPXPOSITION 0 DS)
(DSPYPOSITION 0 DS)
(DSPRIGHTMARGIN (OR (STREAMPROP DISPLAYSTREAM (QUOTE DSPRIGHTMARGIN))
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL DS)))
NIL DS) (* Reset the right margin back to points)
(RETURN DS])
(\BLTSHADE.HCPYMODE
[LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
(* jds " 6-Jan-85 14:59")
(* BLTSHADE to a hardcopy-mode dispolay stream)
(* Just convert the coordinates and do the normal
display thing.)
(\BLTSHADE.1BITDISPLAY TEXTURE STREAM (\MICASTOPTS DESTINATIONLEFT)
(\MICASTOPTS DESTINATIONBOTTOM)
WIDTH HEIGHT OPERATION (\DASHINGCONVERT.HCPYMODE CLIPPINGREGION])
(\BITBLT.HCPYMODE
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM) (* jds " 6-Jan-85 15:01")
(* BITBLT to a hardcopy-mode display stream.
Convert the destination coordinates to micas and do the
normal operation.)
(\BITBLT.1BITDISPLAY SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM (\MICASTOPTS DESTINATIONLEFT)
(\MICASTOPTS DESTINATIONBOTTOM)
WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE (\DASHINGCONVERT.HCPYMODE
CLIPPINGREGION)
CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM])
(\BRUSHCONVERT.HCPYMODE
[LAMBDA (BRUSH) (* jds " 6-Jan-85 15:02")
(* Convert a brush description from points to micas)
(COND
((LISTP BRUSH)
(FOR BB IN BRUSH COLLECT (COND
((NUMBERP BB)
(\MICASTOPTS BB))
(T BB])
(\CHANGECHARSET.HCPYMODE
[LAMBDA (DISPLAYDATA CHARSET) (* AJB "10-Dec-85 15:36")
(* Called when the character set information cached in
a display stream doesn't correspond to CHARSET)
(PROG [BM (PBT (ffetch DDPILOTBBT of DISPLAYDATA))
(CSINFO (\GETCHARSETINFO CHARSET (ffetch DDFONT of DISPLAYDATA)))
(CSDINFO (\GETCHARSETINFO CHARSET (FONTCOPY (ffetch DDFONT of DISPLAYDATA)
(QUOTE DEVICE)
(QUOTE DISPLAY]
(UNINTERRUPTABLY
(freplace DDWIDTHSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO WIDTHS)
of CSINFO))
(freplace DDOFFSETSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO OFFSETS)
of CSINFO))
(freplace DDCHARIMAGEWIDTHS of DISPLAYDATA with (ffetch (CHARSETINFO
IMAGEWIDTHS)
of CSINFO))
(freplace DDCHARSET of DISPLAYDATA with CHARSET)
(SETQ BM (ffetch CHARSETBITMAP of CSINFO))
(freplace PBTSOURCEBPL of PBT with (UNFOLD (ffetch BITMAPRASTERWIDTH
of BM)
BITSPERWORD))
[replace OTHERDEVICEFONTPROPS of (ffetch DDFONT of DISPLAYDATA)
with (LIST (QUOTE WIDTHS)
(fetch (CHARSETINFO WIDTHS) of CSDINFO)
(QUOTE ASCENT)
(fetch (CHARSETINFO CHARSETASCENT) of CSDINFO)
(QUOTE DESCENT)
(fetch (CHARSETINFO CHARSETDESCENT) of CSDINFO)
(QUOTE HEIGHT)
(IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSDINFO)
(fetch (CHARSETINFO CHARSETDESCENT) of CSDINFO]
(* Cache the DISPLAY info, for the various X- and
Y-position updating tasks that affect the display
bitmap itself)
[COND
((OR (NEQ (ffetch DDCHARSETASCENT of DISPLAYDATA)
(ffetch CHARSETASCENT of CSINFO))
(NEQ (ffetch DDCHARSETDESCENT of DISPLAYDATA)
(ffetch CHARSETDESCENT of CSINFO)))
(\SFFixY.HCPYMODE DISPLAYDATA CSINFO))
(T (freplace PBTSOURCE of PBT with (\ADDBASE (ffetch BITMAPBASE of BM)
(ITIMES (ffetch
BITMAPRASTERWIDTH
of BM)
(ffetch
DDCHARHEIGHTDELTA
of DISPLAYDATA])])
(\DASHINGCONVERT.HCPYMODE
[LAMBDA (DASHING) (* jds " 6-Jan-85 15:02")
(* Convert a list of numbers from micas to points. Usually this will be a dashing spec, but it might be a REGION as
well.)
(for DD in DASHING collect (\MICASTOPTS DD])
(\CHARWIDTH.HCPYMODE
[LAMBDA (STREAM CHARCODE) (* jds " 3-Jan-85 12:55")
(* gets the width of a character code in a hardcopy
stream. Should be updated for spacefactor)
(\FGETWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS) of (fetch IMAGEDATA of STREAM))
CHARCODE])
(\DRAWLINE.HCPYMODE
[LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) (* jds " 6-Jan-85 15:03")
(* Do DRAWLINE for a hardcopy-mode display stream.)
(\DRAWLINE.DISPLAY STREAM (\MICASTOPTS X1)
(\MICASTOPTS Y1)
(\MICASTOPTS X2)
(\MICASTOPTS Y2)
(IMAX 1 (\MICASTOPTS WIDTH))
OPERATION COLOR])
(\DRAWCURVE.HCPYMODE
[LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* jds " 6-Jan-85 15:04")
(* Do DRAWCURVE for a hardcopy-mode displaystream.
Converts all the mica values to points and uses the
usual display version.)
(\DRAWCURVE.DISPLAY STREAM [FOR KNOT IN KNOTS COLLECT (CONS (\MICASTOPTS (CAR KNOT))
(\MICASTOPTS (CDR KNOT]
CLOSED
(\BRUSHCONVERT.HCPYMODE BRUSH)
(\DASHINGCONVERT.HCPYMODE DASHING])
(\DRAWCIRCLE.HCPYMODE
[LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* jds " 6-Jan-85 15:04")
(* DRAWCIRCLE for a hardcopy-mode display stream.
Convert coordinates to points and use the display
driver)
(\DRAWCIRCLE.DISPLAY STREAM (\MICASTOPTS CENTERX)
(\MICASTOPTS CENTERY)
(\MICASTOPTS RADIUS)
(\BRUSHCONVERT.HCPYMODE BRUSH)
(\DASHINGCONVERT.HCPYMODE DASHING])
(\DRAWELLIPSE.HCPYMODE
[LAMBDA (STREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
(* jds " 6-Jan-85 15:06")
(* DRAWELLIPSE driver for hardcopy-mode displaystreams.
Convert all the values to points from micas, and use
the display DRAWELLIPSE.)
(\DRAWELLIPSE.DISPLAY STREAM (\MICASTOPTS CENTERX)
(\MICASTOPTS CENTERY)
(\MICASTOPTS SEMIMINORRADIUS)
(\MICASTOPTS SEMIMAJORRADIUS)
ORIENTATION
(\BRUSHCONVERT.HCPYMODE BRUSH)
(\DASHINGCONVERT.HCPYMODE DASHING])
(\DSPFONT.HCPYMODE
[LAMBDA (HDCPYDSTREAM FONT) (* AJB " 4-Dec-85 15:36")
(* changes the font of a hardcopy display stream. Does what the display does then puts the hardcopy widths where
they can be found {FOR NOW USE THE DDCHARIMAGEWIDTHS FIELD})
(PROG (XFONT OLDFONT (DD (fetch IMAGEDATA of HDCPYDSTREAM)))
(* save old value to return, smash new value and
update the bitchar portion of the record.)
(RETURN (PROG1 (SETQ OLDFONT (fetch DDFONT of DD))
(COND
(FONT (SETQ XFONT (OR (\GETFONTDESC FONT (fetch IMFONTCREATE
of (fetch IMAGEOPS
of HDCPYDSTREAM))
T)
(FONTCOPY (ffetch DDFONT of DD)
FONT)))
(* updating font information is fairly expensive
operation. Don't bother unless font has changed.)
(OR (EQ XFONT OLDFONT)
(UNINTERRUPTABLY
(freplace DDFONT of DD with XFONT)
(freplace DDLINEFEED of DD
with (IMINUS (fetch \SFHeight of XFONT)))
(* Each line moves down by the font height, by
default)
(freplace DDSPACEWIDTH of DD with (\FGETCHARWIDTH
XFONT
(CHARCODE SPACE)))
(\SFFixFont HDCPYDSTREAM DD)
(* Fix up the font-dependent fields of the
DISPLAYSTREAM)
)])
(\DSPLEFTMARGIN.HCPYMODE
[LAMBDA (DISPLAYSTREAM XPOSITION) (* jds " 6-Jan-85 15:09")
(* * Sets the left margin that determines when a cr is inserted by print for the hardcopy display stream.)
(* * Sets the left margin for a hardcopy-mode displaystream, to determine where CR returns you to.)
(PROG1 [\DSPRIGHTMARGIN.DISPLAY DISPLAYSTREAM (AND XPOSITION (FIXR (FQUOTIENT XPOSITION
MICASPERPT]
(* LATER, WHEN DDLEFTMARGINMICA EXISTS...
(AND XPOSITION (replace (\DISPLAYDATA
DDMICARIGHTMARGIN) of (fetch IMAGEDATA of
DISPLAYSTREAM) with XPOSITION)))
])
(\DSPLINEFEED.HCPYMODE
[LAMBDA (DISPLAYSTREAM DELTAY) (* jds " 6-Jan-85 15:10")
(* For a hardcopy-mode displaystream, sets the amount
that a line feed increases the y coordinate by.)
(PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(RETURN (PROG1 (ffetch DDLINEFEED of DD) (* Return the old value.)
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace DDLINEFEED of DD with DELTAY))
(T (\ILLEGAL.ARG DELTAY])
(\DSPRIGHTMARGIN.HCPYMODE
[LAMBDA (DISPLAYSTREAM XPOSITION) (* jds " 6-Jan-85 15:13")
(* * Sets the right margin that determines when a cr is inserted by print for the hardcopy display stream.)
(PROG1 (fetch (\DISPLAYDATA DDMICARIGHTMARGIN) of (fetch IMAGEDATA of DISPLAYSTREAM))
(* Return the old mica value.)
[\DSPRIGHTMARGIN.DISPLAY DISPLAYSTREAM (AND XPOSITION (FIXR (FQUOTIENT XPOSITION
MICASPERPT]
(* Set the right margin in display units,)
(AND XPOSITION (replace (\DISPLAYDATA DDMICARIGHTMARGIN) of (fetch IMAGEDATA of
DISPLAYSTREAM)
with XPOSITION)) (* And set the new mica value)
])
(\DSPXPOSITION.HCPYMODE
[LAMBDA (HARDCOPYSTREAM XPOSITION) (* jds " 6-Jan-85 15:12")
(* Update the X position for a mica-unit hardcopy-mode
displaystream)
(PROG1 (fetch (\DISPLAYDATA DDXPOSITION) of (fetch IMAGEDATA of HARDCOPYSTREAM))
(* Return the old value...)
[\DSPXPOSITION.DISPLAY HARDCOPYSTREAM (AND XPOSITION (FIXR (FQUOTIENT XPOSITION MICASPERPT]
(* Set up the display right for this mica value)
(AND XPOSITION (replace (\DISPLAYDATA DDXPOSITION) of (fetch IMAGEDATA of HARDCOPYSTREAM)
with XPOSITION)) (* And remember what it was.)
])
(\DSPYPOSITION.HCPYMODE
[LAMBDA (HARDCOPYSTREAM YPOSITION) (* jds " 7-Jun-85 14:04")
(* Move to a new mica Y position)
(PROG ((DD (fetch IMAGEDATA of HARDCOPYSTREAM)))
(RETURN (PROG1 (ffetch DDYPOSITION of DD) (* Return the old value first.)
(COND
((NULL YPOSITION))
((NUMBERP YPOSITION)
(UNINTERRUPTABLY
(freplace DDYPOSITION of DD with YPOSITION))
(\INVALIDATEDISPLAYCACHE DD))
(T (\ILLEGAL.ARG YPOSITION])
(\MOVETO.HCPYMODE
[LAMBDA (STREAM X Y) (* jds " 3-Jan-85 13:18")
(\DSPXPOSITION.HCPYMODE STREAM X)
(\DSPYPOSITION.HCPYMODE STREAM Y])
(\FONTCREATE.HCPYMODE.PRESS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* AJB "11-Dec-85 15:07")
(* Create a font descriptor for a display stream that
is mimicing an PRESS device)
(PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (create FONTDESCRIPTOR
using (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE PRESS))
FONTCHARSETVECTOR ←(\CREATEFONTCHARSETVECTOR)))
(CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT)))
(replace FONTDEVICE of HFONT with (QUOTE PRESSDISPLAY))
[replace OTHERDEVICEFONTPROPS of HFONT with (LIST (QUOTE WIDTHS)
(fetch (CHARSETINFO WIDTHS)
of CS0DINFO)
(QUOTE ASCENT)
(fetch (CHARSETINFO
CHARSETASCENT)
of CS0DINFO)
(QUOTE DESCENT)
(fetch (CHARSETINFO
CHARSETDESCENT)
of CS0DINFO)
(QUOTE HEIGHT)
(IPLUS (fetch (CHARSETINFO
CHARSETASCENT)
of CS0DINFO)
(fetch (CHARSETINFO
CHARSETDESCENT)
of CS0DINFO]
(* Cache the DISPLAY info, for the various X- and
Y-position updating tasks that affect the display
bitmap itself)
(RETURN HFONT])
(\CREATECHARSET.HCPYMODE.PRESS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* AJB "11-Dec-85 15:09")
(* Build the CHARSETINFO for an PRESSDISPLAY font)
(PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE PRESS)))
(CSDINFO (\GETCHARSETINFO CHARSET DFONT))
(CSHINFO (\GETCHARSETINFO CHARSET HFONT))
(CSINFO (CREATE CHARSETINFO USING CSHINFO)))
(replace (CHARSETINFO OFFSETS) of CSINFO with (fetch (CHARSETINFO OFFSETS)
of CSDINFO))
(* Fill in the right offsets from the display
font--into the hcpy font, and its Charset-0 info
block)
(replace (CHARSETINFO CHARSETBITMAP) of CSINFO with (fetch (CHARSETINFO
CHARSETBITMAP)
of CSDINFO))
(* Likewise the character rasters)
(replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO IMAGEWIDTHS)
of CSDINFO))
(* And the raster widths (as distinct from the nominal
mica widths))
(RETURN CSINFO])
(\FONTCREATE.HCPYMODE.INTERPRESS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* AJB " 6-Dec-85 16:17")
(* Create a font descriptor for a display stream that
is mimicing an INTERPRESS device)
(PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (create FONTDESCRIPTOR
using (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE INTERPRESS))
FONTCHARSETVECTOR ←(\CREATEFONTCHARSETVECTOR)))
(CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT)))
(replace FONTDEVICE of HFONT with (QUOTE INTERPRESSDISPLAY))
[replace OTHERDEVICEFONTPROPS of HFONT with (LIST (QUOTE WIDTHS)
(fetch (CHARSETINFO WIDTHS)
of CS0DINFO)
(QUOTE ASCENT)
(fetch (CHARSETINFO
CHARSETASCENT)
of CS0DINFO)
(QUOTE DESCENT)
(fetch (CHARSETINFO
CHARSETDESCENT)
of CS0DINFO)
(QUOTE HEIGHT)
(IPLUS (fetch (CHARSETINFO
CHARSETASCENT)
of CS0DINFO)
(fetch (CHARSETINFO
CHARSETDESCENT)
of CS0DINFO]
(* Cache the DISPLAY info, for the various X- and
Y-position updating tasks that affect the display
bitmap itself)
(RETURN HFONT])
(\CREATECHARSET.HCPYMODE.INTERPRESS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* AJB " 4-Dec-85 17:29")
(* Build the CHARSETINFO for an INTERPRESSDISPLAY
font)
(PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE INTERPRESS)))
(CSDINFO (\GETCHARSETINFO CHARSET DFONT))
(CSHINFO (\GETCHARSETINFO CHARSET HFONT))
(CSINFO (CREATE CHARSETINFO USING CSHINFO)))
(replace (CHARSETINFO OFFSETS) of CSINFO with (fetch (CHARSETINFO OFFSETS)
of CSDINFO))
(* Fill in the right offsets from the display
font--into the hcpy font, and its Charset-0 info
block)
(replace (CHARSETINFO CHARSETBITMAP) of CSINFO with (fetch (CHARSETINFO
CHARSETBITMAP)
of CSDINFO))
(* Likewise the character rasters)
(replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO IMAGEWIDTHS)
of CSDINFO))
(* And the raster widths (as distinct from the nominal
mica widths))
(RETURN CSINFO])
(\STRINGWIDTH.HCPYMODE
[LAMBDA (STREAM STR RDTBL) (* rmk: "12-Sep-84 11:11")
(* Returns the width of for the current
font/spacefactor in hardcopy stream STREAM.)
(PROG (WIDTHSBASE)
(RETURN (IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR (SETQ WIDTHSBASE
(ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS)
of (ffetch IMAGEDATA of STREAM)))
RDTBL
(\FGETWIDTH WIDTHSBASE (CHARCODE SPACE)))
(CONSTANT IHALFMICASPERPT))
(CONSTANT IMICASPERPT])
(\HCPYMODEBLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* AJB "10-Dec-85 15:25")
(* puts a character on a hardcopy display stream. Much of the information needed by the BitBlt microcode is
prestored by the routines that change it. This is kept in the BitBltTable.)
(* knows about the representation of a DisplayStream.)
(DECLARE (LOCALVARS . T))
(PROG (LOCAL1 RIGHT LEFT CURX MICARIGHT (CHAR8CODE (\CHAR8CODE CHARCODE)))
CRLP[COND
((NEQ (ffetch DDCHARSET of DISPLAYDATA)
(\CHARSET CHARCODE))
(\CHANGECHARSET.HCPYMODE DISPLAYDATA (\CHARSET CHARCODE]
[COND
((ffetch (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA)
(RETURN (\SLOWHCPYMODEBLTCHAR CHARCODE DISPLAYSTREAM]
(SETQ CURX (FIXR (FQUOTIENT (ffetch DDXPOSITION of DISPLAYDATA)
MICASPERPT))) (* Convert the mica-position value to points only at
the last minute.)
[COND
((IGREATERP (SETQ MICARIGHT (IPLUS (ffetch (\DISPLAYDATA DDXPOSITION) of DISPLAYDATA)
(\DSPGETCHARWIDTH CHAR8CODE DISPLAYDATA)))
(ffetch (\DISPLAYDATA DDMICARIGHTMARGIN) of DISPLAYDATA))
(* would go past right margin, force a cr)
(COND
((IGREATERP CURX (ffetch DDLeftMargin of DISPLAYDATA))
(* don't bother CR if position is at left margin
anyway. This also serves to break the loop.)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM) (* reuse the code in the test of this conditional
rather than repeat it here.)
(GO CRLP]
(freplace (\DISPLAYDATA DDXPOSITION) of DISPLAYDATA with MICARIGHT)
(* update the display stream x position.
Make sure that there is at least one point width for
each character.)
[SETQ CURX (IPLUS CURX (SETQ LOCAL1 (ffetch DDXOFFSET of DISPLAYDATA]
(* Screen position of the window, generally.)
(SETQ RIGHT (IPLUS CURX (\FGETWIDTH (ffetch DDCHARIMAGEWIDTHS of DISPLAYDATA)
CHAR8CODE))) (* Right edge of the character's image.)
(COND
((IGREATERP RIGHT (SETQ LOCAL1 (ffetch DDClippingRight of DISPLAYDATA)))
(* character overlaps right edge of clipping region.)
(SETQ RIGHT LOCAL1)))
(SETQ LEFT (COND
((IGREATERP CURX (SETQ LOCAL1 (ffetch DDClippingLeft of DISPLAYDATA)))
CURX)
(T LOCAL1))) (* Left edge of the character, as displayed.)
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ LOCAL1 (ffetch DDPILOTBBT
of DISPLAYDATA)))
0)) (* If the character will appear on screen at all,
let's display it.)
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace PBTDESTBIT of LOCAL1 with LEFT)
(* Set up the destination bit with the screen-relative
left edge)
(freplace PBTWIDTH of LOCAL1 with (IDIFFERENCE RIGHT LEFT)
) (* The display width from the clipped left and right
edges)
(freplace PBTSOURCEBIT of LOCAL1
with (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE
DISPLAYDATA)
LEFT)
CURX))
(* And the source bit-offset from the OFFSETs array)
(\PILOTBITBLT LOCAL1 0)
(* Do the BITBLT)
)
T])
(\HCPYMODEDISPLAYINIT
[LAMBDA NIL (* jds " 4-Jan-85 20:32")
(* * Initializes global variables for the hardcopy Display device. This device appears to the user as an INTERPRESS
or PRESS device meaning units in micas but outputs to the screen. Much of this code was borrowed from the display
case.)
(DECLARE (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
[SETQ \HCPYMODEDISPLAYIMAGEOPS.PRESS (create IMAGEOPS using \DISPLAYIMAGEOPS IMAGETYPE ←(QUOTE
(HARDCOPY DISPLAY))
IMFONT ←(FUNCTION \DSPFONT.HCPYMODE)
IMRIGHTMARGIN ←(FUNCTION
\DSPRIGHTMARGIN.HCPYMODE)
IMLEFTMARGIN ←(FUNCTION
\DSPLEFTMARGIN.HCPYMODE)
IMLINEFEED ←(FUNCTION
\DSPLINEFEED.HCPYMODE)
IMDRAWLINE ←(FUNCTION
\DRAWLINE.HCPYMODE)
IMDRAWCURVE ←(FUNCTION
\DRAWCURVE.HCPYMODE)
IMDRAWCIRCLE ←(FUNCTION
\DRAWCIRCLE.HCPYMODE)
IMDRAWELLIPSE ←(FUNCTION
\DRAWELLIPSE.HCPYMODE)
IMFILLCIRCLE ←(FUNCTION
\FILLCIRCLE.HCPYMODE)
IMBLTSHADE ←(FUNCTION
\BLTSHADE.HCPYMODE)
IMBITBLT ←(FUNCTION \BITBLT.HCPYMODE)
IMXPOSITION ←(FUNCTION
\DSPXPOSITION.HCPYMODE)
IMYPOSITION ←(FUNCTION
\DSPYPOSITION.HCPYMODE)
IMMOVETO ←(FUNCTION \MOVETO.HCPYMODE)
IMSTRINGWIDTH ←(FUNCTION
\STRINGWIDTH.HCPYMODE)
IMCHARWIDTH ←(FUNCTION
\CHARWIDTH.HCPYMODE)
IMFONTCREATE ←(FUNCTION PRESSDISPLAY)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT MICASPERINCH
72]
IMNEWPAGE ←(FUNCTION (LAMBDA (STREAM)
(PAGEFULLFN STREAM)
(CLEARW STREAM]
(SETQ \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS (create IMAGEOPS using \DISPLAYIMAGEOPS IMAGETYPE ←(
QUOTE (HARDCOPY DISPLAY))
IMFONT ←(FUNCTION
\DSPFONT.HCPYMODE)
IMRIGHTMARGIN ←(FUNCTION
\DSPRIGHTMARGIN.HCPYMODE)
IMLEFTMARGIN ←(FUNCTION
\DSPLEFTMARGIN.HCPYMODE)
IMLINEFEED ←(FUNCTION
\DSPLINEFEED.HCPYMODE)
IMDRAWLINE ←(FUNCTION
\DRAWLINE.HCPYMODE)
IMDRAWCURVE ←(FUNCTION
\DRAWCURVE.HCPYMODE)
IMDRAWCIRCLE ←(FUNCTION
\DRAWCIRCLE.HCPYMODE)
IMDRAWELLIPSE ←(FUNCTION
\DRAWELLIPSE.HCPYMODE)
IMFILLCIRCLE ←(FUNCTION
\FILLCIRCLE.HCPYMODE)
IMBLTSHADE ←(FUNCTION
\BLTSHADE.HCPYMODE)
IMBITBLT ←(FUNCTION
\BITBLT.HCPYMODE)
IMXPOSITION ←(FUNCTION
\DSPXPOSITION.HCPYMODE)
IMYPOSITION ←(FUNCTION
\DSPYPOSITION.HCPYMODE)
IMMOVETO ←(FUNCTION
\MOVETO.HCPYMODE)
IMSTRINGWIDTH ←(FUNCTION
\STRINGWIDTH.HCPYMODE)
IMCHARWIDTH ←(FUNCTION
\CHARWIDTH.HCPYMODE)
IMFONTCREATE ←(FUNCTION
INTERPRESSDISPLAY)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT
MICASPERINCH 72]
IMNEWPAGE ←(FUNCTION (LAMBDA (
STREAM)
(PAGEFULLFN STREAM)
(CLEARW STREAM])
(\HCPYMODEDSPPRINTCHAR
[LAMBDA (STREAM CHARCODE) (* jds " 3-Jan-85 12:53")
(* * displays a character on a hardcopy display stream. This uses a display font but updates the x position
according to hardcopy widths.)
(PROG ((DD (fetch IMAGEDATA of STREAM)))
(\CHECKCARET STREAM)
(RETURN
(SELECTC
(fetch CCECHO of (\SYNCODE \PRIMTERMSA CHARCODE))
[INDICATE.CCE (PROG ((CC CHARCODE))
(add (fetch CHARPOSITION of STREAM)
(IPLUS (COND
((IGREATERP CC 127)
(* META character)
(\HCPYMODEBLTCHAR (CHARCODE #)
STREAM DD)
(SETQ CC (LOGAND CC 127))
1)
(T 0))
(COND
((ILESSP CC 32)
(* CONTROL character)
(\HCPYMODEBLTCHAR (CHARCODE ↑)
STREAM DD)
(SETQ CC (LOGOR CC 64))
1)
(T 0))
(PROGN (\HCPYMODEBLTCHAR CC STREAM DD)
1]
[SIMULATE.CCE
(SELCHARQ CHARCODE
((EOL CR LF)
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ESCAPE (\HCPYMODEBLTCHAR (CHARCODE $)
STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1))
[BELL (* make switching of bits uninterruptable but allow
interrupts between flashes.)
(SELECTQ (MACHINETYPE)
[DANDELION (PLAYTUNE (QUOTE ((880 . 2500]
(FLASHWINDOW (WFROMDS STREAM]
[TAB (PROG (TABWIDTH (SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
STREAM)))
(SETQ TABWIDTH (UNFOLD SPACEWIDTH 8))
(COND
((IGREATERP (\DISPLAYSTREAMINCRXPOSITION
(SETQ TABWIDTH
(IDIFFERENCE TABWIDTH
(MOD (IDIFFERENCE (fetch
DDXPOSITION
of DD)
(ffetch
DDLeftMargin
of DD))
TABWIDTH)))
DD)
(ffetch DDRightMargin of DD))
(* tab was past rightmargin, force cr.)
(\DSPPRINTCR/LF (CHARCODE EOL)
STREAM)))
(* return the number of spaces taken.)
(add (fetch CHARPOSITION of STREAM)
(IQUOTIENT TABWIDTH SPACEWIDTH]
(PROGN (* this case was copied from \DSCCOUT.)
(\HCPYMODEBLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
[REAL.CCE (SELECTC CHARCODE
((CHARCODE (EOL CR LF))
(\DSPPRINTCR/LF CHARCODE STREAM)
(replace CHARPOSITION of STREAM with 0))
(ERASECHARCODE (DSPBACKUP (CHARWIDTH (CHARCODE A)
STREAM)
STREAM)
(* line buffering routines have already taken care of
backing up the position)
0)
(PROGN (\HCPYMODEBLTCHAR CHARCODE STREAM DD)
(add (fetch CHARPOSITION of STREAM)
1]
(IGNORE.CCE)
(SHOULDNT])
(\SLOWHCPYMODEBLTCHAR
(LAMBDA (CHARCODE DISPLAYSTREAM) (* kbr:
" 1-Feb-86 13:24")
(* * IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH
\SLOWBLTCHAR? KBR 1-FEB-86. *)
(* * THIS HAS BEEN SEPARATED OUT BUT HASN'T BEEN EDITTED TO DO CORRECT
THING WRT UPDATING MICA FIELDS.)
(* case of BLTCHAR where
either font is rotated
or destination is a
color bitmap.
DISPLAYSTREAM is known
to be a hardcopy display
stream.)
(PROG (ROTATION (CHAR8CODE (\CHAR8CODE CHARCODE))
(DD (ffetch (STREAM IMAGEDATA) of DISPLAYSTREAM)))
(SETQ ROTATION (ffetch (FONTDESCRIPTOR ROTATION) of (ffetch (\DISPLAYDATA DDFONT)
of DD)))
(COND
((EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
PILOTBBT DESTBIT WIDTH SOURCEBIT)
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))
(COND
((IGREATERP NEWX (ffetch (\DISPLAYDATA DDRightMargin) of DD))
(* past RIGHT margin,
force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch (\DISPLAYDATA DDXPOSITION) of DD))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHAR8CODE DD)))))
(* update the x
position.)
(freplace (\DISPLAYDATA DDXPOSITION) of DD with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DD))
(SETQ LEFT (IMAX (ffetch (\DISPLAYDATA DDClippingLeft) of DD)
CURX))
(SETQ RIGHT (IMIN (ffetch (\DISPLAYDATA DDClippingRight) of DD)
(\DSPTRANSFORMX NEWX DD)))
(SETQ PILOTBBT (ffetch (\DISPLAYDATA DDPILOTBBT) of DD))
(COND
((AND (ILESSP LEFT RIGHT)
(NEQ (ffetch (PILOTBBT PBTHEIGHT) of PILOTBBT)
0))
(SETQ DESTBIT LEFT)
(SETQ WIDTH (IDIFFERENCE RIGHT LEFT))
(SETQ SOURCEBIT (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DD)
LEFT)
CURX))
(SELECTQ (ffetch (BITMAP BITMAPBITSPERPIXEL) of (ffetch (\DISPLAYDATA
DDDestination)
of DD))
(1)
(4 (SETQ DESTBIT (LLSH DESTBIT 2))
(SETQ WIDTH (LLSH WIDTH 2))
(SETQ SOURCEBIT (LLSH SOURCEBIT 2)))
(8 (SETQ DESTBIT (LLSH DESTBIT 3))
(SETQ WIDTH (LLSH WIDTH 3))
(SETQ SOURCEBIT (LLSH SOURCEBIT 3)))
(SHOULDNT))
(.WHILE.TOP.DS. DISPLAYSTREAM (freplace (PILOTBBT PBTDESTBIT) of PILOTBBT
with DESTBIT)
(freplace (PILOTBBT PBTWIDTH) of PILOTBBT with WIDTH)
(freplace (PILOTBBT PBTSOURCEBIT) of PILOTBBT with SOURCEBIT)
(\PILOTBITBLT PILOTBBT 0))
T))))
(T (* handle rotated fonts)
(PROG (YPOS HEIGHTMOVED CSINFO)
(SETQ YPOS (ffetch (\DISPLAYDATA DDYPOSITION) of DD))
(SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
(SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
(ffetch (\DISPLAYDATA DDFONT) of DD)))
(COND
((EQ ROTATION 90) (* don't force CR for
rotated fonts.)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
(* update the display
stream x position.)
(BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
0
(\DSPGETCHAROFFSET CHAR8CODE DD)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION) of DD)
(ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)))
YPOS
(IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
HEIGHTMOVED))
((EQ ROTATION 270)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED))
(BITBLT (ffetch (CHARSETINFO CHARSETBITMAP) of CSINFO)
0
(\DSPGETCHAROFFSET CHAR8CODE DD)
DISPLAYSTREAM
(IDIFFERENCE (ffetch (\DISPLAYDATA DDXPOSITION) of DD)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
(ffetch (\DISPLAYDATA DDYPOSITION) of DISPLAYSTREAM)
(IPLUS (ffetch (CHARSETINFO CHARSETASCENT) of CSINFO)
(ffetch (CHARSETINFO CHARSETDESCENT) of CSINFO))
HEIGHTMOVED))
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270")))))))))
(\SFFixY.HCPYMODE
[LAMBDA (DISPLAYDATA CSINFO) (* jds " 7-Jun-85 14:11")
(* makes that part of the bitblt table of a display stream which deals with the Y information consistent.
This is called whenever any of the information which effects it changes by the DSPFn eg DSPPosition.
If the change affected the clipping region, \SFFixClippingRegion should be called before \SFFixY.HCPYMODE)
(* assumes DISPLAYDATA has already been type checked.)
(PROG ((PBT (ffetch DDPILOTBBT of DISPLAYDATA))
(FONT (ffetch DDFONT of DISPLAYDATA))
(Y (\DSPTRANSFORMY (\MICASTOPTS (ffetch DDYPOSITION of DISPLAYDATA))
DISPLAYDATA))
TOP CHARTOP BM)
[SETQ CHARTOP (IPLUS Y (LISTGET (fetch OTHERDEVICEFONTPROPS of FONT)
(QUOTE ASCENT]
[freplace PBTDEST of PBT
with (\ADDBASE (fetch BITMAPBASE of (SETQ BM (ffetch DDDestination of
DISPLAYDATA)))
(ITIMES (ffetch BITMAPRASTERWIDTH of BM)
(\SFInvert BM (SETQ TOP (IMAX (IMIN (ffetch DDClippingTop
of DISPLAYDATA)
CHARTOP)
0]
[freplace PBTSOURCE of PBT with (\ADDBASE (ffetch BITMAPBASE
of (SETQ BM (ffetch (CHARSETINFO
CHARSETBITMAP)
of CSINFO)))
(ITIMES (ffetch BITMAPRASTERWIDTH
of BM)
(freplace DDCHARHEIGHTDELTA
of DISPLAYDATA
with
(IMIN (IMAX (IDIFFERENCE
CHARTOP TOP)
0)
MAX.SMALL.INTEGER]
(freplace PBTHEIGHT of PBT
with (IMAX (IDIFFERENCE TOP (IMAX [IDIFFERENCE Y (freplace DDCHARSETDESCENT
of DISPLAYDATA
with (LISTGET (fetch
OTHERDEVICEFONTPROPS
of FONT)
(QUOTE DESCENT]
(ffetch DDClippingBottom of DISPLAYDATA)))
0])
)
(ADDTOVAR IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS)))
(DECLARE: DONTEVAL@LOAD DOCOPY
(\HCPYMODEDISPLAYINIT)
)
(PUTPROPS HARDCOPY COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4739 14062 (HARDCOPY.SOMEHOW 4749 . 5408) (HARDCOPYIMAGEW 5410 . 5623) (
HARDCOPYIMAGEW.TOFILE 5625 . 5890) (HARDCOPYIMAGEW.TOPRINTER 5892 . 6280) (HARDCOPYREGION.TOFILE 6282
. 6722) (HARDCOPYREGION.TOPRINTER 6724 . 7221) (\STRINGWIDTH.HCPYDISPLAYAUX 7223 . 12911) (
COPY.WINDOW.TO.BITMAP 12913 . 14060)) (14130 19998 (MakeMenuOfPrinters 14140 . 14639) (
MakeMenuOfImageTypes 14641 . 15629) (GetNewPrinterFromUser 15631 . 15794) (PopUpWindowAndGetAtom 15796
. 16912) (NewPrinter 16914 . 17874) (GetPrinterName 17876 . 18924) (GetImageFile 18926 . 19773) (
FetchDefaultPrinter 19775 . 19996)) (20029 20830 (ExtensionForPrintFileType 20039 . 20304) (
PRINTFILETYPE.FROM.EXTENSION 20306 . 20828)) (20881 37146 (DEFAULTPRINTER 20891 . 21118) (
CAN.PRINT.DIRECTLY 21120 . 21305) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 21307 . 22486) (EMPRESS 22488 .
22880) (HARDCOPYW 22882 . 28997) (LISTFILES1 28999 . 29164) (PRINTER.BITMAPFILE 29166 . 29540) (
PRINTER.BITMAPSCALE 29542 . 29908) (PRINTER.SCRATCH.FILE 29910 . 30073) (PRINTERPROP 30075 . 30308) (
PRINTERSTATUS 30310 . 30563) (PRINTERTYPE 30565 . 31877) (PRINTFILEPROP 31879 . 32119) (PRINTFILETYPE
32121 . 33980) (SEND.FILE.TO.PRINTER 33982 . 37144)) (37147 42176 (PRINTERDEVICE 37157 . 42174)) (
42902 53270 (TEXTTOIMAGEFILE 42912 . 46469) (COPY.TEXT.TO.IMAGE 46471 . 53268)) (53271 55611 (
\BLTSHADE.GENERICPRINTER 53281 . 55609)) (55731 81376 (MAKEHARDCOPYSTREAM 55741 . 57181) (
UNMAKEHARDCOPYSTREAM 57183 . 58153) (HARDCOPYSTREAMTYPE 58155 . 58533) (\CHARWIDTH.HDCPYDISPLAY 58535
. 59203) (\DSPFONT.HDCPYDISPLAY 59205 . 61363) (\DSPRIGHTMARGIN.HDCPYDISPLAY 61365 . 62035) (
\DSPXPOSITION.HDCPYDISPLAY 62037 . 62384) (\DSPYPOSITION.HDCPYDISPLAY 62386 . 62733) (
\STRINGWIDTH.HDCPYDISPLAY 62735 . 63457) (\HDCPYBLTCHAR 63459 . 67245) (\HDCPYDISPLAY.FIX.XPOS 67247
. 67771) (\HDCPYDISPLAY.FIX.YPOS 67773 . 68297) (\HDCPYDISPLAYINIT 68299 . 69312) (\HDCPYDSPPRINTCHAR
69314 . 72643) (\SLOWHDCPYBLTCHAR 72645 . 79801) (\CHANGECHARSET.HDCPYDISPLAY 79803 . 81374)) (81834
126538 (MAKEHARDCOPYMODESTREAM 81844 . 84417) (UNMAKEHARDCOPYMODESTREAM 84419 . 85964) (
\BLTSHADE.HCPYMODE 85966 . 86638) (\BITBLT.HCPYMODE 86640 . 87418) (\BRUSHCONVERT.HCPYMODE 87420 .
87814) (\CHANGECHARSET.HCPYMODE 87816 . 90381) (\DASHINGCONVERT.HCPYMODE 90383 . 90711) (
\CHARWIDTH.HCPYMODE 90713 . 91123) (\DRAWLINE.HCPYMODE 91125 . 91574) (\DRAWCURVE.HCPYMODE 91576 .
92164) (\DRAWCIRCLE.HCPYMODE 92166 . 92692) (\DRAWELLIPSE.HCPYMODE 92694 . 93411) (\DSPFONT.HCPYMODE
93413 . 95153) (\DSPLEFTMARGIN.HCPYMODE 95155 . 95929) (\DSPLINEFEED.HCPYMODE 95931 . 96553) (
\DSPRIGHTMARGIN.HCPYMODE 96555 . 97460) (\DSPXPOSITION.HCPYMODE 97462 . 98355) (\DSPYPOSITION.HCPYMODE
98357 . 99018) (\MOVETO.HCPYMODE 99020 . 99217) (\FONTCREATE.HCPYMODE.PRESS 99219 . 100758) (
\CREATECHARSET.HCPYMODE.PRESS 100760 . 102260) (\FONTCREATE.HCPYMODE.INTERPRESS 102262 . 103821) (
\CREATECHARSET.HCPYMODE.INTERPRESS 103823 . 105355) (\STRINGWIDTH.HCPYMODE 105357 . 106030) (
\HCPYMODEBLTCHAR 106032 . 110188) (\HCPYMODEDISPLAYINIT 110190 . 113881) (\HCPYMODEDSPPRINTCHAR 113883
. 117234) (\SLOWHCPYMODEBLTCHAR 117236 . 124395) (\SFFixY.HCPYMODE 124397 . 126536)))))
STOP