Program graficky znázorňuje prácu so zásobníkom (stack&LIFO)

{ STACK.PAS                                                         }
{ Program graficky znazornuje pracu so zasobnikom (stack&LIFO) je   }
{ castou zdrojoveho kodu mojej semestralnej prace z predmetu        }
{ "udajove struktury 1", standardne procedury ako pridaj ci zmaz    }
{ prvok z vrchu zasobnika chybaju kedze mi islo hlavne o zakladny   }
{ princip fungovania zasobnika                                      }
{                                                                   }
{ Author: Unknown                                                   }
{ Datum: 10.04.2009                            http://www.trsek.com }
 
Program stack;
uses crt;
 
 
type mp3 = record
       id:integer;
       singer:string[20];
       song:string[20];
       time:integer;
       style:string[15];
     end;
 
     smernik = ^prvok;
     prvok = record
       hod:mp3;
       nas:smernik;
     end;
 
var i,l:integer;
    zac:smernik;
 
 
 
procedure init;
begin
  zac:=nil;
end;
 
procedure writexy(x,y:integer; s:string);
begin
  gotoxy(x,y);
  write(s);
end;
 
procedure zisti_id(var id:integer);
var p:smernik;
begin
  id:=0;
  p:=zac;
  if p=nil then id:=0;
  while p<>nil do
    begin
      if p^.hod.id>id
        then id:=p^.hod.id;
      p:=p^.nas;
    end;
end;
 
 
procedure nacitaj_zo_suboru;
var p,s:smernik;
    fr:text;
    id:integer;
 
begin
  assign(fr,'D:\file.txt');
  reset(fr);
  zisti_id(id);
 
  while not eof(fr) do
    begin
      new(p);
      readln(fr,p^.hod.singer);
      readln(fr,p^.hod.song);
      readln(fr,p^.hod.time);
      readln(fr,p^.hod.style);
      id:=id+1;
      p^.hod.id:=id;
      p^.nas:=zac;
      zac:=p;
    end;
  close(fr);
end;
 
 
procedure ramik(a,b,x,y:integer);
begin
  for i:=x to a+x-1 do
  begin
    writexy(i,y,chr(205));
  end;
  writexy(a+x,y,chr(187));
 
  for i:=y+1 to b+y-1 do
  begin
    writexy(a+x,i,chr(186));
  end;
  writexy(a+x,b+y,chr(188));
 
  for i:=a+x-1 downto x+1 do
  begin
    writexy(i,b+y,chr(205));
  end;
  writexy(x,b+y,chr(200));
 
  for i:=b+y-1 downto y+1 do
  begin
    writexy(x,i,chr(186));
  end;
  writexy(x,y,chr(201));
  gotoxy(x+1,y+1);
end;
 
procedure kolko(var n:integer);
var p:smernik;
begin
  n:=0;
  p:=zac;
  if p=nil then n:=0;
  while p<>nil do
    begin
      n:=n+1;
      p:=p^.nas;
    end;
end;
 
 
 
procedure oznac(x,y,rezim:integer);
begin
  textbackground(blue);
  textcolor(white);
   case rezim of
        1: begin
             gotoxy(x,y);
             write(chr(219),chr(219));
             gotoxy(x,y+1);
             write(chr(219),chr(219));
           end;
        2: begin
             gotoxy(x,y);
             write('  ');
             gotoxy(x,y+1);
             write('  ');
           end;
   end;
end;
 
 
procedure prvky;
 var i,x,y,ak,n:integer;
     z:char;
     p,o,m:smernik;
 
begin
  textbackground(blue);
  clrscr;
  p:=zac;
  kolko(n);
  gotoxy(3,8);
  write('ZAC--');
  gotoxy(72,8);
  write('NIL');
  for i:=1 to 8 do
    begin
      ramik(5,5,8*i,5);
      gotoxy(8*i+1,6);
      write(i:4);
      gotoxy(8*i+6,8);
      write('--');
    end;
 
  textbackground(yellow);
  writexy(1,1,'Ovladacie prvky: << A      D >>                          navrat do menu "ESCAPE"');
 
  oznac(10,8,1);
 
 
  x:=9;
  y:=6;
  ak:=1;
  gotoxy(x,y);
 
 
  repeat
  z:='a';
 
  while ((z='a') or (z='d')) do
    begin
 
       ramik(49,10,14,13);
 
        gotoxy(20,16);
        write('ID skladby   : ',p^.hod.id:20);
        gotoxy(20,17);
        write('Interpret    : ',p^.hod.singer:20);
        gotoxy(20,18);
        write('Nazov skladby: ',p^.hod.song:20);
        gotoxy(20,19);
        write('Cas (min)    : ',p^.hod.time:20);
        gotoxy(20,20);
        write('Hudobny styl : ',p^.hod.style:20);
 
      z:=readkey;
 
      if ak<=n then
      begin
        case z of
         'a' : begin
                 if (ak>1) then
                   begin
                     ak:=ak-1;
                     new(o);
                     o:=zac;
                     while(o^.nas<>p) do o:=o^.nas;
                     p:=o;
                   end;
 
                 if (x>16) then
                   begin x:=x-8;
                     oznac(x+1,8,1);
                     oznac(x+9,8,2);
                   end;
 
                 if (x<17) then for i:=8 downto 1 do
                   begin
                     gotoxy(8*i+1,6);
                     write(ak+i-1:4);
                   end;
 
               end;
 
         'd' : begin
                 if ak<n then
                   begin
                     ak:=ak+1;
                     p:=p^.nas;
                   end;
                 if (x<60) then
                   begin x:=x+8;
                     oznac(x+1,8,1);
                     oznac(x-7,8,2);
                   end;
 
                 if (x>64) then for i:=1 to 8 do
                   begin
                     gotoxy(8*i+1,6);
                     write(ak+i-8:4);
                   end;
 
               end;
 
        end; {belongs to CASE}
 
 
 
      end;  {belongs to condition}
 
    end; {belongs to WHILE cycle}
 
  until(z=#27);
 
end;
 
begin
init;
nacitaj_zo_suboru;
 
 
clrscr;
 
prvky;
 
end.