program linearni_seznam;
uses crt,menu;

type
karta=record
      jmeno:string[30];
      prijmeni:string[30];
      vek:string[30];
      end;

typUKZ=^zaznam; {ty ukazatele ukazuje na zaznam (a,b,c...) }

zaznam=record
       polozka:karta;
       predchozi:typUKZ;
       dalsi:typUKZ;        {napriklad c^.predchozi:=UKZend}
       end;

var a,b,c,UKZposledni,UKZprvni,UKZbylaktivni,UKZaktivni,UKZpamet:typUKZ;
    txt:string[30];         {pomocna}

    KonecProgramu:string;
    temp:integer;

    smazjmeno,smazprijmeni,smazvek:string[30];
    soubor:text;
    souborname:string;
    anone:boolean;
    tmpblbost:byte;

function testnewblbosti:Boolean;
         begin
         testnewblbosti:=true;
         tmpblbost:=0;
         repeat
           tmpblbost:=tmpblbost + 1;
           if (ord(c^.polozka.jmeno[tmpblbost]) < 32) or (ord(c^.polozka.jmeno[tmpblbost]) > 172) then
              begin
              testnewblbosti:=false;
              break;
              end;
         until tmpblbost = length(c^.polozka.jmeno[tmpblbost]);

         tmpblbost:=0;
         repeat
           tmpblbost:=tmpblbost + 1;
           if (ord(c^.polozka.prijmeni[tmpblbost]) < 32) or (ord(c^.polozka.prijmeni[tmpblbost]) > 172) then
              begin
              testnewblbosti:=false;
              break;
              end;
         until tmpblbost = length(c^.polozka.prijmeni[tmpblbost]);

         tmpblbost:=0;
         repeat
           tmpblbost:=tmpblbost + 1;
           if (ord(c^.polozka.vek[tmpblbost]) < 32) or (ord(c^.polozka.vek[tmpblbost]) > 172) then
              begin
              testnewblbosti:=false;
              break;
              end;
         until tmpblbost = length(c^.polozka.vek[tmpblbost]);
         end;

function testblbosti:Boolean;
         begin
         testblbosti:=true;
         tmpblbost:=0;
         repeat
           tmpblbost:=tmpblbost + 1;
           if (ord(txt[tmpblbost]) < 32) or (ord(txt[tmpblbost]) > 172) then
              begin
              testblbosti:=false;
              break;
              end;
         until tmpblbost = (length(txt))
         end;

function testdelky:boolean;
         begin
         testdelky:=true;
         if 30 < length(UKZaktivni^.polozka.jmeno) then testdelky:=false;
         if 0 = length(UKZaktivni^.polozka.jmeno) then testdelky:=false;
         if 30 < length(UKZaktivni^.polozka.prijmeni) then testdelky:=false;
         if 0 = length(UKZaktivni^.polozka.prijmeni) then testdelky:=false;
         if 30 < length(UKZaktivni^.polozka.vek) then testdelky:=false;
         if 0 = length(UKZaktivni^.polozka.vek) then testdelky:=false;
         end;

function testnewdelky:boolean;
         begin
         testnewdelky:=true;
         if 0 = length(c^.polozka.jmeno) then testnewdelky:=false;
         if 30 < length(c^.polozka.jmeno) then testnewdelky:=false;
         if 0 = length(c^.polozka.prijmeni) then testnewdelky:=false;
         if 30 < length(c^.polozka.prijmeni) then testnewdelky:=false;
         if 0 = length(c^.polozka.vek) then testnewdelky:=false;
         if 30 < length(c^.polozka.vek) then testnewdelky:=false;
         end;

procedure kartatext;
          begin
TextBackground(0);
textcolor(13);
gotoxy(19,9); writeln(' / ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ \');
gotoxy(19,10);writeln('|                                            |');
gotoxy(19,11);writeln('|                                            |');
gotoxy(19,12);writeln('|                                            |');
gotoxy(19,13);writeln('|                                            |');
gotoxy(19,14);writeln('|                                            |');
gotoxy(19,15);writeln('|                                            |');
gotoxy(19,16);writeln(' \ ________________________________________ /');
textcolor(2);
gotoxy(38,10);write('KARTA');
textcolor(14);
gotoxy(37,11);write('^^^^^^^');
textcolor(7);
gotoxy(22,13);write('Jmeno   : ............................');
gotoxy(22,14);write('Prijmeni: ............................');
gotoxy(22,15);write('Vek     : ............................');
         end;

procedure textkartyvypis;
          begin
          kartatext;
          TextBackground(0);
          TextColor(15);
          gotoxy(32,13);write(UKZaktivni^.polozka.jmeno);
          gotoxy(32,14);write(UKZaktivni^.polozka.prijmeni);
          gotoxy(32,15);write(UKZaktivni^.polozka.vek);
          end;

procedure zaznampridej;
          begin
          new(c);

          repeat
          kartatext;
          TextBackground(0);
          TextColor(15);

          gotoxy(32,13);
          readln(txt);
          c^.polozka.jmeno:=txt;

          gotoxy(32,14);
          readln(txt);
          c^.polozka.prijmeni:=txt;

          gotoxy(32,15);
          readln(txt);
          c^.polozka.vek:=txt;

          until (testnewdelky=true) and (testnewblbosti=true);

          c^.predchozi:=UKZposledni;
          c^.dalsi:=nil;
          UKZposledni^.dalsi:=c;
          UKZposledni:=c;
          UKZaktivni:=c;
          c:=nil;
          delay(500);
          end;

procedure aktivnilist;
          begin
          if (testdelky=false) or (testblbosti=false) then
            begin
            TextBackground(0);
            TextColor(15);
            writeln('');
            writeln(' Neni vlozen zadny zaznam.');
            end
          else
            begin
            textkartyvypis;
          end;
          delay(3000);
          end;

procedure predchozilist;
          begin
          UKZpamet:=UKZaktivni;
          UKZaktivni:=UKZaktivni^.predchozi;
          if (testdelky=false) or (testblbosti=false) then
            begin
            TextBackground(0);
            TextColor(15);
            writeln('');
            writeln(' Jste na prvnim zaznamu, nebo neni zadny zaznam vlozen.');
            UKZaktivni:=UKZpamet;
            end
          else
            begin
            textkartyvypis;
          end;
          delay(3000);
          end;

procedure dalsilist;
          begin
          UKZpamet:=UKZaktivni;
          UKZaktivni:=UKZaktivni^.dalsi;
          if (testdelky=false) or (testblbosti=false) then
            begin
            TextBackground(0);
            TextColor(15);
            writeln('');
            writeln(' Jste na poslednim zaznamu, nebo neni zadny zaznam vlozen.');
            UKZaktivni:=UKZpamet;
            end
          else
            begin
            textkartyvypis;
            end;
          delay(3000);
          end;

procedure prvnilist;
          begin
          repeat
          UKZpamet:=UKZaktivni;
          UKZaktivni:=UKZaktivni^.predchozi;
          if (testdelky=false) or (testblbosti=false) then
          begin
              UKZaktivni:=UKZpamet;
              if (testdelky=false) or (testblbosti=false) then
                begin
                TextBackground(0);
                TextColor(15);
                writeln('');
                writeln(' Neni zadny zaznam vlozen.');
                end
              else
                begin
                textkartyvypis;
                break;
                end;
          end;
          until (testdelky=false) or (testblbosti=false);
          end;

procedure poslednilist;
          begin
          repeat
          UKZpamet:=UKZaktivni;
          UKZaktivni:=UKZaktivni^.dalsi;
          if (testdelky=false) or (testblbosti=false) then
          begin
              UKZaktivni:=UKZpamet;
              if (testdelky=false) or (testblbosti=false) then
                begin
                TextBackground(0);
                TextColor(15);
                writeln('');
                writeln(' Neni zadny zaznam vlozen.');
                end
              else
                begin
                textkartyvypis;
                break;
                end;
          end;
          until (testdelky=false) or (testblbosti=false);
          end;

function teststejnelist:boolean;
         begin
         teststejnelist:=false;
         if b^.polozka.jmeno = smazjmeno then
           begin
           if b^.polozka.prijmeni = smazprijmeni then
              begin
              if b^.polozka.vek = smazvek then
                begin
                teststejnelist:=true;
                end;
              end;
           end;
         end;

procedure zaznamoprav;
          begin
          if (testdelky=false) or (testblbosti=false) then
             begin
             TextBackground(0);
             TextColor(15);
             writeln('');
             writeln(' Neni zadny zaznam vlozen.');
             delay(3000);
             end
           else
             begin
             textkartyvypis;
             delay(3000);
             TextBackground(0);

             repeat
             TextColor(7);
             gotoxy(32,13);write('............................');
             TextColor(15);
             gotoxy(32,13);readln(txt);
             UKZaktivni^.polozka.jmeno:=txt;

             TextColor(7);
             gotoxy(32,14);write('............................');
             TextColor(15);
             gotoxy(32,14);readln(txt);
             UKZaktivni^.polozka.prijmeni:=txt;

             TextColor(7);
             gotoxy(32,15);write('............................');
             TextColor(15);
             gotoxy(32,15);readln(txt);
             UKZaktivni^.polozka.vek:=txt;
             delay(500);
             until (testnewdelky=true) and (testnewblbosti=true)
             end;
           end;

procedure smazzaznam;
          begin
  if (testdelky=true) or (testblbosti=false) then
    begin
     UKZpamet:=UKZaktivni;
     UKZaktivni:=UKZaktivni^.dalsi;
     if (testdelky=false) or (testblbosti=false) then
        begin
        UKZaktivni:=UKZpamet;
        UKZaktivni^.polozka.jmeno:='';
        UKZaktivni^.polozka.prijmeni:='';
        UKZaktivni^.polozka.vek:='';

        TextBackground(0);
        TextColor(15);
        writeln('');
        writeln(' Zaznam je uspesne smazan.');
        end
       else
        begin
        UKZbylaktivni:=UKZpamet;
        poslednilist;
        smazjmeno:=UKZaktivni^.polozka.jmeno;
        smazprijmeni:=UKZaktivni^.polozka.prijmeni;
        smazvek:=UKZaktivni^.polozka.vek;
        UKZaktivni^.polozka.jmeno:='';
        UKZaktivni^.polozka.prijmeni:='';
        UKZaktivni^.polozka.vek:='';
        UKZaktivni:=UKZbylaktivni;
        UKZaktivni^.polozka.jmeno:=smazjmeno;
        UKZaktivni^.polozka.prijmeni:=smazprijmeni;
        UKZaktivni^.polozka.vek:=smazvek;

        clrscr;
        hlavnimenu;
        TextBackground(0);
        TextColor(15);
        writeln('');
        writeln(' Zaznam je uspesne smazan.');
        end;
    end
   else
    begin
    TextBackground(0);
    TextColor(15);
    writeln('');
    writeln(' Neni zadny zaznam vlozen.');
    end;
          delay(3000);
          end;

procedure startprogramu;
          begin
          new(a);
          new(b);
          new(c);
          new(UKZprvni);
          new(UKZposledni);
          new(UKZaktivni);

          dispose(a);
          dispose(b);
          dispose(c);
          dispose(UKZprvni);
          dispose(UKZposledni);
          dispose(UKZaktivni);

          new(a);
          new(b);
          new(UKZprvni);
          new(UKZposledni);
          new(UKZaktivni);
          UKZprvni:=a;
          UKZposledni:=a;

          a^.dalsi:=nil;
          a^.predchozi:=nil;
          end;

procedure souboruloz;
          begin
          prvnilist;
          clrscr;
          hlavnimenu;

          TextBackground(0);
          TextColor(15);
          writeln;
          write(' Zadejte cestu a jmeno souboru s koncovkou: ');
          readln(souborname);
          Assign(soubor, souborname);
          Rewrite(soubor);

          UKZaktivni:=UKZprvni;
          UKZaktivni:=UKZaktivni^.dalsi;

          if (testdelky=false) or (testblbosti=false) then
            begin
            writeln(soubor,'Nejsou nalezeny zadne zaznamy k ulozeni.');
            end
           else
            begin
            repeat
            writeln(soubor,'-------------------------------------------');
            writeln(soubor,UKZaktivni^.polozka.jmeno);
            writeln(soubor,UKZaktivni^.polozka.prijmeni);
            writeln(soubor,UKZaktivni^.polozka.vek);
            UKZaktivni:=UKZaktivni^.dalsi;
            until (testdelky=false) or (testblbosti=false);
            writeln(soubor,'-------------------------------------------');
            end;
            close(soubor);
            TextBackground(0);
            TextColor(15);
            writeln('');
            writeln(' Zazanamy jsou ulozeny do: ',souborname);
          end;

procedure soubornovy;
          begin
          startprogramu;
          end;

procedure logoprogramu;
          begin
          TextBackground(0);
          TextColor(15);
          clrscr;
          TextColor(3);
          writeln('-------------------------------------------------------------------------------');
          TextColor(15);
          writeln(' Linearni seznam -->> ZK <<-- zk.zk@post.cz ---- SPSSE a VOS Liberec 13.4.2000');
          TextColor(3);
          writeln('-------------------------------------------------------------------------------');
          TextColor(7);
          writeln('');
          writeln('');
          writeln('');
          end;

procedure datainfo;
          begin
          UKZaktivni:=UKZprvni;
          UKZaktivni:=UKZaktivni^.dalsi;

          if (testdelky=false) or (testblbosti=false) then
            begin
            TextBackground(0);
            TextColor(15);
            writeln('');
            writeln(' Nejsou vlozeny zadne zaznamy.');
            end
           else
            begin
            writeln('');
            writeln('');
            TextBackground(0);
            TextColor(15);

            repeat
              writeln('-------------------------------------------');
              writeln(UKZaktivni^.polozka.jmeno);
              writeln(UKZaktivni^.polozka.prijmeni);
              writeln(UKZaktivni^.polozka.vek);
              UKZaktivni:=UKZaktivni^.dalsi;
            until (testdelky=false) or (testblbosti=false);
            writeln('-------------------------------------------');
            end;

          TextBackground(0);
          TextColor(15);
          writeln;
          writeln;
          writeln (' -- The END -- ');
          delay(1000);
          end;

procedure souborotevrit;
          begin
          startprogramu;

          TextBackground(0);
          TextColor(15);
          writeln;
          write(' Zadejte cestu a jmeno souboru s koncovkou: ');

          readln(txt);
          txt:='x:\a.txt';
          assign(soubor, txt);
          reset(soubor);

          temp:=0;
          writeln('');
          writeln('');
          writeln('');
          anone:=false;
          while not eof(soubor) do
          begin
          if anone=false then
            begin
            anone:=true;
            readln(soubor, txt);
            end;

           new(c);
           readln(soubor, txt);
           writeln(txt);
           c^.polozka.jmeno:=txt;
           readln(soubor, txt);
           writeln(txt);
           c^.polozka.prijmeni:=txt;
           readln(soubor, txt);
           writeln(txt);
           c^.polozka.vek:=txt;
           readln(soubor, txt);
           writeln(txt);

          c^.predchozi:=UKZposledni;
          c^.dalsi:=nil;
          UKZposledni^.dalsi:=c;
          UKZposledni:=c;
          UKZaktivni:=c;
          c:=nil;
          delay(400);
          end;
          close(soubor);
          end;

begin
startprogramu;
repeat
polozkahlavnimenu;

if ch='k' then begin
  polozkakonecmenu;
  hlavnimenu;
  if ch='a' then KonecProgramu:='konec';
  ch:=' ';
end;

if ch='s' then begin
  polozkasoubormenu;
  hlavnimenu;
  if ch='v' then soubornovy;
  if ch='o' then souborotevrit;
  if ch='u' then souboruloz;
  ch:=' ';
end;

if ch='z' then begin
  polozkazaznammenu;
  hlavnimenu;
  if ch='p' then zaznampridej;
  if ch='o' then zaznamoprav;
  if ch='s' then smazzaznam;
  ch:=' ';
end;

if ch='l' then begin
  polozkalistovanimenu;
  hlavnimenu;
  if ch='r' then begin;prvnilist;delay(3000);end;
  if ch='d' then dalsilist;
  if ch='a' then aktivnilist;
  if ch='p' then predchozilist;
  if ch='o' then begin;poslednilist;delay(3000);end;
  ch:=' ';
end;

if ch='h' then begin
  helpmenu;
  hlavnimenu;
  ch:=' ';
end;

until KonecProgramu='konec';

logoprogramu;
{datainfo;
}end.