<<>> <> <> <> <> <> DIRECTORY Basics, ImagerBox, ImagerError, ImagerPath, ImagerPen, ImagerStroke, ImagerTransformation, Real, RealFns, RealInline, Vector2, ProcessProps, IO, Rope; ImagerStrokeImpl: CEDAR PROGRAM IMPORTS Basics, ImagerError, ImagerPath, ImagerTransformation, Real, RealFns, RealInline, Vector2, ProcessProps, IO EXPORTS ImagerStroke ~ BEGIN EndCode: TYPE ~ ImagerStroke.EndCode; JointCode: TYPE ~ ImagerStroke.JointCode; maxReal: REAL ~ Real.LargestNumber; VEC: TYPE ~ Vector2.VEC; Pen: TYPE ~ ImagerPen.Pen; PathProc: TYPE ~ ImagerPath.PathProc; MoveToProc: TYPE ~ ImagerPath.MoveToProc; LineToProc: TYPE ~ ImagerPath.LineToProc; ConicToProc: TYPE ~ ImagerPath.ConicToProc; CurveToProc: TYPE ~ ImagerPath.CurveToProc; ArcToProc: TYPE ~ ImagerPath.ArcToProc; Transformation: TYPE ~ ImagerTransformation.Transformation; VertexIndex: TYPE ~ NAT; Bezier: TYPE ~ ARRAY [0..4) OF VEC; dbug: BOOL ~ FALSE; -- A compile-time FALSE inhibits generation of debugging code. DBug: PROC [label: Rope.ROPE, v: LIST OF Vector2.VEC, d: INT ¬ FIRST[INT]] ~ { IF dbug THEN { WITH ProcessProps.GetProp[$ErrOut] SELECT FROM s: IO.STREAM => { IO.PutRope[s, label]; IF d # FIRST[INT] THEN { IO.PutF1[s, "(%g)", [integer[d]]]; }; FOR tail: LIST OF Vector2.VEC ¬ v, tail.rest UNTIL tail = NIL DO IO.PutFL[s, " [%g, %g]", LIST[[real[tail.first.x]], [real[tail.first.y]]]]; ENDLOOP; IO.PutRope[s, "\n"]; }; ENDCASE; }; }; RealMax: PROC [x, y: REAL] RETURNS [REAL] = INLINE { RETURN [IF x > y THEN x ELSE y]; }; curveTolerance: REAL ¬ 0.5; <> SetCurveTolerance: PROC [millis: INT] = { IF millis IN [1..10000] THEN curveTolerance ¬ millis * 0.001; }; Add: PROC [v1, v2: VEC] RETURNS [VEC] ~ INLINE { RETURN[[v1.x+v2.x, v1.y+v2.y]] }; Sub: PROC [v1, v2: VEC] RETURNS [VEC] ~ INLINE { RETURN[[v1.x-v2.x, v1.y-v2.y]] }; Half: PROC [r: REAL] RETURNS [REAL] ~ INLINE { RETURN [r*0.5]; }; Mid: PROC [p, q: VEC] RETURNS [VEC] ~ INLINE { RETURN [[Half[p.x+q.x], Half[p.y+q.y]]] }; non: VEC ~ [Real.TrappingNaN, Real.TrappingNaN]; Eq: PROC [a, b: VEC] RETURNS [BOOL] ~ INLINE {RETURN [a.x=b.x AND a.y=b.y]}; <> AddMod: PROC [a, b: NAT, mod: NAT] RETURNS [c: NAT] ~ INLINE { IF (c ¬ a + b) >= mod THEN c ¬ c - mod; }; FindVertex: PUBLIC PROC [pen: Pen, direction: VEC, i: NAT ¬ 0] RETURNS [NAT] ~ { <> penSize: NAT ~ pen.size; penSizeLess1: NAT ~ penSize-1; DO prv: NAT ~ IF i = 0 THEN penSizeLess1 ELSE i - 1; dotPrv: REAL ~ Vector2.InlineDot[direction, Sub[pen[prv], pen[i]]]; IF dotPrv > 0 THEN i ¬ prv ELSE EXIT ENDLOOP; DO nxt: NAT ~ IF i = penSizeLess1 THEN 0 ELSE i + 1; dotNxt: REAL ~ Vector2.InlineDot[direction, Sub[pen[nxt], pen[i]]]; IF dotNxt > 0 THEN i ¬ nxt ELSE EXIT ENDLOOP; RETURN [i] }; State: TYPE ~ RECORD [ p: VEC ¬ non, -- position v: VEC ¬ non, -- velocity left: NAT ¬ NAT.LAST, -- index of active pen vertex to the left right: NAT ¬ NAT.LAST -- index of active pen vertex to the right ]; Reverse: PROC [state: State] RETURNS [State] ~ { t: NAT ¬ state.left; state.left ¬ state.right; state.right ¬ t; state.v ¬ [RealInline.Neg[state.v.x], RealInline.Neg[state.v.y]]; RETURN [state]; }; PenBB: PROC [pen: ImagerPen.Pen] RETURNS [ImagerBox.Box] ~ { box: ImagerBox.Box ¬ [xmin: maxReal, ymin: maxReal, xmax: -maxReal, ymax: -maxReal]; FOR i: NAT IN [0..pen.size) DO p: VEC ~ pen[i]; IF p.x < box.xmin THEN box.xmin ¬ p.x; IF p.x > box.xmax THEN box.xmax ¬ p.x; IF p.y < box.ymin THEN box.ymin ¬ p.y; IF p.y > box.ymax THEN box.ymax ¬ p.y; ENDLOOP; RETURN [box]; }; ExtendBB: PROC [b0, b1: ImagerBox.Box] RETURNS [ImagerBox.Box] ~ { RETURN [[xmin: b0.xmin+b1.xmin, xmax: b0.xmax+b1.xmax, ymin: b0.ymin+b1.ymin, ymax: b0.ymax+b1.ymax]] }; BezierParabola: TYPE ~ ARRAY [0..3) OF VEC; SubDivideParabola: PROC [b: BezierParabola, t: REAL] RETURNS [low, high: BezierParabola] ~ { s: REAL ~ 1-t; Interpolate: PROC [a, b: VEC] RETURNS [VEC] ~ { RETURN [[a.x*s+b.x*t, a.y*s+b.y*t]] }; q1 : VEC ~ Interpolate[b[0], b[1]]; q2: VEC ~ Interpolate[b[1], b[2]]; qp1: VEC ~ Interpolate[q1, q2]; low ¬ [b[0], q1, qp1]; high ¬ [qp1, q2, b[2]]; }; Turning: TYPE ~ { undecided, left, right }; TraverseParabola: PROC [pen: Pen, p: BezierParabola, vertex, endVertex: VertexIndex, lineTo: LineToProc, conicTo: ImagerPath.ConicToProc, turning: Turning] RETURNS [Turning] ~ { penSize: NAT ~ pen.size; max: NAT ~ penSize-1; Forw: PROC [v: NAT] RETURNS [NAT] ~ INLINE {RETURN [IF v = max THEN 0 ELSE v + 1]}; Back: PROC [v: NAT] RETURNS [NAT] ~ INLINE {RETURN [IF v = 0 THEN max ELSE v - 1]}; delta0: VEC ~ Sub[p[1], p[0]]; delta1: VEC ~ Sub[p[2], p[1]]; offset: VEC ¬ pen[vertex]; t: REAL ¬ 0.0; b: BezierParabola ¬ p; turnRight: BOOLEAN ~ SELECT turning FROM $left => FALSE, $right => TRUE, ENDCASE => (Vector2.InlineCross[delta0, delta1] < 0); IF dbug THEN DBug["TraverseParabola", LIST[p[0], p[1], p[2], [vertex, endVertex], delta0, delta1], ORD[turnRight]]; UNTIL vertex = endVertex DO nextVertex: NAT ~ IF turnRight THEN Back[vertex] ELSE Forw[vertex]; nextDirection: VEC ~ Sub[pen[nextVertex], offset]; d0: REAL ~ Vector2.InlineCross[delta0, nextDirection]; d1: REAL ~ Vector2.InlineCross[delta1, nextDirection]; r: REAL ~ IF d0 = d1 THEN 1.0 ELSE d0/(d0-d1); newT: REAL ~ IF r < t OR r > 1.0 THEN 1.0 ELSE r; b0, b1: BezierParabola; [b0, b1] ¬ SubDivideParabola[b, IF t = 1.0 THEN 1.0 ELSE (newT-t)/(1.0-t)]; conicTo[Add[b0[1], offset], Add[b0[2], offset], 0.5]; vertex ¬ nextVertex; offset ¬ pen[vertex]; lineTo[Add[b1[0], offset]]; b ¬ b1; IF dbug THEN DBug["TraverseParabolaStep", LIST[b[0], b[1], b[2], [t, newT]], ORD[turnRight]]; t ¬ newT; ENDLOOP; IF b[0]#b[1] OR b[1]#b[2] THEN conicTo[Add[b[1], offset], Add[b[2], offset], 0.5]; RETURN [IF turnRight THEN $left ELSE $right] }; ExternalHalfPlane: TYPE ~ {xLo, xHi, yLo, yHi}; Region: TYPE ~ PACKED ARRAY ExternalHalfPlane OF BOOL; Intersect: PROC [a, b: Region] RETURNS [Region] ~ { <> RETURN [LOOPHOLE[Basics.BITAND[LOOPHOLE[a], LOOPHOLE[b]]]]; }; depthLimit: NAT = 15; -- Prevent runaways PenStroke: PUBLIC PROC [path: ImagerPath.PathProc, pen: ImagerPen.Pen, closed: BOOL, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, conicTo: ImagerPath.ConicToProc, end: PROC [p: VEC, v: VEC, i0, i1: VertexIndex], joint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex], box: ImagerBox.Box, cull: BOOL ] ~ { <> bb: ImagerBox.Box ~ ExtendBB[PenBB[pen], box]; RegionOf: PROC [p: VEC] RETURNS [Region] ~ { RETURN [[xLo: p.x < bb.xmin, xHi: p.x > bb.xmax, yLo: p.y < bb.ymin, yHi: p.y > bb.ymax]] }; where: {nowhere, firstpoint, normal} ¬ nowhere; first: State ¬ []; last: State ¬ []; Joint: PROC [s0, s1: State] ~ INLINE { joint[s0.p, s0.v, s1.v, s0.right, s1.right] }; Finish: PROC ~ { SELECT where FROM nowhere => NULL; firstpoint => { moveTo[Add[last.p, pen[last.right]]]; end[last.p, [-last.v.x, -last.v.y], last.right, last.left]; end[last.p, last.v, last.left, last.right]; }; ENDCASE => { IF closed THEN { Line[first.p]; SELECT Vector2.InlineCross[last.v, first.v] FROM > 0 => { moveTo[Add[last.p, pen[last.right]]]; Joint[last, first]; lineTo[Add[last.p, pen[last.left]]]; }; < 0 => { moveTo[Add[last.p, pen[first.left]]]; Joint[Reverse[first], Reverse[last]]; lineTo[Add[last.p, pen[first.right]]]; }; ENDCASE => { <> moveTo[Add[last.p, pen[0]]]; FOR i: VertexIndex IN (0..pen.size) DO lineTo[Add[last.p, pen[i]]]; ENDLOOP; }; } ELSE { moveTo[Add[last.p, pen[last.right]]]; end[last.p, last.v, last.right, last.left]; }; }; where ¬ nowhere; last.p ¬ non; }; Move: PROC [p: VEC] ~ { Finish[]; last ¬ [p, [0, 0], 0, pen.size/2]; where ¬ firstpoint; }; RoundJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ { UNTIL i0 = i1 DO i0 ¬ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; depth: NAT ¬ 0; -- keeps track of recursion depth for Conic and Curve inCurve: BOOL ¬ FALSE; -- used to prevent mitering inside of curves Parabola: PROC [p1, p2: VEC] ~ { <> join: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ IF inCurve THEN RoundJoint ELSE joint; p0: VEC ~ last.p; isLine: BOOL ~ Eq[p1, p2] OR Eq[p0, p1]; v0: VEC ~ Sub[IF isLine THEN p2 ELSE p1, p0]; v2: VEC ~ IF isLine THEN v0 ELSE Sub[p2, p1]; turning: Turning ¬ undecided; IF NOT (isLine AND Eq[p0, p2]) THEN { left: VertexIndex ~ FindVertex[pen, [-v0.y, v0.x], last.left]; right: VertexIndex ~ FindVertex[pen, [v0.y, -v0.x], last.right]; newLeft: VertexIndex ~ IF isLine THEN left ELSE FindVertex[pen, [-v2.y, v2.x], left]; newRight: VertexIndex ~ IF isLine THEN right ELSE FindVertex[pen, [v2.y, -v2.x], right]; jointFirst: BOOL ~ Vector2.InlineCross[last.v, v0] > 0; IF dbug THEN DBug["Parabola", LIST[p0, p1, p2, v0, v2], ORD[isLine] + 2*ORD[jointFirst]]; IF where = normal THEN { IF jointFirst THEN { moveTo[Add[p0, pen[last.right]]]; IF last.right # right THEN join[p0, last.v, v0, last.right, right]; } ELSE { moveTo[p0]; lineTo[Add[p0, pen[right]]]; }; } ELSE { moveTo[Add[p0, pen[right]]]; }; IF isLine THEN lineTo[Add[p2, pen[newRight]]] ELSE turning ¬ TraverseParabola[pen, [p0, p1, p2], right, newRight, lineTo, conicTo, turning]; lineTo[Add[p2, pen[newLeft]]]; IF isLine THEN lineTo[Add[p0, pen[left]]] ELSE turning ¬ TraverseParabola[pen, [p2, p1, p0], newLeft, left, lineTo, conicTo, turning]; IF where = normal THEN { IF jointFirst THEN { lineTo[p0] } ELSE { join[p0, [-v0.x, -v0.y], [-last.v.x, -last.v.y], left, last.left] } }; IF where = firstpoint THEN { IF closed THEN first ¬ [p: p0, v: v0, left: left, right: right] ELSE end[p0, [-v0.x, -v0.y], left, right]; }; last ¬ [p: p2, v: v2, left: newLeft, right: newRight]; where ¬ normal; IF depth # 0 THEN inCurve ¬ TRUE; }; }; Line: PROC [p1: VEC] ~ { IF Eq[p1, last.p] OR ((NOT closed AND where # firstpoint) AND cull AND Intersect[RegionOf[last.p], RegionOf[p1]] # ALL[FALSE]) THEN { last.p ¬ p1; RETURN }; Parabola[p1, p1]; }; Conic: ConicToProc ~ { p0: VEC ~ last.p; OutsideOfBB: PROC RETURNS [BOOL] ~ INLINE { r: Region ¬ Intersect[RegionOf[p0], RegionOf[p2]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r ¬ Intersect[r, RegionOf[p1]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; RETURN [TRUE]; }; depth ¬ depth + 1; IF depth > depthLimit OR OutsideOfBB[] OR NOT RealInline.IsValid[r] THEN { Line[p1]; Line[p2] } ELSE { SELECT r FROM > 0.9999 => { Line[p1]; Line[p2] }; <= 0.0 => { Line[p2] }; ENDCASE => { p02: VEC ~ Mid[p0, p2]; m: VEC ~ [p1.x-p02.x, p1.y-p02.y]; IF (RealInline.Abs[m.x]+RealInline.Abs[m.y])*RealInline.Abs[r-0.5] < curveTolerance THEN { Parabola[p1, p2] } ELSE { q: VEC ~ [m.x*r+p02.x, m.y*r+p02.y]; rNew: REAL ~ 1.0/(1.0+RealFns.SqRt[2.0*(1-r)]); Conic[[(p1.x-p0.x)*r+p0.x, (p1.y-p0.y)*r+p0.y], q, rNew]; Conic[[(p1.x-p2.x)*r+p2.x, (p1.y-p2.y)*r+p2.y], p2, rNew]; }; }; }; depth ¬ depth - 1; IF depth = 0 THEN inCurve ¬ FALSE; }; firstHalf: BOOL ¬ FALSE; Curve: CurveToProc ~ { p0: VEC ~ last.p; OutsideOfBB: PROC RETURNS [BOOL] ~ INLINE { r: Region ¬ Intersect[RegionOf[p0], RegionOf[p3]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r ¬ Intersect[r, RegionOf[p1]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r ¬ Intersect[r, RegionOf[p2]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; RETURN [TRUE]; }; IF dbug THEN DBug["Curve", LIST[p0, p1, p2, p3], depth]; IF depth = 0 THEN firstHalf ¬ TRUE; depth ¬ depth + 1; IF depth > depthLimit OR OutsideOfBB[] THEN { Line[p1]; Line[p2]; Line[p3] } ELSE { R: PROC [p, q: REAL] RETURNS [REAL] ~ INLINE { RETURN [q + Half[q-p]] }; Ext: PROC [p, q: VEC] RETURNS [VEC] ~ INLINE { RETURN [[R[p.x, q.x], R[p.y, q.y]]] }; q1: VEC ~ Ext[p0, p1]; q2: VEC ~ Ext[p3, p2]; error: REAL ~ RealInline.Abs[q1.x-q2.x]+RealInline.Abs[q1.y-q2.y]; IF error < curveTolerance AND (depth > 1 OR error = 0.0) THEN { Parabola[IF firstHalf THEN q1 ELSE q2, p3] } ELSE { p01: VEC ~ Mid[p0, p1]; p12: VEC ~ Mid[p1, p2]; p23: VEC ~ Mid[p2, p3]; p012: VEC ~ Mid[p01, p12]; p123: VEC ~ Mid[p12, p23]; p0123: VEC ~ Mid[p012, p123]; Curve[p01, p012, p0123]; IF depth = 1 THEN firstHalf ¬ FALSE; Curve[p123, p23, p3]; }; }; depth ¬ depth - 1; IF depth = 0 THEN inCurve ¬ FALSE; }; Arc: ArcToProc ~ {ImagerPath.ArcToConics[last.p, p1, p2, Conic]}; path[Move, Line, Curve, Conic, Arc]; Finish[]; }; verySmallNumber: REAL ¬ Real.FScale[1, -20]; SignalSquareEndWithNoDirection: PUBLIC PROC ~ { SIGNAL ImagerError.Warning[[$squareEndOnStrokeOfZeroLength, "Zero-length stroke has no direction for square end"]]; }; PathFromStroke: PUBLIC PROC [path: ImagerPath.PathProc, closed: BOOL, pen: Pen, end: EndCode, joint: JointCode, m: ImagerTransformation.Transformation, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, conicTo: ImagerPath.ConicToProc, box: ImagerBox.Box, pathT: ImagerTransformation.Transformation ¬ NIL, miterLimit: REAL ¬ 0] = { RoundEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] = { UNTIL i0 = i1 DO i0 ¬ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; SquareEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] = { IF v.x = 0.0 AND v.y = 0.0 THEN { IF end = ImagerStroke.warningSquareEnd THEN SignalSquareEndWithNoDirection[]; GOTO Exception; <> }; { ihalf: VertexIndex ¬ FindVertex[pen, v, i0]; V: VEC = ImagerTransformation.InverseTransformVec[m, v ! Real.RealException => GOTO Exception]; U: VEC = [-V.y, V.x]; u: VEC ¬ ImagerTransformation.TransformVec[m, U]; IF Vector2.InlineCross[u, v] > 0 THEN u ¬ Vector2.Neg[u]; MiterJoint[p, v, u, i0, ihalf]; MiterJoint[p, u, Vector2.Neg[v], ihalf, i1]; }; EXITS Exception => {lineTo[Add[p, pen[i1]]]}; }; Beam: PROC [v: VEC, i: VertexIndex] RETURNS [VEC] = { <> V: VEC = ImagerTransformation.InverseTransformVec[ m, v ! Real.RealException => GOTO Singular]; u: VEC = ImagerTransformation.TransformVec[m, [-V.y, V.x]]; a: REAL = Vector2.InlineCross[pen[i], v] / Vector2.InlineCross[u, v]; beam: VEC = Vector2.Mul[u, a]; RETURN[beam]; EXITS Singular => {RETURN[pen[i]]}}; ButtEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] = { IF NOT Eq[v, [0.0, 0.0]] THEN { u: VEC = Beam[v, i0]; lineTo[Add[p, u]]; lineTo[Sub[p, u]]; }; lineTo[Add[p, pen[i1]]]; }; RoundJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] = { UNTIL i0 = i1 DO i0 ¬ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; BevelJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] = { IF NOT (Eq[v0, [0.0, 0.0]] OR Eq[v1, [0.0, 0.0]]) THEN { beam0: VEC = Beam[v0, i0]; beam1: VEC = Beam[v1, i1]; lineTo[Add[p, beam0]]; lineTo[Sub[p, beam0]]; lineTo[Sub[p, pen[i0]]]; lineTo[p]; lineTo[Add[p, beam1]]; lineTo[Add[p, pen[i1]]]; lineTo[Sub[p, pen[i1]]]; lineTo[Sub[p, beam1]]; lineTo[p]; lineTo[Add[p, beam0]]; lineTo[Add[p, beam1]]; lineTo[p]; <> }; lineTo[Add[p, pen[i1]]]; }; MiterJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] = { u: VEC = Sub[pen[i1], pen[i0]]; d: REAL ¬ Vector2.InlineCross[v0, v1]; a: REAL ¬ Vector2.InlineCross[u, v1] / (RealMax[d, verySmallNumber]); lineTo[Add[p, Add[pen[i0], Vector2.Mul[v0, a]]]]; lineTo[Add[p, pen[i1]]]; }; MiterOrBevelJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] = { u: VEC = Sub[pen[i1], pen[i0]]; d: REAL ¬ Vector2.InlineCross[v0, v1]; a: REAL ¬ Vector2.InlineCross[u, v1] / (RealMax[d, verySmallNumber]); miterTipDelta: VEC = Add[pen[i0], Vector2.Mul[v0, a]]; IF miterLimit < Vector2.Length[miterTipDelta] / RealInline.AbsMin[Vector2.Length[pen[i0]], Vector2.Length[pen[i1]]] THEN { <> BevelJoint[p, v0, v1, i0, i1] } ELSE { lineTo[Add[p, miterTipDelta]]; lineTo[Add[p, pen[i1]]] }; }; Path: PROC [ moveTo: MoveToProc, lineTo: LineToProc, curveTo: CurveToProc, conicTo: ConicToProc, arcTo: ArcToProc] = { ImagerPath.Transform[ path: path, m: IF pathT = NIL THEN m ELSE pathT, moveTo: moveTo, lineTo: lineTo, curveTo: curveTo, conicTo: conicTo, arcTo: arcTo]; }; Joint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ¬ SELECT joint FROM ImagerStroke.miterJoint => ( SELECT miterLimit FROM < 1.0 => MiterJoint, = 1.0 => BevelJoint, ENDCASE => MiterOrBevelJoint ), ImagerStroke.bevelJoint => BevelJoint, ImagerStroke.roundJoint => RoundJoint, ENDCASE => MiterJoint; End: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ¬ SELECT end FROM ImagerStroke.warningSquareEnd, ImagerStroke.squareEnd => SquareEnd, ImagerStroke.buttEnd => ButtEnd, ImagerStroke.roundEnd => RoundEnd, ENDCASE => SquareEnd; PenStroke[path: Path, pen: pen, moveTo: moveTo, lineTo: lineTo, conicTo: conicTo, closed: closed, end: End, joint: Joint, box: box, cull: NOT (Joint = MiterJoint OR Joint = MiterOrBevelJoint OR End = SquareEnd)]; }; PathFromVector: PUBLIC PROC [p0, p1: VEC, pen: Pen, end: EndCode, m: ImagerTransformation.Transformation, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ { d0: VEC ~ ImagerTransformation.Transform[m, p0]; d1: VEC ~ ImagerTransformation.Transform[m, p1]; IF end = ImagerStroke.roundEnd THEN { <> RoundEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ~ INLINE { UNTIL i0 = i1 DO i0 ¬ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; direction: VEC ~ Sub[d1, d0]; ix0: NAT ~ FindVertex[pen: pen, direction: [-direction.y, direction.x]]; ix1: NAT ~ FindVertex[pen: pen, direction: [direction.y, -direction.x], i: AddMod[ix0, pen.size/2, pen.size]]; moveTo[Add[d0, pen[ix0]]]; RoundEnd[d0, Sub[d0, d1], ix0, ix1]; lineTo[Add[d1, pen[ix1]]]; RoundEnd[d1, direction, ix1, ix0]; } ELSE { <> min: VEC ¬ [maxReal, maxReal]; max: VEC ¬ [-maxReal, -maxReal]; delta: VEC ~ Sub[p1, p0]; s: REAL ~ RealInline.Abs[delta.x]+RealInline.Abs[delta.y]; t: Transformation ¬ NIL; IF s=0.0 THEN { IF end = ImagerStroke.warningSquareEnd THEN SignalSquareEndWithNoDirection[]; <> RETURN; } ELSE { <> cos: REAL ~ delta.x/s; sin: REAL ~ delta.y/s; t ¬ ImagerTransformation.Create[a: cos, b: -sin, c: 0, d: sin, e: cos, f: 0]; ImagerTransformation.ApplyPostConcat[t, m]; ImagerTransformation.ApplyInvert[t]; }; FOR i: NAT IN [0..pen.size) DO p: VEC ~ ImagerTransformation.TransformVec[t, pen[i]]; IF p.x < min.x THEN min.x ¬ p.x; IF p.x > max.x THEN max.x ¬ p.x; IF p.y < min.y THEN min.y ¬ p.y; IF p.y > max.y THEN max.y ¬ p.y; ENDLOOP; ImagerTransformation.ApplyInvert[t]; IF end = ImagerStroke.buttEnd THEN { min.x ¬ max.x ¬ 0 }; moveTo[Add[d0, ImagerTransformation.TransformVec[t, [min.x, max.y]]]]; lineTo[Add[d0, ImagerTransformation.TransformVec[t, [min.x, min.y]]]]; lineTo[Add[d1, ImagerTransformation.TransformVec[t, [max.x, min.y]]]]; lineTo[Add[d1, ImagerTransformation.TransformVec[t, [max.x, max.y]]]]; ImagerTransformation.Destroy[t]; }; }; nPts: NAT ¬ 6; RealPlusOrMinus: TYPE ~ RECORD [value: REAL, error: REAL]; AverageSpeed: PROC [p: Bezier] RETURNS [RealPlusOrMinus] ~ { <> nReal: REAL ~ nPts; min: REAL ¬ maxReal; max: REAL ¬ 0; delta: ARRAY [0..3) OF VEC ~ [Sub[p[1], p[0]], Sub[p[2], p[1]], Sub[p[3], p[2]]]; <> FOR i: NAT IN [0..nPts] DO t: REAL ~ i/nReal; s: REAL ~ 1.0-t; d01: VEC ¬ Add[Vector2.Mul[delta[0], t], Vector2.Mul[delta[1], s]]; d12: VEC ¬ Add[Vector2.Mul[delta[1], t], Vector2.Mul[delta[2], s]]; d012: VEC ¬ Add[Vector2.Mul[d01, t], Vector2.Mul[d12, s]]; sqr: REAL ~ Vector2.Square[d012]; IF sqr > max THEN max ¬ sqr; IF sqr < min THEN min ¬ sqr; ENDLOOP; max ¬ RealFns.SqRt[max]; min ¬ RealFns.SqRt[min]; RETURN [[(max+min)*1.5, (max-min)*1.5]] }; sigBits: NAT ¬ 10; DivideUntilSmooth: PROC [p: Bezier, piece: PROC [p: Bezier, speed: REAL], fullScale: REAL, maxDepth: NAT] ~ { a: RealPlusOrMinus ¬ AverageSpeed[p]; UNTIL maxDepth <= 1 OR Real.FScale[a.error, sigBits] <= fullScale DO Mid: PROC [a,b: VEC] RETURNS [VEC] ~ INLINE { RETURN [[(a.x+b.x)*0.5, (a.y+b.y)*0.5]]; }; p01: VEC ~ Mid[p[0],p[1]]; p12: VEC ~ Mid[p[1],p[2]]; p23: VEC ~ Mid[p[2],p[3]]; p012: VEC ~ Mid[p01,p12]; p123: VEC ~ Mid[p12,p23]; p0123: VEC ~ Mid[p012,p123]; maxDepth ¬ maxDepth-1; DivideUntilSmooth[[p[0], p01, p012, p0123], piece, fullScale, maxDepth]; p ¬ [p0123, p123, p23, p[3]]; a ¬ AverageSpeed[p]; ENDLOOP; IF a.value # 0 THEN piece[p, a.value]; }; SubDivide: PROC [b: Bezier, t: REAL, hi: BOOL] RETURNS [Bezier] ~ { s: REAL ~ 1-t; Interpolate: PROC [a, b: VEC] RETURNS [VEC] ~ INLINE { RETURN [[a.x*s+b.x*t, a.y*s+b.y*t]] }; q1 : VEC ~ Interpolate[b[0], b[1]]; q2: VEC ~ Interpolate[b[1], b[2]]; q3: VEC ~ Interpolate[b[2], b[3]]; qp1: VEC ~ Interpolate[q1, q2]; qp2: VEC ~ Interpolate[q2, q3]; q: VEC ~ Interpolate[qp1, qp2]; RETURN [IF hi THEN [q, qp2, q3, b[3]] ELSE [b[0], q1, qp1, q]] }; SubPiece: PROC [b: Bezier, t0, t1: REAL] RETURNS [Bezier] ~ { IF t1 # 1.0 THEN { b ¬ SubDivide[b, t1, FALSE]; IF t1 # 0.0 THEN {t0 ¬ t0/t1; t1 ¬ 1.0}; }; IF t0 # 0.0 THEN b ¬ SubDivide[b, t0, TRUE]; RETURN [b]; }; MeasurePath: PUBLIC PROC [path: PathProc, closed: BOOL ¬ FALSE] RETURNS [sum: REAL ¬ 0.0] ~ { started: BOOL ¬ FALSE; sp: VEC ¬ [0,0]; lp: VEC ¬ [0,0]; move: PROC [p0: VEC] ~ { IF started AND closed THEN line[sp]; sp ¬ lp ¬ p0; started ¬ TRUE; }; line: PROC [p1: VEC] ~ { sum ¬ sum + Vector2.Length[Sub[p1, lp]]; lp ¬ p1; }; piece: PROC [p: Bezier, speed: REAL] ~ { sum ¬ sum + speed; }; curve: PROC [p1, p2, p3: VEC] ~ TRUSTED { p: Bezier ~ [lp, p1, p2, p3]; fullScale: REAL ~ AverageSpeed[p].value; IF fullScale > 0.0 THEN DivideUntilSmooth[p, piece, fullScale, depthLimit]; lp ¬ p3; }; conic: PROC [p1, p2: VEC, r: REAL] ~ { ImagerPath.ConicToCurves[lp, p1, p2, r, curve] }; arc: PROC [p1, p2: VEC] ~ {ImagerPath.ArcToConics[lp, p1, p2, conic]}; path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc]; IF started AND closed THEN line[sp]; }; FirstDashType: TYPE = {line, curve}; FirstDashRep: TYPE = RECORD [ dashType: FirstDashType ¬ line, p1, p2: VEC ¬ [0,0] -- only used if first segment is a curve ]; ComputeStretch: PROC [path: ImagerPath.PathProc, length: REAL] RETURNS [REAL] = { IF length <= 0.0 THEN RETURN [1.0] ELSE { pathUnits: REAL = MeasurePath[path]; IF pathUnits = 0.0 THEN RETURN [1.0]; RETURN [MIN[MAX[pathUnits / length, 1.0e-8], 1.0e+8]]; }; }; AdjustOffset: PROC [offset: REAL, patternLen: NAT, pattern: PROC [i: NAT] RETURNS [REAL]] RETURNS [REAL] = { patternTotal: REAL ¬ 0.0; FOR i: INT IN [0..patternLen) DO element: REAL = pattern[i]; IF element < 0.0 THEN { ERROR ImagerError.Error[[$illegalArguments, "Negative element in dash pattern"]]; }; patternTotal ¬ patternTotal + element; ENDLOOP; IF NOT (RealInline.IsValid[patternTotal] AND RealInline.IsPositive[patternTotal]) THEN { ERROR ImagerError.Error[[$illegalArguments, "Dash pattern sum must be positive"]]; }; IF offset = 0.0 THEN RETURN [0.0] ELSE { r: REAL ¬ offset / patternTotal; IF ABS[r] >= 2**20 THEN { <> RETURN [0.0]; }; RETURN [offset - Real.Floor[r]*patternTotal] }; }; Dashes: PUBLIC PROC [path: ImagerPath.PathProc, patternLen: NAT, pattern: PROC [i: NAT] RETURNS [REAL], offset, length: REAL, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, conicTo: ImagerPath.ConicToProc, curveTo: ImagerPath.CurveToProc, closed: BOOL ¬ FALSE] = { <> stretch: REAL = ComputeStretch[path, length]; lp, fp, startOfFirstDash, endOfFirstDash: VEC ¬ [0, 0]; index: NAT ¬ 0; -- index of currently active pattern element. residual: REAL ¬ pattern[0] * stretch; -- remaining part of current pattern element, in master units. used: REAL ¬ 0.0; -- amount of pattern used, in master units. on: BOOL ¬ TRUE; needsClosedSetup: BOOL ¬ closed; firstDash: FirstDashRep ¬ [dashType: line]; Advance: PROC [patternOffset: REAL, startAction, stopAction: PROC ¬ NIL] = { anyProgress: BOOL ¬ TRUE; UNTIL used >= patternOffset DO nextUsed: REAL = used + residual; IF nextUsed > used -- Test this instead of residual=0.0, because of floating point fuzz. THEN { <> nextResidual: REAL = nextUsed - patternOffset; anyProgress ¬ TRUE; IF nextResidual <= 0.0 THEN {residual ¬ 0.0; used ¬ nextUsed} ELSE {residual ¬ nextResidual; used ¬ patternOffset}; } ELSE { <> IF on AND stopAction # NIL THEN stopAction[]; index ¬ index + 1; IF index = patternLen THEN { index ¬ 0; IF NOT anyProgress THEN { <> used ¬ patternOffset; -- Bail out silently. }; anyProgress ¬ FALSE; }; residual ¬ pattern[index] * stretch; on ¬ NOT on; IF on AND startAction # NIL THEN startAction[]; }; ENDLOOP; }; move: PROC [p0: VEC] = { lp ¬ p0; IF needsClosedSetup THEN fp ¬ startOfFirstDash ¬ p0; IF on THEN moveTo[lp] }; line: PROC [p1: VEC] = { delta: VEC = Sub[p1, lp]; d: REAL = Vector2.Length[delta]; segmentStart: REAL = used; segmentEnd: REAL = used + d; start: PROC = { s: REAL ¬ (used - segmentStart) / d; p: VEC ¬ Add[lp, Vector2.Mul[delta, s]]; moveTo[p]; IF needsClosedSetup THEN startOfFirstDash ¬ p; }; stop: PROC = { s: REAL ¬ (used - segmentStart) / d; p: VEC ¬ Add[lp, Vector2.Mul[delta, s]]; IF needsClosedSetup THEN { endOfFirstDash ¬ p; needsClosedSetup ¬ FALSE; } ELSE { lineTo[p] }; }; Advance[segmentEnd, start, stop]; IF on THEN lineTo[p1]; lp ¬ p1; }; curve: PROC [p1, p2, p3: VEC] = { piece: PROC [p: Bezier, speed: REAL] = { segmentStart: REAL = used; segmentEnd: REAL = used + speed; dashStartParam: REAL ¬ 0; needMove: BOOL ¬ FALSE; start: PROC = { dashStartParam ¬ IF speed = 0.0 THEN 1.0 ELSE (used - segmentStart) / speed; needMove ¬ TRUE; }; stop: PROC = { dashEndParam: REAL ¬ IF speed = 0.0 THEN 1.0 ELSE (used - segmentStart) / speed; b: Bezier ¬ SubPiece[p, dashStartParam, dashEndParam]; IF needsClosedSetup THEN { startOfFirstDash ¬ b[0]; firstDash.p1 ¬ b[1]; firstDash.p2 ¬ b[2]; endOfFirstDash ¬ b[3]; firstDash.dashType ¬ curve; needsClosedSetup ¬ FALSE; RETURN; }; IF needMove THEN moveTo[b[0]]; curveTo[b[1], b[2], b[3]]; needMove ¬ FALSE; }; Advance[segmentEnd, start, stop]; IF on THEN stop[]; }; p: Bezier = [lp, p1, p2, p3]; fullScale: REAL = AverageSpeed[p].value; IF fullScale > 0.0 THEN DivideUntilSmooth[p, piece, fullScale, depthLimit]; lp ¬ p3; }; conic: PROC [p1, p2: VEC, r: REAL] = { ImagerPath.ConicToCurves[lp, p1, p2, r, curve] }; arc: PROC [p1, p2: VEC] = { ImagerPath.ArcToConics[lp, p1, p2, conic] }; Advance[AdjustOffset[offset, patternLen, pattern] * stretch]; path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc]; IF closed THEN { IF needsClosedSetup THEN endOfFirstDash ¬ startOfFirstDash; line[fp]; IF lp # startOfFirstDash THEN moveTo[startOfFirstDash]; IF firstDash.dashType = line THEN lineTo[endOfFirstDash] ELSE curveTo[firstDash.p1, firstDash.p2, endOfFirstDash]; }; }; ConvolvePenWithPath: PUBLIC PROC [path: ImagerPath.PathProc, pen: Pen, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ { <> started, move: BOOL ¬ FALSE; fp: VEC ¬ [0.0, 0.0]; fi: NAT ¬ 0; lp: VEC ¬ [0.0, 0.0]; li: NAT ¬ 0; Move: ImagerPath.MoveToProc ~ { IF started THEN Close[]; fp ¬ lp ¬ p; started ¬ TRUE; move ¬ TRUE; }; Line: ImagerPath.LineToProc ~ { dx: REAL ~ p1.x - lp.x; dy: REAL ~ p1.y - lp.y; IF NOT (dx = 0.0 AND dy = 0.0) THEN { i: NAT ¬ FindVertex[pen: pen, direction: [dy, -dx], i: li]; IF move THEN { fi ¬ li ¬ i; moveTo[Add[lp, pen[li]]]; move ¬ FALSE; }; UNTIL li = i DO li ¬ AddMod[li, 1, pen.size]; lineTo[Add[lp, pen[li]]]; ENDLOOP; lineTo[Add[p1, pen[li]]]; }; lp ¬ p1; }; Close: PROC ~ { IF started THEN { IF move THEN { fi ¬ pen.size-1; li ¬ 0; moveTo[Add[lp, pen[li]]] } ELSE Line[fp]; UNTIL li = fi DO li ¬ AddMod[li, 1, pen.size]; lineTo[Add[fp, pen[li]]]; ENDLOOP; started ¬ FALSE; move ¬ FALSE; }; }; path[moveTo: Move, lineTo: Line, curveTo: NIL, conicTo: NIL, arcTo: NIL]; IF started THEN Close[]; }; MapBitPath: PUBLIC PROC [byte: BYTE, p0, v1, v2: VEC, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ { swap: BOOL ~ Vector2.InlineCross[v1, v2] < 0; Emit: PROC [p0, v1, v2: VEC] ~ { IF swap THEN { t: VEC ¬ v1; v1 ¬ v2; v2 ¬ t }; moveTo[p0]; lineTo[Add[p0, v1]]; lineTo[Add[p0, Add[v1, v2]]]; lineTo[Add[p0, v2]]; }; k: CARDINAL ¬ byte; started: BOOL ¬ FALSE; start: VEC; pi: VEC ¬ p0; FOR i: NAT IN [0..8] DO IF k >= 128 THEN { k ¬ k - 128; IF NOT started THEN { started ¬ TRUE; start ¬ pi }; } ELSE { IF started THEN { Emit[start, v1, Sub[pi, start]]; started ¬ FALSE; IF k = 0 THEN EXIT; }; }; k ¬ 2*k; pi ¬ Add[pi, v2]; ENDLOOP; }; END.