(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "26-Jun-90 18:59:13" {DSK}local>lde>lispcore>internal>library>READINTERPRESS.;2 16698 changes to%: (VARS READINTERPRESSCOMS) previous date%: " 5-Jan-89 17:42:57" {DSK}local>lde>lispcore>internal>library>READINTERPRESS.;1) (* ; " Copyright (c) 1983, 1984, 1985, 1986, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT READINTERPRESSCOMS) (RPAQQ READINTERPRESSCOMS [(* "Utilities for reading Interpress files") (FNS PRINTMASTER) (FNS OPCODE TOKEN FINDNONPRIMNAME FINDOPNAME SHORTINT TOKENFORMAT FINDSEQUENCETYPE PRINTTOKEN PRINTSEQUENCE SEARCHIPLIST READINT.IP SHOWFILE SHOWBYTE) (MACROS BIN.RIP) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) INTERPRESS)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA SHORTINT TOKEN]) (* "Utilities for reading Interpress files") (DEFINEQ (PRINTMASTER [LAMBDA (FILE OUTPUTFILE FROM TO) (* ; "Edited 1-Dec-88 12:51 by Briggs") (RESETLST (PROG (ISTREAM) [RESETSAVE (SETQ ISTREAM (OPENSTREAM FILE 'INPUT)) '(PROGN (CLOSEF OLDVALUE] [COND (OUTPUTFILE (RESETSAVE (SETQ OUTPUTFILE (OPENSTREAM OUTPUTFILE 'OUTPUT)) '(PROGN (CLOSEF OLDVALUE) (AND RESETSTATE (DELFILE OLDVALUE] (* Print the encoding string) (bind C until (EQ (SETQ C (BIN ISTREAM)) (CHARCODE SPACE)) do (PRINTCCODE C OUTPUTFILE)) (TERPRI OUTPUTFILE) (SETFILEPTR ISTREAM (IMAX (\GETFILEPTR ISTREAM) (OR FROM 0))) (until (OR (EOFP ISTREAM) (AND TO (IGEQ (\GETFILEPTR ISTREAM) TO))) do (printout OUTPUTFILE |.I5| (GETFILEPTR ISTREAM) "|" 8) (PRINTTOKEN ISTREAM OUTPUTFILE))))]) ) (DEFINEQ (OPCODE [LAMBDA (BYTE1 BYTE2) (* rmk%: "19-APR-83 17:51") (FINDOPNAME (IPLUS (LLSH (LOGAND BYTE1 31) 8) (OR BYTE2 0]) (TOKEN [LAMBDA BYTES (* edited%: "20-APR-83 10:06") (COND ((ZEROP BYTES) NIL) ((NLISTP (ARG BYTES 1)) (APPLY (FUNCTION TOKEN) (ARG BYTES 1))) (T (SELECTQ (TOKENFORMAT (ARG BYTES 1)) (SHORTINT (APPLY (FUNCTION SHORTINT) (for I from 1 to BYTES collect (ARG BYTES I)))) (SHORTOP (FINDOPNAME (LOGAND (ARG BYTES 1) 31))) (LONGOP (FINDOPNAME (IPLUS (LLSH (LOGAND (ARG BYTES 1) 31) 8) (OR (ARG BYTES 2) 0)))) (SHORTSEQUENCE [PROG [LEN (TYPE (FINDSEQUENCETYPE (LOGAND (ARG BYTES 1) 31] (COND ((IGREATERP BYTES 0) (SETQ LEN (ARG BYTES 2]) (LONGSEQUENCE) (SHOULDNT]) (FINDNONPRIMNAME [LAMBDA (CODE) (* rmk%: "15-Mar-84 09:07") (SEARCHIPLIST CODE (CONSTANT NONPRIMS]) (FINDOPNAME [LAMBDA (CODE) (* rmk%: "16-Jun-84 15:24") (SEARCHIPLIST CODE (CONSTANT (for OP DOTLOC in OPERATORS collect (* Strip off extension) (COND ((SETQ DOTLOC (STRPOS "." (CAR OP))) (LIST (SUBATOM (CAR OP) 1 (SUB1 DOTLOC)) (CADR OP))) (T OP]) (SHORTINT [LAMBDA BYTES (* rmk%: "19-APR-83 17:34") (for I (RESULT _ 0) from 1 to BYTES do (SETQ RESULT (LOGOR (LLSH RESULT 8) (ARG BYTES I))) finally (RETURN (IDIFFERENCE RESULT 4000]) (TOKENFORMAT [LAMBDA (BYTE) (* rmk%: "19-APR-83 17:41") (SELECTQ (LRSH BYTE 7) (0 'SHORTINT) (SELECT (LOGAND (LRSH BYTE 5) 3) (0 'SHORTOP) (1 'LONGOP) (2 'SHORTSEQUENCE) (3 'LONGSEQUENCE) (SHOULDNT]) (FINDSEQUENCETYPE [LAMBDA (CODE) (* rmk%: "15-Mar-84 09:04") (for X in (CONSTANT SEQUENCETYPES) when (EQ CODE (CADR X)) do (RETURN (CAR X)) finally (RETURN (LIST CODE 'NOT-A-SEQUENCE-TYPE]) (PRINTTOKEN [LAMBDA (ISTREAM OSTREAM) (* hdj "15-Jul-86 21:55") (PROG (CODE BYTE2 (BYTE1 (BIN.RIP ISTREAM OSTREAM))) (SELECTQ (TOKENFORMAT BYTE1) (SHORTINT (SETQ BYTE2 (BIN.RIP ISTREAM OSTREAM)) (printout OSTREAM .TAB 20) (PRINT (SHORTINT BYTE1 BYTE2) OSTREAM)) (SHORTOP (SETQ CODE (LOGAND BYTE1 31)) (printout OSTREAM .TAB 20) (printout OSTREAM (OR (FINDOPNAME CODE) (FINDNONPRIMNAME CODE) (CONCAT CODE "not an opcode")) T)) (LONGOP (SETQ CODE (IPLUS (LLSH (LOGAND BYTE1 31) 8) (BIN.RIP ISTREAM OSTREAM))) (printout OSTREAM .TAB 20) (printout OSTREAM (OR (FINDOPNAME CODE) (FINDNONPRIMNAME CODE) (CONCAT CODE "not an opcode")) T)) (SHORTSEQUENCE (PRINTSEQUENCE ISTREAM OSTREAM (FINDSEQUENCETYPE (LOGAND BYTE1 31)) (BIN.RIP ISTREAM OSTREAM))) (LONGSEQUENCE (PRINTSEQUENCE ISTREAM OSTREAM (FINDSEQUENCETYPE (LOGAND BYTE1 31 )) (LOGOR (LLSH (BIN.RIP ISTREAM OSTREAM) 16) (LLSH (BIN.RIP ISTREAM OSTREAM) 8) (BIN.RIP ISTREAM OSTREAM)))) (SHOULDNT]) (PRINTSEQUENCE [LAMBDA (ISTREAM OUTSTREAM TYPE LENGTH) (* ; "Edited 5-Jan-89 11:13 by jds") (SELECTQ TYPE (SEQIDENTIFIER (printout OUTSTREAM 20 "ID: ") (CHARSET ISTREAM 0) (bind (CHARSET _ 0) until (ILEQ LENGTH 0) do (PRINTCCODE (\NSIN ISTREAM CHARSET CHARSET LENGTH) OUTSTREAM))) (SEQINTEGER (PROG ((NUM (READINT.IP ISTREAM OUTSTREAM LENGTH))) (printout OUTSTREAM 20 NUM))) (SEQRATIONAL (PROG [(NUM (READINT.IP ISTREAM OUTSTREAM (LRSH LENGTH 1))) (DENOM (READINT.IP ISTREAM OUTSTREAM (LRSH LENGTH 1] (printout OUTSTREAM 20 NUM "/" DENOM " = " (FQUOTIENT NUM DENOM)))) (SEQSTRING (printout OUTSTREAM 20 "STR[" LENGTH "] = %"") (CHARSET ISTREAM 0) (bind (CHARSET _ 0) until (ILEQ LENGTH 0) do (PRINTCCODE (\NSIN ISTREAM CHARSET CHARSET LENGTH) OUTSTREAM)) (printout OUTSTREAM '%")) (SEQCOMMENT (for I from 1 to LENGTH first (printout OUTSTREAM 20 "Comment vector of " LENGTH " bytes" 22) do (printout OUTSTREAM |.I4| (BIN ISTREAM)))) (SEQPACKEDPIXELVECTOR (bind YBYTES (I _ 5) (XBITS _ (READINT.IP ISTREAM OUTSTREAM 2)) (YBITS _ (READINT.IP ISTREAM OUTSTREAM 2)) first (printout OUTSTREAM 20 "Packed pixel" " vector of " LENGTH " bytes [" XBITS "X" YBITS "]") (SETQ YBYTES (UNFOLD (FOLDHI YBITS BITSPERWORD) BYTESPERWORD)) (* ;  "The number of bytes on a line is always even--gets to a word boundary") while (ILEQ I LENGTH) do (printout OUTSTREAM T 10) (for J from 1 to YBYTES do (printout OUTSTREAM |.I8.-2.T| (BIN ISTREAM )) (add I 1)))) (SEQLARGEVECTOR (for I VAL (BYTESPERELT _ (BIN ISTREAM)) from 2 to LENGTH first (printout OUTSTREAM 20 "Large vector of " BYTESPERELT " bytes per element") do (SETQ VAL (READINT.IP ISTREAM OUTSTREAM BYTESPERELT)) (printout OUTSTREAM 22 |.I5| I ": " VAL))) (SEQCONTINUED (HELP "Can't handle SEQCONTINUED yet")) (SEQINSERTFILE (HELP "Can't handle SEQINSERTFILE yet")) (SEQCOMPRESSPIXELVECTOR (HELP "Can't handle SEQCOMPRESSPIXELVECTOR yet")) (SHOULDNT)) (TERPRI OUTSTREAM]) (SEARCHIPLIST [LAMBDA (CODE IPLIST) (* rmk%: "15-Mar-84 09:15") (for X in IPLIST when (EQ CODE (CADR X)) do (RETURN (CAR X]) (READINT.IP [LAMBDA (ISTREAM OSTREAM NBYTES) (* ; "Edited 31-Mar-88 16:56 by jds") (* ;; "Read an integer (of NBYTES length), printing out byte values as you go.") (for I (RESULT _ 0) from 1 to NBYTES do (SETQ RESULT (LOGOR (LLSH RESULT 8) (BIN.RIP ISTREAM OSTREAM))) finally (RETURN (SIGNED RESULT (UNFOLD NBYTES BITSPERBYTE]) (SHOWFILE [LAMBDA (IPFILE OUTPUTFILE MAXZEROLINES) (* rmk%: "16-Jun-84 15:29") (OR MAXZEROLINES (SETQ MAXZEROLINES 5)) (RESETLST (PROG (STREAM) [RESETSAVE (SETQ STREAM (OPENFILE IPFILE 'INPUT)) '(PROGN (CLOSEF? OLDVALUE] (SETQ STREAM (GETSTREAM STREAM)) (* Don't do an OPENSTREAM until (OPENP stream) is NIL if stream is closed.) (RESETSAVE (OUTPUT)) [RESETSAVE (SETQ OUTPUTFILE (OPENFILE OUTPUTFILE 'OUTPUT)) '(PROGN (CLOSEF? OLDVALUE) (AND RESETSTATE (DELFILE OLDVALUE] (OUTPUT OUTPUTFILE) (printout NIL .FONT DEFAULTFONT (OPENP STREAM 'INPUT) T T) [for I B1 B2 B3 B4 B5 B6 B7 B8 (NZEROLINES _ 0) from 1 by 8 until (\EOFP STREAM) do (printout NIL |.I5| I %,,) (SETQ B1 (SHOWBYTE STREAM)) (SETQ B2 (SHOWBYTE STREAM)) (SETQ B3 (SHOWBYTE STREAM)) (SETQ B4 (SHOWBYTE STREAM)) (printout NIL %,,) (SETQ B5 (SHOWBYTE STREAM)) (SETQ B6 (SHOWBYTE STREAM)) (SETQ B7 (SHOWBYTE STREAM)) (SETQ B8 (SHOWBYTE STREAM)) (TAB 23) (COND (B1 (printout NIL |.I4| B1))) (COND (B2 (printout NIL |.I4| B2))) (COND (B3 (printout NIL |.I4| B3))) (COND (B4 (printout NIL |.I4| B4))) (printout NIL %,,) (COND (B5 (printout NIL |.I4| B5))) (COND (B6 (printout NIL |.I4| B6))) (COND (B7 (printout NIL |.I4| B7))) (COND (B8 (printout NIL |.I4| B8 T] (RETURN (LIST (CLOSEF IPFILE) (CLOSEF OUTPUTFILE]) (SHOWBYTE [LAMBDA (STREAM) (* rmk%: "13-JUL-82 18:01") (PROG [(BYTE (COND ((NOT (\EOFP STREAM)) (\BIN STREAM] [COND (BYTE (PRIN1 (COND ((AND (IGEQ BYTE (CHARCODE SPACE)) (ILESSP BYTE (CHARCODE DEL)) (NEQ BYTE 96)) (CHARACTER BYTE)) (T '%.] (RETURN BYTE]) ) (DECLARE%: EVAL@COMPILE (PUTPROPS BIN.RIP MACRO [ARGS (LET ((ISTREAM (CAR ARGS)) (OSTREAM (CADR ARGS))) `(LET [(C (BIN ,ISTREAM] (COND ((IGREATERP (POSITION ,OSTREAM) 15) (printout ,OSTREAM 5 "|" 8))) (printout ,OSTREAM |.I3| C " ") C]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) INTERPRESS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA SHORTINT TOKEN) ) (PUTPROPS READINTERPRESS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1249 2653 (PRINTMASTER 1259 . 2651)) (2654 15701 (OPCODE 2664 . 2896) (TOKEN 2898 . 4148) (FINDNONPRIMNAME 4150 . 4311) (FINDOPNAME 4313 . 5063) (SHORTINT 5065 . 5415) (TOKENFORMAT 5417 . 5788) (FINDSEQUENCETYPE 5790 . 6064) (PRINTTOKEN 6066 . 8120) (PRINTSEQUENCE 8122 . 11193) ( SEARCHIPLIST 11195 . 11386) (READINT.IP 11388 . 11965) (SHOWFILE 11967 . 15155) (SHOWBYTE 15157 . 15699))))) STOP