(FILECREATED " 6-Jun-85 16:47:12" {ERIS}<LISPCORE>LIBRARY>BITMAPFNS.;4
 5276   

      changes to:  (MACROS WORDIN WORDOUT)
		   (FNS WRITEBM READBM READPRESS)
		   (VARS BITMAPFNSCOMS)

      previous date: "17-May-85 19:38:13" {ERIS}<LISPCORE>LIBRARY>BITMAPFNS.;3)


(* Copyright (c) 1983, 1984, 1985 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 " 6-Jun-85 16:46")

    (
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)
				    (
HELP
)))
		    [
\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])

(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 (WORDIN OFD)
		   N)
	       (HELP]
)
)
(PUTPROPS BITMAPFNS COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (559 5063 (READBINARYBITMAP 569 . 1070) (WRITEBINARYBITMAP 1072 . 1432) (WRITEBM 1434 . 
1747) (WRITEBMLST 1749 . 2023) (READBMLST 2025 . 2300) (READBM 2302 . 2487) (READPRESS 2489 . 4412) (
WINDOWBM 4414 . 5061)))))
STOP