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

(FILECREATED "21-Jul-88 11:16:07" |{MCS:MCS:STANFORD}<LANE>COURIERDEFS.;4|
 7141   

      changes to%:  (VARS COURIERDEFSCOMS)

      previous date%: "15-Sep-87 11:22:40" |{MCS:MCS:STANFORD}<LANE>COURIERDEFS.;3|)


(* "
Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University.  All rights reserved.
")

(PRETTYCOMPRINT COURIERDEFSCOMS)

(RPAQQ COURIERDEFSCOMS
 ((FNS READCOURIERATOM READCOURIERBRUSH READCOURIERFONT WRITECOURIERFONT 
                                 WRITECOURIERBRUSH READCOURIERNUMBER WRITECOURIERNUMBER 
                                 READCOURIERPOSITION WRITECOURIERPOSITION READCOURIERTEXTURE 
                                 WRITECOURIERTEXTURE)
                            (PROP COURIERDEF ATOM BRUSH FONT NUMBER POSITION TEXTURE)
                            (COURIERPROGRAMS INTERLISP)))
(DEFINEQ

(READCOURIERATOM

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* cdl "10-Nov-85 17:16")

    (MKATOM (COURIER.READ.STRING STREAM])

(READCOURIERBRUSH

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* cdl "21-Nov-85 19:10")

                                                             (* DECLARATIONS%: (RECORD ITEM

                                                           (TYPENAME VALUE)))

    (with
 ITEM (COURIER.READ STREAM 'INTERLISP 'LISPBRUSH)
           (SELECTQ TYPENAME
               (NIL NIL)
               ((NUMBERP BRUSH) 
                    VALUE)
               (SHOULDNT])

(READCOURIERFONT

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* cdl " 5-Dec-85 19:01")

    (FONTCREATE (COURIER.READ STREAM 'INTERLISP 'FONTRECORD])

(WRITECOURIERFONT

  [LAMBDA (STREAM FONT PROGRAM TYPE)
                     (* cdl " 6-Feb-86 19:01")

    (COURIER.WRITE STREAM (COURIER.CREATE (INTERLISP . FONTRECORD)
                                 FAMILY _ (FONTPROP FONT 'FAMILY)
                                 SIZE _ (FONTPROP FONT 'SIZE)
                                 FACE _ (FONTPROP FONT 'FACE)
                                 ROTATION _ (FONTPROP FONT 'ROTATION)
                                 DEVICE _ (FONTPROP FONT 'DEVICE))
           'INTERLISP
           'FONTRECORD])

(WRITECOURIERBRUSH

  [LAMBDA (STREAM ITEM PROGRAM TYPE)
                     (* ; "Edited  3-Sep-87 09:54 by cdl")

    (COURIER.WRITE STREAM (if
 (NULL ITEM)
                              then
 '(NIL 0)
                            elseif
 (NUMBERP ITEM)
                              then
 (LIST 'NUMBERP ITEM)
                            elseif
 (LISTP ITEM)
                              then
 [until
 [GEQ (LENGTH ITEM)
                                                       (CONSTANT (LENGTH (RECORDFIELDNAMES
                                                                          'BRUSH]
                                          do
 (SETQ ITEM (APPEND ITEM '(NIL]
                                    (LIST 'BRUSH ITEM)
                            else
 (SHOULDNT))
           'INTERLISP
           'LISPBRUSH])

(READCOURIERNUMBER

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* cdl "13-Oct-85 12:50")

                                                             (* DECLARATIONS%: (RECORD ITEM

                                                           (TYPENAME VALUE)))

    (with
 ITEM (COURIER.READ STREAM 'INTERLISP 'LISPNUMBER)
           (SELECTQ TYPENAME
               (NIL NIL)
               (NUMBERP VALUE)
               (SHOULDNT])

(WRITECOURIERNUMBER

  [LAMBDA (STREAM ITEM PROGRAM TYPE)
                     (* cdl "13-Oct-85 13:31")

    (COURIER.WRITE STREAM (if
 (NULL ITEM)
                              then
 '(NIL 0)
                            elseif
 (NUMBERP ITEM)
                              then
 (LIST 'NUMBERP ITEM)
                            else
 (SHOULDNT))
           'INTERLISP
           'LISPNUMBER])

(READCOURIERPOSITION

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* cdl "21-Nov-85 18:47")

    (create
 POSITION
           XCOORD _ (COURIER.READ STREAM PROGRAM 'NUMBER)
           YCOORD _ (COURIER.READ STREAM PROGRAM 'NUMBER])

(WRITECOURIERPOSITION

  [LAMBDA (STREAM ITEM PROGRAM TYPE)
                     (* cdl "21-Nov-85 18:46")

    (with
 POSITION ITEM (COURIER.WRITE STREAM XCOORD PROGRAM 'NUMBER)
           (COURIER.WRITE STREAM YCOORD PROGRAM 'NUMBER])

(READCOURIERTEXTURE

  [LAMBDA (STREAM PROGRAM TYPE)
                          (* ; "Edited 15-Sep-87 11:18 by cdl")

    (LOGOR (LLSH (BIN STREAM)
                 BITSPERBYTE)
           (BIN STREAM])

(WRITECOURIERTEXTURE

  [LAMBDA (STREAM SHADE PROGRAM TYPE)
                    (* ; "Edited 15-Sep-87 11:22 by cdl")

    (SETQ SHADE (SELECTQ SHADE
                    (T BLACKSHADE)
                    (NIL WHITESHADE)
                    (if
 (NUMBERP SHADE)
                        then
 SHADE
                      else
 BLACKSHADE)))
    (BOUT STREAM (LRSH SHADE BITSPERBYTE))
    (BOUT STREAM (LOGAND SHADE (MASK.1'S 0 BITSPERBYTE])
)

(PUTPROPS ATOM COURIERDEF
 (READCOURIERATOM COURIER.WRITE.STRING))

(PUTPROPS BRUSH COURIERDEF
 (READCOURIERBRUSH WRITECOURIERBRUSH))

(PUTPROPS FONT COURIERDEF
 (READCOURIERFONT WRITECOURIERFONT))

(PUTPROPS NUMBER COURIERDEF
 (READCOURIERNUMBER WRITECOURIERNUMBER))

(PUTPROPS POSITION COURIERDEF
 (READCOURIERPOSITION WRITECOURIERPOSITION))

(PUTPROPS TEXTURE COURIERDEF
 (READCOURIERTEXTURE WRITECOURIERTEXTURE))

(COURIERPROGRAM INTERLISP
 (1100 0)
    TYPES

      [(REGION (SEQUENCE INTEGER))
       (FONTRECORD (RECORD (FAMILY ATOM)
                          (SIZE CARDINAL)
                          (FACE FONTFACE)
                          (ROTATION NUMBER)
                          (DEVICE ATOM)))
       [FONTFACE (RECORD (WEIGHT (ENUMERATION (LIGHT 0)
                                        (MEDIUM 1)
                                        (BOLD 2)))
                        (SLOPE (ENUMERATION (REGULAR 0)
                                      (ITALIC 1)))
                        (EXPANSION (ENUMERATION (REGULAR 0)
                                          (COMPRESSED 1)
                                          (EXPANDED 2]
       (OPERATION (ENUMERATION (NIL 0)
                         (REPLACE 1)
                         (PAINT 2)
                         (INVERT 3)
                         (ERASE 4)))
       (LISPNUMBER (CHOICE (NIL 0 UNSPECIFIED)
                          (NUMBERP 1 INTEGER)))
       (LISPBRUSH (CHOICE (NIL 0 UNSPECIFIED)
                         (NUMBERP 1 CARDINAL)
                         (BRUSH 2 (RECORD (BRUSHSHAPE ATOM)
                                         (BRUSHSIZE NUMBER)
                                         (BRUSHCOLOR NUMBER]
    PROCEDURES

      NIL
    ERRORS

      NIL)
(PUTPROPS COURIERDEFS COPYRIGHT ("Xerox Corporation & Stanford University" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (920 5241 (READCOURIERATOM 930 . 1083) (READCOURIERBRUSH 1085 . 1579) (READCOURIERFONT 
1581 . 1754) (WRITECOURIERFONT 1756 . 2309) (WRITECOURIERBRUSH 2311 . 3168) (READCOURIERNUMBER 3170 . 
3637) (WRITECOURIERNUMBER 3639 . 4057) (READCOURIERPOSITION 4059 . 4316) (WRITECOURIERPOSITION 4318 . 
4566) (READCOURIERTEXTURE 4568 . 4779) (WRITECOURIERTEXTURE 4781 . 5239)))))
STOP