(FILECREATED "20-Nov-84 14:33:48" {ERIS}<LISPNEW>SOURCES>DRAWCURVEPATCH.;1
 7221   )


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DRAWCURVEPATCHCOMS)

(RPAQQ DRAWCURVEPATCHCOMS
 ((FNS \DRAWCURVE.IP \DRAWCURVE.PRESS \DRAWCURVE.PRESS.LINE)))
(DEFINEQ

(\DRAWCURVE.IP

  [LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING)              (* rmk: "20-Nov-84 10:55")

                                                             (* draws a spline curve with a given brush--except that

							     dashing is currently ignored, and the curve is done 

							     with straight lines.)

    [
COND

      ((
LISTP
 KNOTS)
	(
SHOW.IP
 IPSTREAM)
	(
PROG
 [K (DASHLST (
AND
 DASHING (
OR
 (
AND
 (
LISTP
 DASHING)
						(
EVERY
 DASHING (
FUNCTION
 FIXP))
						DASHING)
					   (
\ILLEGAL.ARG
 DASHING]
                                                             (* The above makes sure that DASHING is a list of 

							     numbers.)

	      [
OR
 (
CDR
 KNOTS)
		  (
SETQ
 KNOTS (
LIST
 (
CAR
 KNOTS)
				    (
CAR
 KNOTS]              (* The funny case of a single knot)

	      (
COND

		((
AND
 (
NULL
 DASHING)
		      (
EQ
 2 (
LENGTH
 KNOTS)))                 (* There were only two knots, and no dashing.)

		  (
OR
 (type?
 POSITION (
SETQ
 K (
CAR
 KNOTS)))
		      (
ERROR
 "bad knot" K))
		  (
MOVETO.IP
 IPSTREAM (fetch
 XCOORD of
 K)
			     (fetch
 YCOORD of
 K))
		  (
OR
 (type?
 POSITION (
SETQ
 K (
CADR
 KNOTS)))
		      (
ERROR
 "bad knot" K))
		  (
LINETO.IP
 IPSTREAM (fetch
 XCOORD of
 K)
			     (fetch
 YCOORD of
 K))
		  (
\SETBRUSH.IP
 IPSTREAM BRUSH)
		  (
MASKSTROKE.IP
 IPSTREAM))
		(T                                           (* Otherwise, use the full-strength curve drawer.)

		   (
\IPCURVE2
 IPSTREAM (
PARAMETRICSPLINE
 KNOTS CLOSED)
			      DASHING BRUSH)                 (* This already leaves the current position at the 

							     endpoint of the curve.)

		   ))
	      (
SETQ
 K (
CAR
 (
LAST
 KNOTS)))
	      (
SETXY.IP
 IPSTREAM (fetch
 XCOORD of
 K)
			(fetch
 YCOORD of
 K]
    IPSTREAM])

(\DRAWCURVE.PRESS

  [LAMBDA (PRSTREAM KNOTS CLOSED BRUSH DASHING)              (* rmk: "20-Nov-84 13:59")

                                                             (* draws a spline curve with a given brush brush.

							     Knots and brushwidth assumed to be in micas)

    [
COND

      ((
LISTP
 KNOTS)
	(
SHOW.PRESS
 PRSTREAM)
	(
PROG
 [LASTKNOT (DASHLST (
AND
 DASHING (
OR
 (
AND
 (
LISTP
 DASHING)
						       (
EVERY
 DASHING (
FUNCTION
 FIXP))
						       DASHING)
						  (
\ILLEGAL.ARG
 DASHING]
                                                             (* The above makes sure that DASHING is a list of 

							     numbers.)

	      [
OR
 (
CDR
 KNOTS)
		  (
SETQ
 KNOTS (
LIST
 (
CAR
 KNOTS)
				    (
CAR
 KNOTS]              (* Handle the trival one-knot case.)

	      (
COND

		((
AND
 (
NULL
 DASHING)
		      (
EQ
 2 (
LENGTH
 KNOTS))
		      (\DRAWCURVE.PRESS.LINE
 PRSTREAM (fetch
 XCOORD of
 (
CAR
 KNOTS))
					     (fetch
 YCOORD of
 (
CAR
 KNOTS))
					     (fetch
 XCOORD of
 (
CADR
 KNOTS))
					     (fetch
 YCOORD of
 (
CADR
 KNOTS))
					     BRUSH DASHING))
                                                             (* There were only two knots, and no dashing.

							     \DRAWCURVE.PRESS.LINE returned T if it managed to draw 

							     the line the fast way.)

                                                             (* Have to move to the endpoint of the line.)

		  )
		(T                                           (* Otherwise, use the full-strength curve drawer.)

		   (
\PRESSCURVE2
 PRSTREAM (
PARAMETRICSPLINE
 [for
 KNOT in
 KNOTS
							       collect

								(
CREATEPOSITION

								  (
FIXR
 (
FTIMES
 (fetch
 XCOORD
										   of
 KNOT)
										ScansPerMica))
								  (
FIXR
 (
FTIMES
 (fetch
 YCOORD
										   of
 KNOT)
										ScansPerMica]
							    CLOSED)
				 DASHING
				 (
\GETBRUSHFONT.PRESS
 BRUSH))
                                                             (* This already leaves the current position at the 

							     endpoint of the curve.)

		   ))
	      (
SETQ
 LASTKNOT (
CAR
 (
LAST
 KNOTS)))
	      (
SETXY.PRESS
 PRSTREAM (fetch
 XCOORD of
 LASTKNOT)
			   (fetch
 YCOORD of
 LASTKNOT]
    PRSTREAM])

(\DRAWCURVE.PRESS.LINE

  [LAMBDA (PRSTREAM X1 Y1 X2 Y2 BRUSH DASHING)               (* rmk: "20-Nov-84 13:58")

                                                             (* Returns T if this is a horizontal or vertical line, 

							     hence can be drawn as a rectangle.)

    (
PROG
 (WIDTH BACKOFF OVERRUN LEFT BOTTOM DIST (SHAPE (
QUOTE
 ROUND)))
          (
SETQ
 WIDTH (
OR
 (
COND

			    ((
LISTP
 BRUSH)
			      (
SETQ
 SHAPE (
CAR
 BRUSH))
			      (
CADR
 BRUSH))
			    (T BRUSH))
			  1))
          (
SELECTQ
 SHAPE
		   (BUTT (
SETQ
 OVERRUN (
SETQ
 BACKOFF 0)))
		   (ROUND (
RETURN
 NIL))
		   (
PROGN
 (
SETQ
 BACKOFF (
IQUOTIENT
 WIDTH 2))
			  (
SETQ
 OVERRUN WIDTH)))             (* For butt ends, we want the line to end at the given 

							     coordinate position)

          (
COND

	    ((
EQP
 X1 X2)                                     (* Vertical line)

	      (
SETQ
 LEFT (
IDIFFERENCE
 X1 (
IQUOTIENT
 WIDTH 2)))
	      (
AND
 (
ILESSP
 LEFT 0)
		   (
RETURN
 T))                               (* Off to the left)

	      (
SETQ
 BOTTOM (
IDIFFERENCE
 (
IMIN
 Y1 Y2)
					BACKOFF))
	      [
SETQ
 DIST (
IPLUS
 OVERRUN (IABS (
IDIFFERENCE
 Y1 Y2]
	      (
COND

		((
ILESSP
 BOTTOM 0)
		  (add
 DIST BOTTOM)
		  (if
 (
ILEQ
 DIST 0)
		      then
 (
RETURN
 T))                       (* The whole thing is clipped)

		  (
SETQ
 BOTTOM 0)))
	      (
SETXY.PRESS
 PRSTREAM LEFT BOTTOM)             (* Move to where the line starts)

	      (
SHOWRECTANGLE.PRESS
 PRSTREAM WIDTH DIST)      (* Draw the rectangle that will do the job.)

	      (
RETURN
 T))
	    ((
EQP
 Y1 Y2)                                     (* Horizontal line)

	      (
SETQ
 BOTTOM (
IDIFFERENCE
 Y1 (
IQUOTIENT
 WIDTH 2)))
	      (
AND
 (
ILESSP
 BOTTOM 0)
		   (
RETURN
 T))                               (* Below the bottom)

	      (
SETQ
 LEFT (
IDIFFERENCE
 (
IMIN
 X1 X2)
				      BACKOFF))
	      [
SETQ
 DIST (
IPLUS
 OVERRUN (IABS (
IDIFFERENCE
 X1 X2]
	      (
COND

		((
ILESSP
 LEFT 0)
		  (add
 DIST LEFT)
		  (if
 (
ILEQ
 DIST 0)
		      then
 (
RETURN
 T))
		  (
SETQ
 LEFT 0)))
	      (
SETXY.PRESS
 PRSTREAM LEFT BOTTOM)             (* Move to where the line starts)

	      (
SHOWRECTANGLE.PRESS
 PRSTREAM DIST WIDTH)      (* Draw the rectangle that will do the job.)

	      (
RETURN
 T])
)
(PUTPROPS DRAWCURVEPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (288 7136 (\DRAWCURVE.IP 298 . 2235) (\DRAWCURVE.PRESS 2237 . 4630) (
\DRAWCURVE.PRESS.LINE 4632 . 7134)))))
STOP