(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "29-Sep-87 07:44:31" |{MCS:MCS:STANFORD}<LANE>BMENCODE.;15|
 4082   

      changes to%:  (FNS BITMAP.ENCODE FILE.TO.BITMAP BITMAP.TO.FILE)

      previous date%: "22-Jan-87 08:05:09" |{MCS:MCS:STANFORD}<LANE>BMENCODE.;14|)


(* "
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)
                                            (* ; "Edited 29-Sep-87 07:38 by cdl")


    (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]
                `((BITMAPS ,@FILENAMES)
                  (P (for
 FILE in
 ',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)
                                             (* ; "Edited 29-Sep-87 07:41 by cdl")


    (DECLARE
 (SPECVARS FILE))
    (LET (STREAM)
         (DECLARE
 (SPECVARS STREAM))
         (RESETLST [RESETSAVE NIL `(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 (LOGAND LENGTH (MASK.1'S 0 16)))
                           (\PUTBASE BITMAPBASE 1 (LRSH LENGTH BITSPERWORD))
                           (\BINS STREAM BITMAPBASE (TIMES 2 BYTESPERWORD)
                                  LENGTH))
                     BITMAP])

(BITMAP.TO.FILE

  [LAMBDA (BITMAP FILE)
                                      (* ; "Edited 29-Sep-87 07:42 by cdl")


    (DECLARE
 (SPECVARS BITMAP FILE))
    (LET (STREAM)
         (DECLARE
 (SPECVARS STREAM))
         (RESETLST [RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTREAM FILE 'OUTPUT]
                [with
 BITMAP (\DTEST BITMAP 'BITMAP)
                      (\BOUTS STREAM BITMAPBASE (TIMES 2 BYTESPERWORD)
                             (PLUS (\GETBASE BITMAPBASE 0)
                                   (LLSH (\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))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (878 1977 (BITMAP.ENCODE 888 . 1975)) (2009 3786 (FILE.TO.BITMAP 2019 . 3130) (
BITMAP.TO.FILE 3132 . 3784)))))
STOP