[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]
{
From: Deavon@sound.demon.co.uk (Deavon Edwards)
I am having some problem with this program. I would like to modified it to
do the following....
i). To simulate the operation of a queue (Last In First Out).
ii) To use a linked list instead of arrays(simulating a stack and queue).
If anyone out there can help it would be greatly appreciated.
This program will simulate the operation of a stack and a queue with a
10 items maximum. It will give the user the opportunity to insert and
delete items from the data structures, display the data on screen,
it on a printer, and save and load the data from a disk
}
PROGRAM StackSimulation(input, output);
USES CRT,DOS,PRINTER;
VAR
Stack : ARRAY [1..10] OF STRING[20];
StackFull : BOOLEAN;
StackEmpty : BOOLEAN;
Pointer : INTEGER;
Choice : CHAR;
{*******************************************************************}
PROCEDURE PressAKey;
BEGIN
WRITELN;
WRITELN;
WRITELN (' ************************************');
WRITELN (' *** PRESS RETURN TO CONTINUE ***');
WRITELN (' ************************************');
READLN;
CLRSCR;
END;
{*******************************************************************}
PROCEDURE Jump_a_Line(Jump: INTEGER);
VAR
Skip : INTEGER;
BEGIN
FOR Skip := 1 TO Jump DO
WRITELN;
END;
{*******************************************************************}
Procedure Introduction; {Display an introduction message to user}
BEGIN
CLRSCR;
gotoxy (1,10);
Textcolor(Cyan);
writeln(' ********************************************************');
writeln(' ********************************************************');
writeln(' * *');
writeln(' * WELCOME TO STACK & QUEUE SIMULATION PROGRAM *');
writeln(' * *');
writeln(' ********************************************************');
writeln(' ********************************************************');
Jump_a_line(3);
DELAY (1000);
end;
{*******************************************************************}
PROCEDURE Initialise (VAR StackFull, StackEmpty : BOOLEAN);
BEGIN
CLRSCR;
gotoxy (1,10);
Jump_a_line(2);
WRITELN (' ******************************************************');
WRITELN (' THE STACK IS INITIALISING...........PLEASE WAIT.......');
WRITELN (' ******************************************************');
Jump_a_line(3);
SOUND (240);
DELAY (1000);
CLRSCR;
NOSOUND;
Pointer := 0;
StackFull := FALSE;
StackEmpty := TRUE;
END;
{*******************************************************************}
PROCEDURE Add (VAR StackFull, StackEmpty : BOOLEAN);
BEGIN
IF StackFull THEN
BEGIN
gotoxy (1,10);
Jump_a_line(2);
WRITELN ('************************************************************');
WRITELN ('** SORRY, THE STACK IS FULL, NO MORE DATA CAN BE ENTERED ***');
WRITELN ('************************************************************');
Jump_a_line(3);
PressAKey;
END
ELSE
BEGIN
INC (Pointer);
Jump_a_line(3);
WRITE ('PLEASE ENTER THE ITEM TO BE ADDED TO THE STACK :=> ');
READLN (Stack [Pointer]);
CLRSCR;
IF StackEmpty THEN StackEmpty := FALSE;
IF Pointer = 10 THEN StackFull := TRUE;
END;
END;
{*******************************************************************}
PROCEDURE Take (VAR StackFull, StackEmpty : BOOLEAN);
BEGIN
IF StackEmpty THEN
BEGIN
gotoxy (1,10);
Jump_a_line(3);
WRITELN (' *******************************************************');
WRITELN (' *** THE STACK IS EMPTY, NO MORE DATA CAN BE REMOVED ***');
WRITELN (' *******************************************************');
Jump_a_line(3);
PressAKey;
END
ELSE
BEGIN
gotoxy (1,10);
Jump_a_line(3);
WRITE ('THE FOLLOWING ITEM HAVE BEEN REMOVE FROM THE STACK :=> ');
WRITELN (Stack [Pointer]);
DEC (Pointer);
IF Pointer = 0 THEN StackEmpty := TRUE;
IF StackFull THEN StackFull := FALSE;
Jump_a_line(3);
PressAKey;
END;
END;
{*******************************************************************}
PROCEDURE Display_to_Screen (StackEmpty : BOOLEAN);
VAR
Counter : INTEGER;
BEGIN
CLRSCR;
GOTOXY (1,10);
IF StackEmpty THEN
WRITELN (' THE STACK IS CURRENTLY EMPTY ');
Jump_a_Line (3);
FOR Counter := 1 TO Pointer DO
WRITELN (Counter:2 ,' ', Stack [Counter]);
Jump_a_Line(2);
PressAKey;
END;
{*******************************************************************}
PROCEDURE Print_to_Printer (StackEmpty : BOOLEAN);
VAR
Counter : INTEGER;
BEGIN
CLRSCR;
GOTOXY (1,10);
{$I-}
WRITELN (lst,#0);
IF IORESULT <> 0 THEN
WRITELN (' >>>>>> PRINTING ERROR.......PRINTER OFF LINE <<<<<< ')
ELSE
BEGIN
IF StackEmpty THEN
WRITELN ('THE STACK IS CURRENTLY EMPTY, THERE IS NO DATA TO BE PRINTED.')
ELSE
WRITELN (' THE CONTENTS OF THE STACK IS PRINTING........');
FOR Counter := Pointer DOWNTO 1 DO
WRITELN (Lst,Counter:2 ,' ', Stack [Counter]);
END;
{$I+}
PressAKey;
END;
{****************************************************}
PROCEDURE Save_to_File;
VAR
Write_to_File : TEXT;
Output_to_File : STRING[20];
Read_File : BOOLEAN;
Counter : INTEGER;
BEGIN
CLRSCR;
Jump_a_Line(3);
WRITE('PLEASE ENTER THE NAME YOU WISH TO CALLED THE FILE :=> ');
READLN(Output_to_File);
ASSIGN(Write_to_File,Output_to_File);
REWRITE(Write_to_File);
FOR Counter := 1 TO Pointer DO
BEGIN
Writeln(Write_to_File,Stack[Counter]);
Writeln('SAVING... ',Counter:2,' ... ',Stack[Counter]);
END;
CLOSE(Write_to_File);
PressAKey;
End;
{**************************************************}
PROCEDURE Open_A_File (StackEmpty : BOOLEAN);
VAR
Read_File : TEXT;
Input_to_File : STRING[20];
BEGIN
CLRSCR;
Jump_a_Line(3);
WRITE ('PLEASE ENTER THE NAME OF THE FILE YOU WHICH TO OPENED :=> ');
READLN(Input_to_File);
ASSIGN(Read_File,Input_to_File);
{$I-}
RESET(Read_File);
IF IOResult = 0 THEN
BEGIN
Jump_a_Line(2);
Pointer := 0;
WHILE NOT EOF(Read_File) DO
BEGIN
INC (Pointer);
READLN(Read_File,Stack [Pointer]);
WRITELN(Pointer:2,' : ',Stack[Pointer]);
END;
CLOSE(Read_File);
StackEmpty := FALSE;
END
ELSE
CLRSCR;
Jump_a_Line(2);
WRITELN (' ***********************************');
WRITELN (' *** FILE NAME DOES NOT EXIT ***');
WRITELN (' ***********************************');
{$I+}
PressAKey;
END;
{****************************************************}
PROCEDURE Menu;
BEGIN
gotoxy (1,10);
Textcolor(White);
WRITELN (' **************************************************');
WRITELN (' **************************************************');
WRITELN (' **** A : Add to Stack *****');
WRITELN (' **** T : Take from Stack *****');
WRITELN (' **** D : Display Stack List to Screen *****');
WRITELN (' **** P : Print Stack List *****');
WRITELN (' **** I : Initialise Stack List *****');
WRITELN (' **** S : Save Stack to disk *****');
WRITELN (' **** L : Load Stack from disk *****');
WRITELN (' **** Q : Quit program *****');
WRITELN (' **************************************************');
WRITELN (' **************************************************');
WRITELN;
WRITELN;
WRITELN (' PLEASE ENTER AN OPTION >> ');
Choice := READKEY;
END;
PROCEDURE QuitProgram;
BEGIN
gotoxy (1,10);
WRITELN (' ***********************************');
WRITELN (' """""""""""""""""""""""""""""""""""');
WRITELN (' [[[[[ GOODBYE!!!!!! ]]]]] ');
WRITELN (' """""""""""""""""""""""""""""""""""');
WRITELN (' ***********************************');
WRITELN;
WRITELN;
END;
{*******************************************************************}
{*******************************************************************}
BEGIN
Introduction;
Initialise (StackFull, StackEmpty);
REPEAT
Menu;
CLRSCR;
CASE Choice OF
'A', 'a' : Add (StackFull, StackEmpty);
'T', 't' : Take (StackFull, StackEmpty);
'D', 'd' : Display_to_Screen (StackEmpty);
'P', 'p' : Print_to_Printer (StackEmpty);
'I', 'i' : Initialise (StackFull, StackEmpty);
'S', 's' : Save_to_File;
'L', 'l' : Open_a_File(StackEmpty);
'Q', 'q' : QuitProgram
ELSE
BEGIN
gotoxy (1,10);
WRITELN (' **************************');
WRITELN (' ** Invalid key pressed **');
WRITELN (' **************************');
WRITELN;
PressAKey;
END;
END;
UNTIL (Choice = 'Q') OR (Choice = 'q');
END.
[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]