(FILECREATED " 3-Jun-86 14:13:59" {ERIS}<LISPCORE>LIBRARY>BITMAPFNS.;6
 6278   

      changes to:  (MACROS RPCHK)
                   (FNS READPRESS)

      previous date: " 2-Jun-86 22:35:15" {ERIS}<LISPCORE>LIBRARY>BITMAPFNS.;5)


(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT BITMAPFNSCOMS)

(RPAQQ BITMAPFNSCOMS
 ((FNS READBINARYBITMAP WRITEBINARYBITMAP WRITEBM WRITEBMLST READBMLST READBM 
                           READPRESS WINDOWBM)
                      (DECLARE: DONTCOPY (MACROS RPCHK))))
(DEFINEQ

(READBINARYBITMAP

  [LAMBDA (WIDTH HEIGHT FILE)                                (* lmm " 4-JAN-83 00:19")

                                                             (* reads a bitmap from the output file.)

    (
PROG
 ((BM (
BITMAPCREATE
 WIDTH HEIGHT)))
          (
\BINS
 (
GETSTREAM
 FILE (
QUOTE
 INPUT))
		 (fetch
 BITMAPBASE of
 BM)
		 0
		 (
ITIMES
 (fetch
 BITMAPRASTERWIDTH of
 BM)
			 (fetch
 BITMAPHEIGHT of
 BM)
			 2))
          (
RETURN
 BM])

(WRITEBINARYBITMAP

  [LAMBDA (BITMAP FILE)                                      (* JWogulis "26-Dec-84 15:06")

    (
\BOUTS
 FILE [ffetch
 BITMAPBASE of
 (
SETQ
 BITMAP (
\DTEST
 BITMAP (
QUOTE
 BITMAP]
	    0
	    (
ITIMES
 (ffetch
 BITMAPHEIGHT of
 BITMAP)
		    (ffetch
 BITMAPRASTERWIDTH of
 BITMAP)
		    BYTESPERWORD])

(WRITEBM

  [LAMBDA (FILE BITMAP)                                      (* lmm " 6-Jun-85 16:46")

    [
BOUT16
 FILE (ffetch
 BITMAPWIDTH of
 (
SETQ
 BITMAP (
\DTEST
 BITMAP (
QUOTE
 BITMAP]
    (
BOUT16
 FILE (ffetch
 BITMAPHEIGHT of
 BITMAP))
    (WRITEBINARYBITMAP
 BITMAP FILE])

(WRITEBMLST

  [LAMBDA (FILE LST)                                         (* JWogulis "26-Dec-84 15:06")

    (
PROG
 [(F (
OPENSTREAM
 FILE (
QUOTE
 OUTPUT)
			  (
QUOTE
 NEW]
          (for
 I in
 LST do
 (WRITEBM
 F I))
          (
CLOSEF
 F])

(READBMLST

  [LAMBDA (FILE)                                             (* JWogulis "26-Dec-84 15:08")

    (bind
 (F ←(
OPENSTREAM
 FILE (
QUOTE
 INPUT)
			  (
QUOTE
 OLD)))
       until
 (
EOFP
 F) collect
 (READBM
 F) finally
 (
CLOSEF
 F])

(READBM

  [LAMBDA (FILE)                                             (* lmm " 6-Jun-85 16:46")

    (READBINARYBITMAP
 (
BIN16
 FILE)
		      (
BIN16
 FILE)
		      FILE])

(READPRESS

  [LAMBDA (FILENAME)
                                         (* lmm " 2-Jun-86 22:34")

    (RESETLST (PROG (WW HT MICAWIDTH MICAHEIGHT BITMAP TOTCOUNT (OFD (GETSTREAM (OPENFILE
                                                                                 FILENAME
                                                                                 (QUOTE INPUT)
                                                                                 (QUOTE OLD))
                                                                            (QUOTE INPUT)))
                        X WIDTH)
                    (RESETSAVE NIL (LIST (QUOTE CLOSEF)
                                         OFD))
                    (RPCHK 256)                              (* Edotcode)

                    (SETQ WW (IQUOTIENT (BIN16 OFD)
                                    16))                     (* Width)

                    (SETQ HT (BIN16 OFD))                    (* Height)

                    (until
 (SELECTC (SETQ X (BIN16 OFD))
                               ((IPLUS 512 3) 
                                                             (* Edotmode and 3)

                                    (RPCHK 2)                (* Edotsize)

                                    (SETQ MICAWIDTH (BIN16 OFD))
                                    (SETQ MICAHEIGHT (BIN16 OFD))
                                    NIL)
                               (1                            (* Edotwindow)

                                  (BIN16 OFD)
                                  (SETQ WIDTH (BIN16 OFD))
                                  (RPCHK 0)
                                  (RPCHK HT)
                                  NIL)
                               (3 T)
                               (GO ERROR)))
                    [\BINS OFD (fetch
 BITMAPBASE of
 (SETQ BITMAP (BITMAPCREATE (ITIMES WW 16)
                                                                        HT)))
                           0
                           (ITIMES 2 (SETQ TOTCOUNT (ITIMES HT WW]
                    (RPCHK 0)                                (* Entity list terminator)

                    [COND
                       (NIL                                  (* more checks, not necessary)

                            (PROGN (RPCHK (IPLUS 65280 238)) (* Nop, setx)

                                   (RPCHK 0)
                                   (RPCHK (IPLUS 65280 239)) (* Nop, sety)

                                   (RPCHK 0)
                                   (RPCHK (IPLUS 65280 252)) (* Nop, show dots)

                                   (RPCHK 0]
                    (RETURN BITMAP)
                ERROR
                    (ERROR "Sorry, unrecognized PRESS file format. READPRESS isn't very general."])

(WINDOWBM

  [LAMBDA (BITMAP POSITION)                                  (* JWogulis "26-Dec-84 15:37")

    (IF
 (
AND
 POSITION (
NOT
 (
POSITIONP
 POSITION)))
	THEN
 (
ERROR
 "NOT A POSITION" POSITION))
    [IF
 (
NOT
 POSITION)
	THEN
 (
SETQ
 POSITION (
GETBOXPOSITION
 (
IPLUS
 8 (
BITMAPWIDTH
 BITMAP))
					    (
IPLUS
 8 (
BITMAPHEIGHT
 BITMAP]
    (
PROG
 ((WIND (
CREATEW
 (
LIST
 (
CAR
 POSITION)
				(
CDR
 POSITION)
				(
IPLUS
 8 (
BITMAPWIDTH
 BITMAP))
				(
IPLUS
 8 (
BITMAPHEIGHT
 BITMAP)))
			  NIL 4)))
          (
BITBLT
 BITMAP 0 0 WIND)
          (
RETURN
 WIND])
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 
[PUTPROPS RPCHK MACRO ((N)
                       (OR (EQ (BIN16 OFD)
                               N)
                           (GO ERROR]
)
)
(PUTPROPS BITMAPFNS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (564 5993 (READBINARYBITMAP 574 . 1075) (WRITEBINARYBITMAP 1077 . 1437) (WRITEBM 1439 . 
1752) (WRITEBMLST 1754 . 2028) (READBMLST 2030 . 2305) (READBM 2307 . 2492) (READPRESS 2494 . 5342) (
WINDOWBM 5344 . 5991)))))
STOP