pg.pas

本光盘是《国际大学生程序设计竞赛例题解（一）》的配套光盘

{$r+}
program pg;
const
  inputname='pg.in';
  outputname='pg.out';
var
  a:array[1..3000,1..2] of byte;
  ak:array[1..3000] of byte;
  fa:array[1..3000] of integer;
  co:array[1..31,1..2] of integer;
  n:byte;
  summit:byte;
  change:boolean;

  procedure readdata;
  var
    f:text;
    i:byte;
  begin
    assign(f,inputname);
    reset(f);
    readln(f,n);
    summit:=1;
    for i:=1 to n+1 do
    begin
      readln(f,co[i,1],co[i,2]);
      if co[i,2]>co[summit,2] then summit:=i;
    end;
    close(f);
  end;

  procedure print(p:integer);
  var
    f:text;
    step:integer;

    procedure printnode(p:integer);
    var
      x1,y1,x2,y2:real;
    begin
      inc(step);
      if fa[p]>0 then printnode(fa[p]) else writeln(f,step);
      case ak[p] of
        1:begin
            x1:=co[a[p,1],1]; y1:=co[a[p,1],2];
            x2:=co[a[p,2],1]+(co[a[p,2]+1,1]-co[a[p,2],1])*
                (y1-co[a[p,2],2])/(co[a[p,2]+1,2]-co[a[p,2],2]);
            y2:=y1;
          end;
        2:begin
            x2:=co[a[p,2],1]; y2:=co[a[p,2],2];
            x1:=co[a[p,1],1]+(co[a[p,1]+1,1]-co[a[p,1],1])*
                (y2-co[a[p,1],2])/(co[a[p,1]+1,2]-co[a[p,1],2]);
            y1:=y2;
          end;
        3:begin
            x1:=co[a[p,1],1]; y1:=co[a[p,1],2];
            x2:=co[a[p,2],1]; y2:=y1;
          end;
      end;
      writeln(f,x1:0:2,' ',y1:0:2,' ',x2:0:2,' ',y2:0:2);
    end;

  begin
    assign(f,outputname);
    rewrite(f);
    step:=0;
    printnode(p);
    close(f);
    halt;
  end;

  procedure work;
  var
    note:array[1..3,1..31,1..31] of byte;
    p,f:integer;

    procedure checknode;
    begin
      if (ak[p]=3) and (a[p,1]=summit) then
      begin
        fa[p]:=f;
        if change then inc(a[f,2]);
        print(p);
      end;

      if note[ak[p],a[p,1],a[p,2]]=1 then dec(p)
      else
      begin
        note[ak[p],a[p,1],a[p,2]]:=1;
        fa[p]:=f;
      end;
    end;

    procedure addnode(w:byte);
    var
      i:integer;
      ud1,ud2:integer;
    begin
      if a[f,w]>1 then
      begin
        inc(p);

        ud1:=co[a[f,w],2]-co[a[f,w]-1,2];
        ud2:=co[a[f,w],2]-co[a[f,3-w],2];
        i:=a[f,3-w];
        if ud1*ud2<=0 then
        begin
          ud2:=co[a[f,w],2]-co[a[f,3-w]+1,2];
          i:=a[f,3-w]+1;
        end;

        if abs(ud1)<abs(ud2) then
        begin
          ak[p]:=w; a[p,w]:=a[f,w]-1; a[p,3-w]:=a[f,3-w];
        end
        else if abs(ud1)>abs(ud2) then
             begin
               ak[p]:=3-w; a[p,w]:=a[f,w]-1; a[p,3-w]:=i;
             end
             else
             begin
               ak[p]:=3; a[p,w]:=a[f,w]-1; a[p,3-w]:=i;
             end;

        checknode;
      end;

      if a[f,w]<=n then
      begin
        inc(p);

        ud1:=co[a[f,w],2]-co[a[f,w]+1,2];
        ud2:=co[a[f,w],2]-co[a[f,3-w],2];
        i:=a[f,3-w];
        if ud1*ud2<=0 then
        begin
          ud2:=co[a[f,w],2]-co[a[f,3-w]+1,2];
          i:=a[f,3-w]+1;
        end;

        if abs(ud1)<abs(ud2) then
        begin
          ak[p]:=w; a[p,w]:=a[f,w]+1; a[p,3-w]:=a[f,3-w];
        end
        else if abs(ud1)>abs(ud2) then
             begin
               ak[p]:=3-w; a[p,w]:=a[f,w]; a[p,3-w]:=i;
             end
             else
             begin
               ak[p]:=3; a[p,w]:=a[f,w]+1; a[p,3-w]:=i;
             end;

        checknode;
      end;
    end;

  begin
    p:=1; f:=1;
    ak[1]:=3; a[1,1]:=1; a[1,2]:=n+1;
    fa[1]:=0;
    fillchar(note,sizeof(note),0);
    while p>=f do
    begin
      note[ak[f],a[f,1],a[f,2]]:=1;
      case ak[f] of
        1:addnode(1);
        2:addnode(2);
        3:begin
            dec(a[f,2]);
            change:=true;
            addnode(1);
            inc(a[f,2]);
            change:=false;
            if a[f,2]<=n then addnode(1);
          end;
      end;
      inc(f);
    end;
  end;

begin
  readdata;
  work;
end.