(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED "24-Sep-2023 13:52:48" {WMEDLEY}<lispusers>READINTERPRESS.;6
 11350  

      :EDIT-BY rmk

      :CHANGES-TO (FNS SHOWFILE)

      :PREVIOUS-DATE "22-Jun-2021 10:52:34" {WMEDLEY}<lispusers>READINTERPRESS.;4)


(* ; "
Copyright (c) 1983-1986, 1988, 2021 by Xerox Corporation.
")

(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) (* hdj "15-Jul-86 21:04") (RESETLST (PROG (ISTREAM) (RESETSAVE (SETQ ISTREAM (OPENSTREAM FILE (QUOTE INPUT))) (QUOTE (PROGN (CLOSEF OLDVALUE)))) (if OUTPUTFILE then (RESETSAVE (SETQ OUTPUTFILE (OPENSTREAM OUTPUTFILE (QUOTE OUTPUT))) (QUOTE (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 (EOFP ISTREAM) 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 (QUOTE SHORTINT)) (SELECT (LOGAND (LRSH BYTE 5) 3) (0 (QUOTE SHORTOP)) (1 (QUOTE LONGOP)) (2 (QUOTE SHORTSEQUENCE)) (3 (QUOTE 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 (QUOTE 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 22-Jun-2021 10:52 by rmk:")

    (DECLARE
 (SPECVARS LENGTH))                          (* ; "For byte counting")

    (SELECTQ TYPE
        (SEQIDENTIFIER (printout OUTSTREAM 20 "ID:  ")
                       (until
 (EQ LENGTH 0) do
 (PRINTCCODE (\INCCODE ISTREAM 'LENGTH LENGTH)
                                                              OUTSTREAM)))
        (SEQINTEGER (printout OUTSTREAM 20)
                    (for
 I from
 1 to
 LENGTH do
 (PRINTTOKEN
 ISTREAM OUTSTREAM)))
        (SEQRATIONAL (PROG [(NUM (READINT.IP
 ISTREAM (LRSH LENGTH 1)))
                            (DENOM (READINT.IP
 ISTREAM (LRSH LENGTH 1]
                           (printout OUTSTREAM 20 NUM "/" DENOM " = " (FQUOTIENT NUM DENOM))))
        (SEQSTRING (printout OUTSTREAM 20 "STR[" LENGTH "] = %"")
                   (until
 (EQ LENGTH 0) do
 (PRINTCCODE (\INCCODE ISTREAM 'LENGTH 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 2))
                    (YBITS _ (READINT.IP
 ISTREAM 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 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 NBYTES) (* ; "Edited 25-Mar-88 17:50 by bvm") (for I (RESULT _ 0) from 1 to NBYTES do (SETQ RESULT (LOGOR (LLSH RESULT 8) (BIN.RIP ISTREAM))) finally (RETURN (SIGNED RESULT (UNFOLD NBYTES BITSPERBYTE)))))
)

(SHOWFILE

  [LAMBDA (IPFILE OUTPUTFILE MAXZEROLINES)
                   (* ; "Edited 24-Sep-2023 13:52 by rmk")

                                                             (* rmk%: "16-Jun-84 15:29")

    (OR MAXZEROLINES (SETQ MAXZEROLINES 5))
    (RESETLST
        [PROG (STREAM)
              [RESETSAVE (SETQ STREAM (OPENSTREAM IPFILE 'INPUT))
                     '(PROGN (CLOSEF? OLDVALUE]              (* Don't do an OPENSTREAM until

                                                             (OPENP stream) is NIL if stream is 

                                                             closed.)

              (RESETSAVE (OUTPUT))
              [RESETSAVE (SETQ OUTPUTFILE (OPENSTREAM 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 (QUOTE %.)))))) (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 ("Xerox Corporation" 1983 1984 1985 1986 1988 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1158 1844 (PRINTMASTER 1168 . 1842)) (1845 10432 (OPCODE 1855 . 1980) (TOKEN 1982 . 
2554) (FINDNONPRIMNAME 2556 . 2661) (FINDOPNAME 2663 . 2920) (SHORTINT 2922 . 3115) (TOKENFORMAT 3117
 . 3359) (FINDSEQUENCETYPE 3361 . 3565) (PRINTTOKEN 3567 . 4518) (PRINTSEQUENCE 4520 . 7397) (
SEARCHIPLIST 7399 . 7531) (READINT.IP 7533 . 7772) (SHOWFILE 7774 . 10152) (SHOWBYTE 10154 . 10430))))
)
STOP