VIRTUALeMEDIA SOFTWARE ENGINEER

WWW.VIRTUALeMEDIA.COM

CONTACT US | HOMEPAGE

VIRTUALeMEDIA SOFTWARE ENGINEERING

CLOTHING :: ELECTRONICS :: HARDWARE :: GIFTS :: BOOKS :: FINANCE :: SOFTWARE :: EMPLOYMENT :: VIRTUAL OFFICES

COOL STUFF

TECHNOLOGY

LINKS

_________________________________________________________________________________________

___________________

Welcome to our website

{$U+,B-}

program dostacks(input,output,infile,outfile);

const maxstack = 100;

type
eltype = char; { test stuff }

stacktype = record
elements : array[1..maxstack] of eltype; { tester }
top : 0..maxstack
end; { record }

var
infile,outfile : text;
stack : stacktype;
flag : boolean;

{********************************************************************}

procedure push(var stack : stacktype;
newelement : eltype);

{ Adds newelement to the top of the stack.
{ Assumes stack is not full.
}

begin { push }
stack.top := stack.top - 1;
stack.elements[stack.top] := newelement
end; { push }

{********************************************************************}

procedure pop(var stack : stacktype;
var poppedelement : eltype);

{ Removes the top element from the stack and returns it in
{ poppedelement. Assumes stack not empty.
}

begin { pop }
poppedelement := stack.elements[stack.top];
stack.top := stack.top + 1
end; { pop }

{********************************************************************}

function fullstack(stack : stacktype) : boolean;

{ Returns true if the stack is full, otherwise false.
}

begin { fullstack }
fullstack := stack.top = maxstack
end; { fullstack }

{********************************************************************}

function emptystack(stack : stacktype) : boolean;

{ Returns true if stack is empty, otherwise false.
}

begin { emptystack }
emptystack := stack.top = 0
end; { emptystack }

{********************************************************************}

procedure clearstack( var stack : stacktype);

{ Initializes stack to empty.
}

begin { clearstack }
stack.top := 0
end; { clearstack }

{********************************************************************}

procedure showstack(var stack : stacktype);

var
ch : eltype;

begin { showstack }
while not emptystack(stack) do
begin
pop(stack,ch);
write(ch)
end
end; { showstack }

{********************************************************************}

{ This procedure is the controlling module for stack refilling
{ process.
}

procedure pushbackon(var infile : text; var stack : stacktype);

var
flag : boolean;
ch : eltype;

begin { drivepush }
clearstack(stack);
{$i-}reset(infile);{$i+}
flag := false;
while not flag do
begin
read(infile,ch);
if ch = '*' then { Checking for eof }
flag := true;
if not fullstack(stack) then
push(stack,ch)
end { while not flag }
end; { drivepush }

{********************************************************************}

{ This procedure is the controlling module for stack filling
{ process.
}

procedure drivepush(var infile : text; var stack : stacktype);

var
flag : boolean;
ch : eltype;

begin { drivepush }
write('Echoprint : ');
clearstack(stack);
{$i-}reset(infile);{$i+}
flag := false;
while not flag do
begin
read(infile,ch);
write(ch);
if ch = '*' then { Checking for eof }
flag := true;
if not fullstack(stack) then
push(stack,ch)
end; { while not flag }
writeln
end; { drivepush }

{********************************************************************}

{ This procedure swaps the top to elements in the stack.
}

procedure swap(var stack1 : stacktype);

var
firstch,secondch : eltype;
stack2,stack3 : stacktype;

begin { Swap }
pop(stack1,firstch);
writeln;writeln;writeln('Firstch = ',firstch);
push(stack2,firstch);
pop(stack1,secondch);
writeln;writeln(secondch,' = secondch');
writeln;
push(stack3,secondch);
pop(stack2,firstch);
push(stack1,firstch);
pop(stack3,secondch);
push(stack1,secondch)
end; { Swap }

{********************************************************************}

{ This procedure finds out how many elements are in the stack.
}

procedure depth(var stack : stacktype);

var
ch : eltype;
numelements : integer;

begin { Depth }
numelements := 0;
while not emptystack(stack) do
begin { while }
pop(stack,ch);
numelements := numelements + 1
end; { while }
writeln('Numelements = ',numelements)
end; { Depth }

{********************************************************************}

{ Duplicates the top element and places it on top of the stack.
}

procedure dupe(var stack : stacktype);

var
ch,dupedch : eltype;

begin { Dupe }
pop(stack,ch);
dupedch := ch;
push(stack,ch);
push(stack,dupedch)
end; { Dupe }

{********************************************************************}

{ Pops the top element off of the stack and does nothing with it,
{ which effectively deletes the character.
}

procedure drop(var stack : stacktype);

var
ch : char;

begin { Drop }
if not emptystack(stack) then
pop(stack,ch)
end; { Drop }

{********************************************************************}

{ Contains all the procedure calls. Controls the order in which
{ the tasks in this program are performed.
}

procedure drivestacks(var infile : text; var stack : stacktype);

begin { drivestacks }
drivepush(infile,stack);
writeln;
write('Stack : ');
showstack(stack);
writeln;
pushbackon(infile,stack);
swap(stack);
write('Swap : ');
showstack(stack);
writeln;
pushbackon(infile,stack);
writeln;
write('Depth : ');
depth(stack);
pushbackon(infile,stack);
writeln;
dupe(stack);
write('Dupe : ');
showstack(stack);
writeln;
pushbackon(infile,stack);
writeln;
drop(stack);
write('Drop : ');
showstack(stack)
end; { drivestacks }

{********************************************************************}

begin
assign(infile,'test.dat');
clrscr;
drivestacks(infile,stack);
close(infile)
end.

DATAFILE: LAB2.DAT

1235 Sam Smith 2.75 CS
CS208 SOC100 EH205
3251 Mary Blake 3.32 MA
MA251 MA 244
8724 Bob Williams 1.99 BYS
BYS113 MA 154 COM113 EH 205
7765 Christine White 3.45 CS
CS 308 CS209
2395 Richard Smith 3.87 PY
PY100 EH102 HY102
1818 Debbie Blake 3.1 CS
CS214 CS208 MA244 HY102
4905 Dick Brown 2.75 CH
CH121 CH125 MA154
3875 Sue Jones 2.50 CS
CS214
7788 Chris Christen 2.15 MA
CS108 MA154 EH205
2947 Mike Smith 3.16 CH
PY100 EH205 FH201
2325 Lane Mosley 3.25 PY
CH121 CH124
4128 Missy Valves 2.78 BYS
MA244 MA251 CS309