Informatika gyűjtemény

Egy szinttel feljebb kb_parc.pas

2004050607080910

<<  9. óra  >>

<<  Parcellák  >>

NézetNyomtat

kb_parc.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 3 KB
uses crt;

const fname = 'parcell9.be';

type parcella = record
              x,y: longint;
              dx,dy: longint;
     end;

var parcellak : array[1..3001] of parcella;
    parc_size : integer;
    N, M, K : integer;

procedure szepit( i:integer );
begin
     parcellak[i].x := 0;
     parcellak[i].y := 0;
     parcellak[i].dx := 0;
     parcellak[i].dy := 0;
end;

procedure torol( i:integer );
begin
     dec(parc_size);
     if( parc_size >= 1 ) then begin
         {ha maradt, meg parcella, akkor mozgatunk}
         parcellak[i] := parcellak[parc_size+1];
         {csak a szepseg miatt}
         szepit( parc_size+1 );
     end else begin
         szepit( i );
     end;
end;

procedure hozzaad( x, y, dx, dy : integer );
begin

     if (( dx-x+1 )*(dy-y+1) <> 0) then begin

        inc(parc_size);
        parcellak[parc_size].x := x;
        parcellak[parc_size].y := y;
        parcellak[parc_size].dx := dx;
        parcellak[parc_size].dy := dy;

     end;
end;

procedure feloszt( x,y :integer );
var i:integer;
    felosztando : parcella;
begin

     {egy adott mezo alapjan osztunk}

     {meghatarozni, hogy melyik parcella-ban van}
     {felosztas, ha kell akkor toroljuk}

     for i:=1 to parc_size do begin

         {nezzuk a parcellakat}

         if( (x >= parcellak[i].x) and (x<= parcellak[i].dx) and
             (y >= parcellak[i].y) and (y<= parcellak[i].dy) ) then begin

             {az eppen vizsgalt parcella tartalmazza a mezot, ami alapjan osztunk}

             {legrosszabb esetben 4 parcella keletkezik}

             {toroljuk, az adott parcellat}

             felosztando := parcellak[i];
             torol(i);

             {toroltuk, most akkor adjuk hozza a parcellakat}

             { balfelso  =>   x: felosztando.x, y:felosztando.y,
                              dx: x-1, dy: y-1

               jobbfelso =>   x: x+1, y: felosztando.y,
                              dx: felosztando.dx, dy: y-1

               balalso =>     x: felosztando.x, y: y+1,
                              dx: x-1, dy: felosztando.dy

               jobbalso =>    x: x+1, y: y+1,
                              dx: felosztando.dx, dy: felosztando.dy
             }

{             if not (( x-1 <= felosztando.x) and ( y-1 <= felosztando.y )) then begin}

                {ha van balfelso parcella}

                hozzaad(felosztando.x, felosztando.y, x-1, y-1);

{             end;

             if not (( felosztando.x <= x+1 ) and ( y-1 <= felosztando.y )) then begin}

                {ha van jobbfelso parcella}

                hozzaad( x+1, felosztando.y, felosztando.dx, y-1 );

{             end;

             if not (( x-1 <= felosztando.x) and ( felosztando.dy >= y+1 )) then begin}

                {ha van balalso parcella}

                hozzaad(felosztando.x, y+1, x-1, felosztando.dy);

{             end;

             if not (( felosztando.dx <= x+1 ) and ( felosztando.dy >= y+1 )) then begin}

                {ha van jobbalso parcella}

                hozzaad( x+1, y+1, felosztando.dx, felosztando.dy );

             {end;}

             break; {kesz vagyunk, felosztottuk}

         end;

     end;


end;

procedure kivalaszt( x,y:integer );
begin
end;

procedure beolvas;
var f:text;
    i:integer;
    oszt_x, oszt_y : integer;
begin
     assign(f, fname);
     reset(f);

     readln(f, N, M, K);
     parcellak[1].x := 1;
     parcellak[1].y := 1;
     parcellak[1].dx := N;
     parcellak[1].dy := M;

     for i:=1 to K do begin
         readln(f, oszt_x, oszt_y);
         feloszt( oszt_x, oszt_y );
     end;

     close(f);
end;

procedure keres_max;
var max:longint;
    i:integer;
    terulet:longint;
begin
     max := 0;
     for i:=1 to parc_size do begin
         terulet := (parcellak[i].dx-parcellak[i].x+1)*(parcellak[i].dy-parcellak[i].y+1);
         if( terulet > max ) then max := terulet;
     end;
     clrscr;
     writeln(max);
     readkey;
end;

procedure main;
begin

     parc_size := 1;

     beolvas;

     keres_max;

end;

begin


     main;

end.
(Vissza)