(FILECREATED "12-Mar-85 20:50:49" {ERIS}<LISPCORE>SOURCES>HARDCOPY.;58 93275
changes to: (FNS GetPrinterName HARDCOPY.SOMEHOW HARDCOPYREGION.TOPRINTER
HARDCOPYREGION.TOFILE NewDefaultPrinter MakeMenuOfPrinters
CanonicalPrinterList NewPrinter)
(VARS HARDCOPYCOMS)
previous date: "12-Mar-85 14:30:16" {ERIS}<LISPCORE>SOURCES>HARDCOPY.;57)
(* Copyright (c) 1984, 1985 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)
(* user interface jazz)
(VARS (ChangeDefaultPrinter))
(FNS MakeMenuOfPrinters CanonicalPrinterList MakeMenuOfImageTypes
GetNewPrinterFromUser PopUpWindowAndGetAtom NewPrinter
NewDefaultPrinter GetPrinterName GetImageFile FetchDefaultPrinter)
(* filename diddlers)
(FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
(COMS (* Interface for PRINTERS and IMAGEFILES)
(FNS 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 (QUOTE (30 {DSK}EMPRESS.SCRATCH)))
(EMPRESS#SIDES T)))
(COMS (* Converting text files to imagestreams)
(INITVARS (TEXTDEFAULTTABS (LIST 20320)))
(* Hack, mica equivalent of 8 inches)
(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)
(DECLARE: DONTCOPY DOEVAL@COMPILE (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 \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
\FONTCREATE.HCPYMODE.INTERPRESS \STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR
\HCPYMODEDISPLAYINIT \HCPYMODEDSPPRINTCHAR \SLOWHCPYMODEBLTCHAR \SFFixY.HCPYMODE)
[ADDVARS (IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE
\FONTCREATE.HCPYMODE.INTERPRESS]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\HCPYMODEDISPLAYINIT])
(* exported functionality)
(DEFINEQ
(HARDCOPY.SOMEHOW
[LAMBDA (WINDOW FILE TYPE) (* hdj "12-Mar-85 20:32")
(* * "either run window's HARDCOPYFN or run HARDCOPYW")
(LET [(HARDCOPYFN (WINDOWPROP WINDOW (QUOTE HARDCOPYFN]
(SPAWN.MOUSE)
(if (NULL HARDCOPYFN)
then (HARDCOPYW WINDOW FILE NIL NIL NIL TYPE) (* knows how to default)
else (LET ((IMAGESTR (OPENIMAGESTREAM FILE TYPE)))
(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) (* hdj "14-Feb-85 15:01")
(LET ((PRINTERCHOICE (GetPrinterName)))
(if PRINTERCHOICE
then (HARDCOPY.SOMEHOW W (PACK* (QUOTE {LPT})
PRINTERCHOICE)
(PRINTERTYPE PRINTERCHOICE])
(HARDCOPYREGION.TOFILE
[LAMBDA NIL (* hdj "12-Mar-85 20:33")
(LET ((REGION (GETREGION))
(FILE&TYPE (GetImageFile)))
(if FILE&TYPE
then (SPAWN.MOUSE)
(HARDCOPYW REGION (CAR FILE&TYPE)
NIL NIL NIL (CDR FILE&TYPE])
(HARDCOPYREGION.TOPRINTER
[LAMBDA NIL (* hdj "12-Mar-85 20:32")
(LET ((REGION (GETREGION))
(PRINTERCHOICE (GetPrinterName)))
(if PRINTERCHOICE
then (SPAWN.MOUSE)
(HARDCOPYW REGION (PACK* (QUOTE {LPT})
PRINTERCHOICE)
NIL NIL NIL (PRINTERTYPE PRINTERCHOICE])
)
(* user interface jazz)
(RPAQQ ChangeDefaultPrinter NIL)
(DEFINEQ
(MakeMenuOfPrinters
[LAMBDA (MENUTITLE) (* hdj "12-Mar-85 20:44")
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST))
(SETQ DEFAULTPRINTINGHOST (for PRINTER in DEFAULTPRINTINGHOST collect (L-CASE PRINTER T)))
(create MENU
ITEMS ←(APPEND (CanonicalPrinterList DEFAULTPRINTINGHOST)
(LIST (LIST "Other..." (KWOTE (QUOTE OTHER))
"You will be prompted for a printer")))
TITLE ← MENUTITLE])
(CanonicalPrinterList
[LAMBDA (PRINTERS) (* hdj "12-Mar-85 20:42")
(if (ATOM PRINTERS)
then (LIST PRINTERS)
else (for P in PRINTERS collect (if (LISTP P)
then (CAR P)
else P])
(MakeMenuOfImageTypes
[LAMBDA (MENUTITLE) (* hdj "18-Feb-85 11:40"
"type selection; DISPLAY is temporarily disallowed")
(DECLARE (GLOBALVARS IMAGESTREAMTYPES)) (* hdj "13-Feb-85 21:11")
(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))
(NEQ (CAR IMAGETYPE)
(QUOTE DISPLAY]
TITLE ← MENUTITLE])
(GetNewPrinterFromUser
[LAMBDA (PROMPTSTRING) (* hdj "13-Feb-85 22:22")
(PopUpWindowAndGetAtom PROMPTSTRING])
(PopUpWindowAndGetAtom
[LAMBDA (PROMPTSTRING CANDIDATE) (* hdj "13-Feb-85 22:44")
(LET* ((FONT (DEFAULTFONT))
[WIDTH (IPLUS (STRINGWIDTH PROMPTSTRING FONT)
(ITIMES 40 (CHARWIDTH (CHARCODE A)
FONT]
(PROMPTW (CREATEW [CREATEREGION LASTMOUSEX LASTMOUSEY (WIDTHIFWINDOW WIDTH)
(HEIGHTIFWINDOW (FONTPROP FONT (QUOTE HEIGHT]
NIL NIL T)))
(RESETLST (RESETSAVE (OPENW PROMPTW)
(BQUOTE (CLOSEW , PROMPTW)))
(PACK* (PROMPTFORWORD PROMPTSTRING CANDIDATE NIL PROMPTW])
(NewPrinter
[LAMBDA (PRINTER)
(DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (* hdj "12-Mar-85 20:49")
(LET ((PRINTERNAME (L-CASE PRINTER T)))
(if (NOT (MEMBER PRINTERNAME DEFAULTPRINTINGHOST))
then (SETQ DEFAULTPRINTINGHOST (APPEND DEFAULTPRINTINGHOST (LIST PRINTERNAME])
(NewDefaultPrinter
[LAMBDA (NEWPRINTER) (* hdj "12-Mar-85 20:46")
(* "DEFAULTPRINTINGHOST can be an atom")
(LET ((PRINTERNAME (L-CASE NEWPRINTER T)))
(if (NEQ PRINTERNAME DEFAULTPRINTINGHOST)
then (SETQ DEFAULTPRINTINGHOST (CONS PRINTERNAME (DREMOVE PRINTERNAME DEFAULTPRINTINGHOST)))
(PROMPTPRINT "Default printer is now " PRINTERNAME)
(TERPRI PROMPTWINDOW])
(GetPrinterName
[LAMBDA NIL (* hdj "12-Mar-85 20:30")
(DECLARE (GLOBALVARS ChangeDefaultPrinter))
(PROG ((PRINTERMENU (MakeMenuOfPrinters "Which printer?"))
PRINTERCHOICE DEFAULTPRINTER)
(SETQ DEFAULTPRINTER (FetchDefaultPrinter))
(if (NOT (type? MENU ChangeDefaultPrinter))
then (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)))
(SETQ PRINTERCHOICE (MENU PRINTERMENU))
(if (EQ PRINTERCHOICE (QUOTE OTHER))
then (SETQ PRINTERCHOICE (GetNewPrinterFromUser "Printer (CR to abort): ")))
[if PRINTERCHOICE
then (if (NEQ PRINTERCHOICE DEFAULTPRINTER)
then (if (AND DEFAULTPRINTER (MENU ChangeDefaultPrinter))
then (NewDefaultPrinter PRINTERCHOICE)
else (NewPrinter PRINTERCHOICE]
(RETURN PRINTERCHOICE])
(GetImageFile
[LAMBDA NIL (* hdj "14-Feb-85 13:07")
(PROG ((FILE (PopUpWindowAndGetAtom "File name (CR to abort): "))
PRINTFILETYPE FILETYPEMENU EXTENSIONSUPPLIED EXTENSIONFORTYPE)
(if (NULL FILE)
then (RETURN))
(SETQ FILETYPEMENU (MakeMenuOfImageTypes "File type?"))
(if (SETQ PRINTFILETYPE (PRINTFILETYPE.FROM.EXTENSION FILE))
then (RETURN (CONS FILE PRINTFILETYPE))
else (SETQ PRINTFILETYPE (MENU FILETYPEMENU))
(if (NULL PRINTFILETYPE)
then (RETURN)
else (RETURN (CONS FILE PRINTFILETYPE])
(FetchDefaultPrinter
[LAMBDA NIL (* hdj "18-Feb-85 12:13")
(if (LISTP DEFAULTPRINTINGHOST)
then (CAR DEFAULTPRINTINGHOST)
else DEFAULTPRINTINGHOST])
)
(* 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) (* rmk: "26-Feb-85 15:01")
(* return the imagestream type corresponding to the
extension)
(bind [EXT ←(U-CASE (FILENAMEFIELD (FULLNAME 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
(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) (* rmk: "26-Feb-85 18:10")
(SETQ FILETYPE (OR FILETYPE (QUOTE TEXT)))
(PROG ((SCRATCH (PRINTER.SCRATCH.FILE FILE PRINTERTYPE)))
(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)
(* lmm " 1-Sep-84 12:22")
(* 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)
(PROG ((BITMAP (SCREENBITMAP))
REGION
(PRINTHOST HOST))
[SETQ REGION (COND
((WINDOWP WINDOW/BITMAP/REGION)
(COND
((OPENWP WINDOW/BITMAP/REGION)
(TOTOPW WINDOW/BITMAP/REGION)
(WINDOWPROP WINDOW/BITMAP/REGION (QUOTE REGION)))
(T (SETQ BITMAP (WINDOWPROP WINDOW/BITMAP/REGION (QUOTE IMAGECOVERED)))
NIL)))
((BITMAPP WINDOW/BITMAP/REGION)
(SETQ BITMAP WINDOW/BITMAP/REGION)
NIL)
((type? REGION WINDOW/BITMAP/REGION)
WINDOW/BITMAP/REGION)
(T (GETREGION]
RETRY
(COND
[PRINTERTYPE (COND
[PRINTHOST (COND
((NEQ 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
(COND
((LISTP
DEFAULTPRINTINGHOST)
(CAR
DEFAULTPRINTINGHOST))
(T DEFAULTPRINTINGHOST]
[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 WIDTH of REGION)
(fetch HEIGHT of REGION)
PRINTERTYPE PRINTHOST))
(T (PRINTER.BITMAPSCALE (fetch BITMAPWIDTH of BITMAP)
(fetch 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
"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 "Window Image")))
,
(AND (NULL FILE)
(BQUOTE (DELFILE (QUOTE , FULLFILE]
(QUOTE NAME)
(QUOTE HARDCOPYW]
(RETURN (COND
((NULL FILE)
NIL)
(T 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 "25-Jun-84 17:05")
(COND
[(AND FULLFILE (FIXP (CAR (LISTP EMPRESS.SCRATCH)))
(IGREATERP (OR (GETFILEINFO FULLFILE (QUOTE SIZE))
0)
(CAR EMPRESS.SCRATCH)))
(CAR (LISTP (CDR EMPRESS.SCRATCH]
(T (QUOTE {CORE}EMPRESS.SCRATCH])
(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) (* lmm " 5-OCT-83 16:42")
(SELECTQ HOST
[(NIL LPT)
(SETQ HOST (COND
((LISTP DEFAULTPRINTINGHOST)
(CAR DEFAULTPRINTINGHOST))
(T DEFAULTPRINTINGHOST]
NIL)
(COND
((LISTP HOST)
(CAR HOST))
((NULL HOST)
DEFAULTPRINTERTYPE)
((GETPROP HOST (QUOTE PRINTERTYPE)))
((STRPOS ":" HOST)
(QUOTE INTERPRESS))
(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) (* hdj "13-Feb-85 21:39")
(* could be extended to know about TEDIT etc.
documents)
(if (IMAGESTREAMP FILE)
then (IMAGESTREAMTYPE FILE)
else (LET [(TYPE (GETFILEINFO FILE (QUOTE TYPE]
(if (OR (EQ TYPE (QUOTE TEXT))
(AND TYPE (ASSOC TYPE PRINTFILETYPES)))
then TYPE
else (OR [AND (NOT DONTOPEN)
(OR (NOT (OPENP FILE))
(RANDACCESSP FILE))
(for TYPE in PRINTFILETYPES
when (CAR (NLSETQ (APPLY* (CADR (ASSOC (QUOTE TEST)
(CDR TYPE)))
FILE)))
do (RETURN (CAR TYPE]
(PRINTFILETYPE.FROM.EXTENSION FILE])
(SEND.FILE.TO.PRINTER
[LAMBDA (FILE HOST PRINTOPTIONS) (* rmk: "26-Feb-85 18:02")
(* 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
(COND
((LISTP
DEFAULTPRINTINGHOST)
(CAR
DEFAULTPRINTINGHOST))
(T DEFAULTPRINTINGHOST]
(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) (* rmk: " 3-Dec-84 10:22")
(* 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 CLOSEFILE of DEV
with (FUNCTION (LAMBDA (STREAM)
(PROG [(SDEV (fetch 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 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 DEVICENAME of SDEV))
(fetch DEVICENAME of SDEV))
(T (PROG ((NAME (fetch 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 (QUOTE (30 {DSK}EMPRESS.SCRATCH)))
(RPAQ? EMPRESS#SIDES T)
(* Converting text files to imagestreams)
(RPAQ? TEXTDEFAULTTABS (LIST 20320))
(* Hack, mica equivalent of 8 inches)
(DEFINEQ
(TEXTTOIMAGEFILE
[LAMBDA (FILE IMAGEFILE IMAGETYPE FONTS HEADING TABS) (* lmm "17-Jan-85 21:05")
(* Generic function for converting PSPOOL format text
files into image files)
(RESETLST (PROG (IMAGESTREAM INSTRM OUTCHARFN INFILE INEOLC MAXFONT FONTARRAY)
(* FONTARRAY is an array of font-descriptors)
[RESETSAVE [SETQ INFILE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
8
(QUOTE ((SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(* 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)
INFILE))
IMAGETYPE
(APPEND [AND (NEQ HEADING T)
(LIST (QUOTE HEADING)
(OR HEADING (CONCAT INFILE " "
(GETFILEINFO INFILE
(QUOTE
CREATIONDATE]
(LIST (QUOTE DOCUMENT.NAME)
INFILE
(QUOTE TABS)
TABS]
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
(* Make \BIN return NIL on EOS)
(COPY.TEXT.TO.IMAGE INFILE IMAGESTREAM FONTS)
(RETURN (LIST (CLOSEF INFILE)
(CLOSEF IMAGESTREAM])
(COPY.TEXT.TO.IMAGE
[LAMBDA (INFILE IMAGESTREAM FONTS) (* lmm "27-Jan-85 01:05")
(LET* [(IMAGESTREAM (GETSTREAM IMAGESTREAM (QUOTE OUTPUT)))
C FC (FONTARRAY (FONTMAPARRAY FONTS))
(MAXFONT (ARRAYSIZE FONTARRAY))
(INSTRM (GETSTREAM INFILE (QUOTE INPUT)))
(INEOLC (GETFILEINFO INSTRM (QUOTE EOL]
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION ZERO))
(do (OR (SETQ C (BIN INSTRM))
(RETURN))
(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 (BIN INSTRM))
[↑T (* tab to absolute pos.)
(COND
((EQ 0 (SETQ FC (BIN INSTRM)))
(\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 (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) (* hdj "12-Mar-85 14:05")
(LET* [(SCALE (DSPSCALE NIL STREAM))
(SCRATCHBM (BITMAPCREATE (FIX (FTIMES (FQUOTIENT SCALE SHADESCALE)
(FQUOTIENT WIDTH SCALE)))
(FIX (FTIMES (FQUOTIENT SCALE SHADESCALE)
(FQUOTIENT HEIGHT SCALE]
(\BLTSHADE.BITMAP TEXTURE SCRATCHBM 0 0 NIL NIL (QUOTE REPLACE))
(BITBLT SCRATCHBM 0 0 STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT (QUOTE INPUT)
OPERATION NIL CLIPPINGREGION])
)
(* hack for printers that can't really BLTSHADE)
(* stuff to support hardcopy streams on the display.)
(DEFINEQ
(MAKEHARDCOPYSTREAM
[LAMBDA (DISPLAYSTREAM IMAGETYPE) (* rmk: "24-Sep-84 17:05")
(* * 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 (PRINTERTYPE))) (* 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) (* rmk: "12-Sep-84 11:37")
(* gets the width of a character code in a hardcopy
stream. Should be updated for spacefactor)
(IQUOTIENT (IPLUS (\FGETWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS)
of (fetch IMAGEDATA of STREAM))
CHARCODE)
(CONSTANT IHALFMICASPERPT))
(CONSTANT IMICASPERPT])
(\DSPFONT.HDCPYDISPLAY
[LAMBDA (HDCPYDSTREAM FONT) (* rmk: "24-Sep-84 17:24")
(* 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 (fetch (ARRAYP BASE)
of (PROG [W (SCALE (FONTPROP FD (QUOTE SCALE]
[COND
((EQP SCALE (CONSTANT MICASPERPT))
(RETURN (fetch \SFWidths of FD]
(SETQ W (COPYARRAY (fetch \SFWidths of FD)))
(SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT)
SCALE))
(* This is very slow, but presumably works)
[for I from (ARRAYORIG W) to (PLUS (ARRAYSIZE W)
(ARRAYORIG W)
-1)
do (SETA W I (FIXR (FTIMES (ELT W 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) (* 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])
(\HDCPYBLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* rrb "21-Aug-84 18:36")
(* 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)
[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)
CHARCODE)))
(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 CHARCODE 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 CHARCODE
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) (* rrb "21-Aug-84 09:44")
(* * 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 (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of (fetch DDFONT of DD)))
(RETURN
(COND
[(EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch DDXPOSITION of DD)))
[COND
((IGREATERP (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD)))
(ffetch DDRightMargin of DD))
(* past RIGHT margin, force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch DDXPOSITION of DD))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD]
(* update the x position.)
(freplace DDXPOSITION of DD with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DD))
(SETQ LEFT (IMAX (ffetch DDClippingLeft of DD)
CURX))
(SETQ RIGHT (IMIN (ffetch DDClippingRight of DD)
(\DSPTRANSFORMX NEWX DD)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ NEWX (ffetch DDPILOTBBT
of DD)))
0))
(SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (\DISPLAYDATA DDDestination) of DD))
(1 (.WHILE.TOP.DS. DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with LEFT)
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE RIGHT LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE
(IPLUS (\DSPGETCHAROFFSET
CHARCODE DD)
LEFT)
CURX))
(\PILOTBITBLT NEWX 0)))
(4 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 2)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 2)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE DD)
2)
LEFT)
(LLSH CURX 2)))
(\PILOTBITBLT NEWX 0)))
(8 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 3)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 3)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE DD)
3)
LEFT)
(LLSH CURX 3)))
(\PILOTBITBLT NEWX 0)))
(SHOULDNT))
T]
(T (* handle rotated fonts)
(PROG ((YPOS (ffetch DDYPOSITION of DD))
(HEIGHTMOVED (\DSPGETCHARWIDTH CHARCODE DD))
(FONT (ffetch DDFONT of DD)))
(RETURN (COND
((EQ ROTATION 90) (* don't force CR for rotated fonts.)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
(* update the display stream x position.)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTASCENT FONT)))
YPOS
(FONTHEIGHT FONT)
HEIGHTMOVED))
((EQ ROTATION 270)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED)
)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTDESCENT FONT))
(ffetch DDYPOSITION of DISPLAYSTREAM)
(FONTHEIGHT FONT)
HEIGHTMOVED))
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
)
(DECLARE: DONTCOPY DOEVAL@COMPILE
(DECLARE: EVAL@COMPILE
(RPAQ MICASPERPT (FQUOTIENT 2540 72))
(RPAQQ IHALFMICASPERPT 17)
(RPAQQ IMICASPERPT 35)
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
(IHALFMICASPERPT 17)
(IMICASPERPT 35))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\HDCPYDISPLAYINIT)
)
(* Stuff to support MICA-unit hardcopy streams on the display)
(DEFINEQ
(MAKEHARDCOPYMODESTREAM
[LAMBDA (DISPLAYSTREAM IMAGETYPE) (* jds " 6-Jan-85 14:56")
(* * 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 (PRINTERTYPE))
(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)
(OR IMAGETYPE (PRINTERTYPE))) (* 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)
(DSPRIGHTMARGIN (FIXR (FTIMES (DSPRIGHTMARGIN NIL DS)
MICASPERPT))
DS) (* And reuse the right margin)
(RETURN DS])
(UNMAKEHARDCOPYMODESTREAM
[LAMBDA (DISPLAYSTREAM) (* jds " 6-Jan-85 14:59")
(* * 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 (FIXR (FQUOTIENT (DSPRIGHTMARGIN NIL DS)
MICASPERPT))
DS) (* Convert the right margin back into 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])
(\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) (* jds " 6-Jan-85 15:08")
(* 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)
(PROG ((PBT (ffetch DDPILOTBBT of DD))
FONTBITMAP TOP CHARTOP BM)
(SETQ FONTBITMAP (fetch CHARACTERBITMAP of XFONT))
[replace DDWIDTHSCACHE of DD
with (fetch (ARRAYP BASE)
of (LISTGET (fetch OTHERDEVICEFONTPROPS
XFONT)
(QUOTE WIDTHS]
(* cache the widths and offsets so that charcter
printing will be faster.)
(replace DDOFFSETSCACHE of DD
with (fetch (ARRAYP BASE)
of (fetch \SFOffsets of FONT)))
(replace PBTSOURCEBPL of PBT
with (UNFOLD (fetch BITMAPRASTERWIDTH of FONTBITMAP)
BITSPERWORD))
(* Set up the PILOTBBT source-bitmap width to be the
strike's width.)
(replace DDSlowPrintingCase of DD
with (NEQ (fetch (FONTDESCRIPTOR ROTATION)
of XFONT)
0))
(* If we're printing at an angle, use the slow-case
code.)
)
(\SFFixY.HCPYMODE DD)
(* Update the PILOTBBT Y-parameters, to account for the
new font.)
(\SFFIXLINELENGTH HDCPYDSTREAM)
(* And note the new linelength.)
))
(replace DDCHARIMAGEWIDTHS of DD
with (fetch (ARRAYP BASE) of (fetch \SFWidths of XFONT)))
(* The HARDCOPY widths)
])
(\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 " 6-Jan-85 15:13")
(* 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)
(\SFFixY.HCPYMODE 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) (* jds " 4-Jan-85 21:40")
(* Create a font descriptor for a display stream that
is mimicing a PRESS device)
(PROG [(DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (create FONTDESCRIPTOR using (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE PRESS]
(replace OTHERDEVICEFONTPROPS of HFONT with (LIST (QUOTE WIDTHS)
(fetch \SFWidths of DFONT)
(QUOTE ASCENT)
(fetch \SFAscent of DFONT)
(QUOTE DESCENT)
(fetch \SFDescent of DFONT)
(QUOTE HEIGHT)
(fetch \SFHeight of DFONT)))
(* Cache the DISPLAY info, for the various X- and
Y-position updating tasks that affect the display
bitmap itself)
(replace \SFOffsets of HFONT with (fetch \SFOffsets of DFONT))
(replace CHARACTERBITMAP of HFONT with (fetch CHARACTERBITMAP of DFONT))
(replace FONTDEVICE of HFONT with (QUOTE PRESSDISPLAY))
(RETURN HFONT])
(\FONTCREATE.HCPYMODE.INTERPRESS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* jds " 4-Jan-85 21:40")
(* Create a FONTDESCRIPTOR for a display stream that is
mimicing an INTERPRESS stream.)
(PROG [(DFONT (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE DISPLAY)))
(HFONT (create FONTDESCRIPTOR using (FONTCREATE FAMILY SIZE FACE ROTATION (QUOTE
INTERPRESS]
(replace OTHERDEVICEFONTPROPS of HFONT with (LIST (QUOTE WIDTHS)
(fetch \SFWidths of DFONT)
(QUOTE ASCENT)
(fetch \SFAscent of DFONT)
(QUOTE DESCENT)
(fetch \SFDescent of DFONT)
(QUOTE HEIGHT)
(fetch \SFHeight of DFONT)))
(* Cache the DISPLAY info, for the various X- and
Y-position updating tasks that affect the display
bitmap itself)
(replace \SFOffsets of HFONT with (fetch \SFOffsets of DFONT))
(* Copy the character bitmap and offsets so we can use
this font for displaying.)
(replace CHARACTERBITMAP of HFONT with (fetch CHARACTERBITMAP of DFONT))
(replace FONTDEVICE of HFONT with (QUOTE PRESSDISPLAY))
(RETURN HFONT])
(\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) (* jds " 6-Jan-85 15:18")
(* 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)
[COND
((ffetch (\DISPLAYDATA DDSlowPrintingCase) of DISPLAYDATA)
(RETURN (\SLOWHCPYMODEBLTCHAR CHARCODE DISPLAYSTREAM]
CRLP(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)
(\FGETWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS)
of DISPLAYDATA)
CHARCODE)))
(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 (ffetch DDXOFFSET of DISPLAYDATA)))
(* Screen position of the window, generally.)
(SETQ RIGHT (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DISPLAYDATA)))
(* 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 CHARCODE
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) (* rrb "21-Aug-84 09:44")
(* * 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 (DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of (fetch DDFONT of DD)))
(RETURN
(COND
[(EQ 0 ROTATION)
(PROG (NEWX LEFT RIGHT (CURX (ffetch DDXPOSITION of DD)))
[COND
((IGREATERP (SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD)))
(ffetch DDRightMargin of DD))
(* past RIGHT margin, force eol)
(\DSPPRINTCR/LF (CHARCODE EOL)
DISPLAYSTREAM)
(SETQ CURX (ffetch DDXPOSITION of DD))
(SETQ NEWX (IPLUS CURX (\DSPGETCHARWIDTH CHARCODE DD]
(* update the x position.)
(freplace DDXPOSITION of DD with NEWX)
(SETQ CURX (\DSPTRANSFORMX CURX DD))
(SETQ LEFT (IMAX (ffetch DDClippingLeft of DD)
CURX))
(SETQ RIGHT (IMIN (ffetch DDClippingRight of DD)
(\DSPTRANSFORMX NEWX DD)))
(RETURN (COND
((AND (ILESSP LEFT RIGHT)
(NEQ (fetch PBTHEIGHT of (SETQ NEWX (ffetch DDPILOTBBT
of DD)))
0))
(SELECTQ (fetch (BITMAP BITMAPBITSPERPIXEL)
of (ffetch (\DISPLAYDATA DDDestination) of DD))
(1 (.WHILE.TOP.DS. DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with LEFT)
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE RIGHT LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE
(IPLUS (\DSPGETCHAROFFSET
CHARCODE DD)
LEFT)
CURX))
(\PILOTBITBLT NEWX 0)))
(4 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 2)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 2)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE DD)
2)
LEFT)
(LLSH CURX 2)))
(\PILOTBITBLT NEWX 0)))
(8 (OR (\DDHASFONT DD)
(\DDSETCOLORFONT DISPLAYSTREAM))
(.WHILE.TOP.DS.
DISPLAYSTREAM
(freplace PBTDESTBIT of NEWX
with (SETQ LEFT (LLSH LEFT 3)))
(freplace PBTWIDTH of NEWX
with (IDIFFERENCE (LLSH RIGHT 3)
LEFT))
(freplace PBTSOURCEBIT of NEWX
with (IDIFFERENCE (IPLUS (LLSH (\DSPGETCHAROFFSET
CHARCODE DD)
3)
LEFT)
(LLSH CURX 3)))
(\PILOTBITBLT NEWX 0)))
(SHOULDNT))
T]
(T (* handle rotated fonts)
(PROG ((YPOS (ffetch DDYPOSITION of DD))
(HEIGHTMOVED (\DSPGETCHARWIDTH CHARCODE DD))
(FONT (ffetch DDFONT of DD)))
(RETURN (COND
((EQ ROTATION 90) (* don't force CR for rotated fonts.)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
(* update the display stream x position.)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(ADD1 (IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTASCENT FONT)))
YPOS
(FONTHEIGHT FONT)
HEIGHTMOVED))
((EQ ROTATION 270)
(\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IDIFFERENCE YPOS HEIGHTMOVED)
)
(BITBLT (fetch (FONTDESCRIPTOR CHARACTERBITMAP) of FONT)
0
(\DSPGETCHAROFFSET CHARCODE DD)
DISPLAYSTREAM
(IDIFFERENCE (ffetch DDXPOSITION of DD)
(FONTDESCENT FONT))
(ffetch DDYPOSITION of DISPLAYSTREAM)
(FONTHEIGHT FONT)
HEIGHTMOVED))
(T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
(\SFFixY.HCPYMODE
[LAMBDA (DISPLAYDATA) (* jds " 4-Jan-85 22:22")
(* 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 CHARACTERBITMAP
of FONT)))
(ITIMES (ffetch BITMAPRASTERWIDTH of BM)
(IMIN (IMAX (IDIFFERENCE CHARTOP TOP)
0)
MAX.SMALL.INTEGER]
(freplace PBTHEIGHT of PBT with (IMAX (IDIFFERENCE TOP
(IMAX (IDIFFERENCE Y
(LISTGET
(fetch
OTHERDEVICEFONTPROPS
of FONT)
(QUOTE DESCENT)))
(ffetch DDClippingBottom
of DISPLAYDATA)))
0])
)
(ADDTOVAR IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)))
(DECLARE: DONTEVAL@LOAD DOCOPY
(\HCPYMODEDISPLAYINIT)
)
(PUTPROPS HARDCOPY COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3572 5656 (HARDCOPY.SOMEHOW 3582 . 4125) (HARDCOPYIMAGEW 4127 . 4340) (
HARDCOPYIMAGEW.TOFILE 4342 . 4607) (HARDCOPYIMAGEW.TOPRINTER 4609 . 4930) (HARDCOPYREGION.TOFILE 4932
. 5265) (HARDCOPYREGION.TOPRINTER 5267 . 5654)) (5727 11155 (MakeMenuOfPrinters 5737 . 6256) (
CanonicalPrinterList 6258 . 6558) (MakeMenuOfImageTypes 6560 . 7282) (GetNewPrinterFromUser 7284 .
7447) (PopUpWindowAndGetAtom 7449 . 8079) (NewPrinter 8081 . 8430) (NewDefaultPrinter 8432 . 8969) (
GetPrinterName 8971 . 10195) (GetImageFile 10197 . 10915) (FetchDefaultPrinter 10917 . 11153)) (11186
12023 (ExtensionForPrintFileType 11196 . 11461) (PRINTFILETYPE.FROM.EXTENSION 11463 . 12021)) (12074
24253 (CAN.PRINT.DIRECTLY 12084 . 12269) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 12271 . 13244) (EMPRESS
13246 . 13638) (HARDCOPYW 13640 . 17538) (LISTFILES1 17540 . 17705) (PRINTER.BITMAPFILE 17707 . 18081)
(PRINTER.BITMAPSCALE 18083 . 18449) (PRINTER.SCRATCH.FILE 18451 . 18808) (PRINTERPROP 18810 . 19043)
(PRINTERSTATUS 19045 . 19298) (PRINTERTYPE 19300 . 19777) (PRINTFILEPROP 19779 . 20019) (PRINTFILETYPE
20021 . 20917) (SEND.FILE.TO.PRINTER 20919 . 24251)) (24254 27502 (PRINTERDEVICE 24264 . 27500)) (
27954 32992 (TEXTTOIMAGEFILE 27964 . 29796) (COPY.TEXT.TO.IMAGE 29798 . 32990)) (32993 33703 (
\BLTSHADE.GENERICPRINTER 33003 . 33701)) (33823 54206 (MAKEHARDCOPYSTREAM 33833 . 35199) (
UNMAKEHARDCOPYSTREAM 35201 . 36171) (HARDCOPYSTREAMTYPE 36173 . 36551) (\CHARWIDTH.HDCPYDISPLAY 36553
. 37066) (\DSPFONT.HDCPYDISPLAY 37068 . 38788) (\DSPRIGHTMARGIN.HDCPYDISPLAY 38790 . 39460) (
\DSPXPOSITION.HDCPYDISPLAY 39462 . 39809) (\DSPYPOSITION.HDCPYDISPLAY 39811 . 40158) (
\STRINGWIDTH.HDCPYDISPLAY 40160 . 40800) (\HDCPYBLTCHAR 40802 . 44132) (\HDCPYDISPLAY.FIX.XPOS 44134
. 44658) (\HDCPYDISPLAY.FIX.YPOS 44660 . 45184) (\HDCPYDISPLAYINIT 45186 . 46199) (\HDCPYDSPPRINTCHAR
46201 . 49530) (\SLOWHDCPYBLTCHAR 49532 . 54204)) (54590 92975 (MAKEHARDCOPYMODESTREAM 54600 . 56979)
(UNMAKEHARDCOPYMODESTREAM 56981 . 58564) (\BLTSHADE.HCPYMODE 58566 . 59238) (\BITBLT.HCPYMODE 59240
. 60018) (\BRUSHCONVERT.HCPYMODE 60020 . 60414) (\DASHINGCONVERT.HCPYMODE 60416 . 60749) (
\CHARWIDTH.HCPYMODE 60751 . 61161) (\DRAWLINE.HCPYMODE 61163 . 61612) (\DRAWCURVE.HCPYMODE 61614 .
62202) (\DRAWCIRCLE.HCPYMODE 62204 . 62730) (\DRAWELLIPSE.HCPYMODE 62732 . 63449) (\DSPFONT.HCPYMODE
63451 . 66772) (\DSPLEFTMARGIN.HCPYMODE 66774 . 67548) (\DSPLINEFEED.HCPYMODE 67550 . 68172) (
\DSPRIGHTMARGIN.HCPYMODE 68174 . 69079) (\DSPXPOSITION.HCPYMODE 69081 . 69974) (\DSPYPOSITION.HCPYMODE
69976 . 70631) (\MOVETO.HCPYMODE 70633 . 70830) (\FONTCREATE.HCPYMODE.PRESS 70832 . 72207) (
\FONTCREATE.HCPYMODE.INTERPRESS 72209 . 73781) (\STRINGWIDTH.HCPYMODE 73783 . 74456) (\HCPYMODEBLTCHAR
74458 . 78665) (\HCPYMODEDISPLAYINIT 78667 . 82358) (\HCPYMODEDSPPRINTCHAR 82360 . 85915) (
\SLOWHCPYMODEBLTCHAR 85917 . 90885) (\SFFixY.HCPYMODE 90887 . 92973)))))
STOP