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

{$P256,G256,B-,R+}

{ THIS PASCAL PROGRAM READS IN A LIST OF FOOTBALL PLAYERS FROM A FILE }
{ AND PRINTS A DUPLICATE OF THE LIST, THEN IT ALPHABETIZES THE }
{ LIST. FINALLY THE PROGRAM READS FROM A DIFFERENT FILE WHICH }
{ CONTAINS A LIST OF REPLACEMENT PLAYERS. IT GOES TO THE NAME }
{ OF THE PLAYER TO BE REPLACED AND SWITCHES NAME AND NUMBER TO }
{ THE NEW NAME AND NUMBER. }

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

const lim = 42;
maxplayer = 22;

type aname = array[1..maxplayer,1..lim] of char;

var namelist : aname;
i,count : integer;
infile,outfile :text;

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

{ THIS PROCEDURE CAUSES THE PRINTER TO TURN THE PAGE. }

procedure page(var otfil : text);
begin
write(otfil,chr(12));
end;

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

{ THIS PROCEDURE STORES THE NAMES IN THE ARRAYS. }
procedure read_file(var nfil : text; var namlst : aname);

var row,column : integer;
ch : char;

begin
for row := 1 to maxplayer do begin
for column := 1 to lim do
begin
read(nfil,ch);
namlst[row,column] := ch;
end;
readln(nfil);
end;
end;

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

{ THIS PROCEDURE PRINTS OUT THE ARRAYS. }
procedure rite_file(var otfil : text; var namlst : aname);

var row,column : integer;

begin
for row := 1 to maxplayer do begin
for column := 1 to lim do
write(otfil,namlst[row,column]);
writeln(otfil);
end;
end;

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

procedure chek_for_same( var list : aname; rw1,rw2 : integer;
var column1 : integer;
var column2 : integer);
begin
if list[rw1,column1] = list[rw2,column2] then
begin
column1 := column1 + 1;
column2 := column2 + 1;
end;
end;

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

procedure restname(var lst : aname; row1,row2,pos : integer );
var column1,column2 : integer;
temp : char;

begin
for column1 := pos + 1 to lim do
begin
column2 := column1;
temp := lst[row1,column1];
lst[row1,column1] := lst[row2,column2];
lst[row2,column2] := temp;
end;

end;

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

{ THIS PROCEDURE ALPHABETIZES THE NAMES OF THE PLAYERS. }

procedure bubble_sort(var ary : aname );
var i,j,row,row2 : integer;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure sort(var list : aname; var col1 : integer;
var col2 : integer );
var temp : char;
rw1,rw2 : integer;

begin
for rw1 := 1 to maxplayer - 1 do
for rw2 := rw1 + 1 to maxplayer do
if list[rw1,col1] > list[rw2,col2] then
begin
temp := list[rw1,col1];
list[rw1,col1] := list[rw2,col2];
list[rw2,col2] := temp;
restname(list,rw1,rw2,col1);
end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

begin
i := 1;
j := 1;
sort(ary,i,j);
end;

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

begin
assign(infile,'START.DAT');
reset(infile);
assign(outfile,'PRN');
rewrite(outfile);
read_file(infile,namelist);
rite_file(outfile,namelist);
page(outfile);
bubble_sort(namelist);
rite_file(outfile,namelist);
close(infile);
close(outfile)
end.

DATAFILE: START.DAT

Bennett, Cornelius 97
Shula, Mike 11
Bell, Al 1
Richardson, Greg 17
Hand, Jon 78
Walker, Hardy 73
Gilmer, David 63
Neighbors, Wes 54
Condon, Bill 77
Otten, Gary 70
Chandler, Thornton 81
Humphrey, Bobby 26
Turner, Craig 44
Rockwell, Randy 57
Jarvis, Curt 95
Sowell, Brent 79
Godwin, Joe 90
Davis, Wayne 58
Robinson, Freddie 21
Wilkinson, Vernon 38
Turner, Rory 37
Cooper, Britton 20