AXS101@PSUVM.BITNET (Adrian Sullivan) (12/26/88)
ok, i REALLY stink at pascal, and for a few days now have been reading
these damn pascal books only to find it's confusing me more and more
every time i go thru it. i was hopin someone on here would be able to help
me... i'm sure just about anyone who knows something about pascal can help,
what i'm tryin to do is sort a file... well, here's what the file looks like
that needs to be sorted.
FIRSTNAME
LASTNAME
STREET ADDRESS
CITY
STATE
ZIPCODE
AREA CODE OF PHONE NUMBER
FIRST THREE DIGITS OF PHONE NUMBER
LAST FOUR DIGITS OF PHONE NUMBER
unneeded text
unneeded text
and then it repeats and repeats.
oh, just to let you know, i'm working with turbo pascal on the mac.
the pascal file is as follows....
program testing;
type
string64= string[64];
var
infile, outfile : TEXT;
inname, outname : string64;
done : boolean;
a : integer;
i : integer;
firstname : string[60];
lastname : string[60];
streetaddr : string[60];
city : string[60];
state : string[60];
zip : integer;
firstthree : integer;
lastfour : integer;
areacode : integer;
userid : string[80];
blank : string[60];
{ ********************************************************************** }
{ ********************************************************************** }
function verified (message :string64) : boolean;
{true if y typed, else false}
var
ch :char;
begin
write( message, '? (y/n) ');
readln( ch );
verified := ( ch = 'Y' ) or ( ch = 'y' )
end; {verified}
{ ********************************************************************** }
{ ********************************************************************** }
function duplicated( name : string64 ) : boolean;
{true if disk file already exists or permission granted to erase}
var
tempfile : text;
begin
if pos( ':', name ) = length ( name )
then
duplicated := false {not a disk file if it ends with : }
else
begin
reset( tempfile, name );
if ioresult <> 0
then
duplicated := false {file not found}
else
begin
duplicated :=
not verified( concat( 'remove old ',name ) );
close ( tempfile )
end {else}
end {else}
end; {duplicated}
{ ********************************************************************** }
{ ********************************************************************** }
function filesopened (var done :boolean ) : boolean;
{return true if input and output files opened}
{set done to true if no input file name was entered}
var
okflag : boolean;
begin
okflag := false; {assume the worst case}
write( 'input file? ');
readln(inname);
done := length(inname) = 0;
if not done then
begin
reset (infile, inname);
if ioresult = 0 then
begin
write('output file? ');
readln(outname);
if length(outname) > 0 then
if not duplicated (outname) then
begin
rewrite(outfile, outname);
okflag := (ioresult = 0);
end; {if}
if not okflag
then close (infile)
end
end;
filesopened := okflag
end; {files opened}
{ ********************************************************************** }
{ ********************************************************************** }
procedure numberlines;
const
bs= #8; {backspace control char}
begin
a:=0;
begin
while not eof (infile ) do
begin
a := a +1;
readln( infile, firstname);
readln( infile, lastname);
readln( infile, streetaddr);
readln( infile, city);
readln( infile, state);
readln( infile, zip);
readln( infile, areacode);
readln( infile, firstthree);
readln( infile, lastfour);
readln( infile, userid);
readln( infile, blank);
end; {while}
end;
end; {numberlines}
{ ********************************************************************** }
{ ********************************************************************** }
procedure writeit;
const
bs= #8; {backspace control char}
begin
i:=1;
begin
for i := 1 to a do
begin
write( outfile, firstname);
write( outfile, ' ');
writeln(outfile, lastname);
writeln(outfile, streetaddr);
write( outfile, city);
write( outfile, ', ');
write( outfile, state);
write( outfile, ' ');
writeln(outfile, zip);
write( outfile, '(');
write( outfile, areacode);
write( outfile, ') ');
write( outfile, firstthree);
write( outfile, '-');
writeln(outfile, lastfour);
end;
end;
end; {numberlines}
{ ********************************************************************** }
{ ********************************************************************** }
procedure display;
begin
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln( ' enter the input file volume:name,');
writeln( ' then the output file volume:name,');
writeln( ' or press return to quit.');
end; {display}
{ ********************************************************************** }
{ ********************************************************************** }
procedure firstnamesort;
begin
writeln('first name sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure lastnamesort;
begin
writeln('last name sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure citysort;
begin
writeln('city sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure statesort;
begin
writeln('state sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure zipsort;
begin
writeln('zipcode sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure areacodesort;
begin
writeln('area code sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure firstthreesort;
begin
writeln('first three sort done');
end;
{ ********************************************************************** }
{ ********************************************************************** }
procedure whatsort;
var
sortkind : char;
sortenter : boolean;
begin
sortenter:= false;
begin
while sortenter= false do
begin
writeln;
writeln;
writeln( ' please pick a sort type: ');
writeln( ' 1: firstname');
writeln( ' 2: lastname');
writeln( ' 3: city');
writeln( ' 4: state');
writeln( ' 5: zipcode');
writeln( ' 6: area code of phone number');
writeln( ' 7: first three digits of phone');
write ( ' your choice: ');
readln (sortkind);
if sortkind = '1' then
begin
sortenter:= true;
firstnamesort;
end;
if sortkind = '2' then
begin
sortenter:= true;
lastnamesort;
end;
if sortkind = '3' then
begin
sortenter:= true;
citysort;
end;
if sortkind = '4' then
begin
sortenter:= true;
statesort;
end;
if sortkind = '5' then
begin
sortenter:= true;
zipsort;
end;
if sortkind = '6' then
begin
sortenter:= true;
areacodesort;
end;
if sortkind = '7' then
begin
sortenter:= true;
firstthreesort;
end;
end;
end;
end;
{ ********************************************************************** }
{ ********************************************************************** }
begin
display;
repeat
writeln;
if filesopened (done ) then
begin
numberlines;
whatsort;
writeit;
close (infile );
close (outfile);
end else
if not done
then writeln('ERROR : bad or duplicate file name.');
until done
end. {end it all}
ok. now i can have it read in the file perfectly, and i can have it output
the data, but what i need to do inbetween there is sort it. either
by first/lastname, city, state, zip, area code, or the first three digits of
the phone number. if anyone could help me out, it would be a great help.
possibly just stick in a piece of code in one of the sort sections and
i could take a look and try to figure out the other ones. please.....
anyone.... HELP!
Adrian Sullivan
AXS101@psuvm.bitnet
please e-mail me, thanks in advance for any helpmarkh@csd4.milw.wisc.edu (Mark William Hopkins) (12/29/88)
The changes made to the program preserve the program's input/output
behavior except in the addition of a sort routine.
My Turbo Pascal knowledge is nil, but I assume that you can have file
parameters for procedures and multiple parameters in write/writeln Statements.
Also, if character sets are not allowed in Turbo Pascal then change the 13th
line of duplicatedF and the 17th line of menuK.
You will need to verify it, but with the way the modified program has been
organized, this should not be any problem. Let me know of the results.
program testing;
const MAX = 100; (* Up to 100 table entries can be handled. *)
type string = string[64];
Table = record
Top: Card;
List: array[1..MAX] of Card
end;
Card = record
FirstName, LastName, StreetAddr, City, State: string[60];
Zip, FirstThree, LastFour, AreaCode: integer;
UserID, Blank: string[80]
end;
Key = (FirstK, LastK, CityK, StateK, ZipK, AreaK, PhoneK);
var inF, outF: TEXT; Buffer: Table;
Option: Key; ok, done: boolean;
(* TEXT FILE ROUTINES: duplicatedF, openF, testF *)
function duplicatedF(name: string): boolean;
(* To determine if the disk file is new or writeable. *)
var tempfile: text;
begin
(* Disk files end in a ':'. *)
if pos(':', name) = length(name) then duplicatedF := false
else begin
reset(tempfile, name);
if ioresult <> 0 then duplicatedF := false
else begin
write('remove old ', name, '? (y/n) ');
readln(ch);
duplicatedF := not (ch in ['Y'..'y'])
close(tempfile)
end
end
end;
procedure testF(var inF, outF: TEXT; var ok, done: boolean);
(*
ok := (The inF and outF files are opened)
done := (no inF file name was entered)
*)
type access = (R, W);
var named: boolean;
procedure openF(var F: TEXT; var named, ok: boolean; io: access);
var Name: string;
begin
readln(Name);
named := (length(Name) > 0);
if named then case io of
R: begin
reset(F, Name);
ok := (ioresult = 0)
end;
W: if not duplicatedF(Name) then begin
rewrite(F, Name);
ok := (ioresult = 0)
end
else ok := false
end
else corrupt := false
end;
begin
write('input file? ');
openF(inF, done, ok, R);
if not done and ok then begin
write('output file? ');
openF(outF, named, ok, W);
if not ok then close(inF)
end
end;
(* STANDARD I/O ROUTINE: prompt. *)
procedure prompt;
var I: integer;
begin
for I := 1 to 7 do writeln;
writeln(' enter the input file volume:name,');
writeln(' then the output file volume:name,');
writeln(' or press return to quit.')
end;
(* OPTION KEY ROUTINES: menuK, convertK. *)
function convertK(Ch: char): Key;
begin
if Ch = 1 then convertK := FirstK
else if Ch = 2 then convertK := LastK
else if Ch = 3 then convertK := CityK
else if Ch = 4 then convertK := StateK
else if Ch = 5 then convertK := ZipK
else if Ch = 6 then convertK := AreaK
else if Ch = 7 then convertK := PhoneK
end;
procedure menuK(var Option: Key);
var Ch: char;
begin
repeat
writeln;
writeln;
writeln( ' please pick a sort type: ');
writeln( ' 1: FirstName');
writeln( ' 2: LastName');
writeln( ' 3: City');
writeln( ' 4: State');
writeln( ' 5: Zipcode');
writeln( ' 6: area code of phone number');
writeln( ' 7: first three digits of phone');
write ( ' your choice: ');
readln(Ch)
until Ch in ['1'..'7'];
Option := convertK(Ch)
end;
(* CARD ROUTINES: readC, writeC, moreC, swapC *)
procedure readC(var inF: TEXT; var C: Card);
begin
with C do begin
readln(inF, FirstName); readln(inF, LastName);
readln(inF, StreetAddr);
readln(inF, City); readln(inF, State); readln(inF, Zip);
readln(inF, AreaCode);
readln(inF, FirstThree); readln(inF, LastFour);
readln(inF, UserID);
readln(inF, Blank);
end
end;
procedure writeC(var outF: TEXT; C: Card);
begin
writeln(outF, FirstName, ' ', LastName);
writeln(outF, StreetAddr);
writeln(outF, City, ', ', State, ' ', Zip);
writeln(outF, '(', AreaCode, ') ', FirstThree, '-', LastFour)
end;
function moreC(Option: Key; A, B: Card): boolean;
begin
case Option of
FirstK: moreC := (A.FirstName > B.FirstName);
LastK: moreC := (A.LastName > B.LastName);
CityK: moreC := (A.City > B.City);
StateK: moreC := (A.State > B.State);
ZipK: moreC := (A.Zip > B.Zip);
AreaK: moreC := (A.AreaCode > B.AreaCode);
PhoneK: moreC := (A.FirstThree > B.FirstThree) or
(A.FirstThree = B.FirstThree) and
(A.LastFour > B.LastFour)
end
end;
procedure swapC(var A, B: Card);
var C: Card;
begin
C := A; A := B; B := C
end;
(* TABLE ROUTINES: readT, writeT, sortT *)
procedure readT(var inF: TEXT; var T: Table);
const bs = #8;
begin
with T do begin
Top := 0;
while not eof(inF) and (Top < MAX) do begin
Top := Top + 1; readC(inF, List[Top])
end
end
end;
procedure writeT(var outF: TEXT; T: integer);
const bs = #8;
var I: integer;
begin
with T do for I := 1 to Top do writeC(outF, List[I])
end;
procedure sortT(Option: Key; var T: Table);
(* Bubble sort or something like that. I could do a merge sort for you,
but it's getting late in the afternoon ... *)
begin
with T do begin
for I := 1 to Top - 1 do for J := I + 1 to Top do
if moreC(Option, List[I], List[J]) then swapC(List[I], List[J])
end
end;
begin
prompt;
repeat
writeln;
testF(inF, outF, ok, done);
if ok then begin
readT(inF, Buffer);
menuK(Option); sortT(Option, Buffer);
writeT(outF, Buffer);
close(inF); close(outF);
end
else if not done then writeln('ERROR : bad or duplicate file name.');
until done
end.