[PASCAL] Stos

[Kaburagi 0]

Witam!

Zrobiłem stos ze zmiennymi dynamicznymi, niemniej nie jestem pewien czy wszystko jest tak jak należy.

Niby wszystko śmiga i żądane czynności się wykonują, ale preferuję by ktoś swoim doświadczonym okiem na to spojrzał i mnie upewnił.

 

Oto kod:

uses
   crt;
type
   wskaznik_stosu=^skladnik_stosu;
   skladnik_stosu=record
                        dane:string;
                        wskaznik:wskaznik_stosu;
   end;
var
  wierzcholek,punkt:wskaznik_stosu;
  i:integer;

function menu:char;
begin
clrscr;
writeln('[D] Dodawanie na stos');
writeln('[W] Wyswietlanie stosu');
writeln('[Z] Zdejmowanie ze stosu');
writeln('[X] Kasowanie stosu');
writeln('[K] Koniec programu');
menu:=upcase(readkey);
end;

procedure dodawanie;
var
  znak:char;
begin
repeat
if i=0 then
begin
    clrscr;
    i:=1;
    new(wierzcholek);
    write('Dane: ');
    readln(wierzcholek^.dane);
    wierzcholek^.wskaznik:=nil;
    punkt:=wierzcholek;
    writeln('N - konczy, inny kontynuuje');
    znak:=upcase(readkey);
end
else
if i<>0 then
begin
    clrscr;
    new(wierzcholek);
    write('Dane: ');
    readln(wierzcholek^.dane);
    wierzcholek^.wskaznik:=punkt;
    punkt:=wierzcholek;
    writeln('N - konczy, inny kontynuuje');
    znak:=upcase(readkey);
end;
until znak='N';
end;

procedure wyswietlanie;
begin
clrscr;
while punkt<>nil do
     begin
          writeln(punkt^.dane);
          punkt:=punkt^.wskaznik;
     end;
if punkt=nil then i:=0;
readln;
end;

procedure kasowanie;
var
  temp:wskaznik_stosu;
begin
    clrscr;
    while punkt <> nil do
          begin
               dispose(wierzcholek);
               wierzcholek:=punkt;
          end;
     writeln('Stos skasowany');
     i:=0;
     readln;
end;

procedure zdejmowanie;
begin
clrscr;
dispose(wierzcholek);
punkt:=wierzcholek^.wskaznik;
wierzcholek:=punkt;
writeln('Wierzcholek zdjety');
readln;
end;

begin
i:=0;
repeat
clrscr;
case menu of
    'D':dodawanie;
    'Z':zdejmowanie;
    'X':kasowanie;
    'W':wyswietlanie;
    'K':halt;
end;
until false;
end.

[Paciorrro 0]

Oj chyba źle masz wyświetlanie i dodawanie wyświetlić można tylko raz jak chcę dopisać coś do stosu stos się kasuje i robi się nowy.

może będzie działać nie obiecuję.

procedure wyswietlanie;
begin
clrscr;
     punkt:=wierzcholek;
while punkt<>nil do
     begin
          writeln(punkt^.dane);
          punkt:=punkt^.wskaznik;
     end;
if punkt=nil then i:=0;{<=== to jest raczej niepotrzebne}
readln;
end;

 

 

Pozdro Paciorrro.

 

PS. Kasowanie też nie działa

[Kaburagi 0]

Fakt, nie zwróciłem na to uwagi

Co do dopisywanie do stosu - to wszystko jest dobrze (tzn. tak ma być)...

Wyświetlanie już też chodzi w pętli...

Kasowanie stosu też już śmiga

 

 

 

Poprawiony kod:

uses
   crt;
type
   wskaznik_stosu=^skladnik_stosu;
   skladnik_stosu=record
                        dane:string;
                        wskaznik:wskaznik_stosu;
   end;
var
  wierzcholek,punkt:wskaznik_stosu;
  i:integer;

function menu:char;
begin
clrscr;
writeln('[D] Dodawanie na stos');
writeln('[W] Wyswietlanie stosu');
writeln('[Z] Zdejmowanie ze stosu');
writeln('[X] Kasowanie stosu');
writeln('[K] Koniec programu');
menu:=upcase(readkey);
end;

procedure dodawanie;
var
  znak:char;
begin
repeat
if i=0 then
begin
    clrscr;
    i:=1;
    new(wierzcholek);
    write('Dane: ');
    readln(wierzcholek^.dane);
    wierzcholek^.wskaznik:=nil;
    punkt:=wierzcholek;
    writeln('N - konczy, inny kontynuuje');
    znak:=upcase(readkey);
end
else
if i<>0 then
begin
    clrscr;
    new(wierzcholek);
    write('Dane: ');
    readln(wierzcholek^.dane);
    wierzcholek^.wskaznik:=punkt;
    punkt:=wierzcholek;
    writeln('N - konczy, inny kontynuuje');
    znak:=upcase(readkey);
end;
until znak='N';
end;

procedure wyswietlanie;
begin
clrscr;
      punkt:=wierzcholek;
while punkt<>nil do
     begin
          writeln(punkt^.dane);
          punkt:=punkt^.wskaznik;
     end;
readln;
end;

procedure kasowanie;
var
  temp:wskaznik_stosu;
begin
    clrscr;
    punkt:=wierzcholek;
    while punkt <> nil do
          begin
               dispose(wierzcholek);
               punkt:=wierzcholek^.wskaznik;
               wierzcholek:=punkt;
          end;
     writeln('Stos skasowany');
     i:=0;
     readln;
end;

procedure zdejmowanie;
begin
clrscr;
dispose(wierzcholek);
punkt:=wierzcholek^.wskaznik;
wierzcholek:=punkt;
writeln('Wierzcholek zdjety');
readln;
end;

begin
i:=0;
repeat
clrscr;
case menu of
    'D':dodawanie;
    'Z':zdejmowanie;
    'X':kasowanie;
    'W':wyswietlanie;
    'K':halt;
end;
until false;
end.

[Paciorrro 0]

Łap dobry stos

uses crt;
type wskaznik_stosu=^skladnik_stosu;
skladnik_stosu=record
	dane:String;
	wskaznik:wskaznik_stosu;
end;
var
wierzcholek,punkt:wskaznik_stosu;

function menu:char;
begin
clrscr;
writeln('[1] - Dodawanie');
writeln('[2] - Wyswietlanie');
writeln('[3] - Zdejmowanie');
writeln('[4] - Kasowanie');
writeln('[Esc] - Wyjscie z programu');
menu:=readkey;
end;
procedure dodaj;
var
znak:char;
begin
repeat
clrscr;
punkt:=wierzcholek;
new(wierzcholek);
	write('Dane: ');
	readln(wierzcholek^.dane);
wierzcholek^.wskaznik:=punkt;
writeln('N - konczy, inny kontynuuje');
	znak:=upcase(readkey);
until znak='N';
end;
procedure wyswietl;
begin
clrscr;
punkt:=wierzcholek;
   Repeat
         writeln(punkt^.dane);
         punkt:=punkt^.wskaznik;
   until punkt=nil;
end;
procedure zdejmij;
begin
clrscr;;
    punkt:=wierzcholek;
    dispose(wierzcholek);
    punkt:=wierzcholek^.wskaznik;
    wierzcholek:=punkt;
writeln('Wierzcholek zdjety');
end;
procedure usun;
begin
clrscr;
  repeat
        punkt:=wierzcholek;
        dispose(wierzcholek);
        punkt:=wierzcholek^.wskaznik;
        wierzcholek:=punkt;
  until punkt=nil;
	writeln('Stos usuniety');
end;

begin
repeat
clrscr;

case menu of
'1':dodaj;
'2':wyswietl;
'3':zdejmij;
'4':usun;
#27:halt;
end;
	writeln;
	writeln('Aby wrocic do menu nacisnij [ENTER]');
readln;
until false;
end.