(FILECREATED "14-Jan-87 17:50:00" {MCS:MCS:STANFORD}<LANE>BMENCODE.;13        

      previous date: "19-Dec-86 14:46:44" {MCS:MCS:STANFORD}<LANE>BMENCODE.;11)


(* Copyright (c) 1986, 1987 by Stanford University. All rights reserved.)

(PRETTYCOMPRINT BMENCODECOMS)

(RPAQQ BMENCODECOMS ((* User function)
		       (FNS BITMAP.ENCODE)
		       (* Internal functions)
		       (FNS FILE.TO.BITMAP BITMAP.TO.FILE)
		       (ADDVARS (BMC.MAKEFILE.OPTIONS NEW))
		       (INITVARS (BMC.EXTENSION 'BMC)
				 (BMC.BYTESPERLINE 64))
		       (GLOBALVARS BMC.MAKEFILE.OPTIONS BMC.EXTENSION BMC.BYTESPERLINE)))



(* User function)

(DEFINEQ

(BITMAP.ENCODE
  [LAMBDA (FILES)                                            (* cdl "19-Dec-86 14:43")
    (LET [FILENAME (FILENAMES (bind NAME for FILE inside FILES
				 collect (PROG1 (SETQ NAME (NAMEFIELD FILE T))
						    (SETATOMVAL NAME (FILE.TO.BITMAP FILE]
         (DECLARE (SPECVARS FILENAME))
         [SETATOMVAL [FILECOMS (NAMEFIELD (SETQ FILENAME (PACKFILENAME 'EXTENSION
										 BMC.EXTENSION
										 'BODY
										 (CAR FILENAMES]
		       (BQUOTE ((BITMAPS ,@ FILENAMES)
				  (P (for FILE in (QUOTE , FILENAMES)
					do (PRIN1 "Restoring file ")
					     (PRIN1 (BITMAP.TO.FILE (EVALV FILE)
									FILE))
					     (TERPRI]
         (RESETVAR FONTCHANGEFLG NIL (MAKEFILE FILENAME BMC.MAKEFILE.OPTIONS])
)



(* Internal functions)

(DEFINEQ

(FILE.TO.BITMAP
  [LAMBDA (FILE)                                             (* cdl "19-Dec-86 13:37")
    (DECLARE (SPECVARS FILE))
    (LET (STREAM)
         (DECLARE (SPECVARS STREAM))
         (RESETLST [RESETSAVE NIL (BQUOTE (CLOSEF? , (SETQ STREAM (OPENSTREAM
							       FILE
							       'INPUT]
		     (LET (BITMAP (LENGTH (GETFILEINFO STREAM 'LENGTH))
				  (BYTESPERLINE (QUOTIENT BMC.BYTESPERLINE 2)))
		          (with BITMAP (SETQ BITMAP (BITMAPCREATE (TIMES BYTESPERLINE 
										 BITSPERBYTE)
									(QUOTIENT
									  (PLUS (TIMES 2 
										     BYTESPERWORD)
										  BYTESPERLINE LENGTH)
									  BYTESPERLINE)))
				  (\PUTBASE BITMAPBASE 0 LENGTH)
				  (\PUTBASE BITMAPBASE 1 (RSH LENGTH BITSPERWORD))
				  (\BINS STREAM BITMAPBASE (TIMES 2 BYTESPERWORD)
					   LENGTH))
		      BITMAP])

(BITMAP.TO.FILE
  [LAMBDA (BITMAP FILE)                                      (* cdl "19-Dec-86 13:40")
    (DECLARE (SPECVARS BITMAP FILE))
    (LET (STREAM)
         (DECLARE (SPECVARS STREAM))
         (RESETLST [RESETSAVE NIL (BQUOTE (CLOSEF? , (SETQ STREAM (OPENSTREAM
							       FILE
							       'OUTPUT]
		     [with BITMAP (\DTEST BITMAP 'BITMAP)
			     (\BOUTS STREAM BITMAPBASE (TIMES 2 BYTESPERWORD)
				       (PLUS (\GETBASE BITMAPBASE 0)
					       (LSH (\GETBASE BITMAPBASE 1)
						      BITSPERWORD]
		     (FULLNAME STREAM])
)

(ADDTOVAR BMC.MAKEFILE.OPTIONS NEW)

(RPAQ? BMC.EXTENSION 'BMC)

(RPAQ? BMC.BYTESPERLINE 64)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BMC.MAKEFILE.OPTIONS BMC.EXTENSION BMC.BYTESPERLINE)
)
(PUTPROPS BMENCODE COPYRIGHT ("Stanford University" 1986 1987))
STOP