home *** CD-ROM | disk | FTP | other *** search
- program eliminateme;
- uses duree,
- globvariables,
- crt;
- label 2,3,4,5,6,2620;
- type
- jeuxid=record
- vainqueur:person; {person=string[61]}
- gagnes:byte;
- perdus:byte;
- end;
- var
- jeuxfile:file of jeuxid;
- jeuxrec:jeuxid;
- dummy:integer;
- monopath:string[20];
- wu:text;
- usernum:integer;
- vide:string;
- l0:integer;
- line1:string;
- h:text;
- chemin,
- logname:string[20];
- numer,
- status,
- cumulelim,
- tampax,
- k:integer;
- total:array[1..4] of integer;
- var monobul:string;
- var colorbul:string;
-
- procedure sortdeed;
- label 58,54,56;
- begin
- {sort deeds}
- for indice8:=1 to 4 do begin
- if d[indice8]<2 then goto 58;
- for indice6:=1 to d[indice8]-1 do begin
- for indice4:=1 to d[indice8]-1 do begin
- str(papa[indice8,indice4],nom5);
- str(papa[indice8,indice4+1],nom1);
- if (copy(nom5,2,2)='23') or (copy(nom5,2,1)='4') then begin
- val(copy(nom5,2,1),valeur,code);
- indice5:=2-valeur;
- goto 54;
- end;
- val(copy(nom5,4,2),indice5,code);
- 54:;
- if (copy(nom1,2,2)='23') or (copy(nom1,2,1)='4') then begin
- val(copy(nom1,2,1),valeur,code);
- x:=2-valeur;
- goto 56;
- end;
- val(copy(nom1,4,2),x,code);
- 56:;
- if indice5>x then begin
- indice9:=papa[indice8,indice4];
- papa[indice8,indice4]:=papa[indice8,indice4+1];
- papa[indice8,indice4+1]:=indice9;
- end;
- end;
- end;
- 58:;
- end;
- end;
-
-
-
- procedure readgame;
- begin
-
- readln(f,status); {1=Computer 2=Players-integer}
- readln(f,oui); {Y=need players N=Game Filled-char}
- readln(f,n); {number of players-integer}
- readln(f,team); {0=no team 1=team game-integer}
- readln(f,numhe); {# of hours a player can play is turn-integer}
- readln(f,fastflag);{1=cards have been distributed-integer}
- readln(f,tradeflag);{1=trade option is enable}
- readln(f,expiration);{days when a game should be over 0=does not apply-integer}
- readln(f,freepark); {1=free landing 0=no money in free landing}
- readln(f,parkmoney); {amount in free landing-integer}
- for i:=1 to n do begin
- readln(f,names[i]); {players name-array[1..4] of string}
- readln(f,password[i]);{password if any-array[1..4] of string[8]}
- readln(f,l[i]); {position of player in the game-array[1..4] of integer}
- readln(f,amount[i]); {total amount of money of player-array[1..4] of integer}
- readln(f,d[i]); {# of properties owned-array[1..4] of integer}
- readln(f,house[i]); {# of cities owned-array[1..4] of integer}
- readln(f,hotel[i]); {# of capitals owned-array[1..4] of integer}
- readln(f,jo[i]); {array[1..4] of integer}
- readln(f,lastime[i]); {array[1..4] of string}
- readln(f,lastheure[i]);{array[1..4] of integer}
- readln(f,eliminate[i]);{0=in the game 1=eliminated-array[1..4] of integer}
- readln(f,playteam[i]); {array[1..4] of integer-1=team one 2=team two}
- for x:=1 to d[i] do begin
- readln(f,buffer); {string-read the properties owned}
- val(buffer,papa[i,x],code);
- end;
- for x:=0 to 40 do begin
- readln(f,price[i,x]); {integer}
- readln(f,price1[i,x]); {integer}
- end;
- for x:=0 to 40 do begin
- readln(f,bought[i,x]); {char}
- readln(f,sold[i,x]); {char}
- end;
- for x:=1 to 10 do begin
- readln(f,transatoffer[i,x]); {integer}
- readln(f,transatdemand[i,x]); {integer}
- readln(f,transatbuy[i,x]); {integer}
- readln(f,transatsell[i,x]); {integer}
- end;
- readln(f,offer[i]); {integer}
- readln(f,demand[i]); {integer}
- end;
- end;
-
-
- procedure writegame; {rewrite the game with all the modifications}
- begin
- writeln(f,status);
- writeln(f,oui);
- writeln(f,n);
- writeln(f,team);
- writeln(f,numhe);
- writeln(f,fastflag);
- writeln(f,tradeflag);
- writeln(f,expiration);
- writeln(f,freepark);
- writeln(f,parkmoney);
- for i:=1 to n do begin
- writeln(f,names[i]);
- writeln(f,password[i]);
- writeln(f,l[i]);
- writeln(f,amount[i]);
- writeln(f,d[i]);
- writeln(f,house[i]);
- writeln(f,hotel[i]);
- writeln(f,jo[i]);
- writeln(f,lastime[i]);
- writeln(f,lastheure[i]);
- writeln(f,eliminate[i]);
- writeln(f,playteam[i]);
- for x:=1 to d[i] do begin
- str(papa[i,x],buffer);
- if length(buffer)<9 then begin {that checked a problem i used to get}
- clrscr;
- writeln('Problem-Contact Pierre Tavernier');
- writeln('Author of multipolix-Leave message for him');
- writeln('At 803-366-6235...Critical Mass BBS');
- writeln(f,buffer);
- close(f);
- halt;
- end;
- writeln(f,buffer);
- end;
- for x:=0 to 40 do begin
- writeln(f,price[i,x]);
- writeln(f,price1[i,x]);
- end;
- for x:=0 to 40 do begin
- writeln(f,bought[i,x]);
- writeln(f,sold[i,x]);
- end;
- for x:=1 to 10 do begin
- writeln(f,transatoffer[i,x]);
- writeln(f,transatdemand[i,x]);
- writeln(f,transatbuy[i,x]);
- writeln(f,transatsell[i,x]);
- end;
- writeln(f,offer[i]);
- writeln(f,demand[i]);
- end;
- end;
-
-
-
-
- procedure loose(buffnom:string);
-
-
-
- function findid(caller:person):integer; {find the id # of the player in the score.dat file}
- var ind:integer; {if the player has never played his id will be 0}
-
- begin
- usernum:=0;
- ind:=0;
- { reset(jeuxfile); }
- if not eof(jeuxfile) then begin
- repeat
- ind:=ind+1;
- read(jeuxfile,jeuxrec);
- if jeuxrec.vainqueur=caller then usernum:=ind;
- until (usernum>0) or (eof(jeuxfile));
- end;
- findid:=usernum;
- writeln('usernum=',usernum);
- end;
-
- function nextuser:integer; {if new player, find an id for him/her}
- var tempete:integer;
- begin
- tempete:=findid('***');
- if tempete=0 then nextuser:=1+ filesize(jeuxfile) else nextuser:=tempete;
- end;
-
- procedure rout1; {this one is for new player}
- begin
- usernum:=nextuser;
- jeuxrec.gagnes:=0;
- jeuxrec.perdus:=0;
- jeuxrec.vainqueur:=buffnom;
- if looseflag then jeuxrec.perdus:=1
- else jeuxrec.gagnes:=1;
- seek(jeuxfile,usernum-1);
- write(jeuxfile,jeuxrec);
- end;
-
- procedure rout2; {this one has already an id}
- begin
- {read(jeuxfile,jeuxrec); }
- if looseflag then jeuxrec.perdus:=jeuxrec.perdus+1
- else jeuxrec.gagnes:=jeuxrec.gagnes+1;
- seek(jeuxfile,dummy-1);
- write(jeuxfile,jeuxrec);
- end;
-
- begin
- assign(jeuxfile,'score.dat');
- {$I-}
- reset(jeuxfile);
- {$I+}
- if ioresult=2 then rewrite(jeuxfile);
- dummy:=findid(buffnom);
- if dummy=0 then rout1;
- if dummy>0 then rout2;
- close(jeuxfile);
- end;
-
- procedure elimgame; {reset all variables when the player is elimnated}
-
- begin
- newxx:=41;
- l[i]:=41;
- jo[i]:=1000;
- amount[i]:=0;
- for indice6:=1 to d[i] do begin
- papa[i,indice6]:=0;
- end;
- d[i]:=0;
- indice11:=0;
- indice12:=0;
- eliminate[i]:=1;
- sortdeed; {sort the deeds}
- end;
-
- procedure generatebulletins; {this is the part to be improved}
- begin
- assign(wu,monobul);
- rewrite(wu);
- writeln(wu,' Multipolix Hall of Fame ');
- writeln(wu,' ----------------------- ');
- writeln(wu,' ');
- writeln(wu,'Player"s Name Games Won Games Lost');
- assign(jeuxfile,'score.dat');
- reset(jeuxfile);
- if not eof(jeuxfile) then begin
- repeat
- vide:='';
- read(jeuxfile,jeuxrec);
- l0:=length(jeuxrec.vainqueur);
- for i:=1 to 30-l0 do vide:=vide + ' ';
- writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
- ' ',jeuxrec.perdus);
- until eof(jeuxfile);
- end;
- close(jeuxfile);
- close(wu);
- assign(wu,colorbul);
- rewrite(wu);
- line1:=concat(#27,'[31m',' Multipolix Hall of Fame ');
- writeln(wu,line1);
- writeln(wu,' ----------------------- ');
- writeln(wu,' ');
- line1:=concat(#27,'[32m','Player"s Name');
- line1:=concat(line1,#27,'[33m',' Games Won Games Lost');
- writeln(wu,line1);
- reset(jeuxfile);
- if not eof(jeuxfile) then begin
- repeat
- vide:='';
- read(jeuxfile,jeuxrec);
- l0:=length(jeuxrec.vainqueur);
- for i:=1 to 30-l0 do vide:=vide + ' ';
- writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
- ' ',jeuxrec.perdus);
- until eof(jeuxfile);
- end;
- close(wu);
- close(jeuxfile);
- end;
-
-
- begin {main loop}
- assign(h,'monomain.ctl'); {this file is edited by the sysop}
- {$I-}
- reset(h);
- {$I+}
- if ioresult =2 then begin
- writeln('Monomain.ctl is missing');
- halt;
- end;
- readln(h,numer); {# of days a game should be erased if not played}
- readln(h,monobul); {name of monochrome bulletin}
- readln(h,colorbul); {name of ansi bulletin}
- {writeln('monobul=',monobul);
- writeln('colorbul=',colorbul); this was just done for debugging}
- close(h);
- for k:=1 to 99 do begin {computer game loop to see if the player}
- str(k,sub); {has not played during numer days}
- monopath:='mono'+sub;
- assign(f,monopath);
- {$I-}
- reset(f);
- {$I+}
- if ioresult=2 then goto 2;
- readln(f,status);
- if status<>1 then begin {status=1 for computer game}
- close(f);
- goto 2;
- end;
- readln(f,buffnom); {string-name of the player}
- readln(f,laston); {string-date the game was last played}
- close(f);
- if daynum(date)-daynum(laston)>numer then begin
- {close(f); } {eradicate the game if it has not been played}
- erase(f);
- end;
- 2:;
- end;
- for k:=1 to 99 do begin {players game loop to check if a player has not}
- str(k,sub); {played in numer days}
- monopath:='mono'+sub;
- assign(f,monopath);
- {$I-}
- reset(f);
- {$I+}
- if ioresult=2 then goto 3;
- readln(f,status);
- if status<>2 then begin
- close(f);
- goto 3;
- end;
- close(f);
- reset(f);
- readgame;
- close(f);
- if oui='Y' then goto 3; {game still needs players-do not process}
- for i:=1 to n do begin
- if (daynum(date)-daynum(lastime[i]) > numer)
- and (eliminate[i]=0) then begin
- elimgame; {reset his/her variables}
- end;
- end;
- rewrite(f);
- writegame; {write the new modifications}
- close(f);
- 3:;
- end;
-
-
- {check to see if a game is finished-That means only one player is playing}
- for k:=1 to 99 do begin
- str(k,sub);
- monopath:='mono'+sub;
- assign(f,monopath);
- {$I-}
- reset(f);
- {$I+}
- if ioresult=2 then goto 4;
- for i:=1 to 4 do names[i]:='';
- readln(f,status);
- if status<>2 then begin {take only player games}
- close(f);
- goto 4;
- end;
- close(f);
- reset(f);
- readgame;
- close(f);
- if oui='Y' then goto 4; {still needs players-Do not process}
- cumulelim:=0;
- for i:=1 to n do
- if eliminate[i]=0 then cumulelim:=cumulelim+1;
- if cumulelim=0 then begin {means that everybody is eliminated}
- erase(f);
- str(k,sub);
- logname:='log'+sub;
- assign(u,logname);
- {$I-}
- erase(u); {erase the log}
- {$I+}
- end
- else if cumulelim=1 then begin {only one player left}
- for i:=1 to n do begin {let's find him}
- if eliminate[i]=0 then looseflag:=true else looseflag:=false;
- buffnom:=names[i];
- loose(buffnom);
- end;
- generatebulletins;
- logname:='log'+sub;
- assign(u,logname);
- {$I-}
- erase(u); {erase the log}
- {$I+}
- end;
- 4:;
- end;
-
- for k:=1 to 99 do begin {check if the game has an epiration date}
- str(k,sub);
- monopath:='mono'+sub;
- assign(f,monopath);
- {$I-}
- reset(f);
- {$I+}
- if ioresult=2 then goto 5;
- for i:=1 to 4 do names[i]:='';
- readln(f,status);
- if status<>2 then begin
- close(f);
- goto 5;
- end;
- close(f);
- reset(f);
- readgame;
- close(f);
- if oui='Y' then goto 5;
- for i:=1 to 4 do total[i]:=0;
- if (expiration<>0) and (expiration < daynum(date)) then begin
- for i:=1 to n do begin {compute the total amount of $$$}
- total[i]:=amount[i]; {for each player}
- if d[i]=0 then goto 6;
- for k:=0 to d[i] do begin
- str(papa[i,k],nom1);
- val(copy(nom1,6,2),valeur,code);
- total[i]:=total[i]+20*fininfo[8*valeur];
- val(copy(nom1,8,1),indice2,code);
- if copy(nom5,2,1)='4' then goto 6;
- if copy(nom5,2,2)='23' then goto 6;
- if indice2>2 then goto 2620;
- val(copy(nom1,6,2),valeur,code);
- total[i]:=total[i]+fininfo[8*valeur+indice2-8];
- 2620:;
- val(copy(nom1,6,2),valeur,code);
- total[i]:=total[i]+10*fininfo[8*valeur+indice2-8];
- end;
- 6:;
- end;
- tampax:=total[1];
- for i:=2 to n do
- if total[i] > tampax then tampax:=total[i];
- for i:=1 to n do
- if total[i]=tampax then eliminate[i]:=0 else eliminate[i]:=1;
- erase(f);
- logname:='log'+sub;
- assign(u,logname);
- {$I-}
- erase(u); {erase log}
- {$I+}
- for i:=1 to n do begin
- if eliminate[i]=0 then looseflag:=true else looseflag:=false;
- buffnom:=names[i];
- loose(buffnom);
- end;
- generatebulletins;
- end;
- 5:;
- end;
- end.