(FILECREATED "19-Mar-85 10:34:34" {ERIS}<LISPNEW>PATCHES>PRESSPATCH.;2 12673 changes to: (FNS SETX.PRESS SETXY.PRESS) (VARS PRESSPATCHCOMS) previous date: "18-Mar-85 18:25:50" {ERIS}<LISPNEW>PATCHES>PRESSPATCH.;1) (* Copyright (c) 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT PRESSPATCHCOMS) (RPAQQ PRESSPATCHCOMS ((FNS \PRESSCURVE2 SETX.PRESS SETY.PRESS))) (DEFINEQ (\PRESSCURVE2 [LAMBDA (PRSTREAM SPLINE DASHING BRUSHFONT) (* rrb "18-Mar-85 16:57") (* Given a spline curve and a font, draw the lines to PRSTREAM) (RESETLST (RESETSAVE NIL (LIST (QUOTE DSPFONT) (DSPFONT BRUSHFONT PRSTREAM) PRSTREAM)) [PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM))) (COND ((IGREATERP (IDIFFERENCE (GETFILEPTR (fetch ELSTREAM of PRDATA)) (fetch ELSTARTBYTE of PRDATA)) 25000) (\ENTITYEND.PRESS PRSTREAM) (* Hack to prevent mysterious overflow in length of entities) (\ENTITYSTART.PRESS PRSTREAM] (\BOUT (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM)) ResetSpaceCode) (* because the space code shouldn't be interpreted specially when we are drawing in the vector font) (PROG ((XPOLY (create POLYNOMIAL)) (X'POLY (create POLYNOMIAL)) (YPOLY (create POLYNOMIAL)) (Y'POLY (create POLYNOMIAL)) (X (fetch (SPLINE SPLINEX) of SPLINE)) (Y (fetch (SPLINE SPLINEY) of SPLINE)) (X'(fetch (SPLINE SPLINEDX) of SPLINE)) (Y'(fetch (SPLINE SPLINEDY) of SPLINE)) (X''(fetch (SPLINE SPLINEDDX) of SPLINE)) (Y''(fetch (SPLINE SPLINEDDY) of SPLINE)) (X'''(fetch (SPLINE SPLINEDDDX) of SPLINE)) (Y'''(fetch (SPLINE SPLINEDDDY) of SPLINE)) (#KNOTS (fetch #KNOTS of SPLINE)) (X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE) 1)) (Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE) 1)) IX IY DX DY XT YT X'T Y'T NEWXT NEWYT XDIFF YDIFF XWALLDT YWALLDT DUPLICATEKNOT EXTRANEOUS TT NEWT DELTA DASHON DASHLST DASHCNT HALFVECWIDTH PUTDX EXTRADX PUTDY EXTRADY) (SETQ HALFVECWIDTH (FONTPROP BRUSHFONT (QUOTE SIZE))) (* Half the width of the brush, in dots. Used to help decide when the line we're drawing goes off-paper.) (SETQ DASHON T) (* These are initialized outside the prog-bindings cause the compiler can't hack so many initialized variables) (SETQ DASHLST DASHING) (SETQ DASHCNT (CAR DASHING)) (SETXY.PRESS PRSTREAM (FIXR (FTIMES X0 MicasPerScan)) (FIXR (FTIMES Y0 MicasPerScan))) (* Move to the first knot on the curve) (replace VECMOVINGRIGHT of (fetch IMAGEDATA of PRSTREAM) with T) (* Start by assuming we're moving in increasing X (since the vector fonts only have strokes that work in that direction)) (replace VECWASDISPLAYING of (fetch IMAGEDATA of PRSTREAM) with (AND (GEQ X0 0) (GEQ Y0 0))) (replace VECSEGCHARS of (fetch IMAGEDATA of PRSTREAM) with NIL) (replace VECCURX of (fetch IMAGEDATA of PRSTREAM) with X0) (* And set the current X and Y positions, denominated in dover spots) (replace VECCURY of (fetch IMAGEDATA of PRSTREAM) with Y0) (* Set up initial values in vec variables, perform SetX/SetY.) (SETQ TT 0.0) (SETQ DELTA 16) (SETQ IX (FIXR X0)) (SETQ IY (FIXR Y0)) [for KNOT# from 1 to (SUB1 #KNOTS) do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#) (ELT X'' KNOT#) (ELT X' KNOT#) (ELT X KNOT#)) (* Set up the polynomials that describe X and X' over this segment) (LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#) (ELT Y'' KNOT#) (ELT Y' KNOT#) (ELT Y KNOT#)) (* Set up the polynomials that describe Y and Y' over this segment) (SETQ XT (POLYEVAL TT XPOLY 3)) (* XT ← X (t) --Evaluate the next point) (SETQ YT (POLYEVAL TT YPOLY 3)) (* YT ← Y (t)) (COND [(NOT (IEQP KNOT# (SUB1 #KNOTS))) (* This isn't the last knot. Check to see if the next knot in line is a duplicated knot.) (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#)) (ELT X (IPLUS KNOT# 2))) (EQP (ELT Y (ADD1 KNOT#)) (ELT Y (IPLUS KNOT# 2] (T (SETQ DUPLICATEKNOT NIL))) [until (GEQ TT 1.0) do (* Run the parameter, TT, from 0.0 up to 1.0. That moves the X and Y locations smoothly from this knot to the next one.) (SETQ X'T (POLYEVAL TT X'POLY 2)) (* X'T ← X' (t)) (SETQ Y'T (POLYEVAL TT Y'POLY 2)) (* Y'T ← Y' (t)) (COND ((EQP X'T 0.0) (* Never let X' really get to 0.0 -- things become ill-conditioned there.) (SETQ X'T .0005))) (COND ((EQP Y'T 0.0) (* Likewise Y'.) (SETQ Y'T .0005))) [COND ((FGTP X'T 0.0) (* If X' is positive, we'll try moving in the +X direction) (SETQ DX DELTA)) (T (* If not, we'll try the -X direction.) (SETQ DX (IMINUS DELTA] [COND ((FGTP Y'T 0.0) (* Likewise, if Y' is positive, try moving by DELTA in the +Y direction) (SETQ DY DELTA)) (T (SETQ DY (IMINUS DELTA] (SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX) XT) X'T)) (* Compute a dT, based on moving by DELTA in X.) (SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY) YT) Y'T)) (* And a dT based on moving by DELTA in Y.) [COND ((FLESSP XWALLDT YWALLDT) (* Use the smaller of the two dT's. In this case, dT for X was smaller, so compute a new DY as depending on DX.) (SETQ NEWT (FPLUS TT XWALLDT)) (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T))) IY))) (T (* Changing Y gave the smaller dT. Compute a new DX, as though it depended on DY.) (SETQ NEWT (FPLUS TT YWALLDT)) (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T))) IX] (SETQ PUTDX DX) (SETQ EXTRADX 0) (SETQ PUTDY DY) (SETQ EXTRADY 0) [COND ((IGREATERP DX 16) (SETQ PUTDX 16) (SETQ EXTRADX (IDIFFERENCE DX 16] [COND ((IGREATERP -16 DX) (SETQ PUTDX -16) (SETQ EXTRADX (IPLUS DX 16] [COND ((IGREATERP DY 16) (SETQ PUTDY 16) (SETQ EXTRADY (IDIFFERENCE DY 16] [COND ((IGREATERP -16 DY) (SETQ PUTDY -16) (SETQ EXTRADY (IPLUS DY 16] (COND ([AND (FGTP NEWT 1.0) (OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS] (SETQ NEWT 1.0))) (SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) (* New XT ← X (new t)) (SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) (* New YT ← Y (new t)) (SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX) NEWXT))) (SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY) NEWYT))) (COND ((AND (IGREATERP DELTA 1) (OR (FGTP XDIFF 1.0) (FGTP YDIFF 1.0))) (* If we're more than a dover spot off where we'd expect to be because of the size of DELTA--and if there's room to make DELTA smaller--then try DELTA←DELTA/2) (SETQ DELTA (LRSH DELTA 1))) (T (* No, this estimate is close enough. Put out a vector segment based on it, and move to the new TT.) (\VECPUT PRSTREAM PUTDX PUTDY HALFVECWIDTH) (* Print out a stroke using the vector font.) (COND ((OR (NEQ EXTRADX 0) (NEQ EXTRADY 0)) (* If, actually, it was too big for one stroke, use another.) (\VECPUT PRSTREAM EXTRADX EXTRADY HALFVECWIDTH))) (SETQ IX (IPLUS IX DX)) (* Our new current location, in Dover spots) (SETQ IY (IPLUS IY DY)) (SETQ TT NEWT) (* Set TT to its new value) (SETQ XT NEWXT) (* And set the new floating-point values for X (t) and Y (t).) (SETQ YT NEWYT) (COND ((AND (ILESSP DELTA 16) (OR (FLESSP XDIFF .5) (FLESSP YDIFF .5))) (* If we were especially close, try making DELTA larger for the next go round.) (SETQ DELTA (LLSH DELTA 1] (SETQ TT (FDIFFERENCE TT 1.0)) (* Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try to keep the line going from where it got to in passing the last knot.) (COND (DUPLICATEKNOT (* This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are discontinuous there.) (add KNOT# 1] (\ENDVECRUN PRSTREAM HALFVECWIDTH]) (SETX.PRESS [LAMBDA (PRSTREAM X) (* rrb "19-Mar-85 09:53") (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM] (COND ([AND (IGEQ X SPRUCEPAPERLEFTMICAS) (ILEQ X SPRUCEPAPERRIGHTMICAS) (NOT (IEQP X (fetch PRXPOS of (fetch IMAGEDATA of PRSTREAM] (\BOUT ELSTREAM SetXCode) (* Outcharfn ignores characters that are not in the clipping region) (\WOUT ELSTREAM X))) (replace PRXPOS of (fetch IMAGEDATA of PRSTREAM) with X]) (SETY.PRESS [LAMBDA (PRSTREAM Y) (* rrb "18-Mar-85 16:55") (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM] (COND ([AND (IGEQ Y SPRUCEPAPERBOTTOMMICAS) (ILEQ Y SPRUCEPAPERTOPMICAS) (NOT (IEQP Y (fetch PRYPOS of (ffetch IMAGEDATA of PRSTREAM] (\BOUT ELSTREAM SetYCode) (\WOUT ELSTREAM Y))) (freplace PRYPOS of (ffetch IMAGEDATA of PRSTREAM) with Y]) ) (PUTPROPS PRESSPATCH COPYRIGHT ("Xerox Corporation" 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (414 12592 (\PRESSCURVE2 424 . 11382) (SETX.PRESS 11384 . 12040) (SETY.PRESS 12042 . 12590))))) STOP