-- ALELines.mesa
-- Edited by Sweet, September 12, 1980 12:01 AM
DIRECTORY
ALEOps,
InlineDefs,
Storage,
Table,
UserTerminal,
Window;
ALELines: PROGRAM
IMPORTS ALEOps, InlineDefs, Storage, Table, UserTerminal, Window
EXPORTS ALEOps =
BEGIN OPEN ALEOps;
header: PUBLIC ALEHeader ← [0, 0, 0, 0, 0, 0, 0, LTNull, LBNull, PTNull, LTNull, LBNull];
ptb, ltb, lbb, hrb, vrb: Table.Base;
tableSpace: POINTER;
hArray: PUBLIC DESCRIPTOR FOR ARRAY OF HorizRec;
vArray: PUBLIC DESCRIPTOR FOR ARRAY OF VertRec;
lastH, lastV: PUBLIC INTEGER;
LineNotify: Table.Notifier =
BEGIN
ptb ← base[ptType];
ltb ← base[ltType];
lbb ← base[lbType];
hrb ← base[hrType];
hArray ← DESCRIPTOR[hrb, LENGTH[hArray]];
vrb ← base[vrType];
vArray ← DESCRIPTOR[vrb, LENGTH[vArray]];
END;
InitLines: PUBLIC PROC =
BEGIN
weights: ARRAY [0..nTables) OF CARDINAL ← [10, 10, 10, 10, 10, 10, 10];
p: POINTER;
header ← [0, 0, 0, 0, 0, 0, 0, LTNull, LBNull, PTNull, LTNull, LBNull];
tableSpace ← p ← Storage.Pages[60];
hArray ← DESCRIPTOR[NIL, 0];
vArray ← DESCRIPTOR[NIL, 0];
lastH ← lastV ← -1;
Table.Create[[LOOPHOLE[p], 60*256], DESCRIPTOR[weights]];
Table.AddNotify[LineNotify];
InitHash[];
END;
ResetLines: PUBLIC PROC =
BEGIN
FOR i: CARDINAL IN [0..nTables) DO Table.Trim[i, 0] ENDLOOP;
hArray ← DESCRIPTOR[NIL, 0];
vArray ← DESCRIPTOR[NIL, 0];
lastH ← lastV ← -1;
ResetHash[];
header ← [0, 0, 0, 0, 0, 0, 0, LTNull, LBNull, PTNull, LTNull, LBNull]
END;
lastHY: ADistance;
FindHList: PROC [y: ADistance, addNew: BOOLEAN ← FALSE] RETURNS [hi: INTEGER] =
BEGIN
l, u: INTEGER;
l ← 0; u ← LENGTH[hArray] - 1;
IF u = -1 AND ~addNew THEN RETURN[-1];
IF lastH # -1 THEN SELECT y FROM
> lastHY => l ← MIN[lastH + 1, LENGTH[hArray]-1];
< lastHY => u ← MAX[lastH - 1, 0];
ENDCASE => RETURN[lastH];
WHILE l <= u DO
hi ← (l+u)/2;
SELECT hArray[hi].y FROM
< y => l ← hi + 1;
> y => u ← hi - 1;
ENDCASE => {lastHY ← y; lastH ← hi; RETURN};
ENDLOOP;
hi ← l;
IF ~addNew THEN
{IF hi = LENGTH[hArray] THEN RETURN[-1];
lastHY ← hArray[hi].y; lastH ← hi; RETURN}; -- first item > y
[] ← Table.Allocate[hrType, SIZE[HorizRec]];
hArray ← DESCRIPTOR[hrb, LENGTH[hArray]+1];
FOR i: INTEGER DECREASING IN (hi..LENGTH[hArray]) DO
hArray[i] ← hArray[i-1];
ENDLOOP;
hArray[hi] ← [y: y];
lastHY ← y; lastH ← hi;
RETURN
END;
AddHoriz: PROCEDURE [l: LTIndex] =
BEGIN
x1: ADistance = ptb[ltb[l].p1].pos.x;
x2: ADistance = ptb[ltb[l].p2].pos.x;
y: ADistance = ptb[ltb[l].p1].pos.y;
hi: INTEGER = FindHList[y, TRUE];
prev: LTIndex ← LTNull;
m: LTIndex ← hArray[hi].lines;
WHILE m # LTNull AND ptb[ltb[m].p1].pos.x < x1 DO
prev ← m; m ← ltb[m].thread;
ENDLOOP;
IF prev = LTNull THEN {hArray[hi].lines ← l; hArray[hi].l.min ← x1}
ELSE ltb[prev].thread ← l;
ltb[l].thread ← m;
hArray[hi].l.max ← MAX[hArray[hi].l.max, x2];
hArray[hi].maxW ← MAX[hArray[hi].maxW, ltb[l].width];
END;
UnChainHoriz: PROC [l: LTIndex] =
BEGIN
hi: INTEGER = FindHList[ptb[ltb[l].p1].pos.y];
prev: LTIndex ← LTNull;
IF hi = -1 THEN ERROR;
FOR nl: LTIndex ← hArray[hi].lines, ltb[nl].thread WHILE
nl # l DO
IF nl = LTNull THEN ERROR;
prev ← nl;
ENDLOOP;
IF hArray[hi].l.min = ptb[ltb[l].p1].pos.x OR
hArray[hi].l.max = ptb[ltb[l].p2].pos.x THEN
BEGIN
max: INTEGER ← 0;
min: INTEGER ← LAST[INTEGER];
FOR nl: LTIndex ← hArray[hi].lines, ltb[nl].thread WHILE
nl # LTNull DO
min ← MIN[ptb[ltb[nl].p1].pos.x, min];
max ← MAX[ptb[ltb[nl].p2].pos.x, max];
ENDLOOP;
hArray[hi].l ← [min: min, max: max];
END;
IF prev = LTNull THEN hArray[hi].lines ← ltb[l].thread
ELSE ltb[prev].thread ← ltb[l].thread;
END;
UnChainVert: PROC [l: LTIndex] =
BEGIN
vi: INTEGER = FindVList[ptb[ltb[l].p1].pos.x];
prev: LTIndex ← LTNull;
IF vi = -1 THEN ERROR;
FOR nl: LTIndex ← vArray[vi].lines, ltb[nl].thread WHILE
nl # l DO
IF nl = LTNull THEN ERROR;
prev ← nl;
ENDLOOP;
IF vArray[vi].l.min = ptb[ltb[l].p1].pos.y OR
vArray[vi].l.max = ptb[ltb[l].p2].pos.y THEN
BEGIN
max: INTEGER ← 0;
min: INTEGER ← LAST[INTEGER];
FOR nl: LTIndex ← vArray[vi].lines, ltb[nl].thread WHILE
nl # LTNull DO
min ← MIN[ptb[ltb[nl].p1].pos.y, min];
max ← MAX[ptb[ltb[nl].p2].pos.y, max];
ENDLOOP;
vArray[vi].l ← [min: min, max: max];
END;
IF prev = LTNull THEN vArray[vi].lines ← ltb[l].thread
ELSE ltb[prev].thread ← ltb[l].thread;
END;
UnChainDiag: PROC [l: LTIndex] =
BEGIN
prev: LTIndex ← LTNull;
FOR nl: LTIndex ← header.diagLines, ltb[nl].thread WHILE
nl # l DO
IF nl = LTNull THEN ERROR;
prev ← nl;
ENDLOOP;
IF prev = LTNull THEN header.diagLines ← ltb[l].thread
ELSE ltb[prev].thread ← ltb[l].thread;
END;
lastVX: ADistance;
FindVList: PROC [x: ADistance, addNew: BOOLEAN ← FALSE] RETURNS [vi: INTEGER] =
BEGIN
l, u: INTEGER;
l ← 0; u ← LENGTH[vArray] - 1;
IF u = -1 AND ~addNew THEN RETURN[-1];
IF lastV # -1 THEN SELECT x FROM
> lastVX => l ← MIN[lastV + 1, LENGTH[vArray]-1];
< lastVX => u ← MAX[lastV - 1, 0];
ENDCASE => RETURN[lastV];
WHILE l <= u DO
vi ← (l+u)/2;
SELECT vArray[vi].x FROM
< x => l ← vi + 1;
> x => u ← vi - 1;
ENDCASE => {lastVX ← x; lastV ← vi; RETURN};
ENDLOOP;
vi ← l;
IF ~addNew THEN
{IF vi = LENGTH[vArray] THEN RETURN[-1];
lastVX ← vArray[vi].x; lastV ← vi; RETURN}; -- first item > x
[] ← Table.Allocate[vrType, SIZE[VertRec]];
vArray ← DESCRIPTOR[vrb, LENGTH[vArray]+1];
FOR i: INTEGER DECREASING IN (vi..LENGTH[vArray]) DO
vArray[i] ← vArray[i-1];
ENDLOOP;
vArray[vi] ← [x: x];
lastVX ← x; lastV ← vi;
RETURN
END;
AddVert: PROCEDURE [l: LTIndex] =
BEGIN
y1: ADistance = ptb[ltb[l].p1].pos.y;
y2: ADistance = ptb[ltb[l].p2].pos.y;
x: ADistance = ptb[ltb[l].p1].pos.x;
vi: INTEGER = FindVList[x, TRUE];
prev: LTIndex ← LTNull;
m: LTIndex ← vArray[vi].lines;
WHILE m # LTNull AND ptb[ltb[m].p1].pos.y < y1 DO
prev ← m; m ← ltb[m].thread;
ENDLOOP;
IF prev = LTNull THEN {vArray[vi].lines ← l; vArray[vi].l.min ← y1}
ELSE ltb[prev].thread ← l;
ltb[l].thread ← m;
vArray[vi].l.max ← MAX[vArray[vi].l.max, y2];
vArray[vi].maxW ← MAX[vArray[vi].maxW, ltb[l].width];
END;
AllPoints: PUBLIC PROC [action: PointScan] RETURNS [p: PTIndex] =
BEGIN
header.pointTableSize ← Table.Bounds[ptType].size;
FOR p ← FIRST[PTIndex], p + SIZE[Point] WHILE
LOOPHOLE[p, CARDINAL] < header.pointTableSize DO
IF ~ptb[p].free AND action[p, @ptb[p]] THEN RETURN;
ENDLOOP;
RETURN[PTNull]
END;
SelectedPoints: PUBLIC PROC [action: PointScan] RETURNS [p: PTIndex] =
BEGIN
next: PTIndex;
FOR p ← header.selectedPoints, next WHILE p # PTNull DO
next ← ptb[p].selNext;
IF action[p, @ptb[p]] THEN RETURN;
ENDLOOP;
END;
AllLines: PUBLIC PROC [action: LineScan] RETURNS [l: LTIndex] =
BEGIN
header.lineTableSize ← Table.Bounds[ltType].size;
FOR l ← FIRST[LTIndex], l + SIZE[Line] WHILE
LOOPHOLE[l, CARDINAL] < header.lineTableSize DO
IF ~ltb[l].free AND action[l, @ltb[l]] THEN RETURN;
ENDLOOP;
RETURN[LTNull]
END;
SelectedLines: PUBLIC PROC [action: LineScan] RETURNS [l: LTIndex] =
BEGIN
next: LTIndex;
FOR l ← header.selectedLines, next WHILE l # LTNull DO
next ← ltb[l].selNext;
IF action[l, @ltb[l]] THEN RETURN;
ENDLOOP;
END;
LinesThru: PUBLIC PROC [p: PTIndex, action: LineScan] RETURNS [l: LTIndex] =
BEGIN
next: LTIndex;
l ← ptb[p].lines;
WHILE l # LTNull DO
next ← IF ltb[l].p1 = p THEN ltb[l].p1Chain ELSE ltb[l].p2Chain;
IF action[l, @ltb[l]] THEN RETURN;
l ← next;
ENDLOOP;
RETURN
END;
HLinesInABox: PUBLIC PROC [box: POINTER TO ABox, action: LineScan, completely: BOOLEAN ← FALSE] RETURNS [l: LTIndex] =
BEGIN
y1: ADistance ← box.y1;
hi: INTEGER;
IF ~completely THEN y1 ← y1 - AdjForWidth[4]; -- min possible
hi ← FindHList[y1];
IF hi = -1 THEN RETURN[LTNull];
DO
hr: HorizRec ← hArray[hi];
IF hr.y > box.y2 THEN EXIT;
IF hr.l.min < box.x2 AND hr.l.max > box.x1 THEN
BEGIN
FOR l ← hr.lines, ltb[l].thread WHILE l # LTNull DO
x1: ADistance = ptb[ltb[l].p1].pos.x;
x2: ADistance = ptb[ltb[l].p2].pos.x;
IF x1 > box.x2 THEN EXIT;
IF (
(completely AND x1>= box.x1 AND x2 <= box.x2 AND
hr.y + AdjForWidth[ltb[l].width] <= box.y2) OR
(x2 >= box.x1 AND hr.y + AdjForWidth[ltb[l].width] >= box.y1))
AND action[l, @ltb[l]] THEN RETURN;
ENDLOOP;
END;
hi ← hi + 1;
IF hi >= LENGTH[hArray] THEN EXIT;
ENDLOOP;
RETURN [LTNull];
END;
VLinesInABox: PUBLIC PROC [box: POINTER TO ABox, action: LineScan, completely: BOOLEAN ← FALSE] RETURNS [l: LTIndex] =
BEGIN
x1: ADistance ← box.x1;
vi: INTEGER;
IF ~completely THEN x1 ← x1 - AdjForWidth[4]; -- min possible
vi ← FindVList[x1];
IF vi = -1 THEN RETURN[LTNull];
DO
vr: VertRec ← vArray[vi];
IF vr.x > box.x2 THEN EXIT;
IF vr.l.min < box.y2 AND vr.l.max > box.y1 THEN
BEGIN
FOR l ← vr.lines, ltb[l].thread WHILE l # LTNull DO
y1: ADistance = ptb[ltb[l].p1].pos.y;
y2: ADistance = ptb[ltb[l].p2].pos.y;
IF y1 > box.y2 THEN EXIT;
IF (
(completely AND y1>= box.y1 AND y2 <= box.y2 AND
vr.x + AdjForWidth[ltb[l].width] <= box.x2) OR
(y2 >= box.y1 AND vr.x + AdjForWidth[ltb[l].width] >= box.x1))
AND action[l, @ltb[l]] THEN RETURN;
ENDLOOP;
END;
vi ← vi + 1;
IF vi >= LENGTH[vArray] THEN EXIT;
ENDLOOP;
RETURN [LTNull];
END;
AdjForWidth: PROC [w: INTEGER] RETURNS [ADistance] =
INLINE {RETURN [DrawnWidth[magnify]*w-1]};
DLinesInABox: PUBLIC PROC [box: POINTER TO ABox, action: LineScan, completely: BOOLEAN ← FALSE] RETURNS [l: LTIndex] =
BEGIN
FOR l ← header.diagLines, ltb[l].thread WHILE l # LTNull DO
lBox: ABox ← ABoxForBox[BoxForLine[l]];
IF ~(lBox.x1 > box.x2 OR box.x1 > lBox.x2 OR
lBox.y1 > box.y2 OR box.y1 > lBox.y2)
AND action[l, @ltb[l]] THEN RETURN;
ENDLOOP;
RETURN [LTNull];
END;
LinesInABox: PUBLIC PROC [box: POINTER TO ABox, action: LineScan, completely: BOOLEAN ← FALSE] RETURNS [l: LTIndex] =
BEGIN
l ← HLinesInABox[box, action, completely];
IF l # LTNull THEN RETURN;
l ← VLinesInABox[box, action, completely];
IF l # LTNull THEN RETURN;
RETURN [DLinesInABox[box, action, completely]];
END;
ABoxForBox: PUBLIC PROCEDURE [box: Window.Box] RETURNS [aBox: ABox] =
BEGIN
aPlace: APosition = APosForPlace[box.place];
aBox ← [
x1: aPlace.x,
x2: aPlace.x + ADistanceForDots[box.dims.w],
y1: aPlace.y,
y2: aPlace.y + ADistanceForDots[box.dims.h]];
END;
SelectedLabels: PUBLIC PROC [action: LabelScan] RETURNS [lb: LBIndex] =
BEGIN
next: LBIndex;
FOR lb ← header.selectedLabels, next WHILE lb # LBNull DO
next ← lbb[lb].selNext;
IF action[lb, @lbb[lb]] THEN RETURN;
ENDLOOP;
END;
MaybeDisplayLine: PROC [l: LTIndex] =
BEGIN
lBox: Window.Box ← BoxForLine[l];
vBox: Window.Box ← [
[x: -pictureWindow.box.place.x, y: -pictureWindow.box.place.y],
FrameBox.dims];
IF ~Disjoint[@lBox, @vBox] THEN DisplayLine[l, lBox]; -- conservative
END;
currentWidth: PUBLIC LineWidth ← 1;
currentTexture: PUBLIC LineTexture ← solid;
ClearSelections: PUBLIC PROC =
BEGIN
DeselectLine: LineScan =
BEGIN
lth.selected ← FALSE;
lth.selNext ← LTNull;
MaybeDisplayLine[l];
RETURN[FALSE]
END;
DeselectLabel: LabelScan =
BEGIN
lbh.selected ← FALSE;
lbh.selNext ← LBNull;
PaintLabel[lb];
RETURN[FALSE]
END;
DeselectPoint: PointScan =
BEGIN
Window.InvalidateBox[pictureWindow, BoxForPoint[p]];
pth.selNext ← PTNull;
pth.selected ← FALSE;
RETURN[FALSE]
END;
[] ← SelectedPoints[DeselectPoint];
[] ← SelectedLines[DeselectLine];
[] ← SelectedLabels[DeselectLabel];
header.selectedPoints ← PTNull;
header.selectedLines ← LTNull;
header.selectedLabels ← LBNull;
END;
BoxForPoint: PUBLIC PROC [p: PTIndex] RETURNS [Window.Box] =
BEGIN
pPlace: Window.Place = PicturePlace[ptb[p].pos];
RETURN[[[pPlace.x-4, pPlace.y-4], [9,9]]]
END;
ClosePoint: PROC [pos: APosition, selected: BOOLEAN ← FALSE] RETURNS [p: PTIndex] =
BEGIN
epsilon: INTEGER ← ADistanceForDots[2 * DrawnWidth[magnify]];
Check: PointScan =
BEGIN
RETURN [ (~selected OR pth.selected) AND
ABS[pth.pos.x-pos.x] <= epsilon AND ABS[pth.pos.y-pos.y] <= epsilon];
END;
p ← AllPoints[Check];
END;
CloseLine: PROC [pos: APosition, selected: BOOLEAN ← FALSE] RETURNS [l: LTIndex] =
BEGIN
epsilon: INTEGER ← ADistanceForDots[1];
box: ABox ← [x1: pos.x - epsilon, x2: pos.x + epsilon,
y1: pos.y - epsilon, y2: pos.y + epsilon];
Check: LineScan =
BEGIN
y, x: ADistance;
pos1: APosition = ptb[lth.p1].pos;
pos2: APosition = ptb[lth.p2].pos;
IF selected AND ~lth.selected THEN RETURN[FALSE];
SELECT lth.class FROM
horiz => RETURN [TRUE];
vert => RETURN [TRUE];
shallow =>
BEGIN
IF pos.x ~IN [pos1.x..pos2.x] THEN RETURN[FALSE];
y ← pos1.y + INTEGER[InlineDefs.LowHalf[
(LONG[pos.x - pos1.x]*LONG[pos2.y - pos1.y])/(pos2.x - pos1.x)]];
RETURN [pos.y IN
[y-epsilon..
y + ADistanceForDots[DrawnWidth[lth.width]] + epsilon]];
END;
ENDCASE => IF pos1.y > pos2.y THEN
BEGIN
IF pos.y ~IN [pos2.y..pos1.y] THEN RETURN[FALSE];
END
ELSE IF pos.y ~IN [pos1.y..pos2.y] THEN RETURN[FALSE];
x ← pos1.x + INTEGER[InlineDefs.LowHalf[
(LONG[pos1.y - pos.y]*LONG[pos2.x - pos1.x])/(pos1.y - pos2.y)]];
RETURN [pos.x IN
[x-epsilon..
x + ADistanceForDots[DrawnWidth[lth.width]] + epsilon]];
END;
l ← LinesInABox[@box, Check];
END;
CloseLabel: PROC [pos: APosition, selected: BOOLEAN ← FALSE] RETURNS [lb: LBIndex] =
BEGIN
place: Window.Place ← PicturePlace[pos];
box: Window.Box ← [[place.x-2, place.y-2], [4,4]];
Check: LabelScan =
BEGIN
labelBox: Window.Box;
IF selected AND ~lbh.selected THEN RETURN[FALSE];
labelBox ← BoxForLabel[lb];
RETURN [~Disjoint[@labelBox, @box]];
END;
lb ← AllLabels[Check];
END;
AddSelection: PUBLIC PROC [pos: APosition] =
BEGIN
l: LTIndex;
lb: LBIndex;
p: PTIndex;
p ← ClosePoint[pos];
IF p # PTNull THEN
BEGIN
pPlace: Window.Place = PicturePlace[ptb[p].pos];
ptb[p].selected ← TRUE;
Window.DisplayData[
window: pictureWindow,
box: [[x: pPlace.x-8, y: pPlace.y-8], [16,16]],
data: @Cursors[selPt],
wpl: 1];
ptb[p].selNext ← header.selectedPoints;
header.selectedPoints ← p;
ASetSourcePos[ptb[p].pos];
RETURN
END;
l ← CloseLine[pos];
IF l # LTNull THEN
{ltb[l].selected ← TRUE; MaybeDisplayLine[l];
ltb[l].selNext ← header.selectedLines;
header.selectedLines ← l;
ASetSourcePos[ptb[ltb[l].p1].pos];
RETURN};
lb ← CloseLabel[pos];
IF lb # LBNull THEN
{lbb[lb].selected ← TRUE; PaintLabel[lb];
lbb[lb].selNext ← header.selectedLabels;
header.selectedLabels ← lb;
ASetSourcePos[lbb[lb].pos];
RETURN};
END;
UnSelChainPoint: PROC [p: PTIndex] =
BEGIN
prev: PTIndex ← PTNull;
FOR np: PTIndex ← header.selectedPoints, ptb[np].selNext WHILE
np # p DO
IF np = PTNull THEN ERROR;
prev ← np;
ENDLOOP;
IF prev = PTNull THEN header.selectedPoints ← ptb[p].selNext
ELSE ptb[prev].selNext ← ptb[p].selNext;
ptb[p].selNext ← PTNull;
END;
UnSelChainLine: PROC [l: LTIndex] =
BEGIN
prev: LTIndex ← LTNull;
FOR nl: LTIndex ← header.selectedLines, ltb[nl].selNext WHILE
nl # l DO
IF nl = LTNull THEN ERROR;
prev ← nl;
ENDLOOP;
IF prev = LTNull THEN header.selectedLines ← ltb[l].selNext
ELSE ltb[prev].selNext ← ltb[l].selNext;
ltb[l].selNext ← LTNull;
END;
UnSelChainLabel: PUBLIC PROC [lb: LBIndex] =
BEGIN
prev: LBIndex ← LBNull;
FOR nlb: LBIndex ← header.selectedLabels, lbb[nlb].selNext WHILE
nlb # lb DO
IF nlb = LBNull THEN ERROR;
prev ← nlb;
ENDLOOP;
IF prev = LBNull THEN header.selectedLabels ← lbb[lb].selNext
ELSE lbb[prev].selNext ← lbb[lb].selNext;
lbb[lb].selNext ← LBNull;
END;
SubSelection: PUBLIC PROC [pos: APosition] =
BEGIN
l: LTIndex;
lb: LBIndex;
p: PTIndex;
p ← ClosePoint[pos, TRUE];
IF p # PTNull THEN
BEGIN
Window.InvalidateBox[pictureWindow, BoxForPoint[p]];
ptb[p].selected ← FALSE;
UnSelChainPoint[p];
RETURN
END;
l ← CloseLine[pos, TRUE];
IF l # LTNull THEN
{ltb[l].selected ← FALSE;
UnSelChainLine[l];
MaybeDisplayLine[l];
RETURN};
lb ← CloseLabel[pos, TRUE];
IF lb # LBNull THEN
{lbb[lb].selected ← FALSE;
UnSelChainLabel[lb];
PaintLabel[lb];
RETURN};
END;
SelectInBox: PUBLIC PROC [pos1, pos2: APosition] =
BEGIN
ul: APosition = [x: MIN[pos1.x, pos2.x], y: MIN[pos1.y, pos2.y]];
lr: APosition = [x: MAX[pos1.x, pos2.x], y: MAX[pos1.y, pos2.y]];
newSource: APosition ← [LAST[INTEGER], LAST[INTEGER]];
CheckLine: LineScan =
BEGIN
lp1: APosition = ptb[lth.p1].pos;
lp2: APosition = ptb[lth.p2].pos;
IF lp1.x IN [ul.x..lr.x] AND lp2.x IN [ul.x..lr.x] AND
lp1.y IN [ul.y..lr.y] AND lp2.y IN [ul.y..lr.y] THEN
{lth.selected ← TRUE;
lth.selNext ← header.selectedLines;
header.selectedLines ← l;
MaybeDisplayLine[l];
newSource.x ← MIN[newSource.x, lp1.x];
newSource.y ← MIN[newSource.y, lp1.y, lp2.y]};
RETURN[FALSE];
END;
CheckLabel: LabelScan =
BEGIN
IF lbh.pos.x IN [ul.x..lr.x] AND lbh.pos.y IN [ul.y..lr.y] THEN
{lbh.selected ← TRUE;
lbh.selNext ← header.selectedLabels;
header.selectedLabels ← lb;
PaintLabel[lb];
newSource.x ← MIN[newSource.x, lbh.pos.x];
newSource.y ← MIN[newSource.y, lbh.pos.y]};
RETURN[FALSE];
END;
ClearSelections[];
[] ← AllLines[CheckLine];
[] ← AllLabels[CheckLabel];
IF newSource # [LAST[INTEGER], LAST[INTEGER]] THEN
ASetSourcePos[newSource];
END;
DeleteSelections: PUBLIC PROC =
BEGIN
deleted: Redraw ← NIL;
KillLine: LineScan =
BEGIN
new: Redraw = Storage.Node[SIZE[line RedrawObject]];
pos1: APosition = ptb[lth.p1].pos;
pos2: APosition = ptb[lth.p2].pos;
new↑ ← [next: deleted, var: line[
pos1: pos1,
pos2: pos2,
width: lth.width,
texture: lth.texture]];
deleted ← new;
DeleteLine[l];
RETURN[FALSE];
END;
KillLabel: LabelScan =
BEGIN
new: Redraw = Storage.Node[SIZE[label RedrawObject]];
new↑ ← [next: deleted, var: label[
font: lbh.font, mode: lbh.mode,
pos: lbh.pos,
hti: lbh.hti]];
deleted ← new;
DeleteLabel[lb];
RETURN[FALSE];
END;
[] ← SelectedLines[KillLine];
[] ← SelectedLabels[KillLabel];
header.selectedLines ← LTNull;
header.selectedPoints ← PTNull;
ToWasteBasket[deleted];
END;
UndeleteItems: PUBLIC PROC =
BEGIN
ClearSelections[];
RedrawItems[FromWasteBasket[]];
END;
wbDepth: CARDINAL = 4;
wasteBasket: ARRAY [0..wbDepth) OF Redraw ← ALL[NIL];
ToWasteBasket: PROC [new: Redraw] =
BEGIN
FreeItems[wasteBasket[wbDepth-1]];
FOR i: CARDINAL DECREASING IN (0..wbDepth) DO
wasteBasket[i] ← wasteBasket[i-1]
ENDLOOP;
wasteBasket[0] ← new;
END;
FromWasteBasket: PROC RETURNS [rd: Redraw] =
BEGIN
rd ← wasteBasket[0];
FOR i: CARDINAL IN (0..wbDepth) DO
wasteBasket[i-1] ← wasteBasket[i]
ENDLOOP;
wasteBasket[wbDepth-1] ← NIL;
END;
FreeItems: PROC [rd: Redraw] =
BEGIN
next: Redraw;
WHILE rd # NIL DO
next ← rd.next;
Storage.Free[rd];
rd ← next;
ENDLOOP;
END;
SourceToClosePoint: PUBLIC PROC [pos: APosition] =
BEGIN
p: PTIndex ← ClosePoint[pos];
IF p # PTNull THEN ASetSourcePos[ptb[p].pos];
END;
DestToClosePoint: PUBLIC PROC [pos: APosition] =
BEGIN
p: PTIndex ← ClosePoint[pos];
IF p # PTNull THEN ASetDestPos[ptb[p].pos];
END;
PosOf: PUBLIC PROC [p: PTIndex] RETURNS [APosition] =
{RETURN [ptb[p].pos]};
PointsOf: PUBLIC PROC [l: LTIndex] RETURNS [p1, p2: PTIndex] =
{RETURN [ltb[l].p1, ltb[l].p2]};
WidthOf: PUBLIC PROC [l: LTIndex] RETURNS [[1..4]] =
{RETURN [ltb[l].width]};
ShouldLengthen: PUBLIC PROC [l: LTIndex] RETURNS [extra: [0..4]] =
BEGIN
CheckThis: LineScan =
BEGIN
IF lth.class = vert AND lth.p2 = endP THEN
extra ← MAX[extra, lth.width];
RETURN[FALSE];
END;
endP: PTIndex = ltb[l].p2;
extra ← 0;
IF ltb[l].class = horiz THEN [] ← LinesThru[endP, CheckThis];
END;
DrawLine: PUBLIC PROC [pos1, pos2: APosition, selected: BOOLEAN ← TRUE] =
BEGIN
l: LTIndex;
IF pos1 = pos2 THEN RETURN;
IF selected THEN ClearSelections[];
l ← InsertLine[
InsertPoint[pos1], InsertPoint[pos2], currentWidth, currentTexture];
ltb[l].selected ← selected;
IF selected THEN header.selectedLines ← l;
MaybeDisplayLine[l];
END;
InsertLine: PROC [p1, p2: PTIndex, width: LineWidth, texture: LineTexture]
RETURNS [newL: LTIndex] =
BEGIN
pos1: APosition;
pos2: APosition;
pTemp: PTIndex;
FindP2: LineScan =
BEGIN
p: PTIndex = IF ltb[l].p1 = p1 THEN ltb[l].p2 ELSE ltb[l].p1;
RETURN [p = p2];
END;
newL ← LinesThru[p1, FindP2];
IF newL # LTNull THEN
BEGIN
Window.InvalidateBox[pictureWindow, BoxForLine[newL]];
ltb[newL].width ← width;
ltb[newL].texture ← texture;
ltb[newL].selected ← TRUE;
RETURN
END;
pos1 ← ptb[p1].pos;
pos2 ← ptb[p2].pos;
SELECT pos1.x FROM
< pos2.x => NULL;
> pos2.x => {pTemp ← p1; p1 ← p2; p2 ← pTemp};
ENDCASE => IF pos1.y > pos2.y THEN
{pTemp ← p1; p1 ← p2; p2 ← pTemp};
newL ← AllocateLine[];
ltb[newL] ← [
p1: p1, p1Chain: ptb[p1].lines,
p2: p2, p2Chain: ptb[p2].lines,
width: width, texture: texture, class: NULL];
ptb[p1].lines ← newL;
ptb[p2].lines ← newL;
ltb[newL].class ← SELECT TRUE FROM
pos1.x = pos2.x => vert,
pos1.y = pos2.y => horiz,
ABS[pos1.x-pos2.x] <= ABS[pos1.y-pos2.y] => steep,
ENDCASE => shallow;
SELECT ltb[newL].class FROM
horiz => AddHoriz[newL];
vert => AddVert[newL];
ENDCASE =>
{ltb[newL].thread ← header.diagLines; header.diagLines ← newL};
END;
AllocateLine: PROC RETURNS [l: LTIndex] =
BEGIN
IF (l ← header.freeLine) # LTNull THEN
BEGIN
header.freeLine ← ltb[LOOPHOLE[header.freeLine, FNIndex]].next;
RETURN
END;
l ← Table.Allocate[ltType, SIZE[Line]];
END;
FreeLine: PROC [l: LTIndex] =
BEGIN
ltb[LOOPHOLE[l, FNIndex]] ← [next: header.freeLine];
header.freeLine ← l;
END;
InsertPoint: PROC [pos: APosition] RETURNS [newP: PTIndex] =
BEGIN
hi: INTEGER = FindHList[pos.y, TRUE];
follows: PTIndex ← PTNull;
next: PTIndex;
newP ← hArray[hi].points;
WHILE newP # PTNull DO
SELECT ptb[newP].pos.x FROM
< pos.x => NULL;
> pos.x => EXIT;
ENDCASE => RETURN;
follows ← newP;
newP ← ptb[follows].thread;
ENDLOOP;
next ← IF follows = PTNull THEN hArray[hi].points
ELSE ptb[follows].thread;
newP ← AllocatePoint[];
ptb[newP] ← [pos: pos, thread: next];
IF follows = PTNull THEN hArray[hi].points ← newP
ELSE ptb[follows].thread ← newP;
hArray[hi].p.max ← MAX[hArray[hi].p.max, pos.x];
hArray[hi].p.min ← MIN[hArray[hi].p.min, pos.x];
END;
AllocatePoint: PROC RETURNS [p: PTIndex] =
BEGIN
IF (p ← header.freePoint) # PTNull THEN
BEGIN
header.freePoint ← ptb[LOOPHOLE[header.freePoint, FNIndex]].next;
RETURN
END;
p ← Table.Allocate[ptType, SIZE[Point]];
END;
FreePoint: PROC [p: PTIndex] =
BEGIN
hi: INTEGER = FindHList[ptb[p].pos.y, FALSE];
follows: PTIndex ← PTNull;
np: PTIndex;
FOR np ← hArray[hi].points, ptb[np].thread WHILE np # p DO
follows ← np;
ENDLOOP;
IF follows = PTNull THEN hArray[hi].points ← ptb[p].thread
ELSE ptb[follows].thread ← ptb[p].thread;
IF ptb[p].selected THEN UnSelChainPoint[p];
ptb[LOOPHOLE[p, FNIndex]] ← [next: header.freePoint];
header.freePoint ← p;
END;
DrawnWidth: ARRAY [0..4] OF CARDINAL = [1, 1, 2, 4, 4];
BoxForLine: PUBLIC PROC [l: LTIndex] RETURNS [box: Window.Box] =
BEGIN
pos1: APosition = ptb[ltb[l].p1].pos;
pos2: APosition = ptb[ltb[l].p2].pos;
x1: ADistance = MIN[pos1.x, pos2.x];
y1: ADistance = MIN[pos1.y, pos2.y];
width: CARDINAL = ltb[l].width * DrawnWidth[magnify];
w: CARDINAL ← DotsForADistance[ABS[pos1.x-pos2.x]];
h: CARDINAL ← DotsForADistance[ABS[pos1.y-pos2.y]];
IF ltb[l].class >= steep THEN w ← w + width
ELSE h ← h + width;
IF ltb[l].class = horiz THEN
w ← w + ShouldLengthen[l] * DrawnWidth[magnify];
RETURN [[PicturePlace[[x: x1, y: y1]], [w: w, h: h]]];
END;
DeleteLine: PROC [l: LTIndex] =
BEGIN
prev: LTIndex;
pt, pb: PTIndex;
FindPT: LineScan =
BEGIN
p: PTIndex = IF ltb[l].p1 = pb THEN ltb[l].p2 ELSE ltb[l].p1;
IF p = pt THEN RETURN[TRUE];
prev ← l;
RETURN[FALSE]
END;
Window.InvalidateBox[pictureWindow, BoxForLine[l]];
pb ← ltb[l].p1; pt ← ltb[l].p2; prev ← LTNull;
IF LinesThru[pb, FindPT] = LTNull THEN ERROR;
IF prev = LTNull THEN ptb[pb].lines ← ltb[l].p1Chain
ELSE
IF ltb[prev].p1 = pb THEN ltb[prev].p1Chain ← ltb[l].p1Chain
ELSE ltb[prev].p2Chain ← ltb[l].p1Chain;
pb ← ltb[l].p2; pt ← ltb[l].p1; prev ← LTNull;
IF LinesThru[pb, FindPT] = LTNull THEN ERROR;
IF prev = LTNull THEN ptb[pb].lines ← ltb[l].p2Chain
ELSE
IF ltb[prev].p1 = pb THEN ltb[prev].p1Chain ← ltb[l].p2Chain
ELSE ltb[prev].p2Chain ← ltb[l].p2Chain;
SELECT ltb[l].class FROM
horiz => UnChainHoriz[l];
vert => UnChainVert[l];
ENDCASE => UnChainDiag[l];
FreeLine[l];
IF ptb[pb].lines = LTNull THEN FreePoint[pb];
IF ptb[pt].lines = LTNull THEN FreePoint[pt];
END;
DisplayLine: PUBLIC PROC [l: LTIndex, box: Window.Box] =
BEGIN
inch: ADistance = 16;
tex: LineTexture = ltb[l].texture;
dash: ADistance ← SELECT tex FROM
d2 => 2*inch,
d4 => 4*inch,
ENDCASE => 6*inch; -- solid will ignore this value
gap: ADistance = inch;
class: LineClass = ltb[l].class;
width: LineWidth = ltb[l].width;
pos1: APosition ← ptb[ltb[l].p1].pos;
pos2: APosition ← ptb[ltb[l].p2].pos;
solidColor: LineColor = IF ltb[l].selected THEN grey ELSE black;
length, ends: ADistance;
SELECT class FROM
horiz => length ← pos2.x - pos1.x;
vert => length ← pos2.y - pos1.y;
ENDCASE =>
BEGIN
dx: CARDINAL = pos2.x - pos1.x;
dy: CARDINAL = ABS[pos2.y - pos1.y];
length ← Sqrt[
InlineDefs.LongMult[dx,dx] + InlineDefs.LongMult[dy,dy]];
END;
IF tex = solid OR length < dash+4*gap THEN
{DisplaySolidLine[pos1, pos2, class, solidColor, width, @box];
RETURN};
END;
LineColor: TYPE = {white, grey, black};
GreyColor: ARRAY LineColor OF Window.GreyArray = [
[0, 0, 0, 0],
[125252B,52525B,125252B, 52525B],
[177777B, 177777B, 177777B, 177777B]];
DisplaySolidLine: PROC [pos1, pos2: APosition, class: LineClass, color: LineColor, lWidth: LineWidth, box: POINTER TO Window.Box] =
BEGIN
deltaY, deltaX: LONG INTEGER;
start, stop, current: Window.Place;
width: CARDINAL = lWidth * DrawnWidth[magnify];
drawn: BOOLEAN ← FALSE;
chunkBox: Window.Box;
start ← PicturePlace[pos1];
stop ← PicturePlace[pos2];
SELECT class FROM
horiz =>
BEGIN
Window.DisplayShade[
pictureWindow,
[start, [w: stop.x - start.x, h: width]],
GreyColor[color]];
RETURN
END;
vert =>
BEGIN
Window.DisplayShade[
pictureWindow,
[start, [w: width, h: stop.y - start.y]],
GreyColor[color]];
RETURN
END;
ENDCASE;
MarksOut[];
current ← start;
deltaY ← stop.y - start.y;
deltaX ← stop.x - start.x;
IF class = steep THEN
BEGIN
negSlope: BOOLEAN ← FALSE;
PaintChunk: PROC [Window.Handle] RETURNS [Window.Box, INTEGER] =
BEGIN
longH: LONG INTEGER;
h: INTEGER;
DO
IF negSlope THEN {IF current.y <= stop.y THEN EXIT}
ELSE IF current.y >= stop.y THEN EXIT;
longH ← ABS[start.y - current.y +
((current.x - start.x + 1)*deltaY)/deltaX];
h ← MAX[INTEGER[InlineDefs.LowHalf[longH]], 1];
h ← MIN [ABS[stop.y - current.y], h];
IF negSlope THEN
chunkBox ← [[current.x, current.y-h], [w: width, h: h]]
ELSE chunkBox ← [current, [w: width, h: h]];
current.x ← current.x + 1;
current.y ← current.y + (IF negSlope THEN -h ELSE h);
IF Disjoint[box, @chunkBox] THEN
{IF drawn THEN RETURN [Window.NullBox, 0]}
ELSE
BEGIN
drawn ← TRUE;
RETURN [chunkBox, 0];
END;
ENDLOOP;
RETURN [Window.NullBox, 0];
END;
IF deltaY < 0 THEN negSlope ← TRUE;
Window.Trajectory[
window: pictureWindow,
box: box↑,
proc: PaintChunk,
bbop: replace,
bbsource: gray, -- why can't they agree on spelling?
grey: GreyColor[color]];
END
ELSE -- shallow
BEGIN
negSlope: BOOLEAN ← FALSE;
dy: INTEGER;
PaintChunk: PROC [Window.Handle] RETURNS [Window.Box, INTEGER] =
BEGIN
longW: LONG INTEGER;
w: INTEGER;
DO
IF current.x >= stop.x THEN EXIT;
longW ← start.x - current.x +
((current.y - start.y + dy)*deltaX)/deltaY;
w ← MAX[INTEGER[InlineDefs.LowHalf[longW]], 1];
w ← MIN[stop.x - current.x, w];
IF negSlope THEN
chunkBox ← [[current.x, current.y-1], [w: w, h: width]]
ELSE chunkBox ← [current, [w: w, h: width]];
current.x ← current.x + w;
current.y ← current.y + dy;
IF Disjoint[box, @chunkBox] THEN
{IF drawn THEN RETURN [Window.NullBox, 0]}
ELSE
BEGIN
drawn ← TRUE;
RETURN [chunkBox, 0];
END;
ENDLOOP;
RETURN [Window.NullBox, 0];
END;
IF deltaY < 0 THEN {dy ← -1; negSlope ← TRUE} ELSE dy ← 1;
Window.Trajectory[
window: pictureWindow,
box: box↑,
proc: PaintChunk,
bbop: replace,
bbsource: gray,
grey: GreyColor[color]];
END;
MarksIn[];
END;
pending: Redraw ← NIL;
CopySelections: PUBLIC PROC [delta: APosition] =
BEGIN
originalSource: APosition = Absolute[GetSourcePos[FALSE]];
CopyLine: LineScan =
BEGIN
IF lth.selected THEN
BEGIN
new: Redraw = Storage.Node[SIZE[line RedrawObject]];
pos1: APosition = ptb[lth.p1].pos;
pos2: APosition = ptb[lth.p2].pos;
new↑ ← [next: pending, var: line[
pos1: [pos1.x + delta.x, pos1.y + delta.y],
pos2: [pos2.x + delta.x, pos2.y + delta.y],
width: lth.width,
texture: lth.texture]];
lth.selected ← FALSE;
MaybeDisplayLine[l];
pending ← new;
END;
RETURN[FALSE];
END;
CopyLabel: LabelScan =
BEGIN
IF lbh.selected THEN
BEGIN
new: Redraw = Storage.Node[SIZE[label RedrawObject]];
pos: APosition = lbh.pos;
new↑ ← [next: pending, var: label[
font: lbh.font, mode: lbh.mode,
pos: [pos.x + delta.x, pos.y + delta.y],
hti: lbh.hti]];
pending ← new;
lbh.selected ← FALSE;
PaintLabel[lb];
END;
RETURN[FALSE];
END;
IF BadMove[delta] THEN RETURN;
[] ← SelectedLines[CopyLine];
[] ← SelectedLabels[CopyLabel];
header.selectedLines ← LTNull;
header.selectedLabels ← LBNull;
RedrawItems[pending];
pending ← NIL;
ASetSourcePos[[x: originalSource.x + delta.x,
y: originalSource.y + delta.y]];
ASetDestPos[[x: originalSource.x + 2*delta.x,
y: originalSource.y + 2*delta.y]];
END;
BadMove: PROC [delta: APosition] RETURNS [BOOLEAN] =
BEGIN
BadPoint: PointScan =
BEGIN
RETURN [pth.selected AND
(pth.pos.x + delta.x < 0 OR pth.pos.y + delta.y < 0)];
END;
BadLine: LineScan =
BEGIN
p1: PTIndex = lth.p1;
p2: PTIndex = lth.p2;
RETURN [lth.selected AND
(ptb[p1].pos.x + delta.x < 0 OR ptb[p1].pos.y + delta.y < 0 OR
ptb[p2].pos.x + delta.x < 0 OR ptb[p2].pos.y + delta.y < 0)]
END;
BadLabel: LabelScan =
BEGIN
RETURN [lbh.selected AND
(lbh.pos.x + delta.x < 0 OR lbh.pos.y + delta.y < 0)];
END;
IF delta.x > 0 AND delta.y > 0 THEN RETURN[FALSE];
IF AllPoints[BadPoint] # PTNull THEN GO TO bad;
IF AllLines[BadLine] # LTNull THEN GO TO bad;
IF AllLabels[BadLabel] # LBNull THEN GO TO bad;
RETURN[FALSE];
EXITS
bad => {UserTerminal.BlinkDisplay[]; RETURN[TRUE]};
END;
MoveSelections: PUBLIC PROC [delta: APosition] =
BEGIN
originalSource: APosition = Absolute[GetSourcePos[FALSE]];
MoveLine: LineScan =
BEGIN
IF lth.selected THEN
BEGIN
new: Redraw = Storage.Node[SIZE[line RedrawObject]];
pos1: APosition = ptb[lth.p1].pos;
pos2: APosition = ptb[lth.p2].pos;
new↑ ← [next: pending, var: line[
pos1: [pos1.x + delta.x, pos1.y + delta.y],
pos2: [pos2.x + delta.x, pos2.y + delta.y],
width: lth.width,
texture: lth.texture]];
pending ← new;
DeleteLine[l];
END;
RETURN[FALSE];
END;
MoveLabel: LabelScan =
BEGIN
IF lbh.selected THEN
BEGIN
new: Redraw = Storage.Node[SIZE[label RedrawObject]];
pos: APosition = lbh.pos;
new↑ ← [next: pending, var: label[
font: lbh.font, mode: lbh.mode,
pos: [pos.x + delta.x, pos.y + delta.y],
hti: lbh.hti]];
pending ← new;
DeleteLabel[lb];
END;
RETURN[FALSE];
END;
MovePoint: PointScan =
BEGIN
IF pth.selected THEN
BEGIN
pos1: APosition = [x: pth.pos.x + delta.x, y: pth.pos.y + delta.y];
pBox: Window.Box = BoxForPoint[p];
StretchLine: LineScan =
BEGIN
other: PTIndex = IF lth.p1 = p THEN lth.p2 ELSE lth.p1;
pos2: APosition ← ptb[other].pos;
new: Redraw = Storage.Node[SIZE[line RedrawObject]];
IF ptb[other].selected THEN
{pos2.x ← pos2.x + delta.x; pos2.y ← pos2.y + delta.y};
new↑ ← [next: pending, var: line[
pos1: pos1, pos2: pos2, width: lth.width, texture: lth.texture]];
pending ← new;
DeleteLine[l];
RETURN[FALSE];
END;
Window.InvalidateBox[pictureWindow, pBox];
[] ← LinesThru[p, StretchLine];
END;
RETURN[FALSE];
END;
IF BadMove[delta] THEN RETURN;
[] ← SelectedLines[MoveLine];
[] ← SelectedLabels[MoveLabel];
[] ← SelectedPoints[MovePoint];
header.selectedLines ← LTNull;
header.selectedPoints ← PTNull;
header.selectedLabels ← LBNull;
Window.ValidateTree[];
RedrawItems[pending];
pending ← NIL;
ASetSourcePos[[x: originalSource.x + delta.x,
y: originalSource.y + delta.y]];
ASetDestPos[originalSource];
END;
RedrawItems: PROC [rd: Redraw] =
BEGIN
WHILE rd # NIL DO
this: Redraw = rd;
WITH this SELECT FROM
line =>
BEGIN
l: LTIndex = InsertLine[
InsertPoint[pos1], InsertPoint[pos2], width, texture];
ltb[l].selNext ← header.selectedLines;
header.selectedLines ← l;
MaybeDisplayLine[l];
END;
label =>
BEGIN
lb: LBIndex =
InsertLabel[pos: pos, hti: hti, font: font, mode: mode];
lbb[lb].selNext ← header.selectedLabels;
header.selectedLabels ← lb;
PaintLabel[lb];
END;
ENDCASE;
rd ← this.next;
ENDLOOP;
END;
END.