(FILECREATED "27-Mar-85 00:20:29" {ERIS}<LISPNEW>PATCHES>READBITMAPPATCH.;2
 2438   

      changes to:  (FNS READBITMAP)

      previous date: "27-Mar-85 00:15:25" {ERIS}<LISPNEW>PATCHES>READBITMAPPATCH.;1)


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

(PRETTYCOMPRINT READBITMAPPATCHCOMS)

(RPAQQ READBITMAPPATCHCOMS
 ((FNS READBITMAP)))
(DEFINEQ

(READBITMAP

  [LAMBDA (
FILE
)                                             (* rmk: "27-Mar-85 00:20")

                                                             (* reads the a bitmap from the input file.)

    (
SKIPSEPRS
 FILE)
    (
OR
 (
EQ
 (
READC
 FILE)
	    (
QUOTE
 %())
	(
ERROR
 "BAD FORMAT OF BITMAP IN FILE"))
    (
PROG
 [BASE BM W BITSPERPIXEL (WIDTH (
RATOM
 FILE))
		(HEIGHT (
RATOM
 FILE))
		(STRM (
GETSTREAM
 FILE (
QUOTE
 INPUT]
          [
SETQ
 BITSPERPIXEL (
SELECTQ
 (
SKIPSEPRS
 STRM)
				      ((%" %))
					1)
				      (
PROGN
                 (* after height can come the bits per pixel.)

					     (
RATOM
 FILE]
          (
SETQ
 W (FOLDHI (
ITIMES
 BITSPERPIXEL WIDTH)
			  BITSPERWORD))
          (
SETQ
 BM (
BITMAPCREATE
 WIDTH HEIGHT BITSPERPIXEL))
          (
SETQ
 BASE (fetch
 BITMAPBASE of
 BM))
          (
COND

	    ((
OR
 (
EQ
 WIDTH 0)
		 (
EQ
 HEIGHT 0)))
	    [(
EQ
 (
SKIPSEPRS
 STRM)
		 (
QUOTE
 %"))
	      (
FRPTQ
 HEIGHT (
SKIPSEPRS
 STRM)
		     (
OR
 (
EQ
 (
\BIN
 STRM)
			     (
CHARCODE
 %"))
			 (
GO
 BAD))
		     (
FRPTQ
 W [
\PUTBASEBYTE
 BASE 0 (
LOGOR
 (
LLSH
 (
IDIFFERENCE
 (
\BIN
 STRM)
									     (
SUB1
 (
CHARCODE
 A)))
								4)
							  (
IDIFFERENCE
 (
\BIN
 STRM)
								       (
SUB1
 (
CHARCODE
 A]
			    [
\PUTBASEBYTE
 BASE 1 (
LOGOR
 (
LLSH
 (
IDIFFERENCE
 (
\BIN
 STRM)
									   (
SUB1
 (
CHARCODE
 A)))
							      4)
							(
IDIFFERENCE
 (
\BIN
 STRM)
								     (
SUB1
 (
CHARCODE
 A]
			    (
SETQ
 BASE (
\ADDBASE
 BASE 1)))
		     (
OR
 (
EQ
 (
\BIN
 STRM)
			     (
CHARCODE
 %"))
			 (
GO
 BAD]
	    (T (
GO
 BAD)))
          (
SKIPSEPRS
 STRM)
          (
OR
 (
EQ
 (
\BIN
 STRM)
		  (
CHARCODE
 %)))
	      (
GO
 BAD))
          (
RETURN
 BM)
      BAD (
ERROR
 "BAD FORMAT OF BITMAP IN FILE"])
)
(PUTPROPS READBITMAPPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (371 2352 (READBITMAP 381 . 2350)))))
STOP