[ home | archive | contact | computer | raster to vector ]

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 ]