(FILECREATED " 6-Feb-86 19:08:57" {ERIS}<LANE>COURIERDEFS.;10 6404   

      changes to:  (FNS WRITECOURIERFONT)

      previous date: " 5-Dec-85 19:42:29" {ERIS}<LANE>COURIERDEFS.;9)


(* Copyright (c) 1985, 1986 by Xerox Corporation. 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 (
QUOTE
 INTERLISP)
				 (
QUOTE
 LISPBRUSH))
	    (
SELECTQ
 TYPENAME
		       (NIL NIL)
		       ((
NUMBERP
 BRUSH)
			 VALUE)
		       (
SHOULDNT
])

(READCOURIERFONT

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

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

(WRITECOURIERFONT
  [LAMBDA (STREAM FONT PROGRAM TYPE)                                       (* cdl 
                                                                           " 6-Feb-86 19:01")
    (COURIER.WRITE STREAM (COURIER.CREATE (INTERLISP . FONTRECORD)
                                 FAMILY ←(FONTPROP FONT (QUOTE FAMILY))
                                 SIZE ←(FONTPROP FONT (QUOTE SIZE))
                                 FACE ←(FONTPROP FONT (QUOTE FACE))
                                 ROTATION ←(FONTPROP FONT (QUOTE ROTATION))
                                 DEVICE ←(FONTPROP FONT (QUOTE DEVICE)))
           (QUOTE INTERLISP)
           (QUOTE FONTRECORD])

(WRITECOURIERBRUSH

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

    (
COURIER.WRITE
 STREAM (if
 (
NULL
 ITEM)
				then
 (
QUOTE
 (NIL 0))
			      elseif
 (
NUMBERP
 ITEM)
				then
 (
LIST
 (
QUOTE
 NUMBERP)
					       ITEM)
			      elseif
 (
LISTP
 ITEM)
				then
 (
LIST
 (
QUOTE
 BRUSH)
					       ITEM)
			      else
 (
SHOULDNT
))
		     (
QUOTE
 INTERLISP)
		     (
QUOTE
 LISPBRUSH])

(READCOURIERNUMBER

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

                                                             (* DECLARATIONS: (RECORD ITEM 

							     (TYPENAME VALUE)))

    (with
 ITEM (
COURIER.READ
 STREAM (
QUOTE
 INTERLISP)
				 (
QUOTE
 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
 (
QUOTE
 (NIL 0))
			      elseif
 (
NUMBERP
 ITEM)
				then
 (
LIST
 (
QUOTE
 NUMBERP)
					       ITEM)
			      else
 (
SHOULDNT
))
		     (
QUOTE
 INTERLISP)
		     (
QUOTE
 LISPNUMBER])

(READCOURIERPOSITION

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

    (create
 POSITION
	      XCOORD ←(
COURIER.READ
 STREAM PROGRAM (
QUOTE
 NUMBER))
	      YCOORD ←(
COURIER.READ
 STREAM PROGRAM (
QUOTE
 NUMBER])

(WRITECOURIERPOSITION

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

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

(READCOURIERTEXTURE

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

    (GETWORD STREAM])

(WRITECOURIERTEXTURE

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

    (PUTWORD STREAM (
SELECTQ
 SHADE
			       (T BLACKSHADE)
			       (NIL WHITESHADE)
			       (if
 (
NUMBERP
 SHADE)
				   then
 SHADE
				 else
 BLACKSHADE])
)
(PUTPROPS COURIERDEFS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2490 6317 (READCOURIERATOM 2500 . 2661) (READCOURIERBRUSH 2663 . 3112) (READCOURIERFONT
 3114 . 3322) (WRITECOURIERFONT 3324 . 4002) (WRITECOURIERBRUSH 4004 . 4493) (READCOURIERNUMBER 4495
 . 4934) (WRITECOURIERNUMBER 4936 . 5331) (READCOURIERPOSITION 5333 . 5609) (WRITECOURIERPOSITION 5611
 . 5882) (READCOURIERTEXTURE 5884 . 6020) (WRITECOURIERTEXTURE 6022 . 6315)))))
STOP