-- Copyright (C) 1983 by Xerox Corporation. All rights reserved.
-- DisplayImplF.mesa - last edited by
-- S. Schiller 8-Mar-83 18:06:34
-- Rick 22-Nov-83 17:37:12
-- Bruce 24-Feb-83 16:08:51
-- Poskanzer 20-May-83 9:04:41
DIRECTORY
BitBlt USING [BitBltFlags],
Display USING [],
DisplayOps USING [
AbsPlace, Color, LogError, FillList, FillObject, Intersect, Shade],
DisplayInternal USING [],
IVector USING [IPoint, IVec],
SpecialDisplay USING [defaultContext, LineStyle, solid, Special],
Window USING [BoxHandle, Place],
WindowOps USING [
AbsoluteBoxHandle, Bounds, DisplayList, GetContext, lock, Object, RecList,
ScanLine, ScreenBox, SpecialTimesWpl];
DisplayImplF: MONITOR LOCKS WindowOps.lock
IMPORTS DisplayOps, SpecialDisplay, WindowOps
EXPORTS DisplayInternal, SpecialDisplay, Window =
BEGIN
-- exported types
Handle: TYPE = LONG POINTER TO Object;
Object: PUBLIC TYPE = WindowOps.Object;
FillHandle: TYPE = LONG POINTER TO FillObject;
FillObject: PUBLIC TYPE = DisplayOps.FillObject;
-- copied types because John doesn't like them
LineStyle: TYPE = SpecialDisplay.LineStyle;
Special: TYPE = SpecialDisplay.Special;
yMin, yLen: INTEGER; -- used for filing
fillLeft, fillRight: FillHandle;
gA, gB, gC: LONG INTEGER; -- global coefficients for conic
gD, gE: LONG INTEGER;
gF: REAL;
gStop: IVector.IPoint; -- global stop place
gOrg: Window.Place; -- origin for coeffs
clip: WindowOps.RecList;
globeContext: Special;
globeShade: DisplayOps.Color;
StoreGlobalCoeffs: PROC [
a, b, c, d, e, errorTerm: LONG INTEGER, start: IVector.IPoint] = {
gA ← a; gB ← b; gC ← c; gD ← d; gE ← e; gF ← errorTerm - ConicEval[start]};
ConicEval: PROC [p: IVector.IPoint] RETURNS [REAL] = {
x: REAL = p.x - gOrg.x;
y: REAL = p.y - gOrg.y;
RETURN[gA*x*x + y*y*gB + x*y*gC + gD*x + gE*y]};
DxDyToSlopeDir: PUBLIC PROC [dx, dy: LONG INTEGER]
RETURNS [xDir, yDir: INTEGER] = {
SELECT dx FROM -- Note, position goes up as y decreases
< 0 => IF dy >= 0 THEN {xDir ← -1; yDir ← 1} ELSE {xDir ← -1; yDir ← -1};
> 0 => IF dy > 0 THEN {xDir ← 1; yDir ← 1} ELSE {xDir ← 1; yDir ← -1};
ENDCASE =>
IF dy > 0 THEN {xDir ← 1; yDir ← 1} ELSE {xDir ← -1; yDir ← -1}};
DxConic: PROC [place: IVector.IPoint] RETURNS [LONG INTEGER] = {
RETURN[2*gA*(place.x - gOrg.x) + gC*(place.y - gOrg.y) + gD]};
DyConic: PROC [place: IVector.IPoint] RETURNS [LONG INTEGER] = {
RETURN[2*gB*(place.y - gOrg.y) + gC*(place.x - gOrg.x) + gE]};
Conic: PUBLIC ENTRY PROC [
window: Handle, a, b, c, d, e, errorTerm: LONG INTEGER,
start, stop, origin: Window.Place, sharpCornered: BOOLEAN,
bounds: Window.BoxHandle ← NIL] = {
ENABLE UNWIND => NULL;
absBounds: WindowOps.ScreenBox =
IF bounds = NIL THEN WindowOps.Bounds[window]
ELSE WindowOps.AbsoluteBoxHandle[window, bounds];
absStart: Window.Place = DisplayOps.AbsPlace[window, start];
absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
gOrg ← DisplayOps.AbsPlace[window, origin];
globeShade ← black;
IF ~window.inTree THEN RETURN;
StoreGlobalCoeffs[a, b, c, d, e, errorTerm, absStart];
FOR r: WindowOps.RecList ← WindowOps.DisplayList[window], r.link UNTIL r =
NIL DO
clip ← r;
IF DisplayOps.Intersect[r, absBounds] THEN {
globeContext ← SpecialDisplay.defaultContext;
DDAStartUp[
start: absStart, stop: absStop, startError: errorTerm,
selected: FALSE, filled: FALSE, sharp: sharpCornered,
dashes: SpecialDisplay.solid]};
ENDLOOP};
SpecialConic: PUBLIC ENTRY PROC [
window: Handle, a, b, c, d, e, errorTerm: LONG INTEGER,
start, stop, origin: Window.Place, sharpCornered: BOOLEAN,
bounds: Window.BoxHandle, dashes: SpecialDisplay.LineStyle,
flags: BitBlt.BitBltFlags,
context: Special ← SpecialDisplay.defaultContext] = {
ENABLE UNWIND => NULL;
absBounds: WindowOps.ScreenBox =
IF bounds = NIL THEN WindowOps.Bounds[window]
ELSE WindowOps.AbsoluteBoxHandle[window, bounds];
absStart: Window.Place = DisplayOps.AbsPlace[window, start];
absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
filled: BOOLEAN = context.alloc # NIL;
gOrg ← DisplayOps.AbsPlace[window, origin];
globeShade ← DisplayOps.Shade[flags];
IF ~window.inTree THEN RETURN;
FOR r: WindowOps.RecList ← DisplayOps.FillList[window, filled], r.link UNTIL
r = NIL DO
globeContext ← WindowOps.GetContext[r, context];
clip ← r;
IF DisplayOps.Intersect[r, absBounds] THEN {
StoreGlobalCoeffs[a, b, c, d, e, errorTerm, absStart];
IF filled THEN {
yMin ← MAX[r.box.top, absBounds.top] - 1; -- add saftey bit below
yLen ← MIN[r.box.bottom, absBounds.bottom] - yMin + 1; -- and above
fillLeft ← globeContext.alloc[window, yMin, yLen];
fillRight ← globeContext.alloc[window, yMin, yLen]};
DDAStartUp[
absStart, absStop, errorTerm, TRUE, filled, sharpCornered, dashes];
IF filled THEN { -- clip fill arrays to window
FOR i: INTEGER IN [0..yLen) DO
fillLeft.xs[i] ← MIN[
MAX[fillLeft.xs[i], r.box.left], r.box.right];
fillRight.xs[i] ← MIN[
MAX[fillRight.xs[i], r.box.left], r.box.right];
ENDLOOP}};
ENDLOOP};
-- variables below are initalized by DDAStartUp and used by DDA routines.
-- DDALoopCount, dot, xDot, yDot, xyDot and inBox are also updated
-- by DDA routines.
stopInRightUpDDA, stopInLeftUpDDA, stopInLeftDownDDA, stopInRightDownDDA:
BOOLEAN; -- informs apprpriate DDA to check if it is passing stop point
DDALoopMax, DDALoopCount: CARDINAL; -- used make sure we dont stop too soon
dx, dy, dxdy, dxdx, dydy: LONG INTEGER;
dot, xDot, yDot, xyDot, newXyDot: INTEGER; --used to corerce sharp corned curves
dotVec: IVector.IVec;
dotFudge: INTEGER = -1; -- more sharp cornered stuff
inBox: BOOLEAN; -- true if point currently maintained in DDA in visible
oldX, oldY: INTEGER;
gSelected: BOOLEAN ← FALSE; -- global selected
gFilled: BOOLEAN; -- global filled
gSharp: BOOLEAN; -- global sharp flag
-- dashed lines stuff below
dOrtho: CARDINAL = 5;
dDiag: CARDINAL = 7;
start1: CARDINAL = 0;
stop1, start2, stop2, start3, stop3: CARDINAL;
dashSum, dashCnt: CARDINAL;
thickness: CARDINAL; -- line thickness
dotVisible: BOOLEAN;
DotVisible: PROC [x, y: INTEGER] RETURNS [BOOLEAN] = INLINE {
RETURN[
x IN [clip.box.left..clip.box.right)
AND y IN [clip.box.top..clip.box.bottom)]};
DDAStartUp: PROC [
start, stop: IVector.IPoint, startError: LONG INTEGER, selected: BOOLEAN,
filled: BOOLEAN, sharp: BOOLEAN, dashes: LineStyle] = {
dxStart: LONG INTEGER ← DyConic[start];
dyStart: LONG INTEGER ← -DxConic[start];
dxStop: LONG INTEGER ← DyConic[stop];
dyStop: LONG INTEGER ← -DxConic[stop];
startXDir, startYDir, stopXDir, stopYDir: INTEGER;
Slope: TYPE = RECORD [xDir, yDir: INTEGER];
x: INTEGER = start.x;
y: INTEGER = start.y;
-- Returns true if we have to loop around the curve to get from start
-- to stop, note start = stop returns TRUE.
StartAfterStop: PROC [xDir, yDir: INTEGER] RETURNS [BOOLEAN] = INLINE {
RETURN[
xDir*(start.x - stop.x) > 0 OR yDir*(start.y - stop.y) > 0
OR (start.x = stop.x AND start.y = stop.y -- for ellipses -- )]};
-- set up global variables
gStop ← stop;
gFilled ← filled;
gSharp ← sharp;
gSelected ← selected;
-- set up line style parameters
thickness ← dashes.thickness;
stop1 ← dashes.widths[0]*dOrtho;
start2 ← stop1 + dashes.widths[1]*dOrtho;
stop2 ← start2 + dashes.widths[2]*dOrtho;
start3 ← stop2 + dashes.widths[3]*dOrtho;
stop3 ← start3 + dashes.widths[4]*dOrtho;
dashSum ← stop3 + dashes.widths[5]*dOrtho;
dashCnt ← 0;
-- set up loop monitoring and stop detection
DDALoopCount ← 0;
DDALoopMax ← 0;
stopInRightUpDDA ← stopInLeftUpDDA ← stopInLeftDownDDA ← stopInRightDownDDA
← FALSE;
-- set up DDA parameters
dxdy ← gC;
dxdx ← gA*2;
dydy ← gB*2;
-- inBox used to for fill projections stuff
inBox ← DotVisible[start.x, start.y];
IF sharp THEN {
-- set up parameters for keeping conic on right side of line
xDif: INTEGER = stop.x - start.x;
yDif: INTEGER = stop.y - start.y;
tan45: INTEGER = 1; -- tangent of 45 degrees, rotation angle
-- below does a psuedo rotation by arctan[tan45];
dxStart ← xDif/tan45 - yDif;
dyStart ← xDif + yDif/tan45;
dxStop ← xDif/tan45 + yDif;
dyStop ← -xDif + yDif/tan45;
dotVec ← [-yDif, xDif];
dot ← 0};
[xDir: stopXDir, yDir: stopYDir] ← DxDyToSlopeDir[dxStop, dyStop];
SELECT Slope[xDir: stopXDir, yDir: stopYDir] FROM
[1, -1] => stopInRightUpDDA ← TRUE;
[-1, -1] => stopInLeftUpDDA ← TRUE;
[-1, 1] => stopInLeftDownDDA ← TRUE;
[1, 1] => stopInRightDownDDA ← TRUE;
ENDCASE;
[xDir: startXDir, yDir: startYDir] ← DxDyToSlopeDir[dxStart, dyStart];
SELECT Slope[xDir: startXDir, yDir: startYDir] FROM
[1, -1] => {
IF stopInRightUpDDA AND StartAfterStop[xDir: startXDir, yDir: startYDir]
THEN DDALoopMax ← 2;
RightUpORLeftDown[start: start, error: startError, isRightUp: TRUE]};
[-1, -1] => {
IF stopInLeftUpDDA AND StartAfterStop[xDir: startXDir, yDir: startYDir]
THEN DDALoopMax ← 2;
LeftUpORRightDown[start: start, error: startError, isLeftUp: TRUE]};
[-1, 1] => {
IF stopInLeftDownDDA
AND StartAfterStop[xDir: startXDir, yDir: startYDir] THEN
DDALoopMax ← 2;
RightUpORLeftDown[start: start, error: startError, isRightUp: FALSE]};
[1, 1] => {
IF stopInRightDownDDA
AND StartAfterStop[xDir: startXDir, yDir: startYDir] THEN
DDALoopMax ← 2;
LeftUpORRightDown[start: start, error: startError, isLeftUp: FALSE]};
ENDCASE};
-- Below are two DDA routines.
-- They are pretty much the same, the difference being that one
-- is optimized to handle the right-up and left-down directions
-- while the other handles the left-up and right-down directions.
-- IMPORTANT NOTE FOR MODIFICATIONS:
-- If you fix a bug in one of the DDA routines, most likely you need to
-- fix it in the other. In this case note the following symetry
-- in the code of the routines. Each DDA routine consists of two parts,
-- a steep DDA and a shalow DDA. In one the shallow DDA is first and
-- in the other the steep DDA is first. The difference between a steep DDA
-- and a shalow DDA is that x and y are interchanged. The difference
-- between first and second DDAs is that different variables are
-- maintained and used to determine the direction of the next move.
-- (in particluar, newXyerror is used in place of xyerror in the second DDA.)
-- The only other differences in the routines are 1) they have different
-- names, 2) the declarations of the constants checkYstop and checkXstop and the
-- INLINE procedures xDir and yDir and the StartFillSeg EndFillSeg INLINES, 3)
-- The DDA's they call when done with their section of the curve are
-- different. There is one other important asymetry: RightUpORLeftDown
-- increments the variable DDALoopCount, while the other one doesn't.
RightUpORLeftDown: PROC [
start: IVector.IPoint, error: LONG INTEGER, isRightUp: BOOLEAN] = {
xDir: PROC [i: INTEGER] RETURNS [INTEGER] = INLINE {
RETURN[IF isRightUp THEN i ELSE -i]};
yDir: PROC [i: INTEGER] RETURNS [INTEGER] = INLINE {
RETURN[IF isRightUp THEN -i ELSE i]};
xDirL: PROC [i: LONG INTEGER] RETURNS [LONG INTEGER] = INLINE {
RETURN[IF isRightUp THEN i ELSE -i]};
yDirL: PROC [i: LONG INTEGER] RETURNS [LONG INTEGER] = INLINE {
RETURN[IF isRightUp THEN -i ELSE i]};
newDy, newDx: LONG INTEGER;
xerror, yerror, xyerror, newXyerror: LONG INTEGER;
x: INTEGER ← start.x;
y: INTEGER ← start.y;
ySL: WindowOps.ScanLine ←
globeContext.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[start.y],
globeContext];
checkYstop: BOOLEAN =
IF isRightUp THEN (stopInRightUpDDA OR stopInLeftUpDDA)
AND DDALoopMax <= DDALoopCount
ELSE (stopInLeftDownDDA OR stopInRightDownDDA)
AND DDALoopMax <= DDALoopCount;
checkXstop: BOOLEAN =
IF isRightUp THEN stopInRightUpDDA AND DDALoopMax <= DDALoopCount
ELSE stopInLeftDownDDA AND DDALoopMax <= DDALoopCount;
StartFillSegment: PROC [x, y: INTEGER] = INLINE {
IF gFilled AND y IN [clip.box.top..clip.box.bottom) THEN {
y ← y - yMin;
IF y < 0 OR y >= yLen THEN DisplayOps.LogError[];
IF isRightUp THEN fillRight.xs[y] ← x ELSE fillLeft.xs[y] ← x}};
EndFillSegment: PROC [x, y: INTEGER] = INLINE {
IF gFilled AND y IN [clip.box.top..clip.box.bottom) THEN {
y ← y - yMin;
IF y < 0 OR y >= yLen THEN DisplayOps.LogError[];
IF isRightUp THEN fillRight.xs[y] ← x ELSE fillLeft.xs[y] ← x}};
IncDDALoopCount: PROC = {
DDALoopCount ← DDALoopCount + 1;
IF DDALoopCount > 2 THEN DisplayOps.LogError[infiniteConicDDALoop]};
--
StartFillSegment[x, y];
dx ← DxConic[start] + xDirL[gA];
dy ← DyConic[start] + yDirL[gB];
oldX ← x;
oldY ← y;
-- shallow part
UNTIL checkXstop AND xDir[x - gStop.x] >= 0
OR checkYstop AND yDir[y - gStop.y] > 0 DO
-- x varies more quickly
xerror ← error + xDirL[dx];
newDy ← dy + xDirL[dxdy];
xyerror ← xerror + yDirL[newDy];
yerror ← error + yDirL[dy];
IF gSharp THEN {
xDot ← dot + xDir[dotVec.x];
xyDot ← xDot + yDir[dotVec.y];
yDot ← dot + yDir[dotVec.y]};
IF xerror <= 0 OR (xyerror <= 0 AND xerror <= -xyerror)
OR (gSharp AND xyDot <= dotFudge) THEN { -- inc x only
error ← xerror;
x ← x + xDir[1];
dx ← dx + xDirL[dxdx];
dy ← newDy;
dot ← xDot;
dashCnt ← dashCnt + dOrtho}
ELSE
IF xyerror <= 0 OR (yerror <= 0 AND xyerror <= -yerror)
OR (gSharp AND yDot <= dotFudge) THEN { -- both x and y change
error ← xyerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
x ← x + xDir[1];
dx ← dx + xDirL[dxdx] + yDirL[dxdy];
dy ← newDy + yDirL[dydy];
dot ← xyDot;
dashCnt ← dashCnt + dDiag;
EndFillSegment[oldX, oldY];
StartFillSegment[x, y]}
ELSE EXIT;
-- "paint dot"
dotVisible ← DotVisible[x, y];
UNTIL dashCnt < dashSum DO dashCnt ← dashCnt - dashSum ENDLOOP;
IF NOT gFilled
AND
(dashCnt IN [start1..stop1) OR dashCnt IN [start2..stop2)
OR dashCnt IN [start3..stop3)) THEN {
IF dotVisible THEN
ySL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[x]);
IF thickness > 1 THEN { -- shalow part, interior above
quotiet: INTEGER = thickness/2;
remainder: INTEGER = thickness MOD 2;
FOR i: INTEGER IN [1..quotiet] DO
thickY: INTEGER ← y + yDir[i];
thickYSL: WindowOps.ScanLine ← ySL + yDir[i*globeContext.wpl];
IF DotVisible[x, thickY] THEN
thickYSL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~thickYSL[x]);
IF i < quotiet OR remainder = 1 THEN {
thickY ← y - yDir[i];
thickYSL ← ySL - yDir[i*globeContext.wpl];
IF DotVisible[x, thickY] THEN
thickYSL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~thickYSL[x])};
ENDLOOP}};
oldX ← x;
oldY ← y;
REPEAT FINISHED => {EndFillSegment[x, y]; RETURN}
ENDLOOP;
EndFillSegment[x, y];
-- steep part
UNTIL checkXstop AND xDir[x - gStop.x] > 0
OR checkYstop AND yDir[y - gStop.y] >= 0 DO
yerror ← error + yDirL[dy];
newDx ← dx + yDirL[dxdy];
xyerror ← yerror + xDirL[newDx];
newXyerror ← yerror - xDirL[newDx] + dxdx;
IF gSharp THEN {
yDot ← dot + yDir[dotVec.y];
xyDot ← yDot + xDir[dotVec.x];
newXyDot ← yDot - xDir[dotVec.x]};
IF xyerror <= 0 OR (yerror <= 0 AND xyerror <= -yerror)
OR (gSharp AND yDot <= dotFudge) THEN { -- both change
error ← xyerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
x ← x + xDir[1];
dx ← newDx + xDirL[dxdx];
dy ← dy + yDirL[dydy] + xDirL[dxdy];
dot ← xyDot;
dashCnt ← dashCnt + dDiag}
ELSE
IF yerror <= 0 OR (newXyerror <= 0 AND yerror <= -newXyerror)
OR (gSharp AND newXyDot <= dotFudge) THEN { -- only y changes
error ← yerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
dx ← newDx;
dy ← dy + yDirL[dydy];
dot ← yDot;
dashCnt ← dashCnt + dOrtho}
ELSE EXIT;
dotVisible ← DotVisible[x, y];
UNTIL dashCnt < dashSum DO dashCnt ← dashCnt - dashSum ENDLOOP;
IF NOT gFilled
AND
(dashCnt IN [start1..stop1) OR dashCnt IN [start2..stop2)
OR dashCnt IN [start3..stop3)) THEN {
IF dotVisible THEN
ySL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[x]);
IF thickness > 1 THEN { -- steep part, interior to the left
quotiet: INTEGER = thickness/2;
remainder: INTEGER = thickness MOD 2;
FOR i: INTEGER IN [1..quotiet] DO
thickX: INTEGER ← x - xDir[i];
IF DotVisible[thickX, y] THEN
ySL[thickX] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[thickX]);
IF i < quotiet OR remainder = 1 THEN {
thickX ← x + xDir[i];
IF DotVisible[thickX, y] THEN
ySL[thickX] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[thickX])};
ENDLOOP}};
StartFillSegment[x, y];
EndFillSegment[x, y];
oldX ← x;
oldY ← y;
REPEAT FINISHED => {RETURN}
ENDLOOP;
IncDDALoopCount[];
LeftUpORRightDown[start: [x, y], error: error, isLeftUp: isRightUp]};
LeftUpORRightDown: PROC [
start: IVector.IPoint, error: LONG INTEGER, isLeftUp: BOOLEAN] = {
xDir: PROC [i: INTEGER] RETURNS [INTEGER] = INLINE {
RETURN[IF isLeftUp THEN -i ELSE i]};
yDir: PROC [i: INTEGER] RETURNS [INTEGER] = INLINE {
RETURN[IF isLeftUp THEN -i ELSE i]};
xDirL: PROC [i: LONG INTEGER] RETURNS [LONG INTEGER] = INLINE {
RETURN[IF isLeftUp THEN -i ELSE i]};
yDirL: PROC [i: LONG INTEGER] RETURNS [LONG INTEGER] = INLINE {
RETURN[IF isLeftUp THEN -i ELSE i]};
newDy, newDx: LONG INTEGER;
xerror, yerror, xyerror, newXyerror: LONG INTEGER;
x: INTEGER ← start.x;
y: INTEGER ← start.y;
ySL: WindowOps.ScanLine ←
globeContext.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[start.y],
globeContext];
checkXstop: BOOLEAN =
IF isLeftUp THEN (stopInLeftUpDDA OR stopInLeftDownDDA)
AND DDALoopMax <= DDALoopCount
ELSE (stopInRightDownDDA OR stopInRightUpDDA)
AND DDALoopMax <= DDALoopCount;
checkYstop: BOOLEAN =
IF isLeftUp THEN stopInLeftUpDDA AND DDALoopMax <= DDALoopCount
ELSE stopInRightDownDDA AND DDALoopMax <= DDALoopCount;
StartFillSegment: PROC [x, y: INTEGER] = INLINE {
IF gFilled AND y IN [clip.box.top..clip.box.bottom) THEN {
y ← y - yMin;
IF y < 0 OR y >= yLen THEN DisplayOps.LogError[];
IF isLeftUp THEN fillRight.xs[y] ← x ELSE fillLeft.xs[y] ← x}};
EndFillSegment: PROC [x, y: INTEGER] = INLINE {
IF gFilled AND y IN [clip.box.top..clip.box.bottom) THEN {
y ← y - yMin;
IF y < 0 OR y >= yLen THEN DisplayOps.LogError[];
IF isLeftUp THEN fillRight.xs[y] ← x ELSE fillLeft.xs[y] ← x}};
--
StartFillSegment[x, y];
EndFillSegment[x, y];
dx ← DxConic[start] + xDirL[gA];
dy ← DyConic[start] + yDirL[gB];
oldX ← x;
oldY ← y;
-- steep part
UNTIL checkXstop AND xDir[x - gStop.x] > 0
OR checkYstop AND yDir[y - gStop.y] >= 0 DO
-- y varies more quickly
yerror ← error + yDirL[dy];
newDx ← dx + yDirL[dxdy];
xyerror ← yerror + xDirL[newDx];
xerror ← error + xDirL[dx];
IF gSharp THEN {
xDot ← dot + xDir[dotVec.x];
xyDot ← xDot + yDir[dotVec.y];
yDot ← dot + yDir[dotVec.y]};
IF yerror <= 0 OR (xyerror <= 0 AND yerror <= -xyerror)
OR (gSharp AND xyDot <= dotFudge) THEN { -- only y changes
error ← yerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
dx ← newDx;
dy ← dy + yDirL[dydy];
dot ← yDot;
dashCnt ← dashCnt + dOrtho}
ELSE
IF xyerror <= 0 OR (xerror <= 0 AND xyerror <= -xerror)
OR (gSharp AND xDot <= dotFudge) THEN { -- both change
error ← xyerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
x ← x + xDir[1];
dx ← newDx + xDirL[dxdx];
dy ← dy + yDirL[dydy] + xDirL[dxdy];
dot ← xyDot;
dashCnt ← dashCnt + dDiag}
ELSE EXIT;
dotVisible ← DotVisible[x, y];
UNTIL dashCnt < dashSum DO dashCnt ← dashCnt - dashSum ENDLOOP;
IF NOT gFilled
AND
(dashCnt IN [start1..stop1) OR dashCnt IN [start2..stop2)
OR dashCnt IN [start3..stop3)) THEN {
IF dotVisible THEN
ySL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[x]);
IF thickness > 1 THEN { -- steep part, interior to the left
quotiet: INTEGER = thickness/2;
remainder: INTEGER = thickness MOD 2;
FOR i: INTEGER IN [1..quotiet] DO
thickX: INTEGER ← x + xDir[i];
IF DotVisible[thickX, y] THEN
ySL[thickX] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[thickX]);
IF i < quotiet OR remainder = 1 THEN {
thickX ← x - xDir[i];
IF DotVisible[thickX, y] THEN
ySL[thickX] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[thickX])};
ENDLOOP}};
StartFillSegment[x, y];
EndFillSegment[x, y];
oldX ← x;
oldY ← y;
REPEAT FINISHED => {RETURN}
ENDLOOP;
-- shallow part
oldX ← x;
oldY ← y;
StartFillSegment[x, y];
UNTIL checkXstop AND xDir[x - gStop.x] >= 0
OR checkYstop AND yDir[y - gStop.y] > 0 DO
xerror ← error + xDirL[dx];
newDy ← dy + xDirL[dxdy];
xyerror ← xerror + yDirL[newDy];
newXyerror ← xerror - yDirL[newDy] + dydy;
IF gSharp THEN {
xDot ← dot + xDir[dotVec.x];
xyDot ← xDot + yDir[dotVec.y];
newXyDot ← xDot - yDir[dotVec.y]};
IF xyerror <= 0 OR (xerror <= 0 AND xyerror <= -xerror)
OR (gSharp AND xDot <= dotFudge) THEN { -- both change
error ← xyerror;
ySL ← ySL + yDir[globeContext.wpl];
y ← y + yDir[1];
x ← x + xDir[1];
dx ← dx + xDirL[dxdx] + yDirL[dxdy];
dy ← newDy + yDirL[dydy];
dot ← xyDot;
dashCnt ← dashCnt + dDiag;
EndFillSegment[oldX, oldY];
StartFillSegment[x, y]}
ELSE
IF xerror <= 0 OR (newXyerror <= 0 AND xerror <= -newXyerror)
OR (gSharp AND newXyDot <= dotFudge) THEN { -- only x changes
error ← xerror;
x ← x + xDir[1];
dx ← dx + xDirL[dxdx];
dy ← newDy;
dashCnt ← dashCnt + dOrtho;
dot ← xDot}
ELSE EXIT;
dotVisible ← DotVisible[x, y];
UNTIL dashCnt < dashSum DO dashCnt ← dashCnt - dashSum ENDLOOP;
IF NOT gFilled
AND
(dashCnt IN [start1..stop1) OR dashCnt IN [start2..stop2)
OR dashCnt IN [start3..stop3)) THEN {
IF dotVisible THEN
ySL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~ySL[x]);
IF thickness > 1 THEN { -- shalow part, interior below
quotiet: INTEGER = thickness/2;
remainder: INTEGER = thickness MOD 2;
FOR i: INTEGER IN [1..quotiet] DO
thickY: INTEGER ← y - yDir[i];
thickYSL: WindowOps.ScanLine ← ySL - yDir[i*globeContext.wpl];
IF DotVisible[x, thickY] THEN
thickYSL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~thickYSL[x]);
IF i < quotiet OR remainder = 1 THEN {
thickY ← y + yDir[i];
thickYSL ← ySL + yDir[i*globeContext.wpl];
IF DotVisible[x, thickY] THEN
thickYSL[x] ←
(SELECT globeShade FROM
white => FALSE,
black => TRUE,
ENDCASE => ~thickYSL[x])};
ENDLOOP}};
oldX ← x;
oldY ← y;
REPEAT FINISHED => {EndFillSegment[x, y]; RETURN}
ENDLOOP;
EndFillSegment[x, y];
RightUpORLeftDown[start: [x, y], error: error, isRightUp: NOT isLeftUp]};
END.