The Fill and MatchColor procedures
OutOfRectangle: PUBLIC ERROR ~ CODE;
Direction: TYPE ~ { r, ur, u, ul, l, dl, d, dr};
next: ARRAY Direction OF Direction ~ [ur, u, ul, l, dl, d, dr, r];
prv: ARRAY Direction OF Direction ~ [dr, r, ur, u, ul, l, dl, d];
start:
ARRAY Direction
OF Direction ~
[dr, dr, r, r, ul, ul, dl, dl];
When one has just come from direction x, one needs to check next in direction start[x]. The spots for u and ul (both containing r) are anomolous: there is no possibility of finding a pixel there, but this way those directions will record themselves as left edges.
ds: ARRAY Direction OF INTEGER ~ [ 0, -1, -1, -1, 0, 1, 1, 1];
df: ARRAY Direction OF INTEGER ~ [ 1, 1, 0, -1, -1, -1, 0, 1];
Fill:
PUBLIC
PROC [sm: SampleMap, loc:
CVEC, bounds: Rectangle ← nullRectangle]
RETURNS [extent: Rectangle] ~
TRUSTED {
Basic Approach (taken from M. Bird and other Lispers):
1. Find a left edge.
2. For each edge not previously found:
a. Circumnavigate the edge, marking and remembering it, and stashing location of new left edges
b. Start moving right from the edge until you come to another edge.
sMin, sMax, fMin, fMax: CARDINAL;
filledMap: SampleMap ~ SampleMapOps.Create[sSize: sm.sSize, fSize: sm.fSize, bitsPerSample: 1];
edgesMap: SampleMap ~ SampleMapOps.Create[sSize: sm.sSize, fSize: sm.fSize, bitsPerSample: 1];
filled: ArrayHack ~ SampleMapToArrayHack[filledMap];
edges: ArrayHack ~ SampleMapToArrayHack[edgesMap];
mask: ArrayHack ~ SampleMapToArrayHack[sm];
leftEdges: LIST OF CVEC ← NIL;
IfRectangle:
PROC [v:
CVEC]
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
RETURN [~(v.s IN (sMin .. sMax) AND v.f IN (fMin .. fMax))]
};
IfEdge:
PROC [v:
CVEC]
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
RETURN [(mask[v.s][v.f] AND ~filled[v.s][v.f]) OR IfRectangle[v]]
};
RememberLeftEdgePos:
PROC [p:
CVEC] ~
TRUSTED
INLINE {
leftEdges ← CONS[p, leftEdges];
extent.sMin ← MIN[extent.sMin, p.s];
extent.sMax ← MAX[extent.sMax, p.s];
extent.fMin ← MIN[extent.fMin, p.f];
extent.fMax ← MAX[extent.fMax, p.f]; --Max is check elsewhere
};
GetNextLeftEdgePos:
PROC
RETURNS [p:
CVEC] ~
TRUSTED
INLINE {
p ← leftEdges.first;
leftEdges ← leftEdges.rest;
};
Navigate:
PROC [initial:
CVEC] ~
TRUSTED {
IsSingleton:
PROC
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
count: CARDINAL ← 0;
IF IfRectangle[initial] THEN RETURN [FALSE]; --We know it's not a singleton on the bounds edge, and it may be dangerous to check as below...
FOR f:
INTEGER
IN [-1..1]
DO
FOR s:
INTEGER
IN [-1..1]
DO
IF IfEdge[[s: initial.s+s, f: initial.f+f]] THEN count ← count+1;
ENDLOOP;
ENDLOOP;
RETURN [count <= 1]
};
Assumes you got here from the left.
direction, lastDirection: Direction ← dr; --(Choosing dr rather than r, so that the algorithm checks dl and d).
pos: CVEC ← initial;
IF edges[initial.s][initial.f] THEN RETURN; --We've already seen this edge
IF IsSingleton[]
THEN {
RememberLeftEdgePos[initial];
RETURN;
};
Find the last direction to turn that places us on the initial square, so that main loop can test for it
lastDirection ← r; --(Actually, know can't get this...)
UNTIL IfEdge[[s: pos.s-ds[lastDirection], f: pos.f-df[lastDirection]]]
DO
--Reversed sign is because we're moving
into rather than
out of pos.
lastDirection ← prv[lastDirection];
ENDLOOP;
DO
edges[pos.s][pos.f] ← TRUE;
direction ← start[direction];
DO
IF IfEdge[[s: pos.s+ds[direction], f: pos.f+df[direction]]] THEN EXIT
ELSE IF direction=r THEN RememberLeftEdgePos[pos]; --I.e., if we see a blank spot to our right, then this is a left edge
direction ← next[direction];
ENDLOOP;
Here, direction contain the next direction to move. Make the move.
pos ← [s: pos.s+ds[direction], f: pos.f+df[direction]];
See if this is the end of the line...
IF pos=initial AND direction=lastDirection THEN EXIT;
ENDLOOP;
IF lastDirection IN [ur..ul] THEN RememberLeftEdgePos[initial];
};
Main section.
SampleMapOps.Clear[filledMap];
SampleMapOps.Clear[edgesMap];
bounds ← Intersect[bounds, [sMin: 0, fMin: 0, sMax: sm.sSize-1, fMax: sm.fSize-1]];
sMin ← bounds.sMin;
sMax ← bounds.sMax;
fMin ← bounds.fMin;
fMax ← bounds.fMax;
IF ~loc.s IN (sMin .. sMax) OR ~loc.f IN (fMin .. fMax) THEN ERROR OutOfRectangle[];
IF mask[loc.s][loc.f] THEN RETURN; --If it's already on, there's nothing we can do...
extent ← [sMin: loc.s, sMax: loc.s, fMin: loc.f, fMax: loc.f];
UNTIL mask[loc.s][loc.f]
DO
--Find a right edge
loc.f ← loc.f + 1;
ENDLOOP;
Navigate[loc]; --Navigate the first edge found
UNTIL leftEdges=
NIL
DO
--While left edge positions remain...
f, s: CARDINAL;
vector: LONG POINTER TO PACKED ARRAY [0..0) OF BOOLEAN;
[[s: s, f: f]] ← GetNextLeftEdgePos[];
vector ← mask[s];
f ← f+1; --Start on blank square
UNTIL vector[f]
OR f=fMax
DO
vector[f] ← filled[s][f] ← TRUE;
f ← f+1;
ENDLOOP;
Here, [x, y] is on a right edge
extent.fMax ← MAX[extent.fMax, f];
Navigate[[s: s, f: f]];
ENDLOOP;
};
defaultColorDistance: PUBLIC CARDINAL ← 10;
MatchColorFill:
PUBLIC
PROC [sm: SampleMap, sa: SampleArray, loc:
CVEC, bounds: Rectangle ← nullRectangle, colorDistance:
CARDINAL ← defaultColorDistance]
RETURNS [extent: Rectangle] ~
TRUSTED {
Basic Approach (taken from M. Bird and other Lispers):
1. Find a left edge.
2. For each edge not previously found:
a. Circumnavigate the edge, marking and remembering it, and stashing location of new left edges
b. Start moving right from the edge until you come to another edge.
sMin, sMax, fMin, fMax: CARDINAL;
filledMap: SampleMap ~ SampleMapOps.Create[sSize: sm.sSize, fSize: sm.fSize, bitsPerSample: 1];
edgesMap: SampleMap ~ SampleMapOps.Create[sSize: sm.sSize, fSize: sm.fSize, bitsPerSample: 1];
filled: ArrayHack ~ SampleMapToArrayHack[filledMap];
edges: ArrayHack ~ SampleMapToArrayHack[edgesMap];
mask: ArrayHack ~ SampleMapToArrayHack[sm];
redHack, greenHack, blueHack: SampleArrayHack;
leftEdges: LIST OF CVEC ← NIL;
red, green, blue, g2r, g2b: INTEGER;
ColorDistance:
PROC [r, g, b:
CARDINAL]
RETURNS [d:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [ABS[INTEGER[g]-INTEGER[r] - g2r] + ABS[INTEGER[g]-INTEGER[b] - g2b]];
};
FetchRed:
PROC [v:
CVEC]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [redHack[v.s][v.f]];
};
FetchGreen:
PROC [v:
CVEC]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [greenHack[v.s][v.f]];
};
FetchBlue:
PROC [v:
CVEC]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [blueHack[v.s][v.f]];
};
IfBounds:
PROC [v:
CVEC]
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
RETURN [~(v.s IN (sMin .. sMax) AND v.f IN (fMin .. fMax))]
};
IfEdge:
PROC [v:
CVEC]
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
RETURN [IfBounds[v] OR (ColorDistance[r: FetchRed[v], g: FetchGreen[v], b: FetchBlue[v]] > colorDistance)];
};
RememberLeftEdgePos:
PROC [p:
CVEC] ~
TRUSTED
INLINE {
leftEdges ← CONS[p, leftEdges];
extent.sMin ← MIN[extent.sMin, p.s];
extent.sMax ← MAX[extent.sMax, p.s];
extent.fMin ← MIN[extent.fMin, p.f];
extent.fMax ← MAX[extent.fMax, p.f]; --Max is check elsewhere
};
GetNextLeftEdgePos:
PROC
RETURNS [p:
CVEC] ~
TRUSTED
INLINE {
p ← leftEdges.first;
leftEdges ← leftEdges.rest;
};
Navigate:
PROC [initial:
CVEC] ~
TRUSTED {
IsSingleton:
PROC
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
count: CARDINAL ← 0;
IF IfBounds[initial] THEN RETURN [FALSE]; --We know it's not a singleton on the bounds edge, and it may be dangerous to check as below...
FOR f:
INTEGER
IN [-1..1]
DO
FOR s:
INTEGER
IN [-1..1]
DO
IF IfEdge[[s: initial.s+s, f: initial.f+f]] THEN count ← count+1;
ENDLOOP;
ENDLOOP;
RETURN [count <= 1]
};
Assumes you got here from the left.
direction, lastDirection: Direction ← dr; --(Choosing dr rather than r, so that the algorithm checks dl and d).
pos: CVEC ← initial;
IF edges[initial.s][initial.f] THEN RETURN; --We've already seen this edge
IF IsSingleton[]
THEN {
RememberLeftEdgePos[initial];
RETURN;
};
Find the last direction to turn that places us on the initial square, so that main loop can test for it
lastDirection ← r; --(Actually, know can't get this...)
UNTIL IfEdge[[s: pos.s-ds[lastDirection], f: pos.f-df[lastDirection]]]
DO
--Reversed sign is because we're moving
into rather than
out of pos.
lastDirection ← prv[lastDirection];
ENDLOOP;
DO
edges[pos.s][pos.f] ← TRUE;
direction ← start[direction];
DO
IF IfEdge[[s: pos.s+ds[direction], f: pos.f+df[direction]]] THEN EXIT
ELSE IF direction=r THEN RememberLeftEdgePos[pos]; --I.e., if we see a blank spot to our right, then this is a left edge
direction ← next[direction];
ENDLOOP;
Here, direction contain the next direction to move. Make the move.
pos ← [s: pos.s+ds[direction], f: pos.f+df[direction]];
See if this is the end of the line...
IF pos=initial AND direction=lastDirection THEN EXIT;
ENDLOOP;
IF lastDirection IN [ur..ul] THEN RememberLeftEdgePos[initial];
};
Main section.
IF sa.n#3 THEN ERROR;
redHack ← SampleMapToSampleArrayHack[sa[0].sm];
greenHack ← SampleMapToSampleArrayHack[sa[1].sm];
blueHack ← SampleMapToSampleArrayHack[sa[2].sm];
SampleMapOps.Clear[filledMap];
SampleMapOps.Clear[edgesMap];
bounds ← Intersect[bounds, [sMin: 0, fMin: 0, sMax: sm.sSize-1, fMax: sm.fSize-1]];
sMin ← bounds.sMin;
sMax ← bounds.sMax;
fMin ← bounds.fMin;
fMax ← bounds.fMax;
IF ~loc.s IN (sMin .. sMax) OR ~loc.f IN (fMin .. fMax) THEN ERROR OutOfRectangle[];
extent ← [sMin: loc.s, sMax: loc.s, fMin: loc.f, fMax: loc.f];
Initial values for colors
red ← FetchRed[loc];
green ← FetchGreen[loc];
blue ← FetchBlue[loc];
g2r ← green - red;
g2b ← green - blue;
UNTIL IfEdge[loc]
DO
--Find a right edge
loc.f ← loc.f + 1;
ENDLOOP;
Navigate[loc]; --Navigate the first edge found
UNTIL leftEdges=
NIL
DO
--While left edge positions remain...
f, s: CARDINAL;
vector: LONG POINTER TO PACKED ARRAY [0..0) OF BOOLEAN;
[[s: s, f: f]] ← GetNextLeftEdgePos[];
vector ← mask[s];
f ← f+1; --Start on blank square
UNTIL IfEdge[[s: s, f: f]]
OR f=fMax
DO
vector[f] ← filled[s][f] ← TRUE;
f ← f+1;
ENDLOOP;
Here, [x, y] is on a right edge
extent.fMax ← MAX[extent.fMax, f];
Navigate[[s: s, f: f]];
ENDLOOP;
};
MatchColor:
PUBLIC
PROC [sm: SampleMap, sa: SampleArray, rgb:
RGB, bounds: Rectangle ← nullRectangle, colorDistance:
CARDINAL ← defaultColorDistance] ~
TRUSTED {
mask: ArrayHack ~ SampleMapToArrayHack[sm];
redHack, greenHack, blueHack: SampleArrayHack;
red, green, blue: INTEGER;
ColorDistance:
PROC [r, g, b:
CARDINAL]
RETURNS [d:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [ABS[INTEGER[r] - red] + ABS[INTEGER[g]-green] + ABS[INTEGER[b] - blue]];
};
FetchRed:
PROC [s, f:
CARDINAL]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [redHack[s][f]];
};
FetchGreen:
PROC [s, f:
CARDINAL]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [greenHack[s][f]];
};
FetchBlue:
PROC [s, f:
CARDINAL]
RETURNS [value:
CARDINAL] ~
TRUSTED
INLINE {
RETURN [blueHack[s][f]];
};
IF sa.n#3 THEN ERROR;
redHack ← SampleMapToSampleArrayHack[sa[0].sm];
greenHack ← SampleMapToSampleArrayHack[sa[1].sm];
blueHack ← SampleMapToSampleArrayHack[sa[2].sm];
Initial values for colors
red ← rgb.r;
green ← rgb.g;
blue ← rgb.b;
bounds ← Intersect[bounds, [sMin: 0, fMin: 0, sMax: sm.sSize-1, fMax: sm.fSize-1]];
FOR s:
CARDINAL
IN [bounds.sMin .. bounds.sMax]
DO
vector: LONG POINTER TO PACKED ARRAY [0..0) OF BOOLEAN ~ mask[s];
FOR f:
CARDINAL
IN [bounds.fMin .. bounds.fMax]
DO
IF ColorDistance[r: FetchRed[s: s, f: f], g: FetchGreen[s: s, f: f], b: FetchBlue[s: s, f: f]] < colorDistance THEN vector[f] ← TRUE;
ENDLOOP;
ENDLOOP;
};
DiscriminateColor:
PUBLIC
PROC [sm: SampleMap, sa: SampleArray, near, far:
RGB, bounds: Rectangle ← nullRectangle] ~
TRUSTED {
nearR: INTEGER ~ near.r;
nearG: INTEGER ~ near.g;
nearB: INTEGER ~ near.b;
farR: INTEGER ~ far.r;
farG: INTEGER ~ far.g;
farB: INTEGER ~ far.b;
mask: ArrayHack ~ SampleMapToArrayHack[sm];
redHack, greenHack, blueHack: SampleArrayHack;
Near:
PROC [r, g, b:
CARDINAL]
RETURNS [
BOOLEAN] ~
TRUSTED
INLINE {
RETURN [
ABS[INTEGER[r] - nearR] + ABS[INTEGER[g]-nearG] + ABS[INTEGER[b] - nearB]
< ABS[INTEGER[r] - farR] + ABS[INTEGER[g]-farG] + ABS[INTEGER[b] - farB]
];
};
IF sa.n#3 THEN ERROR;
redHack ← SampleMapToSampleArrayHack[sa[0].sm];
greenHack ← SampleMapToSampleArrayHack[sa[1].sm];
blueHack ← SampleMapToSampleArrayHack[sa[2].sm];
bounds ← Intersect[bounds, [sMin: 0, fMin: 0, sMax: sm.sSize-1, fMax: sm.fSize-1]];
FOR s:
CARDINAL
IN [bounds.sMin .. bounds.sMax]
DO
vector: LONG POINTER TO PACKED ARRAY [0..0) OF BOOLEAN ~ mask[s];
FOR f:
CARDINAL
IN [bounds.fMin .. bounds.fMax]
DO
IF Near[r: redHack[s][f], g: greenHack[s][f], b: blueHack[s][f]] THEN vector[f] ← TRUE;
ENDLOOP;
ENDLOOP;
};
SampleMapToSampleArrayHack:
PROC [sm: SampleMap]
RETURNS [sah: SampleArrayHack] ~
TRUSTED {
ref: REF ~ RefTab.Fetch[x: sampleMapToSampleArrayHack, key: sm].val;
IF ref=
NIL
THEN {
ptr: LONG POINTER ← sm.base.word;
offset: NAT ← sm.bitsPerLine/16;
IF sm.base.bit#0 OR sm.bitsPerSample#8 THEN ERROR;
sah ← NEW[SampleArrayHackRep[sm.sSize]];
FOR i:
NAT
IN [0..sah.n)
DO
sah[i] ← ptr;
ptr ← ptr+offset;
ENDLOOP;
[] ← RefTab.Store[x: sampleMapToSampleArrayHack, key: sm, val: sah];
}
ELSE sah ← NARROW[ref];
};
SampleMapToArrayHack:
PROC [sm: SampleMap]
RETURNS [array: ArrayHack] ~
TRUSTED {
ptr: LONG POINTER ← sm.base.word;
offset: NAT ← sm.bitsPerLine/16;
IF sm.base.bit#0 OR sm.bitsPerSample#1 THEN ERROR;
array ← NEW[ArrayHackRep[sm.sSize]];
FOR i:
NAT
IN [0..array.n)
DO
array[i] ← ptr;
ptr ← ptr+offset;
ENDLOOP;
};
END.