unit terrainc;

interface

  procedure dydis   (var kordx, kordy, dydis: integer);
  function valstybe (kordx, kordy: real): boolean;

implementation

  USES CRT;
  const MAX = 100; { maksimalus daugiakampio virž–ni— skai‡ius }
  type taskas = record
                  x, y: real;
                end;
       virsunes = array [1..MAX] of taskas;
  { ‘emiau suražyti globalieji kintamieji }
  var x, y, n, { kvadrato apatinio kairiojo kampo koordinat‚s }
               { ir kvadrato dydis }
      vsk: integer; { daugiakampio virž–ni— skai‡ius }
      v: virsunes;  { jo koordinat‚s }
      p: real;      { tikslus daugiakampio plotas }
      kviet: longint;

  procedure daugiakampio_plotas (vsk: integer; v: virsunes;
                                 var p: real);
  { randa ižkilojo daugiakampio plot… }
    var x, y, x1, y1, x2, y2, per, a, b, c: real;
        i: integer;
  begin
    p := 0;
    x := v[1].x; y := v[1].y;
    for i := 2 to vsk-1 do
      begin
        { atskiriame trikampŤ nuo daugiakampio }
         x1 := v[i].x;   y1 := v[i].y;
         x2 := v[i+1].x; y2 := v[i+1].y;
         { apskai‡iuojame trikampio kražtines }
         a := sqrt(sqr(x - x1) + sqr(y - y1));
         b := sqrt(sqr(x - x2) + sqr(y - y2));
         c := sqrt(sqr(x1 - x2) + sqr(y1 - y2));
         per := (a + b + c)/2; { perimetro pus‚ }
         { skai‡iuojame jo plot… }
         p := p + sqrt(per*(per-a)*(per-b)*(per-c));
      end;
  end; { daugiakampio_plotas }

  procedure dydis (var kordx, kordy, dydis: integer);
  begin
    kordx := x; kordy := y; dydis := n;
  end; { dydis }

  function valstybe (kordx, kordy: real): boolean;

    function desine_pri (t, t1, t2: taskas): boolean;
    { tikrina, ar tažkas t yra dežin‚je pus‚je (arba priklauso) ties‚s }
    { ižvestos per tažkus t1 ir t2; ties‚s kryptis iž t1 Ť t2 }
    begin
      desine_pri := (t.x - t1.x) * (t2.y - t1.y) -
                    (t.y - t1.y) * (t2.x - t1.x) > 0
    end; { dežin‚_pri }

    var t: taskas;
        gerai: boolean;
        i: integer;
  begin
    { padidiname ižkvietim— skai‡i— }
    kviet := kviet + 1;
    t.x := kordx; t.y := kordy;
    gerai := true;
    for i := 1 to vsk-1 do
      gerai := gerai and desine_pri (t, v[i], v[i+1]);
    valstybe := gerai and desine_pri (t, v[vsk], v[1]);
  end; { valstyb‚ }

  procedure spausdinti (sk: real; tiksl: integer);
  { atspausdina plot… (<= maxlongint) nurodytu tikslumu }
    var kiek, po, i, skaicius: longint;
        tarp: real;
  begin
    { suskai‡iuojame kiek skaitmen— sudaro sveikoji dalis }
    kiek := 1; { priež kablelŤ visuomet ražomas bent nulis }
    tarp := sk;
    while tarp > 10 do
      begin
        tarp := tarp / 10;
        kiek := kiek + 1;
      end;
   po := tiksl - kiek; { tiek skaitmen— reikia atspausdinti po kablelio }
   if po = 0 { sveikoji dalis turi tiksl skaitmen— }
   then writeln (round(sk))
   else if po > 0
        then  writeln (sk: 1: po)
        else begin  { reikia apvalinti sveik…j… dalŤ }
               for i := 1 to kiek do
                 sk := sk/10;
               skaicius := round(sk);
               for i := 1 to kiek do
                 skaicius := skaicius * 10;
               writeln (skaicius);
             end;
  end; { spausdinti }

  procedure pabaiga; far;
    var rez: real;
  begin
    writeln;
    writeln ('Ižkvietim— skai‡ius: ', kviet);
    write ('­veskite j–s— programos rast… plot…: ');
    readln (rez);
    writeln ('Paklaida procentais: ', abs(rez - p)/p*100:10:5);
  end; { pabaiga }

  var i, num: integer;
      byla, numeris: string;
      f: text;
begin
  writeln;
  writeln;
  writeln ('źiam u‘daviniui parengti testai sunumeruoti nuo 0 iki 6 ');
  writeln ('Jei sprend‘iate u‘davinŤ, surinkite nulŤ (0), ');
  writeln ('Jei tikrinate sprendim… surinkite testo numerŤ.');
  write ('KurŤ test… nor‚site vykdyti? ');
  readln (num);
  writeln;
  { perskaitomi pradiniai duomenys }
  str (num, numeris);
  byla := 'VALST'+ numeris + '.DAT';
  assign (f, byla);
  reset (f);
  readln (f, x, y, n);
  readln (f, vsk);
  for i := 1 to vsk do
    readln (f, v[i].x, v[i].y);
  close (f);
  { randamas tikrasis daugiakampio plotas }
  daugiakampio_plotas (vsk, v, p);
  write ('Tikrasis daugiakampio plotas lygus: ');
  spausdinti (p, 5);
  kviet := 0;  { dar neŤvykdytas nei vienas ižkvietimas }
  write ('J–s— apskai‡iuotas plotas lygus:    ');
  exitproc := @pabaiga;
end.