FONForum

Program domac3;
uses crt;
const
perr='Pogresan unos!Pokusajte ponovo!'#7;
type
  f=file of real;
  tniz=array [1..100] of real;
var
  datoteka:f;
  brojac:integer;
  visina,tezina:tniz; {Kraj definicije promenjivih glavnog programa}


  procedure dalje;   {Nastavak uslovljava pritisak nekog tastera}
  begin
  writeln('za nastavak pritisnite neki taster');
  readln;
  end;


  procedure provunosa (var izlaz:integer);  {procedura sluzi za proveru unosa
     unos joj je samo vrednost promenjive na izlazu, unos je u okviru nje}
           var
           unos:string[10];
           kontrolna:integer;
             begin
              repeat
              writeln ('Unesi Trazenu vrednost ');
              readln (unos);
              val (unos,izlaz,kontrolna);  {Uzavisnosti od potreba ispraviti drugu uslovnu}
              if (izlaz<0) or (izlaz>7) or (kontrolna<>0) then writeln (perr);
              until (izlaz>-1) and (izlaz<8) and (kontrolna=0);
             end;

  procedure citaj(var brojac:integer;var visina,tezina:tniz;var datoteka:f);
  {treba da iscita datoteku}
  var
  log:boolean;{Za repeat petlju kod provere teke}
  i:integer;        {I da upise vrednosti u dva nova niza ,tezina i visina}
  putanja:string[255];
  begin
    brojac:=1;{Da prebroji koliko ukupno ima clanova}
    i:=0;  {Za indeksiranje oba niza}
    writeln ('    Molimo vas dajte putanju do datoteke');
    repeat
    readln (putanja);  {Mogucnost da sam korisnik definise putanju ka datoteci}
    assign(datoteka,putanja);{$i-}
    reset(datoteka);
    {$i+}       {Provera ispravnosti same datoteke}
    if ioresult<>0 then
         begin
           writeln(perr);dalje;log:=false;
         end
                  else log:=true;
    {ako datoteka nije u redu sistem salje poruku o gresci i gasi program}
    until log=true;

  while not eof (datoteka) do {Koristio while to je odmah povuklo Koriscenje ovih
  metoda}
    begin
    i:=i+1;  {Jer sam na pocetku stavio 0}
    read (datoteka,visina[i],tezina[i]);
    brojac:=brojac +1;
    end;
  close(datoteka);brojac:=brojac-1;
  end;

           {Srz programa-esencija}
  function esenci(nizx:tniz;brojac:integer;oduzmi:integer ):real;
  var      {Data funkcija treba da vrati vrednost srednje vrednosti proizvodnog
  broja zadnjih clanova niza}
  i:integer;
  sre:real;
  BEGIN
  sre:=0; begin
  FOR i:=(brojac - oduzmi) to brojac do
  sre:=sre+nizx[i];  end;
  esenci:=sre/oduzmi;
  end;

    procedure Uvod;  {Smesna procedura ali mora se}
  begin
  writeln;
  writeln;
    writeln('     Ovaj program Sluzi za odredjevanje srednje visene');
    writeln('     i tezine proizvodnog broja studenata');
    writeln;
  end;

     procedure Meni(visina,tezina:tniz;brojac:integer);  {Meni, trebalo ga je jos rasclaniti
     jer se jedan deo operacija izvrsava i u njemu}
  var izbor:char;
      poruka:string;x:integer;
  begin
    repeat
     writeln('********************************');
     writeln('*            M E N I           *');
     writeln('*                              *');
     writeln('* 1.Odresi srednju visinu ');
     writeln('* 2.Odresi srednju tezinu *');
     writeln('* 3.KRAJ                       *');
     writeln('********************************');
     writeln;
     writeln;
     writeln('Vas izbor je: ');
     izbor:=readkey;
     case izbor of
       '1':begin
       writeln ('Sada unesite za koji broj poslednjih studenata');
       writeln ('se izracunava srednja vrednost');
       provunosa(x); {Unosi se opcioni broj zadnjih}
       writeln;
       writeln ('srednja visina poslednjih ',x,' Studenata je ');
       writeln(esenci(visina,brojac,x):10:4);    {Treba da vrati rezultat}
       writeln;end;
       '2':begin
       writeln ('Sada unesite za koji broj poslednjih studenata');
       writeln ('se izracunava srednja vrednost');
       provunosa(x);                         {Slicno gore navedenom}
       writeln ('srednja tezina poslednjih ',x,' studenata je');
       writeln(esenci(tezina,brojac,x):10:3);
           end;
       '3':begin
             writeln('Izabrali ste KRAJ!');
           end;
     else
       writeln;
       writeln;
       writeln('Greska u unosu!');
     end;
   until izbor='3';
  end;
(*********************************)
{pocetak glavnog programa}
begin
textBackground (9);
 textcolor (3);
 clrscr;
uvod;

{Ovim sam samo pri startovanju}
{Inicirao citanje datoteke i time smanjio vreme pristupa}
{I omogucio da se parametri predju proceduri meni }
citaj(brojac,visina,tezina,datoteka);

{Koja dalje te parametre predaje proceduri esencija}
meni(visina,tezina,brojac);
end.                                {Nema vise narode}

program recenice;
uses
  crt;
var
  ime_dat:string;
  datoteka:text;
  kraj:boolean;

(***Procedura za obradu datoteke****)

procedure Obrada(var datoteka:text;ime_dat:string);
var
  ch:char;
  br_rec:integer;
begin
  clrscr;
  gotoxy(30,10);
  writeln('OBRADA U TOKU...');
  gotoxy(1,1);
  br_rec:=0;
  ch:=' ';
  assign(datoteka,ime_dat);
  {$I-}
  reset(datoteka);
  if ioresult=0 then
  begin
    repeat
    read(datoteka,ch);
    if (ch='.') or (ch='!') or (ch='?') then br_rec:=br_rec+1;
    until eof(datoteka);
  clrscr;
  writeln('Statistike za datoteku "',ime_dat,'": ');
  writeln;
  if br_rec<>0 then
    writeln('Broj recenica: ',br_rec)
  else
    writeln('Broj recenica: 0 ,datoteka nema recenica ili nije txt tipa.');
  end
  else
    begin
      clrscr;
      writeln('Datoteka "',ime_dat,'" ne postoji.');
    end;
  {$I+}
  close(datoteka);
  end;

(****Procedura za uvodni text i upis****)

procedure Uvod(var ime_dat:string);
begin
  clrscr;
  writeln('Ovaj program na osnovu zadate tekstualne datoteke');
  writeln('kao rezultat daje broj recenica u toj datoteci.');
  writeln;
  writeln('Potrebno je napisti putanju i/ili ime datoteke');
  writeln('koju zelite da obradite (obavezno na kraju stavite');
  writeln('ekstenziju datoteke npr. txt ili dat): ');
  writeln;
  writeln('Za izlaz stisnite "q".');
  writeln;
  write('Ime datoteke je: ');
  readln(ime_dat);
  if (ime_dat='q') or (ime_dat='Q') then halt;
  Obrada(datoteka,ime_dat);
end;

(****Pocetak glavnog programa****)

begin
  kraj:=false;
  repeat
  Uvod(ime_dat);
  until kraj;
end.