(FILECREATED "11-Jan-85 11:08:58" {DANTE}<WOGULIS>LISP>BITMAPFNS.;2
 5400   

      changes to:  (VARS BITMAPFNSCOMS)

      previous date: "26-Dec-84 15:43:55" {DANTE}<WOGULIS>LISP>BITMAPFNS.;1)


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

(PRETTYCOMPRINT BITMAPFNSCOMS)

(RPAQQ BITMAPFNSCOMS
 ((FNS READBINARYBITMAP WRITEBINARYBITMAP WRITEBM WRITEBMLST READBMLST READBM 
			   READPRESS WINDOWBM)
		      (MACROS RPCHK WORDIN WORDOUT)))
(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)                                      (* JWogulis "26-Dec-84 15:06")

    [WORDOUT FILE (ffetch
 BITMAPWIDTH of
 (
SETQ
 BITMAP (
\DTEST
 BITMAP (
QUOTE
 BITMAP]
    (WORDOUT 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 " 4-JAN-83 00:21")

    (READBINARYBITMAP
 (WORDIN FILE)
		      (WORDIN FILE)
		      FILE])

(READPRESS

  [LAMBDA (FILENAME)                                         (* lmm " 4-JAN-83 00:25")

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

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

		    (
SETQ
 HT (WORDIN OFD))                   (* Height)

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

				      (RPCHK 2)              (* Edotsize)

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

				       (RPCHK 0)
				       (
SETQ
 WIDTH (WORDIN 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: EVAL@COMPILE 

(PUTPROPS RPCHK MACRO
 ((N)
		       (
OR
 (
EQ
 (WORDIN OFD)
			       N)
			   (
HELP
))))

(PUTPROPS WORDIN MACRO
 ((STREAM)
			(
IPLUS
 (
LLSH
 (
BIN
 STREAM)
				     8)
			       (
BIN
 STREAM))))

(PUTPROPS WORDOUT MACRO
 ((F W)
			 (
BOUT
 F (
LRSH
 W 8))
			 (
BOUT
 F (
LOGAND
 W 255))))
)
(PUTPROPS BITMAPFNS COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (483 4954 (READBINARYBITMAP 493 . 994) (WRITEBINARYBITMAP 996 . 1356) (WRITEBM 1358 . 
1670) (WRITEBMLST 1672 . 1946) (READBMLST 1948 . 2223) (READBM 2225 . 2404) (READPRESS 2406 . 4303) (
WINDOWBM 4305 . 4952)))))
STOP