BMENCODE


(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