(FILECREATED " 5-OCT-83 17:12:57" {PHYLUM}<LISPCORE>SOURCES>PRINTER.;3 7699
changes to: (VARS PRINTERCOMS)
previous date: " 3-OCT-83 21:12:22" {PHYLUM}<LISPCORE>SOURCES>PRINTER.;2)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT PRINTERCOMS)
(RPAQQ PRINTERCOMS ([ADDVARS (PRINTERTYPES ((C.ITOH LOCALPRINTER)
(CANPRINT (TEXT BITMAP))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND LOCAL.PRINT]
(FNS LOCAL.PRINT LOCAL.PRINTFILE LOCAL.BITMAP SAVE.BITMAP.FOR.LOCAL.PRINTER)
(FNS \LOCAL.GRAPHICSINIT \LOCAL.TEXTINIT \LOCAL.SELECT \LOCAL.SENDCOMMAND
\LOCAL.SENDBYTE \LOCAL.SENDSTRING)
(DECLARE: DONTCOPY (MACROS \LOCAL.MODE \LOCAL.CRLF))))
(ADDTOVAR PRINTERTYPES ((C.ITOH LOCALPRINTER)
(CANPRINT (TEXT BITMAP))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND LOCAL.PRINT)))
(DEFINEQ
(LOCAL.PRINT
[LAMBDA (DUMMY FILE) (* lmm " 3-OCT-83 21:04")
(COND
((BITMAPP FILE)
(LOCAL.BITMAP FILE))
(T (LOCAL.PRINTFILE FILE])
(LOCAL.PRINTFILE
[LAMBDA (FILE) (* lmm " 3-OCT-83 21:07")
(RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ FILE (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD]
(\LOCAL.SELECT)
(\LOCAL.TEXTINIT) (* The following is a special hack for the FILECREATED
header)
(\LOCAL.MODE BoldOn)
(\LOCAL.SENDBYTE (BIN FILE))
(\LOCAL.SENDSTRING (READ FILE))
(\LOCAL.SENDBYTE (CHARCODE " "))
(\LOCAL.SENDSTRING (READ FILE))
(\LOCAL.MODE BoldOff)
(\LOCAL.CRLF) (* Now read and print the rest of the file)
(until (EOFP FILE) bind CHAR do (SELCHARQ (SETQ CHAR (BIN FILE))
[↑F (SELCHARQ (SETQ CHAR (BIN FILE))
(↑A
(* print standard)
(\LOCAL.MODE PicaPitch)
(\LOCAL.MODE BoldOff)
(\LOCAL.MODE WideOff))
(↑B
(* print bold)
(\LOCAL.MODE PicaPitch)
(\LOCAL.MODE BoldOn)
(\LOCAL.MODE WideOff))
(↑C
(* print small)
(\LOCAL.MODE
CompressedPitch)
(\LOCAL.MODE BoldOff)
(\LOCAL.MODE WideOff))
(↑D
(* print big)
(\LOCAL.MODE ElitePitch)
(\LOCAL.MODE WideOn)
(\LOCAL.MODE BoldOff))
(PROGN
(* some other mode)
(\LOCAL.MODE PicaPitch)
(\LOCAL.MODE WideOff)
(\LOCAL.MODE BoldOff]
(CR (\LOCAL.CRLF))
(\LOCAL.SENDBYTE CHAR))
finally (\LOCAL.CRLF)
(\LOCAL.SENDBYTE 19])
(LOCAL.BITMAP
[LAMBDA (BITMAP) (* lmm " 3-OCT-83 21:07")
(PROG ((BYTESPERROW (TIMES 2 (fetch BITMAPRASTERWIDTH of BITMAP)))
(HT (fetch BITMAPHEIGHT of BITMAP))
(BASE (fetch BITMAPBASE of BITMAP))
(STR (CONCAT "0000")))
(\RPLRIGHT STR 4 HT)
(\LOCAL.SELECT)
(\LOCAL.GRAPHICSINIT)
(for COLUMN from (IMIN (SUB1 BYTESPERROW)
768)
to 0 by -1
do (\LOCAL.SENDCOMMAND (CHARCODE S))
(\LOCAL.SENDSTRING STR)
(for J from COLUMN by BYTESPERROW as CNT to HT do (\LOCAL.SENDBYTE (\GETBASEBYTE
BASE J)))
(\LOCAL.CRLF])
(SAVE.BITMAP.FOR.LOCAL.PRINTER
[LAMBDA (BITMAP REGION) (* rmk: "22-SEP-83 18:13")
(if REGION
then (PROG [(BM (BITMAPCREATE (IMIN (fetch (REGION WIDTH) of REGION)
(BITMAPWIDTH BITMAP))
(IMIN (fetch (REGION HEIGHT) of REGION)
(BITMAPHEIGHT BITMAP]
(BITBLT BITMAP (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
BM)
(RETURN BM))
else BITMAP])
)
(DEFINEQ
(\LOCAL.GRAPHICSINIT
[LAMBDA NIL (* lmm " 3-OCT-83 21:06")
(\LOCAL.MODE BoldOff)
(\LOCAL.MODE PicaPitch)
(\LOCAL.MODE UniDirectional)
(\LOCAL.MODE Wideoff)
(\LOCAL.SENDCOMMAND (CHARCODE T))
(\LOCAL.SENDSTRING "16"])
(\LOCAL.TEXTINIT
[LAMBDA NIL (* lmm " 3-OCT-83 21:06")
(\LOCAL.MODE BiDirectional)
(\LOCAL.MODE BoldOff)
(\LOCAL.MODE PicaPitch)
(\LOCAL.MODE WideOff)
(\LOCAL.SENDCOMMAND (CHARCODE "A"])
(\LOCAL.SELECT
[LAMBDA NIL (* lmm " 3-OCT-83 21:06")
(WRITEPRINTERPORT 0)
(\LOCAL.SENDBYTE 17])
(\LOCAL.SENDCOMMAND
[LAMBDA (ComChar) (* lmm " 3-OCT-83 21:06")
(\LOCAL.SENDBYTE 27) (* ESCAPE)
(\LOCAL.SENDBYTE ComChar])
(\LOCAL.SENDBYTE
[LAMBDA (Byte) (* lmm " 2-JUL-83 09:32")
(while (NEQ (LOGAND 32768 (READPRINTERPORT))
0)
do (BLOCK))
(WRITEPRINTERPORT Byte)
(WRITEPRINTERPORT 32768)
(WRITEPRINTERPORT Byte])
(\LOCAL.SENDSTRING
[LAMBDA (S) (* lmm " 3-OCT-83 21:06")
(PROG ((SLEN (NCHARS S)))
(for I from 1 to SLEN do (\LOCAL.SENDBYTE (NTHCHARCODE S I])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \LOCAL.MODE MACRO ((Mode)
(SELECTQ (QUOTE Mode)
(BiDirectional (* Print while carriage is moving in either direction)
(\LOCAL.SENDCOMMAND (CHARCODE "<")))
(UniDirectional (* Print only while carriage is moving left to right)
(\LOCAL.SENDCOMMAND (CHARCODE >)))
(BoldOn (* Print Following character in BOLD face)
(\LOCAL.SENDCOMMAND (CHARCODE !)))
(BoldOff (* Print Following character in NORMAL face)
(\LOCAL.SENDCOMMAND (CHARCODE %")))
(CompressedPitch (* Select 17 chars per inch (136 dots/inch, 1088
dots/line))
(* SETQ DotsPerLine 1088)
(\LOCAL.SENDCOMMAND (CHARCODE Q)))
(ElitePitch (* Select 12 chars per inch (96 dots/inch, 768
dots/line))
(* DotsPerLine 768)
(\LOCAL.SENDCOMMAND (CHARCODE E)))
(PicaPitch (* Select 10 chars per inch (80 dots/inch, 640
dots/line))
(* DotsPerLine 640)
(\LOCAL.SENDCOMMAND (CHARCODE N)))
(WideOff (* Print following character DOUBLE width)
(\LOCAL.SENDBYTE 15))
(WideOn (* Print following character NORMAL width)
(\LOCAL.SENDBYTE 14))
NIL)))
(PUTPROPS \LOCAL.CRLF MACRO (NIL (\LOCAL.SENDBYTE (CHARCODE CR))
(\LOCAL.SENDBYTE (CHARCODE LF))
(BLOCK)))
)
)
(PUTPROPS PRINTER COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (867 4368 (LOCAL.PRINT 877 . 1079) (LOCAL.PRINTFILE 1081 . 3105) (LOCAL.BITMAP 3107 .
3843) (SAVE.BITMAP.FOR.LOCAL.PRINTER 3845 . 4366)) (4369 5867 (\LOCAL.GRAPHICSINIT 4379 . 4683) (
\LOCAL.TEXTINIT 4685 . 4952) (\LOCAL.SELECT 4954 . 5118) (\LOCAL.SENDCOMMAND 5120 . 5349) (
\LOCAL.SENDBYTE 5351 . 5629) (\LOCAL.SENDSTRING 5631 . 5865)))))
STOP