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 ]