const
MAXSIZEX = 32; // arbitrary
MAXSIZEY = 32; // abritrary
type
vector = record
charnum: integer;
prev: integer;
sx,sy: integer;
ex,ey: integer;
next: integer;
status: integer;
end;
var
A: array[1..MAXSIZEX, 1..MAXSIZEY] of integer;
V: array[1..1000] of vector;
Vnum: integer;
procedure addsquarevector(j,k: integer);
var
m: integer;
begin
Vnum := Vnum + 1;
V[Vnum].prev := Vnum + 3;
V[Vnum].sx := j; V[Vnum].sy := k;
V[Vnum].ex := j + 1; V[Vnum].ey := k;
V[Vnum].next := Vnum + 1;
V[Vnum].status := 0;
Vnum := Vnum + 1;
V[Vnum].prev := Vnum - 1;
V[Vnum].sx := j + 1; V[Vnum].sy := k;
V[Vnum].ex := j + 1; V[Vnum].ey := k + 1;
V[Vnum].next := Vnum + 1;
V[Vnum].status := 0;
Vnum := Vnum + 1;
V[Vnum].prev := Vnum - 1;
V[Vnum].sx := j + 1; V[Vnum].sy := k + 1;
V[Vnum].ex := j; V[Vnum].ey := k + 1;
V[Vnum].next := Vnum + 1;
V[Vnum].status := 0;
Vnum := Vnum + 1;
V[Vnum].prev := Vnum - 1;
V[Vnum].sx := j; V[Vnum].sy := k + 1;
V[Vnum].ex := j; V[Vnum].ey := k;
V[Vnum].next := Vnum - 3;
V[Vnum].status := 0;
Vnum := Vnum;
end;
procedure procvector;
var
j,k: integer;
begin
Vnum := 0;
for j := 1 to MAXSIZEX do // no, what is x setting?
for k := 1 to MAXSIZEY do // no what is y setting?
if a[j,k] = 1 then
begin
addsquarevector(j,k);
end;
end;
procedure removevector(mm,mm2: integer);
var
p,n: integer;
begin
p := V[mm].prev;
V[p].next := V[mm2].next;
n := V[mm2].next;
V[n].prev := p;
end;
procedure removevectors(m,m2: integer);
begin
removevector(m,m2);
removevector(m2,m);
// lastly etch out the unneeded vectors.
V[m].status := -1;
V[m2].status := -1;
end;
function equalpoints(p1x,p1y,p2x,p2y: integer): boolean;
var
r: boolean;
begin
r := false;
if (p1x = p2x) and (p1y = p2y) then
r := true;
equalpoints := r;
end;
function equalvectors(m,m2: integer): boolean;
var
msx,msy,mex,mey,m2sx,m2sy,m2ex,m2ey: integer;
r: boolean;
begin
r := false;
if (V[m].status <> -1) then
begin
msx := V[m].sx; msy := V[m].sy;
mex := V[m].ex; mey := V[m].ey;
m2sx := V[m2].sx; m2sy := V[m2].sy;
m2ex := V[m2].ex; m2ey := V[m2].ey;
if equalpoints(msx,msy,m2sx,m2sy) and
equalpoints(mex,mey,m2ex,m2ey) then
r := true;
if equalpoints(msx,msy,m2ex,m2ey) and
equalpoints(mex,mey,m2sx,m2sy) then
r := true;
end;
equalvectors := r;
end;
// grab each vector in list. If it is the same as any other vector,
// get rid of it.
procedure simplifyvector;
var
m,m2: integer;
begin
for m := 1 to Vnum do
for m2 := m + 1 to Vnum do
begin
if equalvectors(m,m2) then
removevectors(m,m2);
end;
end;
procedure lengthenvector;
var
m,m2: integer;
begin
// now we have vectors, but some vectors have multiple points.
// so let's turn two vectors into one longer vector. Okay? Okay!
for m := 1 to Vnum do
if (V[m].prev <> 0) and (V[m].status > -1) then
if (V[V[m].prev].sx = V[m].ex) or
(V[V[m].prev].sy = V[m].ey) then
begin
V[V[m].prev].ex := V[m].ex;
V[V[m].prev].ey := V[m].ey;
V[V[m].prev].next := V[m].next;
V[V[m].next].prev := V[m].prev;
V[m].status := -1;
end;
end;
procedure raster2vector;
begin
procvector;
simplifyvector;
lengthenvector;
end;
|
[ home | archive | contact | computer | raster to vector ]