ADT STACK PROJECT (CSC234)

For all my coursemates who havent done thier project (stack). its not the full project sha, just the procedures and function. do the rest!!!


function pop(var tmp:stack_temp):element_type;
begin
  if tmp.top < 1 then
    begin
      writeln('Error, Stack is empty');
      pop:=-1
    end
  else
    begin
      pop:=tmp.element[tmp.top];
      tmp.top:=tmp.top - 1;
    end;
end;

function pop(var stack:stack_type):element_type;
begin
  if stack.top < 1 then
    begin
      writeln('Error, Stack is empty');
      pop:=-1
    end
  else
    begin
      pop:=stack.element[stack.top];
      stack.top:=stack.top - 1;
    end;
end;


procedure push(s:element_type; var stack:stack_type);
begin
  if stack.top = max then
    writeln('Error, stack is full')
  else

    begin
      stack.top := stack.top + 1;
      stack.element[stack.top]:=s;
    end;
end;

procedure push(s:element_type; var tmp:stack_temp);
begin
  if tmp.top = max then
    writeln('Error, stack is full')
  else
    begin
      tmp.top := tmp.top + 1;
      tmp.element[tmp.top]:=s;
    end;
end;

function peek(stack:stack_type):element_type;
begin
  if stack.top < 1 then
    begin
      writeln('Error, stack is empty');
      peek := -1;
    end
  else
    peek := stack.element[stack.top]
end;

procedure printstack(stack:stack_type);
var p: position_type;
begin
  if stack.top < 1 then
    writeln('Error, stack is empty')
  else
    for p:= stack.top downto 1 do
      begin
        writeln(p,'. ',stack.element[p]);
      end;
end;

procedure makenull(var stack:stack_type);
begin
  stack.top:= 0;
end;

procedure insert(s:element_type; p:position_type; var stack:stack_type);
var q,x: integer;
begin
  if (stack.top = max) then
    writeln('Error, stack is full')
  else
    begin
      for q:= stack.top downto p do
        begin
          x:=pop(stack);
          push(x,tmp);
        end;
      push(s,stack);
      for q:= tmp.top downto 1 do
        begin
          x:=pop(tmp);
          push(x,stack);
        end;
     end;
end;

procedure delete(p:position_type; var stack:stack_type);
var q,x,s: integer;
begin
  if (stack.top < 1) or (p >= stack.top) then
    begin
      writeln('Error, position does not exist');
    end
  else
    begin
      for q:= stack.top downto p+1 do
        begin
          x:=pop(stack);
          push(x,tmp);
        end;
      stack.top :=stack.top-1;
      clrscr;
      writeln('ELEMENT AT POSITON >>>[',p,']<<< HAS BEEN DELETED');
      for q:= tmp.top downto 1 do
        begin
          s:=pop(tmp);
          push(s,stack);
        end;
    end;
end;

function retrieve(p: position_type; stack: stack_type):element_type;
var q,s:position_type;
begin
  if (p < 1) or (p > stack.top + 1) then
    begin
      writeln('Error, position does not exist');
      retrieve := stack.top + 1
    end
  else
    begin
      for q:= stack.top downto p+1 do
        begin
          x:=pop(stack);
          push(x,tmp);
        end;
      retrieve:=stack.element[stack.top];
      for q:= tmp.top downto 1 do
        begin
          s:=pop(tmp);
          push(s,stack);
        end;
    end;
end;

function locate(s: element_type; stack: stack_type): position_type;
var q: position_type;
found: boolean;
begin
  q:=1;
  found:= false;
  c:= stack.top;
  while (q <= c) AND (found = false) do
    begin
      if stack.element[stack.top] = s then
        begin
          found := true;
          locate := stack.top;
        end
      else
        begin
          q:=q+1;
          x:=pop(stack);
          push(x,tmp);
          if found = false then
          locate := -50;
        end;
    end;
end;