(FILECREATED "30-Nov-84 18:26:24" {ERIS}<LISPNEW>PATCHES>PRESSCURVEPATCH.;2
 10630  

      changes to:  (FNS \CURVESLOPE)

      previous date: "30-Nov-84 17:40:47" {ERIS}<LISPNEW>PATCHES>PRESSCURVEPATCH.;1)


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

(PRETTYCOMPRINT PRESSCURVEPATCHCOMS)

(RPAQQ PRESSCURVEPATCHCOMS
 ((FNS VECFONTINIT PARAMETRICSPLINE \CURVESLOPE)))
(DEFINEQ

(VECFONTINIT

  [LAMBDA NIL                                                (* rmk: "30-Nov-84 16:53")


          (* Initialize \VecFontDir, a list of lists of dummy font descriptors for the ReDraw vector fonts.

	  The structure is ((round brushes) (square brushes) (horizontal brushes) (vertical brushes)))



    (DECLARE
 (
GLOBALVARS
 \VecFontDir))

          (* WIDTHS is a dummy array descriptor so that \DSPFONT.PRESS doesn't get confused. If any real character output were

	  done with this descriptor in force, the results would be disastrous. But the RESETSAVE in \PRESSCURVE2 should 

	  prevent this.)



    (
OR
 \VecFontDir (
SETQ
 \VecFontDir (for
 FMLY (WIDTHS _(
ARRAY
 256 (
QUOTE
 SMALLP)
								1 0))
					 in
 (
QUOTE
 (NEWVEC SNEWVEC HNEWVEC VNEWVEC))
					 collect
 (for
 BRUSH in
 (
QUOTE
 (4 8 16 32 64))
						    collect
 (create
 FONTDESCRIPTOR
								    FONTDEVICE _(
QUOTE
 PRESS)
								    FONTFAMILY _ FMLY
								    FONTSIZE _ BRUSH
								    FONTFACE _(
QUOTE
 (MEDIUM REGULAR 
											  REGULAR))
								    ROTATION _ 0
								    \SFWidths _ WIDTHS])

(PARAMETRICSPLINE

  [LAMBDA (KNOTS CLOSEDFLG SPLINE)                           (* rmk: "30-Nov-84 17:02")

                                                             (* KNOTS is a non-NIL list of knots, CLOSEDFLG => 

							     closed curve)

    (
PROG
 (DX DY DDX DDY DDDX DDDY #KNOTS A BX BY X Y SX SY A C R D2X D2Y I)
          [
COND

	    (CLOSEDFLG                                       (* Wrap around)

		       (push
 KNOTS (
CAR
 (
LAST
 KNOTS]
          (
SETQ
 #KNOTS (
LENGTH
 KNOTS))
          (
SETQ
 DX (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 DDX (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 DDDX (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 DY (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 DDY (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 DDDY (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 X (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 Y (
ARRAY
 #KNOTS 0 0.0))
          (for
 KNOT in
 KNOTS as
 I from
 1 to
 #KNOTS
	     do
 (
OR
 (type?
 POSITION KNOT)
		    (
ERROR
 "bad knot" KNOT))
		(
SETA
 X I (
CAR
 KNOT))
		(
SETA
 Y I (
CDR
 KNOT)))
          (
SETQ
 A (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 BX (
ARRAY
 #KNOTS 0 0.0))
          (
SETQ
 BY (
ARRAY
 #KNOTS 0 0.0))
          [
COND

	    (CLOSEDFLG (
SETQ
 C (
ARRAY
 #KNOTS 0 0.0))
		       (
SETQ
 R (
ARRAY
 #KNOTS 0 0.0))
		       (
SETQ
 SX (
ARRAY
 #KNOTS 0 0.0))
		       (
SETQ
 SY (
ARRAY
 #KNOTS 0 0.0]
          (
SETA
 A 1 4.0)
          [for
 I from
 2 to
 (
IDIFFERENCE
 #KNOTS 2) do
 (
SETA
 A I (
FDIFFERENCE

							     4.0
							     (
FQUOTIENT
 1.0 (
ELT
 A (
SUB1
 I]
          [
COND

	    (CLOSEDFLG (
SETA
 C 1 1.0)
		       (for
 I from
 2 to
 (
IDIFFERENCE
 #KNOTS 2)
			  do
 (
SETA
 C I (
FMINUS
 (
FQUOTIENT
 (
ELT
 C (
SUB1
 I))
							  (
ELT
 A (
SUB1
 I]
          [
COND

	    ((
IGEQ
 #KNOTS 3)
	      (
COND

		[CLOSEDFLG [
SETA
 BX 1 (
FTIMES
 6.0 (
FPLUS
 (
ELT
 X 2)
							 (
FMINUS
 (
FTIMES
 2.0 (
ELT
 X 1)))
							 (
ELT
 X (
SUB1
 #KNOTS]
			   [
SETA
 BY 1 (
FTIMES
 6.0 (
FPLUS
 (
ELT
 Y 2)
							 (
FMINUS
 (
FTIMES
 2.0 (
ELT
 Y 1)))
							 (
ELT
 Y (
SUB1
 #KNOTS]
			   [for
 I from
 2 to
 (
IDIFFERENCE
 #KNOTS 2)
			      do
 [
SETA
 BX I (
FDIFFERENCE
 [
FTIMES
 6.0
								 (
FPLUS
 (
ELT
 X (
ADD1
 I))
									(
FMINUS
 (
FTIMES
 2.0
											(
ELT
 X I)))
									(
ELT
 X (
SUB1
 I]
							 (
FQUOTIENT
 (
ELT
 BX (
SUB1
 I))
								    (
ELT
 A (
SUB1
 I]
				 (
SETA
 BY I (
FDIFFERENCE
 [
FTIMES
 6.0
								 (
FPLUS
 (
ELT
 Y (
ADD1
 I))
									(
FMINUS
 (
FTIMES
 2.0
											(
ELT
 Y I)))
									(
ELT
 Y (
SUB1
 I]
							 (
FQUOTIENT
 (
ELT
 BY (
SUB1
 I))
								    (
ELT
 A (
SUB1
 I]
			   (
SETA
 R (
SUB1
 #KNOTS)
				 1.0)
			   (
SETA
 SX (
SUB1
 #KNOTS)
				 0.0)
			   (
SETA
 SY (
SUB1
 #KNOTS)
				 0.0)
			   (for
 I from
 (
IDIFFERENCE
 #KNOTS 2) to
 1 by
 -1
			      do
 [
SETA
 R I (
FMINUS
 (
FQUOTIENT
 (
FPLUS
 (
ELT
 R (
ADD1
 I))
								     (
ELT
 C I))
							      (
ELT
 A I]
				 (
SETA
 SX I (
FQUOTIENT
 (
FDIFFERENCE
 (
ELT
 BX I)
								    (
ELT
 SX (
ADD1
 I)))
						       (
ELT
 A I)))
				 (
SETA
 SY I (
FQUOTIENT
 (
FDIFFERENCE
 (
ELT
 BY I)
								    (
ELT
 SY (
ADD1
 I)))
						       (
ELT
 A I]
		(T [
SETA
 BX 1 (
FTIMES
 6.0 (
FPLUS
 (
FDIFFERENCE
 (
ELT
 X 3)
							      (
FTIMES
 2.0 (
ELT
 X 2)))
						 (
ELT
 X 1]
		   [
SETA
 BY 1 (
FTIMES
 6.0 (
FPLUS
 (
FDIFFERENCE
 (
ELT
 Y 3)
							      (
FTIMES
 2.0 (
ELT
 Y 2)))
						 (
ELT
 Y 1]
		   (for
 I from
 2 to
 (
IDIFFERENCE
 #KNOTS 2)
		      do
 [
SETA
 BX I (
FDIFFERENCE
 (
FTIMES
 6.0
							 (
FPLUS
 [
FDIFFERENCE

								  (
ELT
 X (
IPLUS
 I 2))
								  (
FTIMES
 2 (
ELT
 X (
ADD1
 I]
								(
ELT
 X I)))
						 (
FQUOTIENT
 (
ELT
 BX (
SUB1
 I))
							    (
ELT
 A (
SUB1
 I]
			 (
SETA
 BY I (
FDIFFERENCE
 (
FTIMES
 6.0
							 (
FPLUS
 [
FDIFFERENCE

								  (
ELT
 Y (
IPLUS
 I 2))
								  (
FTIMES
 2 (
ELT
 Y (
ADD1
 I]
								(
ELT
 Y I)))
						 (
FQUOTIENT
 (
ELT
 BY (
SUB1
 I))
							    (
ELT
 A (
SUB1
 I]
          [
COND

	    (CLOSEDFLG [
SETQ
 D2X (
FPLUS
 (
ELT
 X #KNOTS)
					[
FMINUS
 (
FTIMES
 2.0 (
ELT
 X (
SUB1
 #KNOTS]
					(
ELT
 X (
IDIFFERENCE
 #KNOTS 2]
		       [
SETQ
 D2Y (
FPLUS
 (
ELT
 Y #KNOTS)
					[
FMINUS
 (
FTIMES
 2.0 (
ELT
 Y (
SUB1
 #KNOTS]
					(
ELT
 Y (
IDIFFERENCE
 #KNOTS 2]
		       (
SETA
 DDX (
SUB1
 #KNOTS)
			     (
FQUOTIENT
 (
FDIFFERENCE
 (
FDIFFERENCE
 (
FTIMES
 D2X 6.0)
								  (
ELT
 SX 1))
						     (
ELT
 SX (
IDIFFERENCE
 #KNOTS 2)))
					(
FPLUS
 (
ELT
 R 1)
					       (
ELT
 R (
IDIFFERENCE
 #KNOTS 2))
					       4.0)))
		       (
SETA
 DDY (
SUB1
 #KNOTS)
			     (
FQUOTIENT
 (
FDIFFERENCE
 (
FDIFFERENCE
 (
FTIMES
 D2Y 6.0)
								  (
ELT
 SY 1))
						     (
ELT
 SY (
IDIFFERENCE
 #KNOTS 2)))
					(
FPLUS
 (
ELT
 R 1)
					       (
ELT
 R (
IDIFFERENCE
 #KNOTS 2))
					       4.0)))
		       [for
 I from
 1 to
 (
IDIFFERENCE
 #KNOTS 2)
			  do
 [
SETA
 DDX I (
FPLUS
 (
ELT
 SX I)
						(
FTIMES
 (
ELT
 R I)
							(
ELT
 DDX (
SUB1
 #KNOTS]
			     (
SETA
 DDY I (
FPLUS
 (
ELT
 SY I)
						(
FTIMES
 (
ELT
 R I)
							(
ELT
 DDY (
SUB1
 #KNOTS]
		       (
SETA
 DDX #KNOTS (
ELT
 DDX 1))
		       (
SETA
 DDY #KNOTS (
ELT
 DDY 1)))
	    (T                                               (* COMPUTE SECOND DERIVATIVES.)

	       [
SETA
 DDX 1 (
SETA
 DDY 1 (
SETA
 DDX #KNOTS (
SETA
 DDY #KNOTS 0.0]
	       (for
 I from
 (
SUB1
 #KNOTS) to
 2 by
 -1
		  do
 [
SETA
 DDX I (
FQUOTIENT
 (
FDIFFERENCE
 (
ELT
 BX (
SUB1
 I))
							 (
ELT
 DDX (
ADD1
 I)))
					    (
ELT
 A (
SUB1
 I]
		     (
SETA
 DDY I (
FQUOTIENT
 (
FDIFFERENCE
 (
ELT
 BY (
SUB1
 I))
							 (
ELT
 DDY (
ADD1
 I)))
					    (
ELT
 A (
SUB1
 I]
          [for
 I from
 1 to
 (
SUB1
 #KNOTS)
	     do
                                              (* COMPUTE 1ST & 3RD DERIVATIVES)

		(
SETA
 DX I (
FDIFFERENCE
 (
FDIFFERENCE
 (
ELT
 X (
ADD1
 I))
						     (
ELT
 X I))
					(
FQUOTIENT
 (
FPLUS
 (
FTIMES
 2 (
ELT
 DDX I))
							  (
ELT
 DDX (
ADD1
 I)))
						   6.0)))
		(
SETA
 DY I (
FDIFFERENCE
 (
FDIFFERENCE
 (
ELT
 Y (
ADD1
 I))
						     (
ELT
 Y I))
					(
FQUOTIENT
 (
FPLUS
 (
FTIMES
 2 (
ELT
 DDY I))
							  (
ELT
 DDY (
ADD1
 I)))
						   6.0)))
		(
SETA
 DDDX I (
FDIFFERENCE
 (
ELT
 DDX (
ADD1
 I))
					  (
ELT
 DDX I)))
		(
SETA
 DDDY I (
FDIFFERENCE
 (
ELT
 DDY (
ADD1
 I))
					  (
ELT
 DDY I]
          (
SETQ
 SPLINE
	    (create
 SPLINE
		    #KNOTS _ #KNOTS
		    SPLINEX _ X
		    SPLINEY _ Y
		    SPLINEDX _ DX
		    SPLINEDY _ DY
		    SPLINEDDX _ DDX
		    SPLINEDDY _ DDY
		    SPLINEDDDX _ DDDX
		    SPLINEDDDY _ DDDY))
          (
RETURN
 SPLINE])

(\CURVESLOPE

  [LAMBDA (KNOTS ENDFLG)                                     (* rrb "30-Nov-84 18:17")


          (* returns a CONS of DX DY that gives the slope of the curve thru KNOTS. If ENDFLG is NIL, it is at the beginning.

	  If ENDFLG is T, it is at the last point.)



    (
PROG
 (DX DY PARAMS (#KNOTS (
LENGTH
 KNOTS)))
          (
RETURN
 (
SELECTQ
 #KNOTS
			   ((0 1)                            (* define slope as horizontal)

			     (
QUOTE
 (1 . 0)))
			   [2 (
CONS
 (
DIFFERENCE
 (fetch
 (
POSITION
 XCOORD) of
 (
CADR
 KNOTS))
						(fetch
 (
POSITION
 XCOORD) of
 (
CAR
 KNOTS)))
				    (
DIFFERENCE
 (fetch
 (
POSITION
 YCOORD) of
 (
CADR
 KNOTS))
						(fetch
 (
POSITION
 YCOORD) of
 (
CAR
 KNOTS]
			   (
PROGN
 [
SETQ
 PARAMS (
COND

				      [ENDFLG (PARAMETRICSPLINE
 (
REVERSE
 (
NLEFT
 KNOTS
										(
IMIN
 #KNOTS 4]
				      (T (PARAMETRICSPLINE
 (
COND

							     ((
EQ
 #KNOTS 3)
							       (
LIST
 (
CAR
 KNOTS)
								     (
CADR
 KNOTS)
								     (
CADDR
 KNOTS)))
							     (T (
LIST
 (
CAR
 KNOTS)
								      (
CADR
 KNOTS)
								      (
CADDR
 KNOTS)
								      (
CADDDR
 KNOTS]
				  (
SETQ
 DX (
ELT
 (fetch
 (SPLINE SPLINEDX) of
 PARAMS)
						1))
				  (
SETQ
 DY (
ELT
 (fetch
 (SPLINE SPLINEDY) of
 PARAMS)
						1))
				  (if
 ENDFLG
				      then
 (
CONS
 (
MINUS
 DX)
						 (
MINUS
 DY))
				    else
 (
CONS
 DX DY])
)
(PUTPROPS PRESSCURVEPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (402 10544 (VECFONTINIT 412 . 1579) (PARAMETRICSPLINE 1581 . 9001) (\CURVESLOPE 9003 . 
10542)))))
STOP