(*****************************************************************************)

(*> <*)

(*> MISC1 .PAS - Written by Eric Oman <*)

(*> <*)

(*> Various miscellaneous functions used by the BBS. <*)

(*> <*)

(*> <*)

(*****************************************************************************)

unit misc1;

interface

uses

crt, dos,

{rcg11172000 no overlay under Linux.}

{overlay,}

common;

procedure reqchat(x:astr);

procedure TimeBank(s:astr);

function ctp(t,b:longint):astr;

procedure vote;

implementation

uses mail2;

procedure reqchat(x:astr);

var c,ii,i:integer;

r:char;

chatted:boolean;

s,why:astr;

begin

why:='';

if (pos(';',x)<>0) then why:=copy(x,pos(';',x)+1,length(x));

if (why='') then why:='^3Why do you want to chat?';

nl;

if ((chatt<systat.maxchat) or (cso)) then begin

sprint(why);

chatted:=FALSE;

prt(':'); mpl(70); inputl(s,70);

if (s<>'') then begin

inc(chatt);

if ((not sysop) or (rchat in thisuser.ac)) then

if (length(s)<64) then

sysoplog(#3#4+'Chat attempt: "'+#3#5+s+#3#4+'"')

else begin

sysoplog(#3#4+'Chat attempt:');

sl1(#3#4+' "'+#3#5+s+#3#4+'"');

end

else begin

sl1(#3#4+'Chat: "'+#3#5+s+#3#4+'"');

commandline('Press <SPACE> to chat or <ENTER> to SHUT UP for rest of call');

nl;

sprint(fstring.chatcall1);

nl;

ii:=0; c:=0;

repeat

inc(ii);

if (outcom) then sendcom1(^G);

sprompt(fstring.chatcall2);

if (outcom) then sendcom1(^G);

if (shutupchatcall) then delay(1500)

else

for i:=1 to 5 do begin

sound(800); delay(33);

sound(1300); delay(35);

sound(1700); delay(37);

sound(2100); delay(39);

sound(3200); delay(45);

sound(2100); delay(39);

sound(1700); delay(37);

sound(1300); delay(35);

sound(800);

end;

nosound;

if (keypressed) then begin

r:=readkey;

case r of

#32:begin

commandline('');

chatted:=TRUE; chatt:=0;

pap:=0;

chat;

end;

^M:shutupchatcall:=TRUE;

end;

end;

until ((chatted) or (ii=9) or (hangup));

commandline('');

end;

if (not chatted) then begin

chatr:=s;

printf('nosysop');

if (value(x)<>0) then begin

irt:='Tried chatting.';

imail(value(x));

end;

end else

chatr:='';

tleft;

end;

end else begin

printf('goaway');

irt:='Tried chatting (more than '+cstr(systat.maxchat)+' times!)';

sysoplog('Tried chatting more than '+cstr(systat.maxchat)+' times');

imail(value(x));

end;

end;

procedure TimeBank(s:astr);

var lng,maxperday,maxever:longint;

zz:integer;

oc:astr;

c:char;

function cantdeposit:boolean;

begin

cantdeposit:=TRUE;

if ((thisuser.timebankadd>=maxperday) and (maxperday<>0)) then exit;

if ((thisuser.timebank>=maxever) and (maxever<>0)) then exit;

cantdeposit:=FALSE;

end;

begin

maxperday:=value(s); maxever:=0;

if (pos(';',s)<>0) then maxever:=value(copy(s,pos(';',s)+1,length(s)));

if ((maxever<>0) and (thisuser.timebank>maxever)) then

thisuser.timebank:=maxever;

nl; nl;

sprint('^5Telegard Time Bank v'+ver);

nl;

if (not cantdeposit) then

sprint('^3A^1)dd time to your account.');

sprint('^3G^1)oodbye, log off now.');

sprint('^3Q^1)uit to BBS.');

if (choptime=0.0) then

sprint('^3W^1)ithdraw time from your account.');

nl;

if (choptime<>0.0) then

sprint(#3#7+'You cannot withdraw time during this call.');

if (cantdeposit) then begin

if ((thisuser.timebankadd>=maxperday) and (maxperday<>0)) then

sprint(#3#7+'You cannot add any more time to your account today.');

if ((thisuser.timebank>=maxever) and (maxever<>0)) then

sprint(#3#7+'You cannot add any more time to your account!');

end;

nl;

sprompt(#3#5+'In your account: '+#3#3+cstr(thisuser.timebank)+

#3#5+' Time left online: '+#3#3+cstr(trunc(nsl) div 60));

if (thisuser.timebankadd<>0) then

sprompt(' ^5Deposited today: ^3'+cstr(thisuser.timebankadd));

nl;

sprompt(#3#5+'Account limits: '+#3#3);

if (maxever<>0) then sprompt(cstr(maxever)+' max')

else sprompt('No max limit');

if (maxperday<>0) then sprompt(' / '+cstr(maxperday)+' per day');

nl; nl;

prt('Time Bank :');

oc:='QG';

if (choptime=0.0) then oc:=oc+'W';

if (not cantdeposit) then oc:=oc+'A';

onek(c,oc);

case c of

'A':begin

prt('Add how many minutes? '); inu(zz); lng:=zz;

nl;

if (not badini) then

if (lng>0) then

if (lng>trunc(nsl) div 60) then

sprint(#3#7+'You don''t have that much time left to deposit!')

else

if (lng+thisuser.timebankadd>maxperday) and (maxperday<>0) then

sprint(#3#7+'You can only add '+cstr(maxperday)+' minutes to your account per day!')

else

if (lng+thisuser.timebank>maxever) and (maxever<>0) then

sprint(#3#7+'Your account deposit limit is '+cstr(maxever)+' minutes!')

else begin

inc(thisuser.timebankadd,lng);

inc(thisuser.timebank,lng);

dec(thisuser.tltoday,lng);

sprint('^5In your account: ^3'+cstr(thisuser.timebank)+

'^5 Time left online: ^3'+cstr(trunc(nsl) div 60));

sysoplog('TimeBank: Deposited '+cstr(lng)+' minutes.');

end;

end;

'G':hangup:=TRUE;

'W':begin

prt('Withdraw how many minutes? '); inu(zz); lng:=zz;

nl;

if (not badini) then

if (lng>thisuser.timebank) then

sprint(#3#7+'You don''t have that much time left in your account!')

else

if (lng>0) then begin

dec(thisuser.timebankadd,lng);

if (thisuser.timebankadd<0) then thisuser.timebankadd:=0;

dec(thisuser.timebank,lng);

inc(thisuser.tltoday,lng);

sprint('^5In your account: ^3'+cstr(thisuser.timebank)+

'^5 Time left online: ^3'+cstr(trunc(nsl) div 60));

sysoplog('TimeBank: Withdrew '+cstr(lng)+' minutes.');

end;

end;

end;

end;

function ctp(t,b:longint):astr;

var s,s1:astr;

n:real;

begin

if ((t=0) or (b=0)) then begin

ctp:=' 0.0%';

exit;

end;

n:=(t*100)/b;

str(n:5:1,s);

s:=s+'%';

ctp:=s;

(*

s:=cstr((t*100) div b);

if (length(s)=1) then s:=' '+s;

s:=s+'.';

if (length(s)=3) then s:=' '+s;

n:=t/(b+0.0005);

s1:=cstr(trunc(n*1000) mod 10);

ctp:=s+s1+'%';

*)

end;

function vote1x(answeringall:boolean; qnum:integer; var vd:vdatar):boolean;

var s,pva:astr;

i,tv:integer;

c:char;

abort,next,changed,doneyet,b:boolean;

procedure showvotes(stats,nocom:boolean);

var s:astr;

i:integer;

begin

cls;

sprint('Current standings for Question #'+cstr(qnum)+' :');

nl; sprint(#3#7+vd.question); nl;

tv:=0;

for i:=1 to vd.numa do inc(tv,vd.answ[i].numres);

if (tv=0) then tv:=1;

sprint('Users voting: '+#3#3+ctp(tv,systat.numusers)); nl;

abort:=FALSE; i:=1;

if (nocom) then begin

sprint(#3#0+' 0:No Comment');

pva:='Q0';

end else

pva:='';

while (i<=vd.numa) do begin

if (not abort) then begin

s:=#3#5+cstr(i)+#3#7+':'+#3#3+vd.answ[i].ans;

if (stats) then

s:=mln(s,41+length(cstr(i)))+#3#4+' :'+#3#0+mn(vd.answ[i].numres,3)+

#3#4+':'+#3#0+ctp(vd.answ[i].numres,tv)+#3#4+':';

if (i=thisuser.vote[qnum]) then s:=#3#8+'*'+s else s:=' '+s;

printacr(' '+s,abort,next);

end;

pva:=pva+cstr(i);

inc(i);

end;

end;

begin

changed:=FALSE;

if (vd.numa<>0) then begin

doneyet:=(thisuser.vote[qnum]<>0);

showvotes(doneyet,not systat.forcevoting);

nl;

sprint(#3#5+'Your vote: '+#3#3+vd.answ[thisuser.vote[qnum]].ans);

if (not (rvoting in thisuser.ac)) and (not hangup) then begin

if (answeringall) then b:=TRUE else b:=pynq('Change it? ');

if (b) then begin

nl; prt('Which number (0-'+cstr(vd.numa)+') ? ');

onek(s[1],pva);

s[0]:=#1; i:=value(s);

if (s<>'') and (i>=0) and (i<=vd.numa) then begin

if (thisuser.vote[qnum]<>0) then

dec(vd.answ[thisuser.vote[qnum]].numres);

thisuser.vote[qnum]:=i;

if (i<>0) then inc(vd.answ[i].numres);

changed:=TRUE;

if (not answeringall) then showvotes(TRUE,FALSE);

end;

end;

end;

end else

if (not answeringall) then print('Inactive question.');

vote1x:=changed;

end;

procedure vote;

var vdata:file of vdatar;

vd:vdatar;

i,j,int2,vna:integer;

s,i1,ij:astr;

abort,next,done,lq,waschanged:boolean;

procedure getvote(qnum:integer);

begin

seek(vdata,qnum-1); read(vdata,vd);

end;

procedure vote1(answeringall:boolean; qnum:integer);

begin

getvote(qnum);

if (vote1x(answeringall,qnum,vd)) then begin

seek(vdata,qnum-1);

write(vdata,vd);

waschanged:=TRUE;

end;

end;

begin

s:=''; done:=FALSE; lq:=TRUE; waschanged:=FALSE;

assign(vdata,systat.gfilepath+'voting.dat');

{$I-} reset(vdata); {$I+}

if (ioresult<>0) then print('No voting today.')

else begin

sysoplog('Entered voting booths');

repeat

done:=FALSE;

ij:='Q?';

abort:=FALSE;

if (lq) then begin

cls;

printacr(#3#5+'Current Questions:',abort,next);

nl;

end;

int2:=0;

for i:=1 to numvoteqs do begin

seek(vdata,i-1); read(vdata,vd);

if vd.numa<>0 then begin

inc(int2);

if (lq) and (not abort) then begin

if (thisuser.vote[i]=0) then i1:=#3+#8+'* ' else i1:=' ';

i1:=i1+#3#5+cstr(i)+#3#7+': '+#3#3+vd.question;

printacr(i1,abort,next);

end;

ij:=ij+cstr(i);

end;

end;

lq:=FALSE;

if (int2=0) then begin

print('No voting questions now.');

done:=TRUE;

end else begin

nl;

prt('Which question (##,L:ist,A:nswer all,Q:uit) : ');

input(s,2);

i:=value(s);

if (s='A') then begin

j:=0;

i:=1;

while ((i<=numvoteqs) and (not hangup)) do begin

getvote(i);

if ((vd.numa<>0) and (thisuser.vote[i]=0)) then begin

vote1(TRUE,i);

inc(j);

end;

inc(i);

end;

if (j=0) then begin nl; sprint(#3#7+'No more questions need answering!'); end;

end;

if ((s='Q') or (s='')) then done:=TRUE;

if ((s='L') or (s='?')) then lq:=TRUE;

if (i>=1) and (i<=numvoteqs) then vote1(FALSE,i);

end;

if (systat.forcevoting) and (done) then begin

vna:=0;

for i:=1 to numvoteqs do begin

seek(vdata,i-1); read(vdata,vd);

if ((vd.numa<>0) and (thisuser.vote[i]=0)) then inc(vna);

end;

if (vna<>0) then begin

nl;

print('Voting is mandatory - all questions must be answered.');

done:=FALSE;

end;

end;

until (done) or (hangup);

close(vdata);

if (waschanged) then begin

nl;

sprint(#3#3+fstring.thanxvote);

end;

end;

end;

end.