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

(FILECREATED "15-Sep-87 11:22:40" |{MCS:MCS:STANFORD}<LANE>COURIERDEFS.;3|
 7077   

      changes to%:  (FNS READCOURIERTEXTURE WRITECOURIERTEXTURE)

      previous date%: " 3-Sep-87 10:19:24" |{MCS:MCS:STANFORD}<LANE>COURIERDEFS.;2|)


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

(PRETTYCOMPRINT COURIERDEFSCOMS)

(RPAQQ COURIERDEFSCOMS
 ((COURIERPROGRAMS INTERLISP)
                        (PROP COURIERDEF ATOM BRUSH FONT NUMBER POSITION TEXTURE)
                        (FNS READCOURIERATOM READCOURIERBRUSH READCOURIERFONT WRITECOURIERFONT 
                             WRITECOURIERBRUSH READCOURIERNUMBER WRITECOURIERNUMBER 
                             READCOURIERPOSITION WRITECOURIERPOSITION 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 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))
(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 COURIERDEFS COPYRIGHT ("Xerox Corporation & Stanford University" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2687 6962 (READCOURIERATOM 2697 . 2854) (READCOURIERBRUSH 2856 . 3351) (READCOURIERFONT
 3353 . 3530) (WRITECOURIERFONT 3532 . 4089) (WRITECOURIERBRUSH 4091 . 4866) (READCOURIERNUMBER 4868
 . 5337) (WRITECOURIERNUMBER 5339 . 5761) (READCOURIERPOSITION 5763 . 6024) (WRITECOURIERPOSITION 6026
 . 6277) (READCOURIERTEXTURE 6279 . 6495) (WRITECOURIERTEXTURE 6497 . 6960)))))
STOP