(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