{ This program is a solution to exercise #2 for CSC 206, ``Fundamentals of
computer science II,'' offered at Grinnell College in fall semester,
1996.
In this exercise, the student is asked to write three procedures for
reading and writing values of an enumerated type. The type represents
the twenty-two individual cards making up the so-called ``major arcana''
of one form of a traditional Tarot deck.
The ReadMajorArcanum procedure takes a text file as its argument and
attempts to read in from that file a value of the enumerated type,
returning that value through a variable parameter, Legend. Another
variable parameter is set to True to indicate that the attempt succeeded,
or to False to indicate that it failed; if it is False, then the value of
Legend is undefined and should not be used.
The ReadMajorArcanum procedure begins by discarding any leading spaces,
tab characters, and line breaks. It then consumes characters from the
specified text file until it (a) has read in all the characters in the
full string representation of a value of the enumerated type; (b) has
reached the end of the file, or (c) can determine that the next character
cannot be part of the string representation of the value currently being
read in. At this point it stops. If the characters it has read in at
that point constitute an initial segment of one and only one value of the
enumerated type, this value is assigned to the Legend parameter and the
input operation succeeds; otherwise, the input operation fails. So, for
instance, if the next three characters of the text file are 'Jum', the
characters 'Ju' are read in, but the 'm' is not, and the input operation
fails -- 'Ju' is an initial segment of the string representation of three
different values (Juggler, Justice, and Judgement.)
Here are the canonical string representations of the twenty-two values of
the enumerated type:
Juggler
High Priestess
Empress
Emperor
Pope
Lovers
Chariot
Justice
Hermit
Wheel of Fortune
Strength
Hanged Man
Death
Temperance
Devil
Struck Tower
Stars
Moon
Sun
Judgement
Foolish Man
Universe
Case is ignored in the input, so the input characters 'juGGLeR' would
be recognized as a designation of the value Juggler. In addition, any
number of spaces, tab characters, and line breaks occurring in the middle
of a string representation are treated as a single space character.
The WriteMajorArcanum procedure takes a text file and a value of the
enumerated type as arguments and writes the canonical string
representation of that value, as shown above, to the specified text
file.
The WriteAsBits procedure takes a text file and a value of the
enumerated type as arguments and writes a sequence of eight characters
-- zeroes and ones -- to the specified text file. The characters are
chosen to reflect the values of the bits in memory when the given value
of the enumerated type is stored.
This program defines these procedures and then invokes them on a variety
of arguments and test files, to make sure that they work as specified.
Programmer: John Stone, Grinnell College.
Original version: September 22-24, 1996.
}
program TestMajorArcanaProcedures (Output, TestData);
type
MajorArcana = (Juggler, HighPriestess, Empress, Emperor, Pope, Lovers,
Chariot, Justice, Hermit, WheelOfFortune, Strength,
HangedMan, Death, Temperance, Devil, StruckTower,
Stars, Moon, Sun, Judgement, FoolishMan, Universe);
var
Card: MajorArcana;
{ one value of the enumerated type, either to be read in or to be
written out }
TestData: Text;
{ a scratch file }
Success: Boolean;
{ indicates whether an attempted input operation was successful }
procedure ReadMajorArcanum (var Source: Text; var Legend: MajorArcana;
var Success: Boolean);
var
NextCharacter: Char;
{ a letter that is next one available from the source file, or a
code indicating whitespace, a non-letter, or the end of the file }
{ The HorizontalTabulation function returns the ASCII tab character. }
function HorizontalTabulation: Char;
begin
HorizontalTabulation := Chr (9);
end;
{ The Uppercase function determines whether a given character is an
upper-case (capital) letter. }
function Uppercase (Ch: Char): Boolean;
begin
Uppercase := ('A' <= Ch) and (Ch <= 'Z')
end;
{ The Lowercase function determines whether a given character is a
lower-case letter. }
function Lowercase (Ch: Char): Boolean;
begin
Lowercase := ('a' <= Ch) and (Ch <= 'z')
end;
{ Given any upper-case letter, the Downcase function returns the
corresponding lower-case letter; given any other character, the
function returns that same character, unchanged. }
function Downcase (Ch: Char): Char;
const
CaseSeparation = 32;
{ the distance between upper-case letters and their lower-case
counterparts in the ASCII character set }
begin
if Uppercase (Ch) then
Downcase := Chr (Ord (Ch) + CaseSeparation)
else
Downcase := Ch
end;
{ The SkipWhiteSpace procedure advances through a specified text file,
discarding any spaces, tabs, and newlines that it encounters, until
either the end of the file or a character other than space, tab, or
newline is reached. (The procedure does not read in the character
that halts its advance.) }
procedure SkipWhiteSpace (var Source: Text);
var
Continue: Boolean;
{ indicates whether the search for a character other than space,
tab, or newline can and should continue }
begin
Continue := True;
while Continue do
if EOF (Source) then
Continue := False
else if EOLn (Source) then
ReadLn (Source)
else if (Source^ = ' ') or (Source^ = HorizontalTabulation) then
Get (Source)
else
Continue := False
end;
{ The Peek function returns an indication, sometimes encoded, of what
lies just ahead in a specified file. If the end of the file has
been reached, it returns a vertical bar; if the next character is
a letter, it returns the lower-case version of that letter; if the
end of a line has been reached, or if the next character is a space
or a tab character, the function returns a space; in any other case,
it returns a question mark. }
function Peek (var Source: Text): Char;
begin
if EOF (Source) then
Peek := '|'
else if Lowercase (Source^) then
Peek := Source^
else if Uppercase (Source^) then
Peek := Downcase (Source^)
else if EOLn (Source) or (Source^ = ' ')
or (Source^ = HorizontalTabulation) then
Peek := ' '
else
Peek := '?'
end;
{ The Succeed procedure is invoked when enough characters of the
canonical string representation have been found to uniquely
identify a value of the MajorArcana type. It (1) advances past
the last of those characters in the source file; (2) sets the
enclosing procedure's Success parameter to True; (3) stores the
appropriate value in the enclosing procedure's Legend parameter;
and (4) reads in and discards any additional characters from the
source file that match the succeeding characters of the canonical
string representation of the MajorArcana value.
A character in the source file is considered to match a character
in the string representation if (1) the latter is a lower-case
letter and the former is the same lower-case letter or its
upper-case equivalent, or (2) the latter is a space and the former
is a space, tab, or newline. In case (2), additional spaces, tabs,
and newlines in the source file are silently discarded. }
procedure Succeed (Found: MajorArcana;
Remainder: packed array [Low .. High: Integer] of Char);
var
Matching: Boolean;
{ indicates whether all the characters so far read from the file
have matched the canonical string representation of Found }
Index: Integer;
{ counts off the character positions in Remainder }
begin
Get (Source);
Success := True;
Legend := Found;
Matching := True;
Index := Low;
while Matching and (Index <= High) do
if Peek (Source) = Remainder[Index] then begin
Get (Source);
if Remainder[Index] = ' ' then
SkipWhiteSpace (Source);
Index := Index + 1
end
else
Matching := False
end;
begin { ReadMajorArcanum }
SkipWhiteSpace (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'j' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'u' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'g' then
Succeed (Juggler, 'gler')
else if NextCharacter = 's' then
Succeed (Justice, 'tice')
else if NextCharacter = 'd' then
Succeed (Judgement, 'gement')
else
Success := False
end
else
Success := False
end
else if NextCharacter = 'h' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'i' then
Succeed (HighPriestess, 'gh priestess')
else if NextCharacter = 'e' then
Succeed (Hermit, 'rmit')
else if NextCharacter = 'a' then
Succeed (HangedMan, 'nged man')
else
Success := False
end
else if NextCharacter = 'e' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'm' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'p' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'r' then
Succeed (Empress, 'ess')
else if NextCharacter = 'e' then
Succeed (Emperor, 'ror')
else
Success := False
end
else
Success := False
end
else
Success := False
end
else if NextCharacter = 'p' then
Succeed (Pope, 'ope')
else if NextCharacter = 'l' then
Succeed (Lovers, 'overs')
else if NextCharacter = 'c' then
Succeed (Chariot, 'hariot')
else if NextCharacter = 'w' then
Succeed (WheelOfFortune, 'heel of fortune')
else if NextCharacter = 's' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 't' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'r' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'e' then
Succeed (Strength, 'ngth')
else if NextCharacter = 'u' then
Succeed (StruckTower, 'uck tower')
else
Success := False
end
else if NextCharacter = 'a' then
Succeed (Stars, 'rs')
else
Success := False
end
else if NextCharacter = 'u' then
Succeed (Sun, 'n')
else
Success := False
end
else if NextCharacter = 'd' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'e' then begin
Get (Source);
NextCharacter := Peek (Source);
if NextCharacter = 'a' then
Succeed (Death, 'th')
else if NextCharacter = 'v' then
Succeed (Devil, 'il')
else
Success := False
end
else
Success := False
end
else if NextCharacter = 't' then
Succeed (Temperance, 'emperance')
else if NextCharacter = 'm' then
Succeed (Moon, 'oon')
else if NextCharacter = 'f' then
Succeed (FoolishMan, 'oolish man')
else if NextCharacter = 'u' then
Succeed (Universe, 'niverse')
else
Success := False
end;
procedure WriteMajorArcanum (var Target: Text; Scribend: MajorArcana);
begin
case Scribend of
Juggler:
Write (Target, 'Juggler');
HighPriestess:
Write (Target, 'High Priestess');
Empress:
Write (Target, 'Empress');
Emperor:
Write (Target, 'Emperor');
Pope:
Write (Target, 'Pope');
Lovers:
Write (Target, 'Lovers');
Chariot:
Write (Target, 'Chariot');
Justice:
Write (Target, 'Justice');
Hermit:
Write (Target, 'Hermit');
WheelOfFortune:
Write (Target, 'Wheel of Fortune');
Strength:
Write (Target, 'Strength');
HangedMan:
Write (Target, 'Hanged Man');
Death:
Write (Target, 'Death');
Temperance:
Write (Target, 'Temperance');
Devil:
Write (Target, 'Devil');
StruckTower:
Write (Target, 'Struck Tower');
Stars:
Write (Target, 'Stars');
Moon:
Write (Target, 'Moon');
Sun:
Write (Target, 'Sun');
Judgement:
Write (Target, 'Judgement');
FoolishMan:
Write (Target, 'Foolish Man');
Universe:
Write (Target, 'Universe')
end
end;
procedure WriteAsBits (var Target: Text; Scribend: MajorArcana);
procedure WriteCode (var Target: Text; Code: Integer;
BitsLeft: Integer);
begin
if 1 < BitsLeft then
WriteCode (Target, Code div 2, BitsLeft - 1);
if Odd (Code) then
Write (Target, '1')
else
Write (Target, '0')
end;
begin { procedure WriteAsBits }
WriteCode (Target, Ord (Scribend), 8)
end;
{ The HorizontalTabulation function returns the ASCII tab character. }
function HorizontalTabulation: Char;
begin
HorizontalTabulation := Chr (9);
end;
{ The DiscardWord procedure advances through a specified text file,
discarding characters, until it either reaches the end of the file,
the end of a line, or a space or tab character. (It does not discard
the space or tab character, but exits before reading it.) }
procedure DiscardWord (var Source: Text);
var
Continue: Boolean;
{ indicates whether the search for a space, tab, or newline can and
should continue }
begin
Continue := True;
while Continue do
if EOF (Source) then
Continue := False
else if EOLn (Source) then
Continue := False
else if (Source^ = ' ') or (Source^ = HorizontalTabulation) then
Continue := False
else
Get (Source);
end;
begin { main program }
WriteLn ('Test #1: WriteMajorArcanum');
for Card := Juggler to Universe do begin
WriteMajorArcanum (Output, Card);
WriteLn
end;
WriteLn;
WriteLn ('Test #2: ReadMajorArcanum');
WriteLn ('Part a: Canonical forms');
Rewrite (TestData);
WriteLn (TestData, 'Juggler High Priestess Empress Emperor Pope');
WriteLn (TestData, 'Lovers Chariot Justice Hermit Wheel of Fortune');
WriteLn (TestData, 'Strength Hanged Man Death Temperance Devil');
WriteLn (TestData, 'Struck Tower Stars Moon Sun Judgement');
WriteLn (TestData, 'Foolish Man Universe');
Reset (TestData);
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Part b: Abbreviated forms');
Rewrite (TestData);
WriteLn (TestData, 'Jug Hi Empr Empe P L C Jus He W Stre Ha Dea T Dev');
WriteLn (TestData, 'Stru Sta M Su Jud F U');
Reset (TestData);
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Part c: Ambiguous and invalid forms (no output expected)');
Rewrite (TestData);
WriteLn (TestData, 'J Ju H E Em Emp S St Str');
WriteLn (TestData, 'A X $ # Empty Stump');
Reset (TestData);
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found inappropriately.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Part d: Exotic forms');
Rewrite (TestData);
WriteLn (TestData, ' ', HorizontalTabulation,
HorizontalTabulation, 'juGGLeR');
WriteLn (TestData, 'high ');
WriteLn (TestData, ' Priestess');
WriteLn (TestData);
WriteLn (TestData);
WriteLn (TestData, ' emperUniverseHanged man');
Reset (TestData);
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Part e: Extreme testing');
Reset (TestData, 'exercise-2.p');
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Part f: Abusive testing');
Reset (TestData, 'exercise-2');
repeat
ReadMajorArcanum (TestData, Card, Success);
if Success then begin
WriteMajorArcanum (Output, Card);
WriteLn (' found.')
end
else
DiscardWord (TestData)
until EOF (TestData);
WriteLn;
WriteLn ('Test #3: WriteAsBits');
for Card := Juggler to Universe do begin
WriteAsBits (Output, Card);
Write (' ');
WriteMajorArcanum (Output, Card);
WriteLn
end;
WriteLn
end.
created September 30, 1996
last revised September 30, 1996
John David Stone
(stone@math.grin.edu)