Единственное что не могу реализовать это :
Нормальное создание стека ,без "нулевого" элемента.(была проблема с ограничением стека,и последующией проверкой на переполнение,пришлось идти обходными путями)
Добавление сразу нескольких элементов.
Думаю завтра все осилить..или попытатся хотябы.
вот,осудите по все строгости,хочу нормально заботать стеки..
Program stekT; {Created and Tested By Andrewshkovskii}
uses crt;
type
StekType=integer;
L1 = ^stack;
Stack = record
inf:StekType;
link:l1;
end;
var
top:L1;
m:StekType;
el:StekType;
maxE:integer;
procedure DelFStek(var top:l1); {Удаляет первый элемент стэка,использовать для ввода стека(ввод до элемента 0)}
var
k:l1;
m:StekType;
begin
if top=nil then
writeln('Stek is empty')
else
begin
m:=top^.inf;
k:=top;
Top:=top^.link;
dispose(k);
end;
end;
function EmptyStek(top:l1):boolean; (*проверка на пустоту стэка*)
begin
EmptyStek:=(top=nil);
end;
function StekOver(top:l1;maxe:integer):boolean; (*проверка на переполнение стэка *)
var
j:Integer;
k:l1;
begin
j:=0;
k:=top;
if NOT (EmptyStek (k)) then
while k<>Nil do
begin
j:=j+1;
k:=k^.link;
end;
StekOver:=(j>=maxe);
end;
procedure NewStek(top:l1); (**создание пустого стэка *)
begin
top:=nil;
end;
procedure InputStek(var top:l1;var El:StekType); (*добавление элемента в стек*)
var
k:l1;
i:integer;
begin
new(k);
k^.inf:=El;
if not (StekOver(top,maxe)) then
begin
k^.link:=Top;
Top:=k
end
else
begin
writeln;
writeln('Stek perepolnen!');
end;
end;
procedure BStek(var Top:l1); (*создание стэка с элементами с вводом элементов*)
var
k:l1;
i:integer;
el:StekType;
begin
top:=Nil;
repeat
clrscr;
writeln('Vvedite maks 4islo elementov steka(minimum 2)');
readln(MaxE);
if (MaxE<=0) then
begin
writeln('Vi vveli 0 ili otricatelnoe zna4enie kol-va elementov v steke!');
writeln('Eto ne dopystimo!Povtorite vvod!');
writeln('Press any key...');
readkey;
end;
until MaxE>0;
writeln('Vvedite elementi steka');
Writeln('Koncom vvoda yavlyaetsya element 0');
while el<>0 do
begin
readln(el);
inputstek(top,el);
end;
end;
procedure StekView(var top:l1); (*просмотр стэка*)
var
K:l1;
begin
if Top = nil then
writeln('Stek Pyst dlya prosmotra!')
else
begin
k:=top;
writeln('Elementi steka');
while k<>nil do
begin
writeln(k^.inf);
K:=k^.link;
end;
end;
end;
procedure StekDel(var top:L1); (*Удаление элемента стэка*)
var
k:L1;
i,DelVal,m:integer;
begin
If top = nil then
writeln('Stek Pyst Dlya ydaleniya')
else
begin
repeat
writeln('Skolko elementov ydalit iz STEKA(!!) ?');
readln(DelVal);
if DelVal > MaxE then
begin
writeln('Kol-vo elementov k ydaleniu bolshe kol-va elementov v steke!');
writeln('Povtorite Vvod!');
writeln('Press any key...');
readkey;
end;
until DelVal<MaxE;
for i:=1 to DelVal do
begin
m:=top^.inf;
k:=top;
Top:=Top^.Link;
Dispose(k);
end;
end;
end;
begin
clrscr;
NewStek(top);
BStek(top);
DelFStek(top);
StekView(top);
writeln('Vvedite element dlya dobavleniaya');
readln(el);
InputStek(top,el);
StekView(top);
StekDel(top);
StekView(top);
readkey;
end.
вот..первый опыт
Однако, все равно - ты при определении "переполненности" должен пройтись по всему списку, а он может быть немаленьким, что совсем не нужно делать... Достаточно разделить понятия Stack и Item (то, что у тебя описано как Stack - на самом деле - элемент стека), то есть, что-то типа: