{ 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 ak64) 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.