(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-May-87 18:01:23" {ERIS}<LISPUSERS>LYRIC>PLOTOBJECTS.;2 99923  

      changes to%:  (MACROS L1METRIC L2METRIC)
                    (FNS COPYCOMPOUND COPYCURVE COPYFILLEDRECTANGLE COPYGENERIC COPYGRAPHOBJECT 
                         COPYLINE COPYPOINT COPYPOLYGON COPYTEXT CREATECOMPOUND CREATECURVE 
                         CREATEFILLEDRECTANGLE CREATEGRAPH CREATELINE CREATEPOINT CREATEPOLYGON 
                         CREATETEXT DISTANCETOFILLEDRECTANGLE DISTANCETOLINE DRAWCURVEOBJECT 
                         DRAWFILLEDRECTANGLEOBJECT DRAWGRAPHOBJECT DRAWLINEOBJECT DRAWPOINTOBJECT 
                         DRAWPOLYGONOBJECT DRAWTEXTOBJECT ERASECURVEOBJECT ERASEFILLEDRECTANGLEOBJECT 
                         ERASEGRAPHOBJECT ERASELINEOBJECT ERASEPOINTOBJECT ERASEPOLYGONOBJECT 
                         ERASETEXTOBJECT EXTENTOFCOMPOUND EXTENTOFCURVE EXTENTOFGRAPH EXTENTOFPOLYGON 
                         EXTENTOFTEXT GETCOMPOUND GETCURVE GETFILLEDRECTANGLE GETGRAPH GETLINE 
                         GETPOINT GETPOLYGON GETTEXT HIGHLIGHTCURVE HIGHLIGHTFILLEDRECTANGLE 
                         HIGHLIGHTGRAPH HIGHLIGHTLINE HIGHLIGHTPOINT HIGHLIGHTPOLYGON HIGHLIGHTTEXT 
                         LABELGENERIC LABELPOINT PLOTCOMPOUND PLOTCURVE PLOTFILLEDRECTANGLE PLOTGRAPH 
                         PLOTLINE PLOTPOINT PLOTPOINTS PLOTPOLYGON PUTCOMPOUND PUTCURVE 
                         PUTFILLEDRECTANGLE PUTGRAPH PUTLINE PUTPOINT PUTPOLYGON PUTTEXT)

      previous date%: " 5-May-87 14:35:56" {ERIS}<LISPUSERS>LYRIC>PLOTOBJECTS.;1)


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

(PRETTYCOMPRINT PLOTOBJECTSCOMS)

(RPAQQ PLOTOBJECTSCOMS 
       [(FNS COPYCOMPOUND COPYCURVE COPYFILLEDRECTANGLE COPYGENERIC COPYGRAPHOBJECT COPYLINE 
             COPYPOINT COPYPOLYGON COPYTEXT CREATECOMPOUND CREATECURVE CREATEFILLEDRECTANGLE 
             CREATEGRAPH CREATELINE CREATEPOINT CREATEPOLYGON CREATETEXT DISTANCETOCOMPOUND 
             DISTANCETOCURVE DISTANCETOFILLEDRECTANGLE DISTANCETOGRAPH DISTANCETOLINE DISTANCETOPOINT 
             DISTANCETOPOLYGON DISTANCETOTEXT DRAWCOMPOUNDOBJECT DRAWCURVEOBJECT 
             DRAWFILLEDRECTANGLEOBJECT DRAWGRAPHOBJECT DRAWLINEOBJECT DRAWPOINTOBJECT 
             DRAWPOLYGONOBJECT DRAWTEXTOBJECT ERASECOMPOUNDOBJECT ERASECURVEOBJECT 
             ERASEFILLEDRECTANGLEOBJECT ERASEGRAPHOBJECT ERASELINEOBJECT ERASEPOINTOBJECT 
             ERASEPOLYGONOBJECT ERASETEXTOBJECT EXTENTOFCOMPOUND EXTENTOFCURVE 
             EXTENTOFFILLEDRECTANGLE EXTENTOFGRAPH EXTENTOFLINE EXTENTOFPOINT EXTENTOFPOLYGON 
             EXTENTOFTEXT GETCOMPOUND GETCURVE GETFILLEDRECTANGLE GETGENERIC GETGRAPH GETLINE 
             GETPOINT GETPOLYGON GETTEXT HIGHLIGHTCOMPOUND HIGHLIGHTCURVE HIGHLIGHTFILLEDRECTANGLE 
             HIGHLIGHTGRAPH HIGHLIGHTLINE HIGHLIGHTPOINT HIGHLIGHTPOLYGON HIGHLIGHTTEXT LABELGENERIC 
             LABELPOINT LABELTEXT LOWLIGHTCOMPOUND MOVECOMPOUND MOVECURVE MOVEFILLEDRECTANGLE 
             MOVELINE MOVEPOINT MOVEPOLYGON MOVETEXT PLOTCOMPOUND PLOTCURVE PLOTFILLEDRECTANGLE 
             PLOTGRAPH PLOTLINE PLOTPOINT PLOTPOINTS PLOTPOLYGON PLOTTEXT PUTCOMPOUND PUTCURVE 
             PUTFILLEDRECTANGLE PUTGENERIC PUTGRAPH PUTLINE PUTPOINT PUTPOLYGON PUTTEXT)
        (MACROS L1METRIC L2METRIC)
        (VARS CIRCLE CROSS DASH DOT DOTDASH SHADE1 SHADE2 SHADE3 SHADE4 SHADE5 SHADE6 SHADE7 SHADE8 
              STAR)
        (RECORDS COMPOUNDDATA CURVEDATA FILLEDRECTANGLEDATA GRAPHDATA LINEDATA PLOT.STYLE POINTDATA 
               POLYGONDATA TEXTDATA)
        (PROP ARGNAMES PLOTCOMPOUND)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA PLOTCOMPOUND])
(DEFINEQ

(COPYCOMPOUND
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:45 by jop")
          
          (* ;; "Copyfn for COMPOUND objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create COMPOUNDDATA
                         COMPONENTS ← (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of OBJECTDATA)
                                         collect (COPYPLOTOBJECT OBJECT PLOT))
                         COMPOUNDTYPE ← (fetch (COMPOUNDDATA COMPOUNDTYPE) of OBJECTDATA])

(COPYCURVE
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Copyfn for CURVE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create CURVEDATA
                         CURVEPOINTS ← (COPYALL (fetch (CURVEDATA CURVEPOINTS) of OBJECTDATA))
                         STYLE ← (COPYALL (fetch (CURVEDATA STYLE) of OBJECTDATA])

(COPYFILLEDRECTANGLE
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Copyfn for FILLEDRECTANGLE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create FILLEDRECTANGLEDATA
                         OBJECTLEFT ← (fetch (FILLEDRECTANGLEDATA OBJECTLEFT) of OBJECTDATA)
                         OBJECTBOTTOM ← (fetch (FILLEDRECTANGLEDATA OBJECTBOTTOM) of OBJECTDATA)
                         OBJECTWIDTH ← (fetch (FILLEDRECTANGLEDATA OBJECTWIDTH) of OBJECTDATA)
                         OBJECTHEIGHT ← (fetch (FILLEDRECTANGLEDATA OBJECTHEIGHT) of OBJECTDATA)
                         BORDERWIDTH ← (fetch (FILLEDRECTANGLEDATA BORDERWIDTH) of OBJECTDATA)
                         TEXTURE ← (fetch (FILLEDRECTANGLEDATA TEXTURE) of OBJECTDATA])

(COPYGENERIC
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Default COPYFN")

    (HCOPYALL (fetch OBJECTDATA of PLOTOBJECT])

(COPYGRAPHOBJECT
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create GRAPHDATA
                         GRAPHFN ← (fetch (GRAPHDATA GRAPHFN) of OBJECTDATA)
                         NSAMPLES ← (fetch (GRAPHDATA NSAMPLES) of OBJECTDATA)
                         STYLE ← (COPYALL (fetch (GRAPHDATA STYLE) of OBJECTDATA])

(COPYLINE
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Copyfn for LINE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create LINEDATA
                         INFINITESLOPE? ← (fetch (LINEDATA INFINITESLOPE?) of OBJECTDATA)
                         SLOPE ← (fetch (LINEDATA SLOPE) of OBJECTDATA)
                         CONSTANT ← (fetch (LINEDATA CONSTANT) of OBJECTDATA)
                         STYLE ← (COPYALL (fetch (LINEDATA STYLE) of OBJECTDATA])

(COPYPOINT
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Copyfn for POINT objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create POINTDATA
                         POINTPOSITION ← (COPYALL (fetch (POINTDATA POINTPOSITION) of OBJECTDATA))
                         SYMBOL ← (fetch (POINTDATA SYMBOL) of OBJECTDATA])

(COPYPOLYGON
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:46 by jop")
          
          (* ;; "Copyfn for POLYGON objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create POLYGONDATA
                         POLYGONPOINTS ← (COPYALL (fetch (POLYGONDATA POLYGONPOINTS) of OBJECTDATA))
                         STYLE ← (COPYALL (fetch (POLYGONDATA STYLE) of OBJECTDATA])

(COPYTEXT
  [LAMBDA (PLOTOBJECT PLOT)                                  (* ; "Edited  5-May-87 17:47 by jop")
          
          (* ;; "Copyfn for TEXT objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (RETURN (create TEXTDATA
                         TEXTPOSITION ← (COPYALL (fetch (TEXTDATA TEXTPOSITION) of OBJECTDATA))
                         TEXT ← (COPYALL (fetch (TEXTDATA TEXT) of OBJECTDATA))
                         FONT ← (fetch (TEXTDATA FONT) of OBJECTDATA])

(CREATECOMPOUND
  [LAMBDA (COMPOUNDTYPE COMPONENTS LABEL MENU)               (* ; "Edited  5-May-87 17:47 by jop")
          
          (* ;; "create a compound plot object.  First is the required Compoundtype, then the components, a list of plotobjects, then the optional label,and menu")

    (CREATEPLOTOBJECT COMPOUNDFNS 'COMPOUND LABEL MENU (create COMPOUNDDATA
                                                              COMPONENTS ← COMPONENTS
                                                              COMPOUNDTYPE ← COMPOUNDTYPE])

(CREATECURVE
  [LAMBDA (POSITIONS LABEL STYLE MENU)                       (* ; "Edited  5-May-87 17:47 by jop")
          
          (* ;; "Create a curve plot object")

    (CREATEPLOTOBJECT CURVEFNS 'CURVE LABEL MENU (create CURVEDATA
                                                        CURVEPOINTS ← POSITIONS
                                                        STYLE ← (COND
                                                                   ((FIXP STYLE)
                                                                    (create PLOT.STYLE
                                                                           LINEWIDTH ← STYLE))
                                                                   ((LISTP STYLE)
                                                                    (create PLOT.STYLE
                                                                           LINEWIDTH ← (CAR STYLE)
                                                                           DASHING ← (CADR STYLE)
                                                                           COLOR ← (CADDR STYLE)))
                                                                   (T (create PLOT.STYLE
                                                                             LINEWIDTH ← 1])

(CREATEFILLEDRECTANGLE
  [LAMBDA (LEFT BOTTOM WIDTH HEIGHT LABEL TEXTURE BORDERWIDTH MENU)
                                                             (* ; "Edited  5-May-87 17:47 by jop")
          
          (* ;; "Create a filledrectangle plot object")

    (if (NULL TEXTURE)
        then (SETQ TEXTURE 'SHADE3))
    (CREATEPLOTOBJECT FILLEDRECTANGLEFNS 'FILLEDRECTANGLE LABEL MENU
           (create FILLEDRECTANGLEDATA
                  OBJECTLEFT ← LEFT
                  OBJECTBOTTOM ← BOTTOM
                  OBJECTWIDTH ← WIDTH
                  OBJECTHEIGHT ← HEIGHT
                  BORDERWIDTH ← (OR BORDERWIDTH 1)
                  TEXTURE ← TEXTURE])

(CREATEGRAPH
  [LAMBDA (GRAPHFN NSAMPLES LABEL STYLE MENU)                (* ; "Edited  5-May-87 17:47 by jop")

    (CREATEPLOTOBJECT GRAPHFNS 'GRAPH LABEL MENU (create GRAPHDATA
                                                        GRAPHFN ← GRAPHFN
                                                        NSAMPLES ← (OR (FIXP NSAMPLES)
                                                                       100)
                                                        STYLE ←
                                                        (if (FIXP STYLE)
                                                            then (create PLOT.STYLE
                                                                        LINEWIDTH ← STYLE)
                                                          elseif (LISTP STYLE)
                                                            then (create PLOT.STYLE
                                                                        LINEWIDTH ← (CAR STYLE)
                                                                        DASHING ← (CADR STYLE)
                                                                        COLOR ← (CADDR STYLE))
                                                          else (create PLOT.STYLE
                                                                      LINEWIDTH ← 1])

(CREATELINE
  [LAMBDA (SLOPE CONSTANT LABEL STYLE MENU)                  (* ; "Edited  5-May-87 17:47 by jop")
          
          (* ;; "Create a line plot object")

    (CREATEPLOTOBJECT LINEFNS 'LINE LABEL MENU (create LINEDATA
                                                      INFINITESLOPE? ← (NOT SLOPE)
                                                      SLOPE ← (OR SLOPE 0.0)
                                                      CONSTANT ← CONSTANT
                                                      STYLE ← (COND
                                                                 ((FIXP STYLE)
                                                                  (create PLOT.STYLE
                                                                         LINEWIDTH ← STYLE))
                                                                 ((LISTP STYLE)
                                                                  (create PLOT.STYLE
                                                                         LINEWIDTH ← (CAR STYLE)
                                                                         DASHING ← (CADR STYLE)
                                                                         COLOR ← (CADDR STYLE)))
                                                                 (T (create PLOT.STYLE
                                                                           LINEWIDTH ← 1])

(CREATEPOINT
  [LAMBDA (POSITION LABEL SYMBOL MENU)                       (* ; "Edited  5-May-87 17:48 by jop")
          
          (* ;; "Create a point plot object")

    (if (NULL SYMBOL)
        then (SETQ SYMBOL STAR))
    (CREATEPLOTOBJECT POINTFNS 'POINT LABEL MENU (create POINTDATA
                                                        POINTPOSITION ← POSITION
                                                        SYMBOL ← SYMBOL])

(CREATEPOLYGON
  [LAMBDA (POSITIONS LABEL STYLE MENU)                       (* ; "Edited  5-May-87 17:48 by jop")
          
          (* ;; "Create a polygon Plot object")

    (CREATEPLOTOBJECT POLYGONFNS 'POLYGON LABEL MENU (create POLYGONDATA
                                                            POLYGONPOINTS ← POSITIONS
                                                            STYLE ←
                                                            (if (FIXP STYLE)
                                                                then (create PLOT.STYLE
                                                                            LINEWIDTH ← STYLE)
                                                              elseif (LISTP STYLE)
                                                                then (create PLOT.STYLE
                                                                            LINEWIDTH ← (CAR STYLE)
                                                                            DASHING ← (CADR STYLE)
                                                                            COLOR ← (CADDR STYLE))
                                                              else (create PLOT.STYLE
                                                                          LINEWIDTH ← 1])

(CREATETEXT
  [LAMBDA (POSITION TEXT LABEL FONT MENU)                    (* ; "Edited  5-May-87 17:48 by jop")
          
          (* ;; "Create a Text Plot object")

    (CREATEPLOTOBJECT TEXTFNS 'TEXT LABEL MENU
           (create TEXTDATA
                  TEXTPOSITION ← POSITION
                  TEXT ← TEXT
                  FONT ← FONT])

(DISTANCETOCOMPOUND
  [LAMBDA (COMPOUNDDATA STREAMPOSITION PLOT)                 (* edited%: "27-Mar-86 21:25")
    (PROG [(COMPONENTS (fetch (COMPOUNDDATA COMPONENTS) of (fetch OBJECTDATA of COMPOUNDDATA]
          (RETURN (bind (CMIN ← (DISTANCETOPLOTOBJECT (CAR COMPONENTS)
                                       STREAMPOSITION PLOT))
                        PMIN for PART in (CDR COMPONENTS) do (SETQ PMIN (DISTANCETOPLOTOBJECT PART 
                                                                               STREAMPOSITION PLOT))
                                                             (if (LESSP PMIN CMIN)
                                                                 then (SETQ CMIN PMIN))
                     finally (RETURN CMIN])

(DISTANCETOCURVE
  [LAMBDA (CURVEDATA STREAMPOSITION PLOT)                    (* edited%: "21-May-85 15:28")
    (L1METRIC STREAMPOSITION (for POINT in (fetch (CURVEDATA STREAMPOINTS)
                                              of (fetch OBJECTDATA of CURVEDATA))
                                smallest (L1METRIC POINT STREAMPOSITION])

(DISTANCETOFILLEDRECTANGLE
  [LAMBDA (FILLEDRECTANGLE STREAMPOSITION PLOT)              (* ; "Edited  5-May-87 17:48 by jop")

    (PROG ((OBJECTDATA (fetch OBJECTDATA of FILLEDRECTANGLE))
           (CLOSEST (CONSTANT (create POSITION)))
           (STREAMX (fetch XCOORD of STREAMPOSITION))
           (STREAMY (fetch YCOORD of STREAMPOSITION))
           STREAMLEFT STREAMBOTTOM STREAMRIGHT STREAMTOP INSIDEFLG)
          (SETQ STREAMLEFT (fetch (FILLEDRECTANGLEDATA STREAMLEFT) of OBJECTDATA))
          (SETQ STREAMBOTTOM (fetch (FILLEDRECTANGLEDATA STREAMBOTTOM) of OBJECTDATA))
          (SETQ STREAMRIGHT (fetch (FILLEDRECTANGLEDATA STREAMRIGHT) of OBJECTDATA))
          (SETQ STREAMTOP (fetch (FILLEDRECTANGLEDATA STREAMTOP) of OBJECTDATA))
          [replace XCOORD of CLOSEST
             with (if (GREATERP STREAMX STREAMRIGHT)
                      then STREAMRIGHT
                    elseif (LESSP STREAMX STREAMLEFT)
                      then STREAMLEFT
                    else (if (OR (GREATERP STREAMY STREAMTOP)
                                 (LESSP STREAMY STREAMBOTTOM))
                             then STREAMX
                           else (SETQ INSIDEFLG T) 
          
          (* ;; "Hack to deal with the case of adjacent filledrectangles.  Bonus subtracted from metric if cursor inside rectangle")

                                (if (LESSP (IMIN (IDIFFERENCE STREAMTOP STREAMY)
                                                 (IDIFFERENCE STREAMY STREAMBOTTOM))
                                           (IMIN (IDIFFERENCE STREAMRIGHT STREAMX)
                                                 (IDIFFERENCE STREAMX STREAMLEFT)))
                                    then STREAMX
                                  else (if (LESSP (IDIFFERENCE STREAMRIGHT STREAMX)
                                                  (IDIFFERENCE STREAMX STREAMLEFT))
                                           then STREAMRIGHT
                                         else STREAMLEFT]
          [replace YCOORD of CLOSEST
             with (if (GREATERP STREAMY STREAMTOP)
                      then STREAMTOP
                    elseif (LESSP STREAMY STREAMBOTTOM)
                      then STREAMBOTTOM
                    else (if (OR (GREATERP STREAMX STREAMRIGHT)
                                 (LESSP STREAMX STREAMLEFT))
                             then STREAMY
                           else (if (LESSP (IMIN (IDIFFERENCE STREAMRIGHT STREAMX)
                                                 (IDIFFERENCE STREAMX STREAMLEFT))
                                           (IMIN (IDIFFERENCE STREAMTOP STREAMY)
                                                 (IDIFFERENCE STREAMY STREAMBOTTOM)))
                                    then STREAMY
                                  else (if (LESSP (IDIFFERENCE STREAMTOP STREAMY)
                                                  (IDIFFERENCE STREAMY STREAMBOTTOM))
                                           then STREAMTOP
                                         else STREAMBOTTOM]
          (RETURN (if INSIDEFLG
                      then (IDIFFERENCE (L1METRIC STREAMPOSITION CLOSEST)
                                  2)
                    else (L1METRIC STREAMPOSITION CLOSEST])

(DISTANCETOGRAPH
  [LAMBDA (GRAPHOBJECT STREAMPOSITION PLOT)                  (* jop%: "12-Dec-85 13:15")
    (L1METRIC STREAMPOSITION (for POINT in (fetch (GRAPHDATA STREAMPOSITIONS)
                                              of (fetch OBJECTDATA of GRAPHOBJECT))
                                smallest (L1METRIC POINT STREAMPOSITION])

(DISTANCETOLINE
  [LAMBDA (LINEOBJECT STREAMPOSITION PLOT)                   (* ; "Edited  5-May-87 17:49 by jop")

    (PROG ((X0 (fetch XCOORD of STREAMPOSITION))
           (Y0 (fetch YCOORD of STREAMPOSITION))
           (STREAMSLOPE (fetch STREAMSLOPE of (fetch OBJECTDATA of LINEOBJECT)))
           (STREAMCONSTANT (fetch STREAMCONSTANT of (fetch OBJECTDATA of LINEOBJECT)))
           MP BP XI YI)                                      (* ; "Assumes use of the L1metric")

          (RETURN (FIXR (COND
                           ((fetch INFINITESLOPE? of (fetch OBJECTDATA of LINEOBJECT))
                            (FABS (FDIFFERENCE X0 STREAMCONSTANT)))
                           ((EQP STREAMSLOPE 0.0)
                            (FABS (FDIFFERENCE Y0 STREAMCONSTANT)))
                           (T (SETQ MP (FMINUS (FQUOTIENT 1.0 STREAMSLOPE)))
                              (SETQ BP (FDIFFERENCE Y0 (FTIMES MP X0)))
                              (SETQ XI (FQUOTIENT (FDIFFERENCE BP STREAMCONSTANT)
                                              (FDIFFERENCE STREAMSLOPE MP)))
                              (SETQ YI (FPLUS (FTIMES MP XI)
                                              BP))
                              (L1METRIC STREAMPOSITION (create POSITION
                                                              XCOORD ← XI
                                                              YCOORD ← YI])

(DISTANCETOPOINT
  [LAMBDA (POINT STREAMPOSITION PLOT)                        (* edited%: "21-May-85 15:28")
    (L1METRIC (fetch (POINTDATA STREAMPOSITION) of (fetch OBJECTDATA of POINT))
           STREAMPOSITION])

(DISTANCETOPOLYGON
  [LAMBDA (POLYGONDATA STREAMPOSITION PLOT)                  (* edited%: "21-May-85 15:32")
    (L1METRIC STREAMPOSITION (for POINT in (fetch (POLYGONDATA STREAMPOINTS)
                                              of (fetch OBJECTDATA of POLYGONDATA))
                                smallest (L1METRIC POINT STREAMPOSITION])

(DISTANCETOTEXT
  [LAMBDA (TEXTOBJECT STREAMPOSITION PLOT)                   (* jop%: "12-Aug-85 13:42")
    (L1METRIC (fetch (TEXTDATA STREAMPOSITION) of (fetch OBJECTDATA of TEXTOBJECT))
           STREAMPOSITION])

(DRAWCOMPOUNDOBJECT
  [LAMBDA (COMPOUNDOBJECT VIEWPORT PLOT)                     (* edited%: "27-Mar-86 21:25")
    (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of (fetch (PLOTOBJECT OBJECTDATA) of 
                                                                                       COMPOUNDOBJECT
                                                              )) do (DRAWPLOTOBJECT OBJECT VIEWPORT 
                                                                           PLOT])

(DRAWCURVEOBJECT
  [LAMBDA (CURVEOBJECT VIEWPORT PLOT)                        (* ; "Edited  5-May-87 17:49 by jop")
          
          (* ;; "Draw a series of connected lines in VIEWPORT.  Style is the line width in pixels.")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of CURVEOBJECT))
           (POINTS (fetch (CURVEDATA CURVEPOINTS) of OBJECTDATA))
           (STREAMPOINTS (for PT in POINTS collect (WORLDTOSTREAM PT VIEWPORT)))
           (STYLE (fetch (CURVEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (TIMES (DSPSCALE NIL STREAM)
                             (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (DASHING (fetch (PLOT.STYLE DASHING) of STYLE))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOINTS))
                        (fetch YCOORD of (CAR STREAMPOINTS))
                        STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'REPLACE STREAM COLOR DASHING))
          (COND
             ((EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              (replace (CURVEDATA STREAMPOINTS) of OBJECTDATA with STREAMPOINTS])

(DRAWFILLEDRECTANGLEOBJECT
  [LAMBDA (FILLEDRECTANGLEOBJECT VIEWPORT PLOT)              (* ; "Edited  5-May-87 17:49 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of FILLEDRECTANGLEOBJECT))
           (TEXTURE (fetch (FILLEDRECTANGLEDATA TEXTURE) of OBJECTDATA))
           (BORDERWIDTH (TIMES (DSPSCALE NIL STREAM)
                               (fetch (FILLEDRECTANGLEDATA BORDERWIDTH) of OBJECTDATA)))
           STREAMLEFT STREAMBOTTOM STREAMWIDTH STREAMHEIGHT STREAMRIGHT STREAMTOP)
          (SETQ STREAMLEFT (WORLDTOSTREAMX (fetch (FILLEDRECTANGLEDATA OBJECTLEFT) of OBJECTDATA)
                                  VIEWPORT))
          (SETQ STREAMBOTTOM (WORLDTOSTREAMY (fetch (FILLEDRECTANGLEDATA OBJECTBOTTOM) of OBJECTDATA)
                                    VIEWPORT))
          (SETQ STREAMWIDTH (DIFFERENCE (WORLDTOSTREAMX (fetch (FILLEDRECTANGLEDATA OBJECTRIGHT)
                                                           of OBJECTDATA)
                                               VIEWPORT)
                                   STREAMLEFT))
          (SETQ STREAMHEIGHT (DIFFERENCE (WORLDTOSTREAMY (fetch (FILLEDRECTANGLEDATA OBJECTTOP)
                                                            of OBJECTDATA)
                                                VIEWPORT)
                                    STREAMBOTTOM))
          (SETQ STREAMRIGHT (PLUS STREAMLEFT STREAMWIDTH))
          (SETQ STREAMTOP (PLUS STREAMBOTTOM STREAMHEIGHT))
          (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM STREAMLEFT STREAMBOTTOM STREAMWIDTH 
                 STREAMHEIGHT 'TEXTURE 'PAINT TEXTURE)
          (MOVETO STREAMLEFT STREAMBOTTOM STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMBOTTOM BORDERWIDTH 'REPLACE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMTOP BORDERWIDTH 'REPLACE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMTOP BORDERWIDTH 'REPLACE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMBOTTOM BORDERWIDTH 'REPLACE STREAM)
          (if (EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              then (replace (FILLEDRECTANGLEDATA STREAMLEFT) of OBJECTDATA with STREAMLEFT)
                   (replace (FILLEDRECTANGLEDATA STREAMBOTTOM) of OBJECTDATA with STREAMBOTTOM)
                   (replace (FILLEDRECTANGLEDATA STREAMWIDTH) of OBJECTDATA with STREAMWIDTH)
                   (replace (FILLEDRECTANGLEDATA STREAMHEIGHT) of OBJECTDATA with STREAMHEIGHT])

(DRAWGRAPHOBJECT
  [LAMBDA (GRAPHOBJECT VIEWPORT PLOT)                        (* ; "Edited  5-May-87 17:50 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of GRAPHOBJECT))
           (XUPPER (fetch (PLOT XUPPER) of PLOT))
           (XLOWER (fetch (PLOT XLOWER) of PLOT))
           (YUPPER (fetch (PLOT YUPPER) of PLOT))
           (YLOWER (fetch (PLOT YLOWER) of PLOT))
           (GRAPHFN (fetch (GRAPHDATA GRAPHFN) of OBJECTDATA))
           (NSAMPLES (fetch (GRAPHDATA NSAMPLES) of OBJECTDATA))
           (STYLE (fetch (GRAPHDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (TIMES (DSPSCALE NIL STREAM)
                             (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (DASHING (fetch (PLOT.STYLE DASHING) of STYLE))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE))
           STREAMPOSITIONS)
          [SETQ STREAMPOSITIONS (NCONC1 (bind (INC ← (FQUOTIENT (FDIFFERENCE XUPPER XLOWER)
                                                            (SUB1 NSAMPLES))) for I from 1
                                           to (SUB1 NSAMPLES) as X from XLOWER by INC
                                           collect (CREATEPOSITION (WORLDTOSTREAMX X VIEWPORT)
                                                          (WORLDTOSTREAMY (APPLY* GRAPHFN X)
                                                                 VIEWPORT)))
                                       (CREATEPOSITION (WORLDTOSTREAMX XUPPER VIEWPORT)
                                              (WORLDTOSTREAMY (APPLY* GRAPHFN XUPPER)
                                                     VIEWPORT]
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOSITIONS))
                        (fetch YCOORD of (CAR STREAMPOSITIONS))
                        STREAM) for PT in (CDR STREAMPOSITIONS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'REPLACE STREAM COLOR DASHING))
          (if (EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              then (replace (GRAPHDATA STREAMPOSITIONS) of OBJECTDATA with STREAMPOSITIONS])

(DRAWLINEOBJECT
  [LAMBDA (LINEOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:50 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of LINEOBJECT))
           (XUPPER (fetch (PLOT XUPPER) of PLOT))
           (XLOWER (fetch (PLOT XLOWER) of PLOT))
           (YUPPER (fetch (PLOT YUPPER) of PLOT))
           (YLOWER (fetch (PLOT YLOWER) of PLOT))
           (STYLE (fetch (LINEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (TIMES (DSPSCALE NIL STREAM)
                             (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (DASHING (fetch (PLOT.STYLE DASHING) of STYLE))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE))
           (INFINITESLOPE? (fetch (LINEDATA INFINITESLOPE?) of OBJECTDATA))
           (SLOPE (fetch (LINEDATA SLOPE) of OBJECTDATA))
           (CONSTANT (fetch (LINEDATA CONSTANT) of OBJECTDATA))
           STREAMSLOPE STREAMCONSTANT STREAMPT1 STREAMPT2 X1 Y1 X2 Y2)
          (SETQ X1 (COND
                      (INFINITESLOPE? CONSTANT)
                      (T XLOWER)))
          [SETQ Y1 (COND
                      (INFINITESLOPE? YLOWER)
                      (T (FPLUS CONSTANT (FTIMES SLOPE X1]
          (SETQ X2 (COND
                      (INFINITESLOPE? CONSTANT)
                      (T XUPPER)))
          [SETQ Y2 (COND
                      (INFINITESLOPE? YUPPER)
                      (T (FPLUS CONSTANT (FTIMES SLOPE X2]
          [SETQ STREAMSLOPE (AND (NOT INFINITESLOPE?)
                                 (FTIMES SLOPE (FQUOTIENT (fetch (VIEWPORT WORLDTOSTREAMMY)
                                                             of VIEWPORT)
                                                      (fetch (VIEWPORT WORLDTOSTREAMMX) of VIEWPORT]
          [SETQ STREAMCONSTANT (COND
                                  (INFINITESLOPE? (WORLDTOSTREAMX CONSTANT VIEWPORT))
                                  (T (FDIFFERENCE (WORLDTOSTREAMY CONSTANT VIEWPORT)
                                            (FTIMES STREAMSLOPE (fetch (VIEWPORT WORLDTOSTREAMAX)
                                                                   of VIEWPORT]
          (SETQ STREAMPT1 (CREATEPOSITION (WORLDTOSTREAMX X1 VIEWPORT)
                                 (WORLDTOSTREAMY Y1 VIEWPORT)))
          (SETQ STREAMPT2 (CREATEPOSITION (WORLDTOSTREAMX X2 VIEWPORT)
                                 (WORLDTOSTREAMY Y2 VIEWPORT)))
          (CLIPPED.DRAWBETWEEN STREAMSUBREGION STREAMPT1 STREAMPT2 LINEWIDTH 'REPLACE STREAM COLOR 
                 DASHING)
          (COND
             ((EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              (COND
                 (STREAMSLOPE (replace (LINEDATA STREAMSLOPE) of OBJECTDATA with STREAMSLOPE))
                 (T (replace (LINEDATA STREAMSLOPE) of OBJECTDATA with 0.0)))
              (replace (LINEDATA STREAMCONSTANT) of OBJECTDATA with STREAMCONSTANT)
              (replace (LINEDATA STREAMPT1) of OBJECTDATA with STREAMPT1)
              (replace (LINEDATA STREAMPT2) of OBJECTDATA with STREAMPT2])

(DRAWPOINTOBJECT
  [LAMBDA (POINT VIEWPORT PLOT)                              (* ; "Edited  5-May-87 17:50 by jop")
          
          (* ;; "Draw a glyph at POINTPOSITION.  SYMBOL is the glyph to be drawn.")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POINT))
           (SYMBOL (fetch (POINTDATA SYMBOL) of OBJECTDATA))
           (PT (fetch (POINTDATA POINTPOSITION) of OBJECTDATA))
           (STREAMPT (WORLDTOSTREAM PT VIEWPORT)))
          (CLIPPED.PLOTAT STREAMSUBREGION STREAMPT SYMBOL STREAM)
          (if (EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              then (replace (POINTDATA STREAMPOSITION) of OBJECTDATA with STREAMPT])

(DRAWPOLYGONOBJECT
  [LAMBDA (POLYGONOBJECT VIEWPORT PLOT)                      (* ; "Edited  5-May-87 17:50 by jop")
          
          (* ;; "Draws a polygon in VIEWPORT.")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POLYGONOBJECT))
           (POINTS (fetch (POLYGONDATA POLYGONPOINTS) of OBJECTDATA))
           (STREAMPOINTS (for PT in POINTS collect (WORLDTOSTREAM PT VIEWPORT)))
           (STYLE (fetch (POLYGONDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (TIMES (DSPSCALE NIL STREAM)
                             (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (DASHING (fetch (PLOT.STYLE DASHING) of STYLE))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (bind (START ← (CAR STREAMPOINTS)) first (MOVETO (fetch XCOORD of START)
                                                          (fetch YCOORD of START)
                                                          STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'REPLACE STREAM COLOR DASHING) finally (CLIPPED.DRAWTO STREAMSUBREGION
                                                                     (fetch XCOORD of START)
                                                                     (fetch YCOORD of START)
                                                                     LINEWIDTH
                                                                     'REPLACE STREAM COLOR DASHING))
          (if (EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              then (replace (POLYGONDATA STREAMPOINTS) of OBJECTDATA with STREAMPOINTS])

(DRAWTEXTOBJECT
  [LAMBDA (TEXTOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:51 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of TEXTOBJECT))
           (TEXT (fetch (TEXTDATA TEXT) of OBJECTDATA))
           (FONT (fetch (TEXTDATA FONT) of OBJECTDATA))
           (PT (fetch (TEXTDATA TEXTPOSITION) of OBJECTDATA))
           STREAMX STREAMY)
          (SETQ STREAMX (WORLDTOSTREAMX (fetch XCOORD of PT)
                               VIEWPORT))
          (SETQ STREAMY (WORLDTOSTREAMY (fetch YCOORD of PT)
                               VIEWPORT))
          (RESETLST (RESETSAVE (DSPFONT FONT STREAM)
                           (LIST 'DSPFONT (DSPFONT NIL STREAM)
                                 STREAM))
                 (MOVETO STREAMX STREAMY STREAM)
                 (CLIPPED.PRIN1 STREAMSUBREGION TEXT STREAM))
          (COND
             ((EQ STREAM (WINDOWPROP (fetch (PLOT PLOTWINDOW) of PLOT)
                                'DSP))
              (replace (TEXTDATA STREAMPOSITION) of OBJECTDATA with (CREATEPOSITION STREAMX STREAMY])

(ERASECOMPOUNDOBJECT
  [LAMBDA (COMPOUNDOBJECT VIEWPORT PLOT)                     (* edited%: "27-Mar-86 21:26")
    (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of (fetch (PLOTOBJECT OBJECTDATA) of 
                                                                                       COMPOUNDOBJECT
                                                              )) do (ERASEPLOTOBJECT OBJECT PLOT])

(ERASECURVEOBJECT
  [LAMBDA (CURVEOBJECT VIEWPORT)                             (* ; "Edited  5-May-87 17:51 by jop")
          
          (* ;; "Erase the CURVEOBJECT, using the cached stream coordinates")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of CURVEOBJECT))
           (STREAMPOINTS (fetch (CURVEDATA STREAMPOINTS) of OBJECTDATA))
           (STYLE (fetch (CURVEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOINTS))
                        (fetch YCOORD of (CAR STREAMPOINTS))
                        STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'ERASE STREAM COLOR])

(ERASEFILLEDRECTANGLEOBJECT
  [LAMBDA (FILLEDRECTANGLE VIEWPORT PLOT)                    (* ; "Edited  5-May-87 17:51 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of FILLEDRECTANGLE))
           (TEXTURE (fetch (FILLEDRECTANGLEDATA TEXTURE) of OBJECTDATA))
           (BORDERWIDTH (TIMES (DSPSCALE NIL STREAM)
                               (fetch (FILLEDRECTANGLEDATA BORDERWIDTH) of OBJECTDATA)))
           (STREAMLEFT (fetch (FILLEDRECTANGLEDATA STREAMLEFT) of OBJECTDATA))
           (STREAMBOTTOM (fetch (FILLEDRECTANGLEDATA STREAMBOTTOM) of OBJECTDATA))
           (STREAMWIDTH (fetch (FILLEDRECTANGLEDATA STREAMWIDTH) of OBJECTDATA))
           (STREAMHEIGHT (fetch (FILLEDRECTANGLEDATA STREAMHEIGHT) of OBJECTDATA))
           (STREAMRIGHT (fetch (FILLEDRECTANGLEDATA STREAMRIGHT) of OBJECTDATA))
           (STREAMTOP (fetch (FILLEDRECTANGLEDATA STREAMTOP) of OBJECTDATA)))
          (MOVETO STREAMLEFT STREAMBOTTOM STREAM)
          (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM STREAMLEFT STREAMBOTTOM STREAMWIDTH 
                 STREAMHEIGHT 'TEXTURE 'INVERT TEXTURE)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMBOTTOM BORDERWIDTH 'ERASE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMTOP BORDERWIDTH 'ERASE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMTOP BORDERWIDTH 'ERASE STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMBOTTOM BORDERWIDTH 'ERASE STREAM])

(ERASEGRAPHOBJECT
  [LAMBDA (GRAPHOBJECT VIEWPORT)                             (* ; "Edited  5-May-87 17:51 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of GRAPHOBJECT))
           (STREAMPOSITIONS (fetch (GRAPHDATA STREAMPOSITIONS) of OBJECTDATA))
           (STYLE (fetch (GRAPHDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOSITIONS))
                        (fetch YCOORD of (CAR STREAMPOSITIONS))
                        STREAM) for PT in (CDR STREAMPOSITIONS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'ERASE STREAM COLOR])

(ERASELINEOBJECT
  [LAMBDA (LINEOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:51 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of LINEOBJECT))
           (STYLE (fetch (LINEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                             2))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE))
           (STREAMPT1 (fetch (LINEDATA STREAMPT1) of OBJECTDATA))
           (STREAMPT2 (fetch (LINEDATA STREAMPT2) of OBJECTDATA)))
          (CLIPPED.DRAWBETWEEN STREAMSUBREGION STREAMPT1 STREAMPT2 LINEWIDTH 'ERASE STREAM COLOR])

(ERASEPOINTOBJECT
  [LAMBDA (POINT VIEWPORT PLOT)                              (* ; "Edited  5-May-87 17:51 by jop")
          
          (* ;; "Erase POINT, using cached stream coordinates")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POINT))
           (SYMBOL (fetch (POINTDATA SYMBOL) of OBJECTDATA))
           (STREAMPT (fetch (POINTDATA STREAMPOSITION) of OBJECTDATA)))
          (CLIPPED.PLOTAT STREAMSUBREGION STREAMPT SYMBOL STREAM 'ERASE])

(ERASEPOLYGONOBJECT
  [LAMBDA (POLYGONOBJECT VIEWPORT)                           (* ; "Edited  5-May-87 17:52 by jop")
          
          (* ;; "Erase a POLYGONDATA")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POLYGONOBJECT))
           (STREAMPOINTS (fetch (POLYGONDATA STREAMPOINTS) of OBJECTDATA))
           (STYLE (fetch (POLYGONDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (bind (START ← (CAR STREAMPOINTS)) first (MOVETO (fetch XCOORD of START)
                                                          (fetch YCOORD of START)
                                                          STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'ERASE STREAM COLOR) finally (CLIPPED.DRAWTO STREAMSUBREGION
                                                           (fetch XCOORD of START)
                                                           (fetch YCOORD of START)
                                                           LINEWIDTH
                                                           'ERASE STREAM COLOR])

(ERASETEXTOBJECT
  [LAMBDA (TEXTOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:52 by jop")
          
          (* ;; "ERASE the TEXTDATA")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of TEXTOBJECT))
           (TEXT (fetch (TEXTDATA TEXT) of OBJECTDATA))
           (FONT (fetch (TEXTDATA FONT) of OBJECTDATA))
           (STREAMPOSITION (fetch (TEXTDATA STREAMPOSITION) of OBJECTDATA))
           (STREAMX (fetch XCOORD of STREAMPOSITION))
           (STREAMY (fetch YCOORD of STREAMPOSITION))
           BLANCREGION)
          (RESETLST (RESETSAVE (DSPFONT FONT STREAM)
                           (LIST 'DSPFONT (DSPFONT NIL STREAM)
                                 STREAM))
                 (MOVETO STREAMX STREAMY STREAM)
                 (SETQ BLANCREGION (STRINGREGION TEXT STREAM))
                 (with REGION BLANCREGION (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM LEFT 
                                                 BOTTOM WIDTH HEIGHT 'TEXTURE])

(EXTENTOFCOMPOUND
  [LAMBDA (COMPOUNDOBJECT)                                   (* ; "Edited  5-May-87 17:52 by jop")

    (bind (CMINX ← MAX.FLOAT)
          (CMAXX ← MIN.FLOAT)
          (CMINY ← MAX.FLOAT)
          (CMAXY ← MIN.FLOAT)
          PEXTENT for PART in (fetch (COMPOUNDDATA COMPONENTS) of (fetch OBJECTDATA of COMPOUNDOBJECT
                                                                         ))
       declare (TYPE FLOATING CMINX CMAXX CMINY CMAXY)
       do (SETQ PEXTENT (EXTENTOFPLOTOBJECT PART))
          (if (LESSP (fetch MINX of PEXTENT)
                     CMINX)
              then (SETQ CMINX (fetch MINX of PEXTENT)))
          (if (GREATERP (fetch MAXX of PEXTENT)
                     CMAXX)
              then (SETQ CMAXX (fetch MAXX of PEXTENT)))
          (if (LESSP (fetch MINY of PEXTENT)
                     CMINY)
              then (SETQ CMINY (fetch MINY of PEXTENT)))
          (if (GREATERP (fetch MAXY of PEXTENT)
                     CMAXY)
              then (SETQ CMAXY (fetch MAXY of PEXTENT)))
       finally (RETURN (create EXTENT
                              MINX ← CMINX
                              MAXX ← CMAXX
                              MINY ← CMINY
                              MAXY ← CMAXY])

(EXTENTOFCURVE
  [LAMBDA (CURVEOBJECT)                                      (* ; "Edited  5-May-87 17:52 by jop")

    (bind (MINX ← MAX.FLOAT)
          (MAXX ← MIN.FLOAT)
          (MINY ← MAX.FLOAT)
          (MAXY ← MIN.FLOAT)
          X Y for POSITION in (fetch (CURVEDATA CURVEPOINTS) of (fetch OBJECTDATA of CURVEOBJECT))
       declare (TYPE FLOATING MINX MAXX MINY MAXY X Y) do (SETQ X (fetch XCOORD of POSITION))
                                                          (SETQ Y (fetch YCOORD of POSITION))
                                                          (COND
                                                             ((FLESSP X MINX)
                                                              (SETQ MINX X)))
                                                          (COND
                                                             ((FGREATERP X MAXX)
                                                              (SETQ MAXX X)))
                                                          (COND
                                                             ((FLESSP Y MINY)
                                                              (SETQ MINY Y)))
                                                          (COND
                                                             ((FGREATERP Y MAXY)
                                                              (SETQ MAXY Y)))
       finally (RETURN (create EXTENT
                              MINX ← MINX
                              MAXX ← MAXX
                              MINY ← MINY
                              MAXY ← MAXY])

(EXTENTOFFILLEDRECTANGLE
  [LAMBDA (FILLEDRECTANGLE)                                  (* edited%: "21-May-85 15:29")
    (create EXTENT
           MINX ← (fetch (FILLEDRECTANGLEDATA OBJECTLEFT) of (fetch OBJECTDATA of FILLEDRECTANGLE))
           MAXX ← (fetch (FILLEDRECTANGLEDATA OBJECTRIGHT) of (fetch OBJECTDATA of FILLEDRECTANGLE))
           MINY ← (fetch (FILLEDRECTANGLEDATA OBJECTBOTTOM) of (fetch OBJECTDATA of FILLEDRECTANGLE))
           MAXY ← (fetch (FILLEDRECTANGLEDATA OBJECTTOP) of (fetch OBJECTDATA of FILLEDRECTANGLE])

(EXTENTOFGRAPH
  [LAMBDA (GRAPHOBJECT)                                      (* ; "Edited  5-May-87 17:53 by jop")

    (create EXTENT
           MINX ← MAX.FLOAT
           MAXX ← MIN.FLOAT
           MINY ← MAX.FLOAT
           MAXY ← MIN.FLOAT])

(EXTENTOFLINE
  [LAMBDA (LINEOBJECT)                                       (* jop%: " 5-Mar-85 14:03")
    (create EXTENT
           MINX ← MAX.FLOAT
           MAXX ← MIN.FLOAT
           MINY ← MAX.FLOAT
           MAXY ← MIN.FLOAT])

(EXTENTOFPOINT
  [LAMBDA (POINT)                                            (* edited%: "21-May-85 15:28")
    (PROG [(POSITION (fetch (POINTDATA POINTPOSITION) of (fetch OBJECTDATA of POINT]
          (RETURN (create EXTENT
                         MINX ← (fetch XCOORD of POSITION)
                         MAXX ← (fetch XCOORD of POSITION)
                         MINY ← (fetch YCOORD of POSITION)
                         MAXY ← (fetch YCOORD of POSITION])

(EXTENTOFPOLYGON
  [LAMBDA (POLYGONOBJECT)                                    (* ; "Edited  5-May-87 17:53 by jop")

    (bind (MINX ← MAX.FLOAT)
          (MAXX ← MIN.FLOAT)
          (MINY ← MAX.FLOAT)
          (MAXY ← MIN.FLOAT)
          X Y for POSITION in (fetch POLYGONPOINTS of (fetch OBJECTDATA of POLYGONOBJECT))
       declare (TYPE FLOATING MINX MAXX MINY MAXY X Y) do (SETQ X (fetch XCOORD of POSITION))
                                                          (SETQ Y (fetch YCOORD of POSITION))
                                                          (if (FLESSP X MINX)
                                                              then (SETQ MINX X))
                                                          (if (FGREATERP X MAXX)
                                                              then (SETQ MAXX X))
                                                          (if (FLESSP Y MINY)
                                                              then (SETQ MINY Y))
                                                          (if (FGREATERP Y MAXY)
                                                              then (SETQ MAXY Y))
       finally (RETURN (create EXTENT
                              MINX ← MINX
                              MAXX ← MAXX
                              MINY ← MINY
                              MAXY ← MAXY])

(EXTENTOFTEXT
  [LAMBDA (TEXTOBJECT)                                       (* ; "Edited  5-May-87 17:53 by jop")

    (PROG [(POSITION (fetch TEXTPOSITION of (fetch OBJECTDATA of TEXTOBJECT]
          (RETURN (create EXTENT
                         MINX ← (fetch XCOORD of POSITION)
                         MAXX ← (fetch XCOORD of POSITION)
                         MINY ← (fetch YCOORD of POSITION)
                         MAXY ← (fetch YCOORD of POSITION])

(GETCOMPOUND
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:53 by jop")
          
          (* ;; "GETFN for COMPOUND objects")

    (create COMPOUNDDATA
           COMPOUNDTYPE ← (LISTGET PROPLST 'COMPOUNDTYPE)
           COMPONENTS ← (LISTGET PROPLST 'COMPONENTS])

(GETCURVE
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:54 by jop")
          
          (* ;; "GETFN for CURVE objects")

    (PROG [(STYLELST (LISTGET PROPLST 'STYLE]
          (RETURN (create CURVEDATA
                         CURVEPOINTS ← (LISTGET PROPLST 'CURVEPOINTS)
                         STYLE ← (create PLOT.STYLE
                                        LINEWIDTH ← (CAR STYLELST)
                                        DASHING ← (CADR STYLELST)
                                        COLOR ← (CADDR STYLELST])

(GETFILLEDRECTANGLE
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:54 by jop")
          
          (* ;; "GETFN for FILLEDRECTANGLE objects")

    (create FILLEDRECTANGLEDATA
           OBJECTLEFT ← (LISTGET PROPLST 'OBJECTLEFT)
           OBJECTBOTTOM ← (LISTGET PROPLST 'OBJECTBOTTOM)
           OBJECTWIDTH ← (LISTGET PROPLST 'OBJECTWIDTH)
           OBJECTHEIGHT ← (LISTGET PROPLST 'OBJECTHEIGHT)
           BORDERWIDTH ← (LISTGET PROPLST 'BORDERWIDTH)
           TEXTURE ← (LISTGET PROPLST 'TEXTURE])

(GETGENERIC
  [LAMBDA (EXPR)                                             (* jop%: "27-Aug-85 17:11")
    EXPR])

(GETGRAPH
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:54 by jop")

    (PROG [(STYLELST (LISTGET PROPLST 'STYLE]
          (RETURN (create GRAPHDATA
                         GRAPHFN ← (LISTGET PROPLST 'GRAPHFN)
                         NSAMPLES ← (LISTGET PROPLST 'NSAMPLES)
                         STYLE ← (create PLOT.STYLE
                                        LINEWIDTH ← (CAR STYLELST)
                                        DASHING ← (CADR STYLELST)
                                        COLOR ← (CADDR STYLELST])

(GETLINE
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:54 by jop")
          
          (* ;; "GETFN for LINE objects")

    (PROG [(STYLELST (LISTGET PROPLST 'STYLE]
          (RETURN (create LINEDATA
                         INFINITESLOPE? ← (LISTGET PROPLST 'INFINITESLOPE?)
                         SLOPE ← (LISTGET PROPLST 'SLOPE)
                         CONSTANT ← (LISTGET PROPLST 'CONSTANT)
                         STYLE ← (create PLOT.STYLE
                                        LINEWIDTH ← (CAR STYLELST)
                                        DASHING ← (CADR STYLELST)
                                        COLOR ← (CADDR STYLELST])

(GETPOINT
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:54 by jop")
          
          (* ;; "Putfn for POINT objects")

    (create POINTDATA
           POINTPOSITION ← (LISTGET PROPLST 'POINTPOSITION)
           SYMBOL ← (LET [(SYMBOL (LISTGET PROPLST 'SYMBOL]
                         (if (LITATOM SYMBOL)
                             then (EVAL SYMBOL)
                           else SYMBOL])

(GETPOLYGON
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:55 by jop")
          
          (* ;; "GETFN for POLYGON objects")

    (PROG [(STYLELST (LISTGET PROPLST 'STYLE]
          (RETURN (create POLYGONDATA
                         POLYGONPOINTS ← (LISTGET PROPLST 'POLYGONPOINTS)
                         STYLE ← (create PLOT.STYLE
                                        LINEWIDTH ← (CAR STYLELST)
                                        DASHING ← (CADR STYLELST)
                                        COLOR ← (CADDR STYLELST])

(GETTEXT
  [LAMBDA (PROPLST)                                          (* ; "Edited  5-May-87 17:55 by jop")
          
          (* ;; "GETFN for TEXT objects")

    (create TEXTDATA
           TEXTPOSITION ← (LISTGET PROPLST 'TEXTPOSITION)
           TEXT ← (LISTGET PROPLST 'TEXT)
           FONT ← (LISTGET PROPLST 'FONT])

(HIGHLIGHTCOMPOUND
  [LAMBDA (COMPOUNDOBJECT VIEWPORT PLOT)                     (* edited%: "27-Mar-86 21:26")
    (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of (fetch (PLOTOBJECT OBJECTDATA) of 
                                                                                       COMPOUNDOBJECT
                                                              )) do (HIGHLIGHTPLOTOBJECT OBJECT PLOT])

(HIGHLIGHTCURVE
  [LAMBDA (CURVEOBJECT VIEWPORT PLOT)                        (* ; "Edited  5-May-87 17:55 by jop")
          
          (* ;; "Highlight the CURVEOBJECT, by redrawing in invert mode with fatter lines")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of CURVEOBJECT))
           (STREAMPOINTS (fetch (CURVEDATA STREAMPOINTS) of OBJECTDATA))
           (STYLE (fetch (CURVEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOINTS))
                        (fetch YCOORD of (CAR STREAMPOINTS))
                        STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'INVERT STREAM COLOR])

(HIGHLIGHTFILLEDRECTANGLE
  [LAMBDA (FILLEDRECTANGLE VIEWPORT PLOT)                    (* ; "Edited  5-May-87 17:55 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of FILLEDRECTANGLE))
           (BORDERWIDTH (IPLUS 2 (OR (fetch (FILLEDRECTANGLEDATA BORDERWIDTH) of OBJECTDATA)
                                     1)))
           (STREAMLEFT (fetch (FILLEDRECTANGLEDATA STREAMLEFT) of OBJECTDATA))
           (STREAMBOTTOM (fetch (FILLEDRECTANGLEDATA STREAMBOTTOM) of OBJECTDATA))
           (STREAMWIDTH (fetch (FILLEDRECTANGLEDATA STREAMWIDTH) of OBJECTDATA))
           (STREAMHEIGHT (fetch (FILLEDRECTANGLEDATA STREAMHEIGHT) of OBJECTDATA))
           (STREAMRIGHT (fetch (FILLEDRECTANGLEDATA STREAMRIGHT) of OBJECTDATA))
           (STREAMTOP (fetch (FILLEDRECTANGLEDATA STREAMTOP) of OBJECTDATA)))
          (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM STREAMLEFT STREAMBOTTOM STREAMWIDTH 
                 STREAMHEIGHT 'TEXTURE 'INVERT BLACKSHADE)
          (MOVETO STREAMLEFT STREAMBOTTOM STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMBOTTOM BORDERWIDTH 'INVERT STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMRIGHT STREAMTOP BORDERWIDTH 'INVERT STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMTOP BORDERWIDTH 'INVERT STREAM)
          (CLIPPED.DRAWTO STREAMSUBREGION STREAMLEFT STREAMBOTTOM BORDERWIDTH 'INVERT STREAM])

(HIGHLIGHTGRAPH
  [LAMBDA (GRAPHOBJECT VIEWPORT PLOT)                        (* ; "Edited  5-May-87 17:55 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of GRAPHOBJECT))
           (STREAMPOSITIONS (fetch (GRAPHDATA STREAMPOSITIONS) of OBJECTDATA))
           (STYLE (fetch (GRAPHDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (first (MOVETO (fetch XCOORD of (CAR STREAMPOSITIONS))
                        (fetch YCOORD of (CAR STREAMPOSITIONS))
                        STREAM) for PT in (CDR STREAMPOSITIONS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'INVERT STREAM COLOR])

(HIGHLIGHTLINE
  [LAMBDA (LINEOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:55 by jop")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of LINEOBJECT))
           (STYLE (fetch (LINEDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                             2))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE))
           (STREAMPT1 (fetch (LINEDATA STREAMPT1) of OBJECTDATA))
           (STREAMPT2 (fetch (LINEDATA STREAMPT2) of OBJECTDATA)))
          (CLIPPED.DRAWBETWEEN STREAMSUBREGION STREAMPT1 STREAMPT2 LINEWIDTH 'INVERT STREAM COLOR])

(HIGHLIGHTPOINT
  [LAMBDA (POINT VIEWPORT PLOT)                              (* ; "Edited  5-May-87 17:56 by jop")
          
          (* ;; "Highlight POINT")

    (LET* [(STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POINT))
           (SYMBOL (fetch (POINTDATA SYMBOL) of OBJECTDATA))
           (STREAMPT (fetch (POINTDATA STREAMPOSITION) of OBJECTDATA))
           (WIDTHGLYPH (BITMAPWIDTH SYMBOL))
           (HEIGHTGLYPH (BITMAPHEIGHT SYMBOL))
           (OFFSETX (IDIFFERENCE (fetch XCOORD of STREAMPT)
                           (IQUOTIENT WIDTHGLYPH 2)))
           (OFFSETY (IDIFFERENCE (fetch YCOORD of STREAMPT)
                           (IQUOTIENT HEIGHTGLYPH 2]
          (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM OFFSETX OFFSETY WIDTHGLYPH HEIGHTGLYPH
                 'TEXTURE
                 'INVERT BLACKSHADE])

(HIGHLIGHTPOLYGON
  [LAMBDA (POLYGONOBJECT VIEWPORT PLOT)                      (* ; "Edited  5-May-87 17:56 by jop")
          
          (* ;; "Highlight a Polygon")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POLYGONOBJECT))
           (STREAMPOINTS (fetch (POLYGONDATA STREAMPOINTS) of OBJECTDATA))
           (STYLE (fetch (POLYGONDATA STYLE) of OBJECTDATA))
           (LINEWIDTH (IPLUS 2 (fetch (PLOT.STYLE LINEWIDTH) of STYLE)))
           (COLOR (fetch (PLOT.STYLE COLOR) of STYLE)))
          (bind (START ← (CAR STREAMPOINTS)) first (MOVETO (fetch XCOORD of START)
                                                          (fetch YCOORD of START)
                                                          STREAM) for PT in (CDR STREAMPOINTS)
             do (CLIPPED.DRAWTO STREAMSUBREGION (fetch XCOORD of PT)
                       (fetch YCOORD of PT)
                       LINEWIDTH
                       'INVERT STREAM COLOR) finally (CLIPPED.DRAWTO STREAMSUBREGION
                                                            (fetch XCOORD of START)
                                                            (fetch YCOORD of START)
                                                            LINEWIDTH
                                                            'INVERT STREAM COLOR])

(HIGHLIGHTTEXT
  [LAMBDA (TEXTOBJECT VIEWPORT PLOT)                         (* ; "Edited  5-May-87 17:56 by jop")
          
          (* ;; "HIGHLIGHT the TEXTDATA")

    (LET* ((STREAM (fetch (VIEWPORT PARENTSTREAM) of VIEWPORT))
           (STREAMSUBREGION (fetch (VIEWPORT STREAMSUBREGION) of VIEWPORT))
           (OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of TEXTOBJECT))
           (TEXT (fetch (TEXTDATA TEXT) of OBJECTDATA))
           (FONT (fetch (TEXTDATA FONT) of OBJECTDATA))
           (STREAMPOSITION (fetch (TEXTDATA STREAMPOSITION) of OBJECTDATA))
           (STREAMX (fetch XCOORD of STREAMPOSITION))
           (STREAMY (fetch YCOORD of STREAMPOSITION))
           BLANCREGION)
          (RESETLST (RESETSAVE (DSPFONT FONT STREAM)
                           (LIST 'DSPFONT (DSPFONT NIL STREAM)
                                 STREAM))
                 (MOVETO STREAMX STREAMY STREAM)
                 (SETQ BLANCREGION (STRINGREGION TEXT STREAM))
                 (with REGION BLANCREGION (CLIPPED.BITBLT STREAMSUBREGION NIL NIL NIL STREAM LEFT 
                                                 BOTTOM WIDTH HEIGHT 'TEXTURE 'INVERT BLACKSHADE])

(LABELGENERIC
  [LAMBDA (OBJECT PLOT)                                      (* ; "Edited  5-May-87 17:56 by jop")
          
          (* ;; "Generic label routine.  Intended for interactive use only")

    (PROG ((LABEL (fetch OBJECTLABEL of OBJECT))
           (VIEWPORT (fetch PLOTWINDOWVIEWPORT of PLOT))
           (TEXTOBJECT (PLOTOBJECTPROP OBJECT 'LABEL))
           LABELPOSITION)
          (COND
             (TEXTOBJECT (DRAWPLOTOBJECT TEXTOBJECT VIEWPORT PLOT))
             (T (PLOTPROMPT (CONCAT "SELECT A POSITION FOR LABEL " LABEL)
                       PLOT)
                (SETQ LABELPOSITION (STREAMTOWORLD (GETPOSITION (fetch PLOTWINDOW of PLOT))
                                           VIEWPORT))
                (SETQ TEXTOBJECT (CREATETEXT LABELPOSITION LABEL NIL SMALLPLOTFONT))
                (DRAWPLOTOBJECT TEXTOBJECT VIEWPORT PLOT)
                (PLOTOBJECTPROP OBJECT 'LABEL TEXTOBJECT])

(LABELPOINT
  [LAMBDA (POINT PLOT)                                       (* ; "Edited  5-May-87 17:56 by jop")
          
          (* ;; "Label a POINT")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of POINT))
           (VIEWPORT (fetch (PLOT PLOTWINDOWVIEWPORT) of PLOT))
           (LABEL (fetch (PLOTOBJECT OBJECTLABEL) of POINT))
           (TEXTOBJECT (PLOTOBJECTPROP POINT 'LABEL))
           SYMBOL LABELPOSITION)
          (SETQ LABELPOSITION (create POSITION using (fetch (POINTDATA POINTPOSITION) of OBJECTDATA))
           )
          (SETQ SYMBOL (fetch (POINTDATA SYMBOL) of OBJECTDATA))
                                                             (* ; 
                                                            "Displace Label to right of point object")

          (if TEXTOBJECT
              then (DRAWPLOTOBJECT TEXTOBJECT VIEWPORT PLOT)
            else [replace XCOORD of LABELPOSITION with (PLUS (fetch XCOORD of LABELPOSITION)
                                                             (TIMES 2 (STREAMTOWORLDXLENGTH
                                                                       (BITMAPWIDTH SYMBOL)
                                                                       VIEWPORT]
                 (SETQ TEXTOBJECT (CREATETEXT LABELPOSITION LABEL NIL SMALLPLOTFONT))
                 (DRAWPLOTOBJECT TEXTOBJECT VIEWPORT PLOT)   (* ; 
                                                             "CACHE LABEL ON PROP LIST OF OBJECT")

                 (PLOTOBJECTPROP POINT 'LABEL TEXTOBJECT])

(LABELTEXT
  [LAMBDA (TEXTOBJECT PLOT)                                  (* jop%: "20-Feb-86 17:56")
    (PLOTPROMPT "Cannot label text" PLOT])

(LOWLIGHTCOMPOUND
  [LAMBDA (COMPOUNDOBJECT VIEWPORT PLOT)                     (* edited%: "27-Mar-86 21:27")
    (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of (fetch (PLOTOBJECT OBJECTDATA) of 
                                                                                       COMPOUNDOBJECT
                                                              )) do (LOWLIGHTPLOTOBJECT OBJECT PLOT])

(MOVECOMPOUND
  [LAMBDA (COMPOUNDOBJECT DX DY PLOT)                        (* edited%: "27-Mar-86 21:27")
    (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of (fetch OBJECTDATA of COMPOUNDOBJECT))
       do (MOVEPLOTOBJECT OBJECT DX DY PLOT])

(MOVECURVE
  [LAMBDA (CURVEOBJECT DX DY PLOT)                           (* jop%: " 8-Dec-85 18:35")
    (PROG [(POINTS (fetch (CURVEDATA CURVEPOINTS) of (fetch OBJECTDATA of CURVEOBJECT]
          (for POINT in POINTS do (replace XCOORD of POINT with (PLUS DX (fetch XCOORD of POINT)))
                                  (replace YCOORD of POINT with (PLUS DY (fetch YCOORD of POINT])

(MOVEFILLEDRECTANGLE
  [LAMBDA (FILLEDRECTANGLEOBJECT DX DY PLOT)                 (* edited%: "18-May-85 16:32")
    (PROG ((OBJECTDATA (fetch OBJECTDATA of FILLEDRECTANGLEOBJECT)))
          (replace OBJECTLEFT of OBJECTDATA with (PLUS DX (fetch OBJECTLEFT of OBJECTDATA)))
          (replace OBJECTBOTTOM of OBJECTDATA with (PLUS DY (fetch OBJECTBOTTOM of OBJECTDATA])

(MOVELINE
  [LAMBDA (LINEOBJECT DX DY PLOT)                            (* edited%: "18-May-85 16:58")
    (PROG ((OBJECTDATA (fetch OBJECTDATA of LINEOBJECT)))
          (replace CONSTANT of OBJECTDATA
             with (if (fetch INFINITESLOPE? of OBJECTDATA)
                      then (PLUS DX (fetch CONSTANT of OBJECTDATA))
                    else (DIFFERENCE (PLUS (fetch CONSTANT of OBJECTDATA)
                                           (TIMES DX (fetch SLOPE of OBJECTDATA)))
                                DY])

(MOVEPOINT
  [LAMBDA (POINT DX DY PLOT)                                 (* jop%: "24-Feb-86 14:43")
    (PROG [(POSITION (fetch (POINTDATA POINTPOSITION) of (fetch (PLOTOBJECT OBJECTDATA) of POINT]
          (replace XCOORD of POSITION with (PLUS DX (fetch XCOORD of POSITION)))
          (replace YCOORD of POSITION with (PLUS DY (fetch YCOORD of POSITION])

(MOVEPOLYGON
  [LAMBDA (POLYGONOBJECT DX DY PLOT)                         (* edited%: "18-May-85 16:16")
    (PROG [(POINTS (fetch POLYGONPOINTS of (fetch OBJECTDATA of POLYGONOBJECT]
          (for POINT in POINTS do (replace XCOORD of POINT with (PLUS DX (fetch XCOORD of POINT)))
                                  (replace YCOORD of POINT with (PLUS DY (fetch YCOORD of POINT])

(MOVETEXT
  [LAMBDA (TEXTOBJECT DX DY PLOT)                            (* edited%: "18-May-85 17:05")
    (PROG [(POSITION (fetch TEXTPOSITION of (fetch OBJECTDATA of TEXTOBJECT]
          (replace XCOORD of POSITION with (PLUS DX (fetch XCOORD of POSITION)))
          (replace YCOORD of POSITION with (PLUS DY (fetch YCOORD of POSITION])

(PLOTCOMPOUND
  [LAMBDA ARGS                                               (* ; "Edited  5-May-87 17:57 by jop")
          
          (* ;; "ADD A COMPOUND OBJECT with an unknown number of COMPONENTS.  First arg must be a PLOT.  Second arg must be the compound object type.  Next are the Nospread COMPONENTS, then the optional LABEL, MENU, and NODRAWFLG")

    (if (LESSP ARGS 3)
        then (HELP "Must have at least 3 args. Plot, compound type, and one component"))
    (PROG ((PLOT (ARG ARGS 1))
           (COMPOUNDTYPE (ARG ARGS 2))
           COMPONENTS STARTRESTARGS)
          (if (NOT (type? PLOT PLOT))
              then (HELP "NOT a PLOT " PLOT))
          (SETQ COMPONENTS (for I from 3 to ARGS while (type? PLOTOBJECT (ARG ARGS I))
                              collect (ARG ARGS I)))
          (SETQ STARTRESTARGS (PLUS 3 (LENGTH COMPONENTS)))
          (RETURN (ADDPLOTOBJECT [CREATECOMPOUND COMPOUNDTYPE COMPONENTS
                                        (if (GEQ ARGS STARTRESTARGS)
                                            then (ARG ARGS STARTRESTARGS))
                                        (if (GEQ ARGS (PLUS 1 STARTRESTARGS))
                                            then (ARG ARGS (PLUS 1 STARTRESTARGS]
                         PLOT
                         (if (GEQ ARGS (PLUS 2 STARTRESTARGS))
                             then (ARG ARGS (PLUS 2 STARTRESTARGS])

(PLOTCURVE
  [LAMBDA (PLOT POSITIONS LABEL STYLE MENU NODRAWFLG)        (* ; "Edited  5-May-87 17:57 by jop")
          
          (* ;; "User Entry Point.  Draw a piecewise linear curve in a Plotting WINDOW.  Style is either the line width to use or a list (width dashing color) or an instance of PLOT.STYLE.  POSITIONS is a list of positions to be contected.")

    (COND
       ((NOT (type? PLOT PLOT))
        (HELP "NOT a PLOT " PLOT)))
    (ADDPLOTOBJECT (CREATECURVE POSITIONS LABEL STYLE MENU)
           PLOT NODRAWFLG])

(PLOTFILLEDRECTANGLE
  [LAMBDA (PLOT LEFT BOTTOM WIDTH HEIGHT LABEL TEXTURE BORDERWIDTH MENU NODRAWFLG)
                                                             (* ; "Edited  5-May-87 17:57 by jop")
          
          (* ;; 
   "User Entry Point.  Draw a FILLEDRECTANGLE in a Plotting WINDOW.  Style is the line width to use.")

    (if (NOT (type? PLOT PLOT))
        then (HELP "NOT a PLOT " PLOT))
    (if (NULL TEXTURE)
        then (SETQ TEXTURE SHADE3))
    (ADDPLOTOBJECT (CREATEFILLEDRECTANGLE LEFT BOTTOM WIDTH HEIGHT LABEL TEXTURE BORDERWIDTH MENU)
           PLOT NODRAWFLG])

(PLOTGRAPH
  [LAMBDA (PLOT GRAPHFN NSAMPLES LABEL STYLE MENU NODRAWFLG) (* ; "Edited  5-May-87 17:58 by jop")
          
          (* ;; "User Entry Point.")

    (if (NOT (type? PLOT PLOT))
        then (HELP "NOT a PLOT " PLOT))
    (ADDPLOTOBJECT (CREATEGRAPH GRAPHFN NSAMPLES LABEL STYLE MENU)
           PLOT NODRAWFLG])

(PLOTLINE
  [LAMBDA (PLOT SLOPE CONSTANT LABEL STYLE MENU NODRAWFLG)   (* ; "Edited  5-May-87 17:58 by jop")
          
          (* ;; "User Entry Point.")

    (COND
       ((NOT (type? PLOT PLOT))
        (HELP "NOT a PLOT " PLOT)))
    (ADDPLOTOBJECT (CREATELINE SLOPE CONSTANT LABEL STYLE MENU)
           PLOT NODRAWFLG])

(PLOTPOINT
  [LAMBDA (PLOT POSITION LABEL SYMBOL MENU NODRAWFLG)        (* ; "Edited  5-May-87 17:58 by jop")
          
          (* ;; "User entry point.  Add a point to the plotwindow WINDOW, at world position POSITION, with Label LABEL and plotting symbol SYMBOL")

    (if (NOT (type? PLOT PLOT))
        then (HELP "NOT a PLOT " PLOT))
    (ADDPLOTOBJECT (CREATEPOINT POSITION LABEL SYMBOL MENU)
           PLOT NODRAWFLG])

(PLOTPOINTS
  [LAMBDA (PLOT POSITIONS LABELS SYMBOL MENU NODRAWFLG)      (* ; "Edited  5-May-87 17:58 by jop")
          
          (* ;; "User Entry Point.  Draw the POINTs at POSITIONS in a Plotting WINDOW.  Symbol is a LITATOM which Describes the glyph to use.")

    (if (NOT (type? PLOT PLOT))
        then (HELP "NOT a PLOT " PLOT))
    (PROG (EXTENT NEWSCALES OBJECTS)
          [SETQ EXTENT
           (bind (MINX ← MAX.FLOAT)
                 (MAXX ← MIN.FLOAT)
                 (MINY ← MAX.FLOAT)
                 (MAXY ← MIN.FLOAT) for PT in POSITIONS
              do (if (LESSP (fetch XCOORD of PT)
                            MINX)
                     then (SETQ MINX (fetch XCOORD of PT)))
                 (if (GREATERP (fetch XCOORD of PT)
                            MAXX)
                     then (SETQ MAXX (fetch XCOORD of PT)))
                 (if (LESSP (fetch YCOORD of PT)
                            MINY)
                     then (SETQ MINY (fetch YCOORD of PT)))
                 (if (GREATERP (fetch YCOORD of PT)
                            MAXY)
                     then (SETQ MAXY (fetch YCOORD of PT)))
              finally (RETURN (create EXTENT
                                     MINX ← MINX
                                     MAXX ← MAXX
                                     MINY ← MINY
                                     MAXY ← MAXY]
          (ADJUSTSCALE? EXTENT PLOT)                         (* ; 
                                          "Scale up the plot so that each ADDOBJECT need not rescale")

          [SETQ OBJECTS (bind (LABEL ← LABELS) for POSITION in POSITIONS
                           collect (PROG1 (CREATEPOINT POSITION (CAR LABEL)
                                                 SYMBOL MENU)
                                          (SETQ LABEL (CDR LABEL]
                                                             (* ; "Do surgury on the display list")

          (replace (PLOT PLOTOBJECTS) of PLOT with (APPEND OBJECTS (fetch (PLOT PLOTOBJECTS)
                                                                      of PLOT)))
          (if (NULL NODRAWFLG)
              then (REDRAWPLOTWINDOW PLOT))
          (RETURN OBJECTS])

(PLOTPOLYGON
  [LAMBDA (PLOT POSITIONS LABEL STYLE MENU NODRAWFLG)        (* ; "Edited  5-May-87 17:58 by jop")
          
          (* ;; "User Entry Point.  Draw a POLYGON in a Plotting WINDOW.  Style is the line width to use.  POSITIONS is a list of positions to be contected.")

    (if (NOT (type? PLOT PLOT))
        then (HELP "NOT a PLOT " PLOT))
    (ADDPLOTOBJECT (CREATEPOLYGON POSITIONS LABEL STYLE MENU)
           PLOT NODRAWFLG])

(PLOTTEXT
  [LAMBDA (PLOT POSITION TEXT LABEL FONT MENU NODRAWFLG)     (* edited%: "27-Mar-86 21:22")
    (COND
       ((NOT (type? PLOT PLOT))
        (HELP "NOT A PLOT " PLOT)))
    (COND
       ((NULL FONT)
        (SETQ FONT SMALLPLOTFONT)))
    (ADDPLOTOBJECT (CREATETEXT POSITION TEXT LABEL FONT MENU)
           PLOT NODRAWFLG])

(PUTCOMPOUND
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 17:59 by jop")
          
          (* ;; "PUTFN for COMPOUND objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (PRINTOUT STREAM "(" %,)
          (PRINTOUT STREAM "COMPOUNDTYPE" %, |.P2| (fetch (COMPOUNDDATA COMPOUNDTYPE) of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM "COMPONENTS (" %,)                (* ; 
                                                             "THIS ASSUMES APPROPRIATE HPRINT MACROS")

          (for OBJECT in (fetch (COMPOUNDDATA COMPONENTS) of OBJECTDATA)
             do (HPRINT OBJECT STREAM T T))
          (PRINTOUT STREAM "))"])

(PUTCURVE
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 17:59 by jop")
          
          (* ;; "Putfn for CURVE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           STYLE)
          (SETQ STYLE (fetch (CURVEDATA STYLE) of OBJECTDATA))
          (PRINTOUT STREAM "(" %, "CURVEPOINTS" %, |.P2| (fetch (CURVEDATA CURVEPOINTS) of OBJECTDATA
                                                                )
                 %, "STYLE" %, |.P2| (LIST (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                                           (fetch (PLOT.STYLE DASHING) of STYLE)
                                           (fetch (PLOT.STYLE COLOR) of STYLE))
                 %, ")"])

(PUTFILLEDRECTANGLE
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 17:59 by jop")
          
          (* ;; "PUTFN for FILLEDRECTANGLE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT)))
          (PRINTOUT STREAM "(" %,)
          (PRINTOUT STREAM "OBJECTLEFT" %, |.P2| (fetch (FILLEDRECTANGLEDATA OBJECTLEFT) of 
                                                                                           OBJECTDATA
                                                        )
                 %,)
          (PRINTOUT STREAM "OBJECTBOTTOM" %, |.P2| (fetch (FILLEDRECTANGLEDATA OBJECTBOTTOM)
                                                      of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM "OBJECTWIDTH" %, |.P2| (fetch (FILLEDRECTANGLEDATA OBJECTWIDTH)
                                                     of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM "OBJECTHEIGHT" %, |.P2| (fetch (FILLEDRECTANGLEDATA OBJECTHEIGHT)
                                                      of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM "BORDERWIDTH" %, |.P2| (fetch (FILLEDRECTANGLEDATA BORDERWIDTH)
                                                     of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM "TEXTURE" %, |.P2| (fetch (FILLEDRECTANGLEDATA TEXTURE) of OBJECTDATA)
                 %,)
          (PRINTOUT STREAM ")"])

(PUTGENERIC
  [LAMBDA (OBJECT PLOT STREAM)                               (* jop%: "27-Aug-85 17:10")
    (HPRINT (fetch OBJECTDATA of OBJECT)
           STREAM NIL T])

(PUTGRAPH
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 17:59 by jop")
          
          (* ;; "Putfn for CURVE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           STYLE)
          (SETQ STYLE (fetch (GRAPHDATA STYLE) of OBJECTDATA))
          (PRINTOUT STREAM "(" %, "GRAPHFN" %, |.P2| (fetch (GRAPHDATA GRAPHFN) of OBJECTDATA)
                 %, "NSAMPLES" %, |.P2| (fetch (GRAPHDATA NSAMPLES) of OBJECTDATA)
                 %, "STYLE" %, |.P2| (LIST (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                                           (fetch (PLOT.STYLE DASHING) of STYLE)
                                           (fetch (PLOT.STYLE COLOR) of STYLE))
                 %, ")"])

(PUTLINE
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 17:59 by jop")
          
          (* ;; "Putfn for LINE objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           STYLE)
          (SETQ STYLE (fetch (LINEDATA STYLE) of OBJECTDATA))
          (PRINTOUT STREAM "(" %, "INFINITESLOPE?" %, |.P2| (fetch (LINEDATA INFINITESLOPE?)
                                                               of OBJECTDATA)
                 %, "SLOPE" %, |.P2| (fetch (LINEDATA SLOPE) of OBJECTDATA)
                 %, "CONSTANT" %, |.P2| (fetch (LINEDATA CONSTANT) of OBJECTDATA)
                 %, "STYLE" %, |.P2| (LIST (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                                           (fetch (PLOT.STYLE DASHING) of STYLE)
                                           (fetch (PLOT.STYLE COLOR) of STYLE))
                 ")"])

(PUTPOINT
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 18:00 by jop")
          
          (* ;; "Putfn for POINT objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           SYMBOL LAB)
          (SETQ SYMBOL (fetch (POINTDATA SYMBOL) of OBJECTDATA))
          (SETQ LAB (if (EQ SYMBOL STAR)
                        then 'STAR
                      elseif (EQ SYMBOL CROSS)
                        then 'CROSS
                      elseif (EQ SYMBOL CIRCLE)
                        then 'CIRCLE))
          (PRINTOUT STREAM "(" %, "POINTPOSITION" %, |.P2| (fetch (POINTDATA POINTPOSITION)
                                                              of OBJECTDATA)
                 %, "SYMBOL" %,)
          (if LAB
              then (PRINTOUT STREAM |.P2| LAB %,)
            else (HPRINT SYMBOL STREAM T T))
          (PRINTOUT STREAM ")"])

(PUTPOLYGON
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 18:00 by jop")
          
          (* ;; "Putfn for POLYGON objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           STYLE)
          (SETQ STYLE (fetch (POLYGONDATA STYLE) of OBJECTDATA))
          (PRINTOUT STREAM "(" %, "POLYGONPOINTS" %, |.P2| (fetch (POLYGONDATA POLYGONPOINTS)
                                                              of OBJECTDATA)
                 %, "STYLE" %, |.P2| (LIST (fetch (PLOT.STYLE LINEWIDTH) of STYLE)
                                           (fetch (PLOT.STYLE DASHING) of STYLE)
                                           (fetch (PLOT.STYLE COLOR) of STYLE))
                 %, ")"])

(PUTTEXT
  [LAMBDA (PLOTOBJECT PLOT STREAM)                           (* ; "Edited  5-May-87 18:00 by jop")
          
          (* ;; "Putfn for TEXT objects")

    (PROG ((OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA) of PLOTOBJECT))
           FONT)
          (SETQ FONT (fetch (TEXTDATA FONT) of OBJECTDATA))
          (PRINTOUT STREAM "(" %, "TEXTPOSITION" %, |.P2| (fetch (TEXTDATA TEXTPOSITION) of 
                                                                                           OBJECTDATA
                                                                 )
                 %, "TEXT" %, |.P2| (fetch (TEXTDATA TEXT) of OBJECTDATA)
                 %, "FONT" %,)                               (* ; "Assumes FONT has an HPRINTMACRO")

          (HPRINT FONT STREAM T T)
          (PRINTOUT STREAM ")"])
)
(DECLARE%: EVAL@COMPILE 
[PUTPROPS L1METRIC MACRO (OPENLAMBDA (POINT1 POINT2)
                                (* jop%: "17-Jan-85 15:27")
                                
          
          (* ;; "Computes the L 1 metric between POINT1 and POINT2")

                                (PLUS (IABS (DIFFERENCE (fetch XCOORD of POINT1)
                                                   (fetch XCOORD of POINT2)))
                                      (IABS (DIFFERENCE (fetch YCOORD of POINT1)
                                                   (fetch YCOORD of POINT2]
[PUTPROPS L2METRIC MACRO (OPENLAMBDA (POINT1 POINT2 PLOT)
                                (* jop%: "17-Jan-85 15:27")
                                
          
          (* ;; "Computes the L 2 metric between POINT1 and POINT2")

                                (FPLUS (FTIMES (FDIFFERENCE (fetch XCOORD of POINT1)
                                                      (fetch XCOORD of POINT2))
                                              (FDIFFERENCE (fetch XCOORD of POINT1)
                                                     (fetch XCOORD of POINT2)))
                                       (FTIMES (FTIMES (fetch NORMCONSTANT of PLOT)
                                                      (FDIFFERENCE (fetch YCOORD of POINT1)
                                                             (fetch YCOORD of POINT2)))
                                              (FTIMES (fetch NORMCONSTANT of PLOT)
                                                     (FDIFFERENCE (fetch YCOORD of POINT1)
                                                            (fetch YCOORD of POINT2]
)

(RPAQQ CIRCLE #*(5 5)G@@@HH@@HH@@HH@@G@@@)

(RPAQQ CROSS #*(5 5)B@@@B@@@OH@@B@@@B@@@)

(RPAQQ DASH (5))

(RPAQQ DOT (1 5))

(RPAQQ DOTDASH (5 5 1 5))

(RPAQQ SHADE1 64)

(RPAQQ SHADE2 576)

(RPAQQ SHADE3 4680)

(RPAQQ SHADE4 37449)

(RPAQQ SHADE5 55899)

(RPAQQ SHADE6 31710)

(RPAQQ SHADE7 64479)

(RPAQQ SHADE8 65023)

(RPAQQ STAR #*(5 5)JH@@G@@@OH@@G@@@JH@@)
(DECLARE%: EVAL@COMPILE

(DATATYPE COMPOUNDDATA (COMPOUNDTYPE COMPONENTS))

(DATATYPE CURVEDATA (CURVEPOINTS STREAMPOINTS STYLE))

(DATATYPE FILLEDRECTANGLEDATA ((OBJECTLEFT FLOATING)
                               (OBJECTBOTTOM FLOATING)
                               (OBJECTWIDTH FLOATING)
                               (OBJECTHEIGHT FLOATING)
                               STREAMLEFT STREAMBOTTOM STREAMWIDTH STREAMHEIGHT BORDERWIDTH TEXTURE)
                              BORDERWIDTH ← 1 [ACCESSFNS ((OBJECTRIGHT (PLUS (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                     OBJECTLEFT)
                                                                                of DATUM)
                                                                             (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                     OBJECTWIDTH)
                                                                                of DATUM)))
                                                          (OBJECTTOP (PLUS (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                   OBJECTBOTTOM)
                                                                              of DATUM)
                                                                           (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                   OBJECTHEIGHT)
                                                                              of DATUM)))
                                                          (STREAMRIGHT (PLUS (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                     STREAMLEFT)
                                                                                of DATUM)
                                                                             (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                     STREAMWIDTH)
                                                                                of DATUM)))
                                                          (STREAMTOP (PLUS (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                   STREAMBOTTOM)
                                                                              of DATUM)
                                                                           (fetch (
                                                                                  FILLEDRECTANGLEDATA
                                                                                   STREAMHEIGHT)
                                                                              of DATUM])

(DATATYPE GRAPHDATA (GRAPHFN NSAMPLES STYLE STREAMPOSITIONS))

(DATATYPE LINEDATA (STYLE INFINITESLOPE? (SLOPE FLOATING)
                          (CONSTANT FLOATING)
                          (STREAMSLOPE FLOATING)
                          (STREAMCONSTANT FLOATING)
                          STREAMPT1 STREAMPT2)
                   STYLE ← 1)

(DATATYPE PLOT.STYLE (LINEWIDTH DASHING COLOR)
                     LINEWIDTH ← 1)

(DATATYPE POINTDATA (POINTPOSITION STREAMPOSITION SYMBOL)
                    SYMBOL ← STAR)

(DATATYPE POLYGONDATA (POLYGONPOINTS STREAMPOINTS STYLE)
                      STYLE ← 1)

(DATATYPE TEXTDATA (TEXTPOSITION STREAMPOSITION TEXT FONT)
                   FONT ← SMALLPLOTFONT)
)
(/DECLAREDATATYPE 'COMPOUNDDATA '(POINTER POINTER) '((COMPOUNDDATA 0 POINTER)
                                                     (COMPOUNDDATA 2 POINTER)) '4)
(/DECLAREDATATYPE 'CURVEDATA '(POINTER POINTER POINTER) '((CURVEDATA 0 POINTER)
                                                          (CURVEDATA 2 POINTER)
                                                          (CURVEDATA 4 POINTER)) '6)
(/DECLAREDATATYPE 'FILLEDRECTANGLEDATA '(FLOATP FLOATP FLOATP FLOATP POINTER POINTER POINTER POINTER 
                                               POINTER POINTER) '((FILLEDRECTANGLEDATA 0 FLOATP)
                                                                  (FILLEDRECTANGLEDATA 2 FLOATP)
                                                                  (FILLEDRECTANGLEDATA 4 FLOATP)
                                                                  (FILLEDRECTANGLEDATA 6 FLOATP)
                                                                  (FILLEDRECTANGLEDATA 8 POINTER)
                                                                  (FILLEDRECTANGLEDATA 10 POINTER)
                                                                  (FILLEDRECTANGLEDATA 12 POINTER)
                                                                  (FILLEDRECTANGLEDATA 14 POINTER)
                                                                  (FILLEDRECTANGLEDATA 16 POINTER)
                                                                  (FILLEDRECTANGLEDATA 18 POINTER))
       '20)
(/DECLAREDATATYPE 'GRAPHDATA '(POINTER POINTER POINTER POINTER) '((GRAPHDATA 0 POINTER)
                                                                  (GRAPHDATA 2 POINTER)
                                                                  (GRAPHDATA 4 POINTER)
                                                                  (GRAPHDATA 6 POINTER)) '8)
(/DECLAREDATATYPE 'LINEDATA '(POINTER POINTER FLOATP FLOATP FLOATP FLOATP POINTER POINTER)
       '((LINEDATA 0 POINTER)
         (LINEDATA 2 POINTER)
         (LINEDATA 4 FLOATP)
         (LINEDATA 6 FLOATP)
         (LINEDATA 8 FLOATP)
         (LINEDATA 10 FLOATP)
         (LINEDATA 12 POINTER)
         (LINEDATA 14 POINTER))
       '16)
(/DECLAREDATATYPE 'PLOT.STYLE '(POINTER POINTER POINTER) '((PLOT.STYLE 0 POINTER)
                                                           (PLOT.STYLE 2 POINTER)
                                                           (PLOT.STYLE 4 POINTER)) '6)
(/DECLAREDATATYPE 'POINTDATA '(POINTER POINTER POINTER) '((POINTDATA 0 POINTER)
                                                          (POINTDATA 2 POINTER)
                                                          (POINTDATA 4 POINTER)) '6)
(/DECLAREDATATYPE 'POLYGONDATA '(POINTER POINTER POINTER) '((POLYGONDATA 0 POINTER)
                                                            (POLYGONDATA 2 POINTER)
                                                            (POLYGONDATA 4 POINTER)) '6)
(/DECLAREDATATYPE 'TEXTDATA '(POINTER POINTER POINTER POINTER) '((TEXTDATA 0 POINTER)
                                                                 (TEXTDATA 2 POINTER)
                                                                 (TEXTDATA 4 POINTER)
                                                                 (TEXTDATA 6 POINTER)) '8)

(PUTPROPS PLOTCOMPOUND ARGNAMES (NIL (PLOT COMPOUNDTYPE COMPONENT1 |...| LABEL MENU NODRAWFLG) . COMPOUNDARGS
                                     ))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA PLOTCOMPOUND)
)
(PUTPROPS PLOTOBJECTS COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (4043 89779 (COPYCOMPOUND 4053 . 4661) (COPYCURVE 4663 . 5157) (COPYFILLEDRECTANGLE 5159
 . 6102) (COPYGENERIC 6104 . 6333) (COPYGRAPHOBJECT 6335 . 6845) (COPYLINE 6847 . 7498) (COPYPOINT 
7500 . 7991) (COPYPOLYGON 7993 . 8501) (COPYTEXT 8503 . 9071) (CREATECOMPOUND 9073 . 9637) (
CREATECURVE 9639 . 10967) (CREATEFILLEDRECTANGLE 10969 . 11665) (CREATEGRAPH 11667 . 13060) (
CREATELINE 13062 . 14517) (CREATEPOINT 14519 . 14993) (CREATEPOLYGON 14995 . 16352) (CREATETEXT 16354
 . 16720) (DISTANCETOCOMPOUND 16722 . 17531) (DISTANCETOCURVE 17533 . 17912) (
DISTANCETOFILLEDRECTANGLE 17914 . 21400) (DISTANCETOGRAPH 21402 . 21783) (DISTANCETOLINE 21785 . 23293
) (DISTANCETOPOINT 23295 . 23539) (DISTANCETOPOLYGON 23541 . 23926) (DISTANCETOTEXT 23928 . 24172) (
DRAWCOMPOUNDOBJECT 24174 . 24700) (DRAWCURVEOBJECT 24702 . 26337) (DRAWFILLEDRECTANGLEOBJECT 26339 . 
29167) (DRAWGRAPHOBJECT 29169 . 31739) (DRAWLINEOBJECT 31741 . 35176) (DRAWPOINTOBJECT 35178 . 36115) 
(DRAWPOLYGONOBJECT 36117 . 38213) (DRAWTEXTOBJECT 38215 . 39541) (ERASECOMPOUNDOBJECT 39543 . 39986) (
ERASECURVEOBJECT 39988 . 41161) (ERASEFILLEDRECTANGLEOBJECT 41163 . 42878) (ERASEGRAPHOBJECT 42880 . 
43975) (ERASELINEOBJECT 43977 . 44826) (ERASEPOINTOBJECT 44828 . 45488) (ERASEPOLYGONOBJECT 45490 . 
47087) (ERASETEXTOBJECT 47089 . 48317) (EXTENTOFCOMPOUND 48319 . 49730) (EXTENTOFCURVE 49732 . 51415) 
(EXTENTOFFILLEDRECTANGLE 51417 . 52034) (EXTENTOFGRAPH 52036 . 52299) (EXTENTOFLINE 52301 . 52552) (
EXTENTOFPOINT 52554 . 53079) (EXTENTOFPOLYGON 53081 . 54550) (EXTENTOFTEXT 54552 . 55076) (GETCOMPOUND
 55078 . 55405) (GETCURVE 55407 . 55997) (GETFILLEDRECTANGLE 55999 . 56565) (GETGENERIC 56567 . 56690)
 (GETGRAPH 56692 . 57280) (GETLINE 57282 . 57997) (GETPOINT 57999 . 58471) (GETPOLYGON 58473 . 59073) 
(GETTEXT 59075 . 59420) (HIGHLIGHTCOMPOUND 59422 . 59867) (HIGHLIGHTCURVE 59869 . 61055) (
HIGHLIGHTFILLEDRECTANGLE 61057 . 62689) (HIGHLIGHTGRAPH 62691 . 63785) (HIGHLIGHTLINE 63787 . 64635) (
HIGHLIGHTPOINT 64637 . 65690) (HIGHLIGHTPOLYGON 65692 . 67293) (HIGHLIGHTTEXT 67295 . 68544) (
LABELGENERIC 68546 . 69513) (LABELPOINT 69515 . 71170) (LABELTEXT 71172 . 71326) (LOWLIGHTCOMPOUND 
71328 . 71771) (MOVECOMPOUND 71773 . 72057) (MOVECURVE 72059 . 72522) (MOVEFILLEDRECTANGLE 72524 . 
72954) (MOVELINE 72956 . 73554) (MOVEPOINT 73556 . 73982) (MOVEPOLYGON 73984 . 74444) (MOVETEXT 74446
 . 74853) (PLOTCOMPOUND 74855 . 76340) (PLOTCURVE 76342 . 76895) (PLOTFILLEDRECTANGLE 76897 . 77533) (
PLOTGRAPH 77535 . 77892) (PLOTLINE 77894 . 78245) (PLOTPOINT 78247 . 78708) (PLOTPOINTS 78710 . 81126)
 (PLOTPOLYGON 81128 . 81604) (PLOTTEXT 81606 . 81961) (PUTCOMPOUND 81963 . 82742) (PUTCURVE 82744 . 
83560) (PUTFILLEDRECTANGLE 83562 . 85075) (PUTGENERIC 85077 . 85264) (PUTGRAPH 85266 . 86100) (PUTLINE
 86102 . 87089) (PUTPOINT 87091 . 88082) (PUTPOLYGON 88084 . 88909) (PUTTEXT 88911 . 89777)))))
STOP