i build a program which uses a char array and uses fillchar for coloring the line... i tried it for 500 lines with numbers of 4 digits and it gave the same output as my program... please give it some tests.

cheers,
costel.

program timus1019;
const
  MaxN=5000*2;
  MaxM=MaxN*2+1;
  ten_9=1000000000;
  colors=['b','w'];
type
  TArt=record
             ip : longint; {initial point}
             fp : longint; {final   point}
       end;
  tv=array[1..MaxM]of TArt;
const
  sa=SizeOf(TART);
var
  n:longint;
  v:tv;
  nv:longint;
  x,y:longint;
  adding:boolean;

procedure init_st;
begin
  nv:=1;
  with v[1] do
  begin
    ip:=0;
    fp:=ten_9;
  end;
end;

procedure read_n;
begin
  readln(n);
end;

procedure read_ln;
var
  c:char;
begin
    read(x,y);
    read(c);
    while not (c in colors) do
      read(c);
    readln;
    adding:=(c='w');
end;

procedure add_tale;
begin
  inc(nv);
  with v[nv] do
  begin
    ip:=x;
    fp:=y;
  end;
end;

function GetCurrentCoord:longint;
var
  i:longint;
begin
  i:=1;
  while x>v[i].fp do
    inc(i);
  GetCurrentCoord:=i;
end;

procedure InsertBefore(k:longint);
begin
  Move(v[k],v[k+1],sa*(nv-k+1));
  with v[k] do
  begin
    ip:=x;
    fp:=y;
  end;
  inc(nv);
end;

procedure IncreaseLeft(k:longint);
begin
  v[k].ip:=x;
end;

procedure IncreaseRight(k:longint);
begin
  v[k].fp:=y;
end;

procedure JoinTogether(k:longint);
begin
  v[k].fp:=v[k+1].fp;
  move(v[k+2],v[k+1],sa*(nv-k+1));
  dec(nv);
end;

procedure add_normal;
var
  k:longint;
begin
  k:=GetCurrentCoord;
  if y<v[k].ip then
    InsertBefore(k)
  else
    if x<v[k].ip then
      IncreaseLeft(k)
    else
      if y>v[k].fp then
        if (k=nv) or (y<v[k+1].ip) then
          IncreaseRight(k)
        else
          JoinTogether(k)
      else;{NOTHING}
end;

procedure add_ln;
begin
  if x>v[nv].fp then
    add_tale
  else
    if y>v[1].fp then
      add_normal
    else;{NOTHING}
end;

procedure DecreaseLeft(k:longint);
begin
  v[k].ip:=y;
end;

procedure DecreaseRight(k:longint);
begin
  v[k].fp:=x;
end;

procedure BreakInTwo(k:longint);
begin
  if k<nv then
  begin
    Move(v[k+1],v[k+2],sa*(nv-k));
  end;
  v[k+1]:=v[k];
  v[k].fp:=x;
  v[k+1].ip:=y;
  inc(nv);
end;

procedure del_normal;
var
  k:longint;
begin
  k:=GetCurrentCoord;
  if x<=v[k].ip then
    if y>v[k].ip then
      DecreaseLeft(k)
    else{NOTHING}
  else
    if y>=v[k].fp then
    begin
      DecreaseRight(k);
      {Decrease Right And Next Left}
      if k<n then
        if y>v[k+1].ip then
          v[k+1].ip:=y;
    end
    else
      BreakInTwo(k);
end;

procedure del_ln;
begin
  if x>v[nv].fp then
    exit;
  del_normal;
end;

procedure delete_lines(first,last:longint);
begin
  if last<first then
    exit;
  inc(last);
  Move(v[last],v[first],sa*(nv-last+1));
  nv:=nv-(last-first);
end;

procedure delete_in_between;
var
  i1,i2:longint;
begin
  i1:=1;
  while (x>v[i1].ip)and(i1<nv) do
    inc(i1);
  i2:=i1;
  while (y>v[i2].fp)and(i2<nv) do
    inc(i2);
  dec(i2);
  delete_lines(i1,i2);
end;


procedure write_current_line;
var
  i:byte;
  c:char;
begin
  if adding then c:='+' else c:='-';
  write('[',x,',',y,']-> ..',c,c,c,'.. <',nv,'> ... ');
  for i:=1 to nv do
   write('{',v[i].ip,'<->',v[i].fp,'}  ');
  writeln;
end;


procedure read_lines;
var
  i:longint;
begin
  for i:=1 to n do
  begin
    read_ln;
    delete_in_between;
    if adding then
      add_ln
    else
      del_ln;
{    write_current_line;}
  end;
end;

function long(i:longint):longint;
begin
  with v[i] do
    long:=fp-ip;
end;

procedure write_line;
var
  i:longint;
  k:longint;
begin