Category : BBS Programs+Doors
Archive   : TZBANK14.ZIP
Filename : TZPROCS.PAS

{tzprocs - included procedures and functions for the TZCASINO}

const

vernum: string[6] = '1.40'; {current version number}

{For wheel_array, the following definitions hold:
0 = $1 1 = $2 2 = $5 3 = $10
4 = $20 5 = HOUSE 6 = WINNER 7 = RESPIN
}

wheel_array: array[1..40] of byte = (0,1,0,3,0,1,0,2,0,1,0,6,0,1,0,2,0,1,0,3,
0,1,0,5,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,7);

{The following definitions are for the BlackJack game}

maxdeck = 52;
dprompt = '5Dealer''s Hand3:1 ';
pprompt = '5Player''s Hand3:1 ';

type

playarray = array[0..249] of byte;

triviarec = record
guessed:byte; {0=closed,1=open,2=solved}
numtrivia:byte; {number of questions in category}
category:string[30]; {name of category}
question:array[1..5] of string[70]; {question / hint}
numanswer:array[1..5] of byte; {number of possible answers}
answer:array[1..5,1..3] of string[40]; {possible answers}
lastgot:array[1..5] of string[35]; {last person to get question}
attempt:array[1..5] of integer; {number of attempts at question}
numguess:integer; {total number of guesses}
lastguess:string[35]; {last person to attempt category}
opendate:string[10]; {date phrase opened}
lastdate:string[10]; {date of last guess}
dateguess:integer; {date of last guess - integer}
userguess:playarray; {bit-mapped array of users who
have guessed today-max 2000}
sparchar:array[1..26] of byte; {reserved for future growth}
end;


phraserec = record
guessed:byte; {0=closed,1=open,2=solved}
phrase:string[40]; {phrase to be guessed}
hint:string[70]; {hint for phrase}
lastguess:string[35]; {last person to guess at phrase}
numguess:integer; {total number of guesses}
opendate:string[10]; {date phrase opened}
lastdate:string[10]; {date of last guess}
dateguess:integer; {date of last guess - integer}
letters:array[1..26] of byte; {0=not guessed, 1=guessed}
userguess:playarray; {bit-mapped array of users who
have guessed today-max 2000}
sparchar:array[1..61] of byte; {reserved for future growth}
end;

scorerec = record
username:string[35]; {users name}
numphrase:integer; {phrases user has solved}
attphrase:integer; {phrases user has solved}
numtrivia:integer; {trivia user has solved}
atttrivia:integer; {trivia user has solved}
sparchar:array[1..13] of byte; {reserved bytes}
end;

rankrange = 1..13;
suitrange = 1..4;
deckrange = 1..maxdeck;
stackrange = 0..maxdeck;

card = record
rank: string[2];
suit: char;
rvalue: integer;
end;

datatype = card;

stack = record
data: array[deckrange] of datatype;
top: stackrange;
end;

var startgold: longint;
numshots: byte;
in_casino: boolean;
tempstr: string;
thisphrase: phraserec;
phrasefile: file of phraserec;
thistrivia: triviarec;
triviafile: file of triviarec;
open_phrase: array[1..20] of byte;
numopen,numsolved: integer;
raisesl: integer;
maxsl: byte;
maxmins: integer;
timegold: integer;
goldtime: integer;
goldulk: integer;
scores: scorerec;
highscore: array[1..2,1..10] of scorerec;
deck: stack;

procedure reset_high;
var f: file of scorerec;
i,i1:integer;
begin
scores.username:='None';
scores.numphrase:=0;
scores.attphrase:=0;
scores.numtrivia:=0;
scores.atttrivia:=0;
for i := 1 to 13 do
scores.sparchar[i]:=0;
{$I-}
assign(f,datapath+'TZCASINO.HGH');
rewrite(f);
for i := 0 to 1999 do begin
write(f,scores);
end;
close(f);
if ioresult<>0 then writeln('Error resetting high score file!');
assign(f,datapath+'TZCASINO.WIN');
rewrite(f);
for i := 1 to 2 do
for i1 := 1 to 10 do begin
write(f,scores);
highscore[i,i1]:=scores;
end;
close(f);
if ioresult<>0 then writeln('Error resetting high score file!');
{$I+}
end; {reset_high}

procedure get_high;
var f: file of scorerec;

i,i1:integer;
begin
assign(f,datapath+'TZCASINO.HGH');
{$I-}
reset(f);
if ioresult<>0 then begin
reset_high;
reset(f);
end;
seek(f,usernum);
read(f,scores);
if (scores.username<>thisuser.name) then begin
scores.username:=thisuser.name;
scores.numphrase:=0;
scores.attphrase:=0;
scores.numtrivia:=0;
scores.atttrivia:=0;
end;
close(f);
if ioresult<>0 then writeln('Error reading high score file!');
assign(f,datapath+'TZCASINO.WIN');
reset(f);
for i := 1 to 2 do
for i1 := 1 to 10 do
read(f,highscore[i,i1]);
close(f);
if ioresult<>0 then writeln('Error reading high score file!');
{$I+}
end; {get_high}

procedure write_high;
var f: file of scorerec;
i,i1: integer;
begin
assign(f,datapath+'TZCASINO.HGH');
{$I-}
reset(f);
if ioresult<>0 then begin
writeln('Error resetting high score file!');
exit;
end;
seek(f,usernum);
write(f,scores);
close(f);
if ioresult<>0 then writeln('Error writing high score file!');
assign(f,datapath+'TZCASINO.WIN');
reset(f);
for i := 1 to 2 do
for i1 := 1 to 10 do
write(f,highscore[i,i1]);
close(f);
if ioresult<>0 then writeln('Error writing high score file!');
{$I+}
end; {write_high}

procedure calc_high;
var f:file of scorerec;
i,i1:integer;
c,c1:longint;
begin
for i := 1 to 10 do
if scores.username=highscore[1,i].username then begin
for i1 := i to 9 do
highscore[1,i1]:=highscore[1,i1+1];
highscore[1,10].username:='None';
highscore[1,10].numphrase:=0;
highscore[1,10].attphrase:=0;
end;
for i := 10 downto 1 do begin
c:=scores.numphrase*10000+scores.attphrase;
c1:=highscore[1,i].numphrase*10000+highscore[1,i].attphrase;
if (c>c1) then begin
if i<10 then highscore[1,i+1]:=highscore[1,i];
highscore[1,i]:=scores;
end;
end;
for i := 1 to 10 do
if scores.username=highscore[2,i].username then begin
for i1 := i to 9 do
highscore[2,i1]:=highscore[2,i1+1];
highscore[2,10].username:='None';
highscore[2,10].numtrivia:=0;
highscore[2,10].atttrivia:=0;
end;
for i := 10 downto 1 do begin
c:=scores.numtrivia*10000+scores.atttrivia;
c1:=highscore[2,i].numtrivia*10000+highscore[2,i].atttrivia;
if (c>c1) then begin
if i<10 then highscore[2,i+1]:=highscore[2,i];
highscore[2,i]:=scores;
end;
end;
write_high;
end; {calc_high}

procedure show_high;
var s: string;
i,i1: integer;
abort:boolean;
begin
nl; nl;
abort:=false;
pla('3<1=======[4 High Phrase Winners 1]================[4 High Trivia Winners 1]========3>',abort);
pla(' ',abort);
pla(' 2##3 <2User Name3> <2Win3> <2Att3> <2User Name3> <2Win3> <2Att3>',abort);
for i := 1 to 10 do begin
if (i=1) then tempstr:='6'
else tempstr:='1';
str(i:3,s);
tempstr:=tempstr+s+' '+ulstr(copy(highscore[1,i].username,1,24));
for i1 := length(tempstr) to 31 do tempstr:=tempstr+' ';
str(highscore[1,i].numphrase:4,s);
tempstr:=tempstr+s;
str(highscore[1,i].attphrase:6,s);
tempstr:=tempstr+s+' ';
tempstr:=tempstr+ulstr(copy(highscore[2,i].username,1,24));
for i1 := length(tempstr) to 69 do tempstr:=tempstr+' ';
str(highscore[2,i].numtrivia:4,s);
tempstr:=tempstr+s;
str(highscore[2,i].atttrivia:6,s);
tempstr:=tempstr+s;
pla(tempstr,abort);
end;
end; {show_high}

procedure write_stats; forward;

function act_num(pnum:integer):integer;
var i,i1:integer;
begin
i:=0; i1:=0;
while (i i1:=i1+1;
if (open_phrase[i1]>0) then i:=i+1;
end;
act_num:=i1;
end; {act_num}

procedure init_phrases;
var i,i1: integer;
begin
numopen:=0;
numsolved:=0;
tempstr:=datapath+'PHRASES.DAT';
assign(phrasefile,tempstr);
{$I-}
reset(phrasefile);
if ioresult<>0 then begin
rewrite(phrasefile);
thisphrase.guessed:=0;
for i := 1 to 20 do begin
write(phrasefile,thisphrase);
open_phrase[i]:=0;
end;
end else
for i := 1 to 20 do begin
seek(phrasefile,i-1);
read(phrasefile,thisphrase);
open_phrase[i]:=thisphrase.guessed;
case thisphrase.guessed of
1 : numopen:=numopen+1;
2 : numsolved:=numsolved+1;
end;
if (daynum(date)<>thisphrase.dateguess) then begin
for i1 := 0 to 249 do
thisphrase.userguess[i1]:=0;
thisphrase.dateguess:=daynum(date);
end;
seek(phrasefile,i-1);
write(phrasefile,thisphrase);
end;
close(phrasefile);
if ioresult<>0 then begin
prtx(6,'Error reading phrase file. Please inform sysop!'); nl;
end;
{$I+}
end; {init_phrases}

procedure read_phrase(pnum:integer);

begin
tempstr:=datapath+'PHRASES.DAT';
assign(phrasefile,tempstr);
{$I-}
reset(phrasefile);
seek(phrasefile,pnum-1);
read(phrasefile,thisphrase);
close(phrasefile);
if ioresult<>0 then begin
prtx(6,'Error reading phrase file. Please inform sysop!'); nl;
end;
{$I+}
end; {read_phrase}

procedure write_phrase(pnum:integer);

begin
tempstr:=datapath+'PHRASES.DAT';
assign(phrasefile,tempstr);
{$I-}
reset(phrasefile);

seek(phrasefile,pnum-1);
write(phrasefile,thisphrase);
close(phrasefile);
if ioresult<>0 then begin
prtx(6,'Error saving updated phrases. Please inform sysop!'); nl;
end;
{$I+}
end; {write_phrase}

function userplay(var check:playarray):boolean;
var i:integer;
tf:boolean;
begin
tf:=false;
i:=(usernum-1) div 8;
if ((check[i] shr ((usernum-1) mod 8)) and $01) = $01 then tf:=true
else check[i]:=check[i] or ($01 shl ((usernum-1) mod 8));
userplay:=tf;
end; {userplay}

procedure show_open(showall:byte);
var i,i1:integer;
show:boolean;
begin
nl; nl; if (showall<2) then prompt('2Open Phrases 3: 1')
else prompt('2Open Categories 3: 1');
show:=false;
i1:=0;
for i := 1 to 20 do begin
if ((open_phrase[i]>0) or ((showall mod 1)=1)) then i1:=i1+1;
if open_phrase[i]=1 then begin
if show then prompt(', ');
prompt(cstr(i1));
show:=true;
end;
end;
if not(show) then prompt('None.') else prompt('.');
nl; if (showall<2) then prompt('2Solved Phrases 3: 1')
else prompt('2Solved Categories 3: 1');
show:=false;
i1:=0;
for i := 1 to 20 do begin
if ((open_phrase[i]>0) or ((showall mod 1)=1)) then i1:=i1+1;
if open_phrase[i]=2 then begin
if show then prompt(', ');
prompt(cstr(i1));
show:=true;
end;
end;
if not(show) then prompt('None.') else prompt('.');
end; {show_open}

procedure list_open(listall:boolean);
var i,i1,i2,i3:integer;
tf,show,abort:boolean;
s:string;
begin
if (numopen=0) and (numsolved=0) then begin
nl; nl; print('3All phrases are currently closed.');
exit;
end;
cls;
abort:=false;
pla('3<1========================[4 Unsolved Phrases Listing 1]=========================3>',abort);
pla(' ',abort);
show:=false;
i1:=0;
for i := 1 to 20 do begin
if ((open_phrase[i]>0) or (listall)) then i1:=i1+1;
if (open_phrase[i]>0) then begin
if not(show) then
pla(' 2## 3<2Chr3> <2Wd3> <2Hint3> <2Last Guesser3> <2Open Date3> <2Last Date3> <2Total3>'
,abort);
show:=true;
read_phrase(i);
tempstr:='5-';
if userplay(thisphrase.userguess) then tempstr:='2+';
if (thisphrase.guessed=2) then tempstr:='6*';
str(i1:3,s);
tempstr:=tempstr+'1'+s;
i3:=0;
for i2 := 1 to length(thisphrase.phrase) do
if (ord(thisphrase.phrase(.i2.))>64) and
(ord(thisphrase.phrase(.i2.))<91) then i3:=i3+1;
str(i3:5,s);
tempstr:=tempstr+s;
i3:=0;
tf:=true;
for i2 := 1 to length(thisphrase.phrase) do begin
if (tf) and (ord(thisphrase.phrase(.i2.))>64) and
(ord(thisphrase.phrase(.i2.))<91) then begin
i3:=i3+1;
tf:=false;
end;
if (ord(thisphrase.phrase(.i2.))<65) or
(ord(thisphrase.phrase(.i2.))>90) then tf:=true;
end;
str(i3:5,s);
tempstr:=tempstr+s;
if thisphrase.hint='None' then tempstr:=tempstr+' No '
else tempstr:=tempstr+' Yes ';
if length(thisphrase.lastguess)>24 then s:=copy(thisphrase.lastguess,1,24)
else s:=thisphrase.lastguess;
tempstr:=tempstr+s;
for i2 := length(s) to 24 do
tempstr:=tempstr+' ';
tempstr:=tempstr+thisphrase.opendate+' ';
if thisphrase.lastdate='None ' then tempstr:=tempstr+' None '
else tempstr:=tempstr+thisphrase.lastdate;
str(thisphrase.numguess:8,s);
tempstr:=tempstr+s;
pla(tempstr,abort);
end;
end;
pla(' ',abort);
pla('3[5-3]1 Phrase is Open 3[2+3]1 Cannot Try Until Tomorrow 3[6*3]1 Phrase is Solved',abort);
end; {list_open}

procedure add_phrase;
var i,pnum:integer;
begin
nl;
prtx(1,'Add which phrase? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Phrase number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]>0) then begin
print('3That phrase is already in use. It must be deleted first.');
exit;
end;
thisphrase.guessed:=1;
thisphrase.lastguess:='None';
thisphrase.numguess:=0;
thisphrase.opendate:=date;
thisphrase.lastdate:='None ';
thisphrase.dateguess:=daynum(date);
for i := 1 to 26 do
thisphrase.letters[i]:=0;
for i := 0 to 249 do
thisphrase.userguess[i]:=0;
for i := 1 to 61 do begin
thisphrase.sparchar[i]:=0;
end;
print('1Enter the phrase (max 40 chars).');
prompt(':');
input(tempstr,40);
thisphrase.phrase:=tempstr;
print('1Enter the hint for this phrase, or for none.');
prompt(':');
inputl(tempstr,70);
if (length(tempstr)=0) then thisphrase.hint:='None'
else thisphrase.hint:=tempstr;
tempstr:='2Phrase 3: 1'+thisphrase.phrase; print(tempstr);
tempstr:='2Hint 3: 1'+thisphrase.hint; print(tempstr);
nl; ynq('Is this OK? ');
if (yn) then begin
write_phrase(pnum);
open_phrase[pnum]:=1;
numopen:=numopen+1;
nl; print('5Phrase added.');
end else begin
nl; print('5Phrase not added.');
end;
end; {add_phrase}

procedure delete_phrase;
var pnum:integer;
begin
nl;
prtx(1,'Delete which phrase? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Phrase number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]=0) then begin
print('3That phrase is not currently in use.');
exit;
end;
if (open_phrase[pnum]=1) then begin
print('6WARNING!3 That phrase is currently open.');
end;
read_phrase(pnum);
tempstr:='2Phrase 3: 1'+thisphrase.phrase; print(tempstr);
tempstr:='2Hint 3: 1'+thisphrase.hint; print(tempstr);
nl; ynq('Delete this phrase? ');
if (yn) then begin
open_phrase[pnum]:=0;
numopen:=numopen-1;
thisphrase.guessed:=0;
write_phrase(pnum);
nl; print('3Phrase deleted.');
end else begin
nl; print('3Phrase not deleted.');
end;
end; {delete_phrase}

procedure show_phrase;
var i1,pnum:integer;
sc:char;
abort:boolean;
begin
nl;
prtx(1,'Show which phrase? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Phrase number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]=0) then begin
print('3That phrase is not currently in use.');
exit;
end;
read_phrase(pnum);
abort:=false;
if (open_phrase[pnum]=1) then tempstr:='2Status 3: 1Open'
else tempstr:='2Status 3: 1Solved';
pla(tempstr,abort);
tempstr:='2Phrase 3: 1'+thisphrase.phrase; pla(tempstr,abort);
tempstr:='2Hint 3: 1'+thisphrase.hint; pla(tempstr,abort);
tempstr:='2Guessed 3: 1';
for i1 := 1 to length(thisphrase.phrase) do begin
sc:=thisphrase.phrase(.i1.);
if ((ord(sc)<65) or (ord(sc)>90)) then tempstr:=tempstr+sc
else if thisphrase.letters[ord(sc)-64]=0 then tempstr:=tempstr+'_'
else tempstr:=tempstr+sc;
end;
pla(tempstr,abort);
tempstr:='2Used Letters 3: 1';
for i1:=1 to 26 do
if thisphrase.letters[i1]=0 then tempstr:=tempstr+'_'
else tempstr:=tempstr+chr(i1+64);
pla(tempstr,abort);
tempstr:='2Last Guesser 3: 1'+thisphrase.lastguess; pla(tempstr,abort);
tempstr:='2# of Guesses 3: 1'+cstr(thisphrase.numguess); pla(tempstr,abort);
tempstr:='2Open Date 3: 1'+thisphrase.opendate; pla(tempstr,abort);
tempstr:='2Last Date 3: 1'+thisphrase.lastdate; pla(tempstr,abort);
end; {show_phrase}

procedure show_solved;
var abort:boolean;
begin
cls;
abort:=false;
pla('5[4 Solved Phrase 5]',abort); nl;
tempstr:='2Hint 3: 1'+thisphrase.hint; pla(tempstr,abort);
tempstr:='2Phrase 3: 1'+thisphrase.phrase; pla(tempstr,abort);
tempstr:='2Solved By 3: 1'+thisphrase.lastguess; pla(tempstr,abort);
tempstr:='2# of Guesses 3: 1'+cstr(thisphrase.numguess); pla(tempstr,abort);
tempstr:='2Open Date 3: 1'+thisphrase.opendate; pla(tempstr,abort);
tempstr:='2Solve Date 3: 1'+thisphrase.lastdate; pla(tempstr,abort);
end; {show_solved}

procedure pick_solved;
var pnum: integer;

begin
nl; nl;
if (numsolved=0) then begin
print('3There are no solved phrases.');
exit;
end;
prtx(1,'Show which phrase? ');
inputn(pnum,2);
nl;
if (pnum<1) or (pnum>(numopen+numsolved)) then begin
tempstr:='3Phrase number must be from 1 to '+cstr(numopen+numsolved)+'.';
print(tempstr);
exit;
end;
read_phrase(act_num(pnum));
if (open_phrase[act_num(pnum)]=2) then show_solved
else print('3That phrase is still open!');
end; {pick_solved}

function show_clue:byte; {0=open, 1=vowels only, 2=solved}
var i1,i2:integer;
sc:char;
begin
cls;
tempstr:='2Hint 3: 1'+thisphrase.hint; print(tempstr);
tempstr:='1';
i2:=2;
for i1 := 1 to length(thisphrase.phrase) do begin
sc:=thisphrase.phrase(.i1.);
if ((ord(sc)<65) or (ord(sc)>90)) then tempstr:=tempstr+sc
else if thisphrase.letters[ord(sc)-64]=0 then begin
if (pos(sc,'AEIOU')=0) then i2:=0;
if (i2=2) and (pos(sc,'AEIOU')>0) then i2:=1;
tempstr:=tempstr+'_';
end else tempstr:=tempstr+sc;
if i1 end;
nl; print(tempstr); nl;
show_clue:=i2;
end; {show_clue}

procedure play_phrase(pnum:integer);
var curstat: byte;
done: boolean;
ch,cc: char;
i1:integer;
begin
done:=false;
repeat
curstat:=show_clue;
case curstat of
0 : print('1Your guess?');
1 : print('6Only vowels are left!');
2 : print('3Phrase is now solved!');
end;
if curstat=2 then begin
done:=true;
thisphrase.guessed:=2;
open_phrase[pnum]:=2;
numopen:=numopen-1;
numsolved:=numsolved+1;
thisuser.gold:=thisuser.gold+10;
scores.numphrase:=scores.numphrase+1;
calc_high;
nl; print('1You get 4101 gold pieces for that phrase!');
end else begin
ynq(':'); ch:=inkeyt(10.0); if (ch<>#0) then writec(ch);
if (pos(ch,'AEIOU')>0) and (curstat<>1) then begin
if (thisuser.gold<5) then begin
done:=true;
cls; print('3You can''t afford a vowel!');
end else begin
nl; ynq('Pay 5 gold pieces for a vowel? ');
if (yn) then begin
thisuser.gold:=thisuser.gold-5;
end else begin
done:=true;
cls; print('3Nothing lost, nothing gained.');
end;
end;
end;
if not(done) then begin
thisphrase.numguess:=thisphrase.numguess+1;
if ch=#0 then begin
done:=true;
cls; print('3Time limit exceeded.'); nl;
end else if thisphrase.letters[ord(ch)-64]=1 then begin
done:=true;
cls; print('3Letter already guessed. Sorry.');
end else begin
thisphrase.letters[ord(ch)-64]:=1;
if (not(done) and (pos(ch,thisphrase.phrase)=0)) then begin
done:=true;
cls; print('3Incorrect Guess!');
end else if not(done) then begin
if (pos(ch,'AEIOU')=0) then
for i1 := 1 to length(thisphrase.phrase) do
if (thisphrase.phrase(.i1.)=ch) then begin
thisuser.gold:=thisuser.gold+1;
end;
end;
end;
end;
end;
write_phrase(pnum);
until done;
end; {play_phrase}

procedure play_phrases;
var i,pnum:integer;
begin
nl; nl;
if (numopen+numsolved=0) then begin
print('3All phrases are currently closed.');
exit;
end;
prtx(1,'Play which phrase? ');
inputn(pnum,2);
nl;
if (pnum<1) or (pnum>(numopen+numsolved)) then begin
tempstr:='3Phrase number must be from 1 to '+cstr(numopen+numsolved)+'.';
print(tempstr);
exit;
end;
read_phrase(act_num(pnum));
if (open_phrase[act_num(pnum)]=2) then begin
show_solved;
exit;
end;
if (userplay(thisphrase.userguess)) then begin
print('3You''ve already played this phrase today!');
exit;
end;
thisphrase.lastdate:=date;
thisphrase.lastguess:=nam2;
write_phrase(act_num(pnum));
scores.attphrase:=scores.attphrase+1;
calc_high;
play_phrase(act_num(pnum));
end; {play_phrases}

procedure init_trivia;
var i,i1: integer;
begin
numopen:=0;
numsolved:=0;
tempstr:=datapath+'TRIVIA.DAT';
assign(triviafile,tempstr);
{$I-}
reset(triviafile);
if ioresult<>0 then begin
rewrite(triviafile);
thistrivia.guessed:=0;
for i := 1 to 20 do begin
write(triviafile,thistrivia);
open_phrase[i]:=0;
end;
end else
for i := 1 to 20 do begin
seek(triviafile,i-1);
read(triviafile,thistrivia);
open_phrase[i]:=thistrivia.guessed;
case thistrivia.guessed of
1 : numopen:=numopen+1;
2 : numsolved:=numsolved+1;
end;
if (daynum(date)<>thistrivia.dateguess) then begin
for i1 := 0 to 249 do
thistrivia.userguess[i1]:=0;
thistrivia.dateguess:=daynum(date);
end;
seek(triviafile,i-1);
write(triviafile,thistrivia);
end;
close(triviafile);
if ioresult<>0 then begin
prtx(6,'Error reading trivia file. Please inform sysop!'); nl;
end;
{$I+}
end; {init_trivia}

procedure read_trivia(pnum:integer);

begin
tempstr:=datapath+'TRIVIA.DAT';
assign(triviafile,tempstr);
{$I-}
reset(triviafile);
seek(triviafile,pnum-1);
read(triviafile,thistrivia);
close(triviafile);
if ioresult<>0 then begin
prtx(6,'Error reading trivia file. Please inform sysop!'); nl;
end;
{$I+}
end; {read_trivia}

procedure write_trivia(pnum:integer);

begin
tempstr:=datapath+'TRIVIA.DAT';
assign(triviafile,tempstr);
{$I-}
reset(triviafile);
seek(triviafile,pnum-1);
write(triviafile,thistrivia);
close(triviafile);
if ioresult<>0 then begin
prtx(6,'Error saving updated trivia. Please inform sysop!'); nl;
end;
{$I+}
end; {write_trivia}

procedure list_triv(listall:boolean);
var i,i1,i2,i3:integer;
tf,show,abort:boolean;
s:string;
begin
if (numopen=0) and (numsolved=0) then begin
nl; nl; print('3All categories are currently closed.');
exit;
end;
cls;
abort:=false;
pla('3<1=========================[4 Trivia Madness Listing 1]==========================3>',abort);
pla(' ',abort);
show:=false;
i1:=0;
for i := 1 to 20 do begin
if ((open_phrase[i]>0) or (listall)) then i1:=i1+1;
if (open_phrase[i]>0) then begin
if not(show) then
pla(' 2## 3<2?3> <2Category3> <2Last Guesser3> <2Open Date3> <2Last Date3> <2Total3>',abort);
show:=true;
read_trivia(i);
tempstr:='5-';
if userplay(thistrivia.userguess) then tempstr:='2+';
if (thistrivia.guessed=2) then tempstr:='6*';
str(i1:3,s);
tempstr:=tempstr+'1'+s+' '+cstr(thistrivia.numtrivia)+' ';
if length(thistrivia.category)>16 then s:=copy(thistrivia.category,1,16)
else s:=thistrivia.category;
tempstr:=tempstr+s;
for i2 := length(s) to 16 do
tempstr:=tempstr+' ';
tempstr:=tempstr+' ';
if length(thistrivia.lastguess)>20 then s:=copy(thistrivia.lastguess,1,20)
else s:=thistrivia.lastguess;
tempstr:=tempstr+s;
for i2 := length(s) to 20 do
tempstr:=tempstr+' ';
tempstr:=tempstr+thistrivia.opendate+' ';
if thistrivia.lastdate='None ' then tempstr:=tempstr+' None '
else tempstr:=tempstr+thistrivia.lastdate;
str(thistrivia.numguess:8,s);
tempstr:=tempstr+s;
pla(tempstr,abort);
end;
end;
pla(' ',abort);
pla('3[5-3]1 Category is Open 3[2+3]1 Cannot Try Until Tomorrow 3[6*3]1 Category is Solved',abort);
end; {list_triv}

procedure edit_triv;
var i,i1,i2,pnum: integer;
begin
nl;
prtx(1,'Edit which category? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Category number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]<>1) then begin
print('3That category is not currently in use.');
exit;
end;
read_trivia(pnum);
repeat
for i:= 1 to thistrivia.numtrivia do begin
tempstr:='2Question #'+cstr(i)+'3: 1'+thistrivia.question[i]; print(tempstr);
end;
nl; prtx(1,'Edit which question? ');
inputn(i1,2);
nl;
if ((i1<1) or (i1>thistrivia.numtrivia)) then begin
tempstr:='3Question number must be from 1 to '+cstr(thistrivia.numtrivia)+'.';
print(tempstr);
exit;
end;
ynq('Change the question? ');
if (yn) then begin
print('1Enter the new question, to keep old.');
prompt(':');
inputl(tempstr,65);
if length(tempstr)>0 then thistrivia.question[i1]:=tempstr;
end else begin
for i:= 1 to thistrivia.numanswer[i1] do begin
tempstr:='2Answer #'+cstr(i)+'3: 1'+thistrivia.answer[i1,i]; print(tempstr);
end;
nl; prtx(1,'Change which answer? ');
inputn(i2,2);
nl;
print('1Enter the new answer, to keep old.');
prompt(':');
if ((i2<1) or (i2>thistrivia.numanswer[i1])) then begin
tempstr:='3Answer number must be from 1 to '+cstr(thistrivia.numanswer[i1])+'.';
print(tempstr);
exit;
end;
inputl(tempstr,40);
if length(tempstr)>0 then thistrivia.answer[i1,i2]:=tempstr;
end;
tempstr:='2Question 3: 1'+thistrivia.question[i1]; print(tempstr);
for i:=1 to thistrivia.numanswer[i1] do begin
tempstr:='2Answer #'+cstr(i)+'3: 1'+thistrivia.answer[i1,i]; print(tempstr);
end;
nl; ynq('Edit another? ');
until not(yn);
nl; ynq('Save this category? ');
if (yn) then begin
write_trivia(pnum);
nl; print('5Category updated.');
end else begin
nl; print('5Category not updated.');
end;
end; {edit_trivia}

procedure add_trivia;
var i,i1,i2,i3,pnum:integer;
begin
nl;
prtx(1,'Add which category? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Category number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]>0) then begin
print('3That category is already in use. It must be deleted first.');
exit;
end;
thistrivia.guessed:=1;
thistrivia.lastguess:='None';
thistrivia.numguess:=0;
thistrivia.opendate:=date;
thistrivia.lastdate:='None ';
thistrivia.dateguess:=daynum(date);
for i := 0 to 249 do
thistrivia.userguess[i]:=0;
for i := 1 to 26 do
thistrivia.sparchar[i]:=0;
print('1Enter the category name (max 30 chars).');
prompt(':');
inputl(tempstr,40);
thistrivia.category:=tempstr;
i1:=1;
repeat
tempstr:='1Enter question #'+cstr(i1)+', or for none.'; print(tempstr);
prompt(':');
inputl(tempstr,65);
thistrivia.question[i1]:=tempstr;
if length(thistrivia.question[i1])>0 then begin
i2:=1;
repeat
tempstr:='1Enter answer #'+cstr(i2)+', or for none.'; print(tempstr);
prompt(':');
inputl(tempstr,40);
thistrivia.answer[i1,i2]:=tempstr;
if length(thistrivia.answer[i1,i2])>0 then begin
i2:=i2+1;
i3:=0;
end else i3:=1;
until ((i2>3) or (i3=1));
if i2>1 then begin
tempstr:='2Question 3: 1'+thistrivia.question[i1]; print(tempstr);
for i3:=1 to i2-1 do begin
tempstr:='2Answer #'+cstr(i3)+'3: 1'+thistrivia.answer[i1,i3]; print(tempstr);
end;
nl; ynq('Is this OK? ');
if (yn) then begin
thistrivia.numanswer[i1]:=i2-1;
thistrivia.lastgot[i1]:='None';
thistrivia.attempt[i1]:=0;
i1:=i1+1;
end;
end else i2:=9;
end else i2:=9;
until (i1>5) or (i2=9);
if (i1=1) then begin
nl; print('3Category not added.');
exit;
end;
nl; ynq('Save this category? ');
if (yn) then begin
thistrivia.numtrivia:=i1-1;
write_trivia(pnum);
open_phrase[pnum]:=1;
numopen:=numopen+1;
nl; print('5Category added.');
end else begin
nl; print('5Category not added.');
end;
end; {add_trivia}

procedure delete_trivia;
var i,pnum:integer;
abort:boolean;
begin
nl;
prtx(1,'Delete which category? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Category number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]=0) then begin
print('3That category is not currently in use.');
exit;
end;
if (open_phrase[pnum]=1) then begin
print('6WARNING!3 That category is currently open.');
end;
read_trivia(pnum);
abort:=false;
tempstr:='2Category 3: 1'+thistrivia.category; pla(tempstr,abort);
for i:= 1 to thistrivia.numtrivia do begin
tempstr:='2Question #'+cstr(i)+'3: 1'+thistrivia.question[i]; pla(tempstr,abort);
end;
nl; ynq('Delete this category? ');
if (yn) then begin
open_phrase[pnum]:=0;
numopen:=numopen-1;
thistrivia.guessed:=0;
write_trivia(pnum);
nl; print('3Category deleted.');
end else begin
nl; print('3Category not deleted.');
end;
end; {delete_trivia}

procedure show_trivia;
var i1,i2,pnum:integer;
abort:boolean;
begin
nl;
prtx(1,'Show which category? ');
inputn(pnum,2);
nl;
if ((pnum<1) or (pnum>20)) then begin
print('3Category number must be from 1 to 20.');
exit;
end;
if (open_phrase[pnum]=0) then begin
print('3That category is not currently in use.');
exit;
end;
read_trivia(pnum);
abort:=false;
if (open_phrase[pnum]=1) then tempstr:='2Status 3: 1Open'
else tempstr:='2Status 3: 1Solved';
pla(tempstr,abort);
tempstr:='2Category 3: 1'+thistrivia.category; pla(tempstr,abort);
tempstr:='2Open Date 3: 1'+thistrivia.opendate; pla(tempstr,abort);
tempstr:='2Last Date 3: 1'+thistrivia.lastdate; pla(tempstr,abort);
for i1 := 1 to thistrivia.numtrivia do begin
pla(' ',abort);
tempstr:='2Question #'+cstr(i1)+' 3: 1'+thistrivia.question[i1]; pla(tempstr,abort);
for i2 := 1 to thistrivia.numanswer[i1] do begin
tempstr:='2Answer #'+cstr(i2)+' 3: 1'+thistrivia.answer[i1,i2]; pla(tempstr,abort);
end;
tempstr:='2Last Guesser 3: 1'+thistrivia.lastgot[i1]; pla(tempstr,abort);
tempstr:='2# of Guesses 3: 1'+cstr(thistrivia.attempt[i1]); pla(tempstr,abort);
end;
end; {show_trivia}

procedure show_trivs;
var i1,i2:integer;
abort:boolean;
begin
cls;
abort:=false;
pla('5[4 Solved Category 5]',abort); nl;
tempstr:='2Category 3: 1'+thistrivia.category; pla(tempstr,abort);
for i1 := 1 to thistrivia.numtrivia do begin
tempstr:='2Question #'+cstr(i1)+' 3: 1'+thistrivia.question[i1]; pla(tempstr,abort);
for i2 := 1 to thistrivia.numanswer[i1] do begin
tempstr:='2Answer #'+cstr(i2)+' 3: 1'+thistrivia.answer[i1,i2]; pla(tempstr,abort);
end;
end;
tempstr:='2Solved By 3: 1'+thistrivia.lastguess; pla(tempstr,abort);
tempstr:='2# of Guesses 3: 1'+cstr(thistrivia.numguess); pla(tempstr,abort);
tempstr:='2Open Date 3: 1'+thistrivia.opendate; pla(tempstr,abort);
tempstr:='2Solve Date 3: 1'+thistrivia.lastdate; pla(tempstr,abort);
end; {show_trivs}

procedure pick_trivs;
var pnum: integer;
begin
nl; nl;
if (numsolved=0) then begin
print('3There are no solved categories.');
exit;
end;
prtx(1,'Show which category? ');
inputn(pnum,2);
nl;
if (pnum<1) or (pnum>(numopen+numsolved)) then begin
tempstr:='3Category number must be from 1 to '+cstr(numopen+numsolved)+'.';
print(tempstr);
exit;
end;
read_trivia(act_num(pnum));
if (open_phrase[act_num(pnum)]=2) then show_trivs
else print('3That category is still open!');
end; {pick_solved}

procedure play_trivia(pnum:integer);
var done:boolean;
i1,i2:integer;
s:string;
cc:char;
begin
done:=false;
i1:=1;
repeat
tempstr:='5Question # '+cstr(i1)+' of '+cstr(thistrivia.numtrivia); nl; print(tempstr);
nl; print('3[*> Press a key to begin <*]'); nl;
getkey(cc);
cls;
tempstr:='2Category 3: 1'+thistrivia.category; print(tempstr);
tempstr:='2Question #'+cstr(i1)+' 3: 1'+thistrivia.question[i1]; print(tempstr);
tempstr:='2Last Correct Guess 3: 1'+thistrivia.lastgot[i1]; print(tempstr);
thistrivia.attempt[i1]:=thistrivia.attempt[i1]+1; nl;
ynq(':'); inputt(s,40,60.0);
if s='#0' then begin
done:=true;
cls; print('3Time limit exceeded.');
end else begin
done:=true;
for i2:=1 to thistrivia.numanswer[i1] do
if (strip(s)=strip(thistrivia.answer[i1,i2])) then done:=false;
if done then begin
cls; print('3Incorrect Guess!');
write_trivia(pnum);
end else begin
thistrivia.lastgot[i1]:=nam2;
nl; print('2Correct! Possible answers:1'); nl;
for i2 := 1 to thistrivia.numanswer[i1] do
print(thistrivia.answer[i1,i2]);
nl;
end;
end;
if not(done) then i1:=i1+1;
if (i1>thistrivia.numtrivia) then done:=true;
write_trivia(pnum);
until done;
if (i1>thistrivia.numtrivia) then begin
thistrivia.guessed:=2;
open_phrase[pnum]:=2;
numopen:=numopen-1;
numsolved:=numsolved+1;
print('3Category is now solved!'); nl;
tempstr:='1You win 4'+cstr(10*thistrivia.numtrivia)+'1 gold pieces for that category!';
print(tempstr);
thisuser.gold:=thisuser.gold+(10*thistrivia.numtrivia);
scores.numtrivia:=scores.numtrivia+1;
calc_high;
write_stats;
write_trivia(pnum);
end;
end; {play_trivia}

procedure play_category;
var i,pnum:integer;
begin
nl; nl;
if (numopen+numsolved=0) then begin
print('3All categories are currently closed.');
exit;
end;
prtx(1,'Play which trivia category? ');
inputn(pnum,2);
nl;
if (pnum<1) or (pnum>(numopen+numsolved)) then begin
tempstr:='3Category number must be from 1 to '+cstr(numopen+numsolved)+'.';
print(tempstr);
exit;
end;
read_trivia(act_num(pnum));
if (open_phrase[act_num(pnum)]=2) then begin
show_trivs;
exit;
end;
if (userplay(thistrivia.userguess)) then begin
print('3You''ve already played this category today!');
exit;
end;
thistrivia.lastdate:=date;
thistrivia.lastguess:=nam2;
thistrivia.numguess:=thistrivia.numguess+1;
write_trivia(act_num(pnum));
scores.atttrivia:=scores.atttrivia+1;
calc_high;
play_trivia(act_num(pnum));
end; {play_category}

function EmptyS(S:stack): boolean;
begin
EmptyS:=(S.top=0);
end; {EmptyS}

function FullS(S:stack): boolean;
begin
FullS:=(S.top=maxdeck)
end; {FullS}

procedure CreateS(var S:stack);
begin
S.top:=0;
end;

procedure PushSt(x:datatype; var S:stack);
begin
if FullS(S) then print('Stack Full Error - please notify sysop!') else
begin
with S do begin
top:=top+1;
data[top]:=x;
end;
end;
end; {PushSt}

procedure Pop(var x:datatype; var S:stack);
begin
if EmptyS(S) then print('Stack Empty Error - please notify sysop!') else
begin
with S do begin
x:=data[top];
top:=top-1;
end;
end;
end; {Pop}

procedure Shuffle(var S: stack);
var i:rankrange;
j:suitrange;
visited:array[rankrange,suitrange] of boolean;
kntr1:rankrange;
kntr2:suitrange;
temp:card;
begin
nl; prtx(6,'*NEW DECK*'); nl; nl;
CreateS(S);
randomize;
for kntr1 := 1 to 13 do
for kntr2 := 1 to 4 do
visited[kntr1,kntr2] := false;
while not FullS(S) do begin
i :=Random(13)+1;
j :=Random(4)+1;
with temp do begin
if not visited[i,j] then begin
case i of
1 : begin
rank := 'A';
rvalue := 11;
end;
11: begin
rank := 'J';
rvalue := 10;
end;
12: begin
rank := 'Q';
rvalue := 10;
end;
13: begin
rank := 'K';
rvalue := 10;
end;
2..10: begin
rank := cstr(i);
rvalue := i;
end;
end;
case j of
1: suit := 'S';
2: suit := 'C';
3: suit := 'H';
4: suit := 'D';
end;
visited[i,j] := true;
PushSt(temp,S);
end;
end;
end;
Pop(temp,S);
print('5Card Buried3:1 '+temp.rank+temp.suit);
end; {Shuffle}

procedure show_menu(menunum: integer;ansi:boolean); forward;

procedure Play(var bet:integer);
const maxqueue = 15;
type datatype = card;
queuerange = 0..MAXQUEUE;
queue = record
entry: array[queuerange] of datatype;
front,rear: queuerange;
end;
var player,dealer: queue;
kntr: 0..12;
temp,firstcard: card;
ch: char;
flag: boolean;
pcount,dcount: integer;
p_aces,d_aces: byte;

{*************** QUEUE IMPLEMENTATION FUNCTIONS AND PROCEDURES ***************}

function EmptyQ(q: queue): Boolean; {Returns TRUE if queue is empty}

begin
EmptyQ := (q.front = q.rear);
end; {EmptyQ}

function FullQ(q: queue): Boolean;
begin
with q do begin
if (rear=maxqueue) then FullQ := (rear mod maxqueue = front)
else Fullq := (rear + 1 = front);
end;
end; {FullQ}

procedure CreateQ(var q: queue); {Initializes queue for use}
begin
with q do begin
front := 0;
rear := 0;
end;
end; {CreateQ}

procedure Insert(x: datatype; var q: queue); {insert data into queue}
begin
if (FullQ(q)) then writeln('Queue Full Error - please notify sysop!') else
begin
with q do begin
if (rear = maxqueue) then rear := 0
else rear := rear + 1;
entry[rear] := x;
end;
end;
end; {Insert}

procedure Serve(var x: datatype; var q: queue); {receive data from queue}
begin
if (EmptyQ(q)) then writeln('Queue Empty Error - please notify sysop!') else
begin
with q do begin
if (front = maxqueue) then front := 0
else front := front + 1;
x := entry[front];
end;
end;
end; {Serve}

{********************* DEAL THE CARDS AND SHOW THE HANDS *********************}

procedure Deal(var hand: queue;var count: integer;var acecount: byte);
var C: card;
i: 1..4;
begin
if (EmptyS(deck)) then Shuffle(deck);
Pop(C,deck);
if (C.rank = 'A') then acecount := acecount + 1;
count := count+C.rvalue;
while ((count>21) and (acecount>0)) do begin
acecount := acecount - 1;
count := count - 10;
end;
Insert(C,hand);
end; {Deal}

procedure Show(hand: queue;count: integer);
var C: card;
temp: queue;
kount: string[2];
begin
CreateQ(temp);
while not (EmptyQ(hand)) do begin
Serve(C,hand);
with C do begin
prompt(rank+suit+' ');
end;
Insert(C,temp);
end;
print(' ('+cstr(count)+')');
while not (EmptyQ(temp)) do begin
Serve(C,temp);
Insert(C,hand);
end;
end; {Show}

procedure HideHand(X:card);
begin
with X do
print(dprompt+rank+suit+' XX');
end; {HideHand}

procedure PP;
begin
prompt(pprompt);
end; {PP}

procedure DP;
begin
prompt(dprompt);
end;

{************************** PLAY BLACKJACK ROUTINES **************************}

begin {procedure Play}
CreateQ(player);
CreateQ(dealer);
flag:=false;
pcount:=0;
dcount:=0;
p_aces:=0;
d_aces:=0;
for kntr:=1 to 2 do begin
Deal(player,pcount,p_aces);
Deal(dealer,dcount,d_aces);
if (kntr=1) then begin
Serve(temp,dealer);
firstcard:=temp;
Insert(temp,dealer);
end;
end;
kntr := 0;
while ((flag=false) and (pcount<=21)) do begin
kntr:=kntr+1;
nl;
HideHand(firstcard);
PP;
Show(player,pcount);
if ((kntr=1) and (pcount=21)) then begin {if BLACKJACK}
bet:=bet*2;
thisuser.gold:=thisuser.gold+bet;
tempstr:='6BLACKJACK!!1 You win '+cstr(bet)+' gold pieces!';
nl; print(tempstr);
flag:=true;
end else if ((kntr>=4) and (pcount<=21)) then begin
thisuser.gold:=thisuser.gold+bet;
tempstr:='6FIVE CARD SPECIAL!3 You win '+cstr(bet)+' gold pieces!';
nl; print(tempstr);
flag:=true;
end else begin
if (kntr=1) then begin
nl; prompt('2Your choice [H,S,D,?]: ');
onekey(ch,'HSD?');
end else begin
nl; prompt('2Your choice [H,S,?]: ');
onekey(ch,'HS?');
end;
nl;
case ch of
'H': Deal(player,pcount,p_aces); {Hit}
'S': flag := true; {Stand}
'D': begin
if (bet*2>thisuser.gold) then begin
print('3You can''t afford to double your bet! Same bet!'); nl;
end else bet := bet*2;
flag := true;
Deal(player,pcount,p_aces);
kntr:=kntr+1;
end;
'?': begin
kntr := kntr - 1;
show_menu(4,false);
end;
end;
end;
end;
nl;
if ((pcount=21) and (kntr=1)) then nl else
if ((pcount<=21) and (kntr>=4)) then nl else
if (pcount>21) then begin
DP;
Show(dealer,dcount);
PP;
Show(player,pcount);
tempstr:='3YOU''VE BUSTED!!1 You lose '+cstr(bet)+' gold pieces.';
nl; print(tempstr);
thisuser.gold := thisuser.gold-bet;
end else begin {Dealer's hand}
DP;
Show(dealer,dcount);
PP;
Show(player,pcount);
while (dcount<17) do begin
nl; print('3Dealer Hits..');
Deal(dealer,dcount,d_aces);
nl;
delay(1000);
DP;
Show(dealer,dcount);
PP;
Show(player,pcount);
end;
if (dcount>21) then begin
tempstr:='3DEALER BUSTS!!1 You win '+cstr(bet)+' gold pieces!!';
nl; print(tempstr);
thisuser.gold:=thisuser.gold+bet;
end else if (pcount>dcount) then begin
tempstr:='3YOU WIN!!1 You win '+cstr(bet)+' gold pieces!!';
nl; print(tempstr);
thisuser.gold:=thisuser.gold+bet;
end else if (dcount>pcount) then begin
tempstr:='3YOU LOSE!!1 You lose '+cstr(bet)+' gold pieces!!';
nl; print(tempstr);
thisuser.gold:=thisuser.gold-bet;
end else begin
nl; print('3It''s a push. No winner this hand.');
end;
end;
end; {Play}

procedure read_stats;
var f:text;
s:string;
begin
assign(f,datapath+'TZCASINO.DAT');
{$I-}
reset(f);
if ioresult<>0 then begin
raisesl := 2500;
maxsl := 90;
maxmins := 180;
timegold := 5;
goldtime := 3;
goldulk := 2;
exit;
end;
readln(f,s); raisesl := value(s);
readln(f,s); maxsl := value(s);
readln(f,s); maxmins := value(s);
readln(f,s); timegold := value(s);
readln(f,s); goldtime := value(s);
readln(f,s); goldulk := value(s);
close(f);
{$I+}
end; {read_stats}

procedure write_stats;
var f:text;
s:string;
begin
assign(f,'$$CASINO.DAT');
{$I-}
rewrite(f);
str(thisuser.gold:10,s);
writeln(f,s);
str(thisuser.sl:10,s);
writeln(f,s);
str(thisuser.timesaved:10,s);
writeln(f,s);
str(thisuser.uk:10,s);
writeln(f,s);
str(extratime:10,s);
writeln(f,s);
if hangup then writeln(f,' 1')

else writeln(f,' 0');
close(f);
if ioresult<>0 then print('Error updating stats. Please notify sysop.');
write_high;
{$I+}
end; {write_stats}

function logoff: boolean;
var h,m,s:string;
rl:real;

begin
nl; nl; nl;
ynq('Log Off? ');
if yn then
begin
cls;
ansic(0);
rl:=timer-logontime;
s:=tch(cstr(trunc(rl-int(rl/60.0)*60.0)));
m:=tch(cstr(trunc(int(rl/60.0)-int(rl/3600.0)*60.0)));
h:=cstr(trunc(rl/3600.0));
if length(h)=1 then h:='0'+h;
s:=h+':'+m+':'+s;
prompt('Time on = ');
print(s); nl;
s:=gfilespath+'LOGOFF.MSG';
printfile(s);
hangup:=true;
write_stats;
logoff:=true;
end else logoff:=false;
end; {logoff}

procedure show_time;
var s,s1:string;
i1:integer;
begin
nl;
s1:=date;
case daynum(s1) mod 7 of
0:s:='Tuesday';
1:s:='Wednesday';
2:s:='Thursday';
3:s:='Friday';
4:s:='Saturday';
5:s:='Sunday';
6:s:='Monday';
end;
s:=s+', ';
case value(copy(s1,1,2)) of
1:s:=s+'January';
2:s:=s+'February';
3:s:=s+'March';
4:s:=s+'April';
5:s:=s+'May';
6:s:=s+'June';
7:s:=s+'July';
8:s:=s+'August';
9:s:=s+'September';
10:s:=s+'October';
11:s:=s+'November';
12:s:=s+'December';
end;
if value(copy(s1,4,2))>9 then s:=s+' '+copy(s1,4,2)
else s:=s+' '+copy(s1,5,1);
s:=s+', '+cstr(1900+value(copy(s1,7,2)))+' ';
s1:=time;
i1:=value(copy(s1,1,2));
if i1>12 then i1:=i1-12;
if i1=0 then i1:=12;
if i1<10 then s:=s+' '+cstr(i1)+copy(s1,3,3)
else s:=s+cstr(i1)+copy(s1,3,3);
i1:=value(copy(s1,1,2));
if i1>11 then s:=s+' pm'
else s:=s+' am';
print(s);
s:='Time on = '+ctim(timer-logontime); print(s);
s:='Time left = '+ctim(nsl); print(s);
end; {show_time}

procedure show_menu;

var s,s1:string;
f:text;
done,abort,next:boolean;

begin
if ansi then s:=gfilespath+'TZMENU.ANS'
else s:=gfilespath+'TZMENU.MSG';
assign(f,s);
{$I-}
reset(f);
if ioresult<>0 then
begin
print('Error reading menu file. Please notify sysop.');
exit;
end;
s1:='`'+cstr(menunum);
done:=false;
abort:=false;
while not(done) and not(abort) do
begin
readln(f,s);
if (copy(s,1,length(s1))=s1) then
begin
nl; nl;
while not(done) and not(abort) do
begin
if eof(f) then done:=true else
begin
readln(f,s);
if copy(s,1,1)<>'`' then printa1(s,abort,next)
else done:=true;
end;
if not(done) then nl;
end;
end;
if eof(f) then done:=true;
end;
close(f);
if ioresult<>0 then print('Error reading menu file.');
{$I+}
end; {show_menu}

procedure your_information;
var s:string;
x:real;
begin
nl;
nl;
s:='Name : '+nam; print(s);
s:='Security Level : '+cstr(thisuser.sl); print(s);
s:='Time in Bank : '+cstr(thisuser.timesaved); print(s);
s:='Account Maximum: '+cstr(maxmins); print(s);
s:='Uploads : '+cstr(thisuser.uk)+'k in '+cstr(thisuser.uploaded)+' files'; print(s);
s:='Downloads : '+cstr(thisuser.dk)+'k in '+cstr(thisuser.downloaded)+' files'; print(s);
if (thisuser.dk=0) then x:=99.999 else begin
x:=(thisuser.uk/thisuser.dk);
if x>99.998 then x:=99.998;
end;
str(x:5:3,s);
s:='Ratio : '+s; print(s);
s:='Your Gold : '+cstr(thisuser.gold); print(s);
s:='Phrases Solved : '+cstr(scores.numphrase); print(s);
s:='Trivia Solved : '+cstr(scores.numtrivia); print(s);
if (in_casino) then begin
if thisuser.gold begin
str(startgold-thisuser.gold,s);
s:='This Visit : Lost '+s+' gold pieces.';
print(s);
end else if thisuser.gold>startgold then
begin
str(thisuser.gold-startgold,s);
s:='This Visit : Won '+s+' gold pieces.';
print(s);
end else print('This Visit : Even');
end;
end; {your_information}

function casino_sysop(i:integer): boolean;
var f:text;
s:string;

begin
if sysop then begin
casino_sysop:=true;
exit;
end;
casino_sysop:=false;
s:=datapath+'SPONSORS.DAT';
assign(f,s);
{$I-}
reset(f);
if ioresult<>0 then exit;
while not eof(f) do begin
readln(f,s);
if (i=0) or (copy(s,1,1)=cstr(i)) then begin
s:=copy(s,3,length(s)-1);
while (copy(s,length(s),1)=#32) do
s:=copy(s,1,length(s)-1);
if (length(s)>0) and (s=thisuser.name) then casino_sysop:=true;
end;
end;
close(f);
if ioresult<>0 then print('Error reading SPONSORS file.');
{$I+}
end;

procedure show_sponsors;
var f:text;
s:string;
i:integer;
begin
nl; nl;
s:=datapath+'SPONSORS.DAT';
assign(f,s);
{$I-}
reset(f);
if ioresult<>0 then exit;
tempstr:='1 ';
while not eof(f) do begin
readln(f,s);
if (copy(s,1,1)='1') then
tempstr:=tempstr+ulstr(copy(s,2,length(s)-1))+',';
end;
close(f);
tempstr:=tempstr+' '+sysopname+'.';
print('3Unsolved Phrases Sponsors -'); nl;
print(tempstr); nl;
reset(f);
tempstr:='1 ';
while not eof(f) do begin
readln(f,s);
if (copy(s,1,1)='2') then
tempstr:=tempstr+ulstr(copy(s,2,length(s)-1))+',';
end;
close(f);
tempstr:=tempstr+' '+sysopname+'.';
print('3Trivia Madness Sponsors -'); nl;
print(tempstr);
i:=IOResult;
{$I+}
end;

procedure deposit_time;
var minutes,maxsave: integer;
s: string;

begin
nl; nl;
if (thisuser.timesaved>=maxmins) then begin
prtx(5,'You already have the maximum amount of time in your account!'); nl;
exit;
end;
maxsave:=trunc((nsl-59.0)/60.0);
if (maxmins-thisuser.timesaved maxsave:=maxmins-thisuser.timesaved;
s:='Deposit time (Max. '+cstr(maxsave)+' minutes).';
prtx(3,s); nl;
prtx(1,'How many to deposit?'); nl;
prompt(': '); ansic(4);
inputn(minutes,3); nl;
if (minutes<1) then exit;
if (minutes>maxsave) then begin
prtx(6,'You can''t deposit that much!'); nl;
exit;
end;
if (minutes>((nsl-59.0)/60.0)) then begin
prtx(6,'You do not have enough time left to deposit that much!'); nl;
exit;
end;
extratime:=extratime-(minutes*60);
thisuser.timesaved:=thisuser.timesaved+minutes;
s:='- Deposited '+cstr(minutes)+' minutes.';
sysoplog(s);
s:=cstr(minutes)+' minutes deposited in your account.';
prtx(1,s); nl;
end; {deposit_time}

procedure withdraw_time;
var minutes,maxsave: integer;
s: string;

begin
nl; nl;
if (thisuser.timesaved<1) then begin
prtx(5,'You have no time in your account to withdraw!'); nl;
exit;
end;
s:='Withdraw time (Max. '+cstr(thisuser.timesaved)+' minutes).';
prtx(3,s); nl;
prtx(1,'How many to withdraw?'); nl;
prompt(': '); ansic(4);
inputn(minutes,3); nl;
if (minutes<1) then exit;
if (minutes>thisuser.timesaved) then begin
prtx(6,'You don''t have that much time in your account!'); nl;
exit;
end;
extratime:=extratime+(minutes*60);
thisuser.timesaved:=thisuser.timesaved-minutes;
s:='- Withdrew '+cstr(minutes)+' minutes.';
sysoplog(s);
s:=cstr(minutes)+' minutes withdrawn from your account.';
prtx(1,s); nl;
end; {withdraw_time}

procedure sell_time;
var minutes,minsleft: integer;
s: string;

begin
nl; nl;
minsleft:=trunc((nsl-59.0)/60.0);
prtx(5,'The current rate is one gold piece per five minutes.'); nl;
if (minsleft prtx(6,'You don''t have enough time remaining to sell any!'); nl;
exit;
end;
s:='Sell time for gold (Max. '+cstr(minsleft)+' minutes).';
prtx(3,s); nl;
prtx(1,'How many to sell?'); nl;
prompt(': '); ansic(4);
inputn(minutes,3); nl;
minutes:=minutes-(minutes mod timegold);
if (minutes<1) then exit;
if (minutes>minsleft) then begin
prtx(6,'You do not have enough time left to sell that much!'); nl;
exit;
end;
extratime:=extratime-(minutes*60);
thisuser.gold:=thisuser.gold+trunc(minutes/timegold);
s:='- Sold '+cstr(minutes)+' minutes.';
sysoplog(s);
s:=cstr(minutes)+' minutes sold for '+cstr(trunc(minutes/timegold))+' gold pieces.';
prtx(1,s); nl;
end; {sell_time}

procedure buy_time;
var minutes,buymins: integer;
s: string;

begin
nl; nl;
prtx(5,'The current rate is three minutes per gold piece.'); nl; nl;
if (thisuser.gold<1) then begin
prtx(6,'You don''t have any gold to buy time with!'); nl;
exit;
end;
buymins:=thisuser.gold*goldtime;
if (buymins>((thisuser.sl*3)-(nsl/60.0))) then
buymins:=((thisuser.sl*3)-trunc(nsl/60.0));
buymins:=buymins-(buymins mod goldtime);
if (buymins<1) then begin
prtx(6,'You need to use some time before buying more!'); nl;
exit;
end;
s:='Buy time with gold (Max. '+cstr(buymins)+' minutes).';
prtx(3,s); nl;
prtx(1,'How many to buy?'); nl;
prompt(': '); ansic(4);
inputn(minutes,3); nl;
if (minutes>buymins) then begin
prtx(5,'You can''t buy that much time!'); nl;
exit;
end;
minutes:=minutes-(minutes mod goldtime);
if (minutes<1) then exit;
extratime:=extratime+(minutes*60);
thisuser.gold:=thisuser.gold-trunc(minutes/goldtime);
s:='- Bought '+cstr(minutes)+' minutes.';
sysoplog(s);
s:=cstr(minutes)+' minutes bought for '+cstr(trunc(minutes/goldtime))+' gold pieces.';
prtx(1,s); nl;
end; {buy_time}

procedure raise_sl;
var s: string;

begin
nl; nl;
s:='It costs '+cstr(raisesl)+' gold to raise your Security Level.';
prtx(5,s); nl;
if (((thisuser.sl mod 10)=9) or (thisuser.sl>=maxsl)) then begin
prtx(6,'Your can''t raise your Security Level any higher!'); nl;
exit;
end;
if (thisuser.gold prtx(5,'You don''t have that much gold!'); nl;
exit;
end;
prtx(3,'Do you wish to do this? ');
if (yn) then begin
thisuser.sl:=thisuser.sl+1;
thisuser.gold:=thisuser.gold-raisesl;
s:='- Raised SL to '+cstr(thisuser.sl);
sysoplog(s);
s:='Security Level raised to '+cstr(thisuser.sl)+'.';
nl; prtx(1,s);
end;
nl;
end; {raise_sl}

procedure buy_ulk;
var ulcredit,buyulk: integer;
s: string;

begin
nl; nl;
prtx(5,'The current rate is 1K upload credit for two gold pieces.'); nl;
if (thisuser.gold prtx(5,'You don''t have enough gold to buy any credit!'); nl;
exit;
end;
buyulk:=trunc(thisuser.gold/goldulk);
s:='Buy upload credit with gold (Max. '+cstr(buyulk)+'k).';
prtx(3,s); nl;
prtx(1,'How much to buy?'); nl;
prompt(': '); ansic(4);
inputn(ulcredit,3); nl;
if (ulcredit>buyulk) then begin
prtx(6,'You don''t have enough gold to buy that much!'); nl;
exit;
end;
if (ulcredit<1) then exit;
thisuser.uk:=thisuser.uk+ulcredit;
thisuser.gold:=thisuser.gold-trunc(ulcredit*goldulk);
s:='- Bought '+cstr(ulcredit)+'k upload credit.';
sysoplog(s);
s:=cstr(ulcredit)+'k upload credit bought for '+cstr(trunc(ulcredit*goldulk))+' gold pieces.';
prtx(1,s); nl;
end; {buy_ulk}