unit miscpl5;
{$O+,F+}
{$N+,E+}

interface

uses rgoods;

procedure scribz;
procedure trimtext(filename:string; truncate:longint);
procedure payphone;
procedure chatmode;
procedure bumplevel(var u:userrec);
procedure awardxp(var u:userrec; xp:extended);
procedure randomgoodies;
procedure r_sextoy;
procedure r_defense;

implementation

uses dos,crt,bbskv,bbskern,engine2,toyinfo,winner,cheaplok,
		 miscpl4,miscpl3,miscpl2,miscplay,cheri2,gelin,sys_msg;

var scrib:scribrec;
		scribfile:file of scribrec;

procedure trimtext(filename:string; truncate:longint);
type buftype=array[1..8192] of char;
var s:string[2];
    tstr:string;
    inbuf,outbuf:^buftype;
    tmpname:string;
    p:dos.pathstr;
    d:dos.dirstr;
    n:dos.namestr;
    e:dos.extstr;
    infile,outfile:text;
    crap:integer;
    i,
    lines:longint;
label _exit;
begin
  if not exist(filename) then exit;
  p:=filename; fsplit(p,d,n,e); tmpname:=d+n+'.TMP';
{$I-}
  assign(infile,tmpname);
  erase(infile);            {Nuke extant tmp file}
  crap:=ioresult;
{$I+}
  new(inbuf); new(outbuf);
  assign(infile,filename);  {Set input file to filename}
  rename(infile,tmpname);   {Rename it to tmp name}
  assign(infile,tmpname);   {Set it again with that name}
  settextbuf(infile,inbuf^);
  reset(infile);
  lines:=0;
  while not eof(infile) do begin inc(lines); readln(infile,s); end;
  reset(infile);
  if
    lines<=truncate
  then
    begin
      close(infile);
      rename(infile,filename);   {Rename it to tmp name}
      goto _exit;
    end;
  for i:=1 to (lines-truncate) do readln(infile,s);
  assign(outfile,filename); rewrite(outfile);
  repeat
    readln(infile,tstr);
    writeln(outfile,tstr);
  until eof(infile);

_exit:
{$I-}
  close(infile); crap:=ioresult;
  flush(outfile); crap:=ioresult;
  close(outfile); crap:=ioresult;
  dispose(inbuf);
  dispose(outbuf);
{$I+}
end;

procedure scribz;
const filename='RANCHO.SCB';
var tch:char;
		done,doner:boolean;
		scbz:word;
begin
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	done:=false;
	repeat
		sysmsg(619);
		get('lsq'#13); tch:=upcase(ctmp);
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		case tch of
			#13,
			'Q' : begin
							sysmsg(620);
							exit;
						end;
			'S' : begin
							sysmsg(621);
							tstr:=getln(78);
							if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
							fillchar(scrib,sizeof(scrib),#00);
							scrib.txt:=tstr;
							scrib.name:=user.name;
							if
								exist(filename)
							then
								begin
									assign(scribfile,filename);
									reset(scribfile);
									seek(scribfile,filesize(scribfile));
									write(scribfile,scrib);
									close(scribfile);
								end
							else
								begin
									assign(scribfile,filename);
									rewrite(scribfile);
									write(scribfile,scrib);
									close(scribfile);
								end;
							sysmsg(622);
						end; {case 'S'}
			'L' : begin
							scbz:=0; doner:=false;
							sysmsg(623);
							if
								not(exist(filename))
							then
								begin
									sysmsg(624);
									exit;
								end
							else
								begin
									assign(scribfile,filename);
									reset(scribfile);
									repeat
										if lostcarrier then begin close(scribfile); nocarrier; quitnow:=true; exit; end;
										read(scribfile,scrib);
										parameter[1]:=scrib.name;
										parameter[2]:=scrib.txt;
										sysmsg(625);
										inc(scbz);
										if
											(scbz mod 6)=0
										then
											doner:=not(more);
									until (eof(scribfile)) or doner or quitnow or lostcarrier;
									close(scribfile);
									if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
								end
						end; {case "L"}
		end; {case}
	until done or quitnow or lostcarrier;
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

procedure payphone;
var dt,dt2:longint;
		amt:longint;
		tch,tch2,tch3:char;
		surprise,done:boolean;
		minushp:longint;
		action:integer;
		tmpxp:longint;
		disease:boolean;
		distemp:longint;
		shots:integer;
		wins,wins2:word;
		prize:longint;
label _mailwho,_enter;
begin
_enter:
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	updatesbar;
	done:=false;
	repeat
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		sysmsg(626);
		if
			ansi
		then
			sendtext('PAYPHONE.ANS')
		else
			sendtext('PAYPHONE.ASC');
		sysmsg(627);
		checkemail;
		get('123q'#13); tch3:=upcase(ctmp);
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		case tch3 of
			#13,
			'Q' : begin
							sysmsg(628);
							exit;
						end;
			'3' : begin
							sysmsg(629);
							cherichat;
						end;
			'2' : begin
							sysmsg(630);
							scribz;
						end;
			'1' : begin
							sysmsg(631);
							get('slq'#13);
							if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
							tch2:=upcase(ctmp);
							case tch2 of
								'L' : begin sysmsg(632); readmsgs; exit; end;
								#13,
								'Q' : begin sysmsg(633); exit; end;
							end;
							repeat
								begin
_mailwho:
									if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
									parameter[1]:=int2str(maxuser);
									sysmsg(634);
									tstr:=''; amt:=maxuser;
									tstr:=getln(35);
									tstr:=upcasestr(tstr);
                  if (tstr='?') or (tstr='H') then begin sendln('`K'); userlist(false); sendln('`,'); goto _mailwho; end;
									if (tstr='Q') or (tstr='') or (tstr='X') then goto _enter;
									if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
									amt:=lookupuser(tstr);
									if (amt=-1) then goto _enter;
									if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
									if
										(amt=0) or (amt>maxuser)
									then
										sysmsg(635)
									else
										if
											amt>0
										then
											begin
												user2:=userlog^[amt];
												done:=true;

												if {User specified himself}
													upcasestr(user.name)=upcasestr(user2.name)
												then
													begin
														sysmsg(636);
														exit;
													end;
											end;
								end;
							until done or quitnow or lostcarrier;
							if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
							{we have established who to email now}
							send2robot:=user2.robot;
							parameter[1]:=user.name;
							parameter[2]:=user2.name;
							sysmsg(637);
							quoted:=false;
							entermsg(amt);
							updatesbar;
						end;
		end; {case}
	until (true=false) or quitnow or lostcarrier;
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

procedure chatmode;
var exitchat:boolean;
		tch:char;
		wordout:string;
		index:word;
begin
	nomore:=true;
	wordout:='';
	sendln('');
	textattr:=lightcyan;
	writeln('Hit ESC to exit chat...');
	sysmsg(638);
	exitchat:=FALSE;
	repeat
		begin
			if
				charinbuffer and dcd and (not(consoleonly))
			then
				begin
					if tch=space then wordout:='';
					if not(dcd) and not(consoleonly) then exit;
					tch:=com_rx;
					if not(dcd) and not(consoleonly) then exit;
						if
							tch=linefeed
						then
							nothing
						else
							if
								tch=carriagereturn
							then
								begin
									sendln('');
									wordout:='';
								end
							else
								begin
									if
										(tch=bs)
									then
										begin
											if wherex>1 then send(bs+space);
											if wordout[0]>chr(0) then wordout:=copy(wordout,1,length(wordout)-1);
										end;
									if
										(tch=space)
									then
										wordout:=''
									else
										wordout:=wordout+tch;
									if
										wherex<75
									then
										begin
											changecolour('G');
											send(tch);
										end
									else
										begin
											for
												index:=1 to length(wordout)
											do
												send(destructiveBS);
											changecolour('G');
											send(crlf+wordout);
											wordout:='';
										end;
								end;
				end;
			if
				keypressed
			then
				begin
					if not(dcd) and not(consoleonly) then exit;
					tch:=readkey;
					if not(dcd) and not(consoleonly) then exit;
					if tch=space then wordout:='';
					if
						tch=esc
					then
						exitchat:=TRUE
					else
						begin
							if
								tch=linefeed
							then
								nothing
							else
								if
									tch=carriagereturn
								then
									begin
										sendln('');
										wordout:='';
									end
								else
									begin
									if
										(tch=bs)
									then
										begin
											if wherex>1 then send(bs+space);
											if wordout[0]>chr(0) then wordout:=copy(wordout,1,length(wordout)-1);
										end;
									if
										(tch=' ')
									then
										wordout:=''
									else
										wordout:=wordout+tch;
									if
										wherex<75
									then
										begin
											changecolour('L');
											send(tch);
										end
									else
										begin
											if
												wordout[0]>chr(0)
											then
												for
													index:=1 to length(wordout)
												do
													send(destructiveBS);
											changecolour('L');
											send(crlf+wordout);
											wordout:='';
										end;
								end;
					end
			end;
	end;
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	until exitchat or lostcarrier;
	sysmsg(639);
	nomore:=false; totallines:=1;
	if not(dcd) and not(consoleonly) then exit;
end;

procedure awardxp(var u:userrec; xp:extended);
var t1,t2:extended;
begin
	if
    u.level>=105
	then
		exit;
  t1:=u.xp; t2:=xp; t1:=t1+t2;
  if (t1<5e18) then u.xp:=u.xp+xp;
	if
		(u.xp>=(nextlevelxp(u.level)))
	then
    begin
      repeat
        bumplevel(u);
      until (u.xp<(nextlevelxp(u.level))) or quitnow or lostcarrier;
      if
        not(u.robot)
      then
        begin
          parameter[1]:=u.name; parameter[2]:=int2str(u.level);
          log(g_sysmsg(642));
        end;
    end;
end;

procedure centerit(s:String);
var i,x:integer;
begin
	x:=31-(length(s) shr 1);
  send('  `P`h ³ `A`h');
	for i:=1 to x do send(' ');
	send(s);
	repeat send(' ') until (wherex>=70) or lostcarrier or quitnow;
  sendln('`I`h ³ `P`a`1');
end;

procedure bumplevel(var u:userrec);
var tmp,tmp1,tmp2:longint;
begin
  if not registree then if (u.level>50) then begin u.xp:=3.6e10; u.level:=50; exit; end;
  if not registree then if (u.xp>3.6e10) then begin u.xp:=3.6e10; exit; end;
  if u.level>=105 then exit;

  totallines:=0;
	inc(u.level);
	if
		verbbump
	then
		sysmsg(640);

	if
		verbbump
	then
		begin
			parameter[1]:=int2str(u.level);
			centerit(g_sysmsg(641));
			centerit(' ');
		end;

	tmp1:=round((raisepower(u.level,2))*config.bumppay);
	tmp:=tmp1+bigrnd(tmp1);
	if
		verbbump
	then
		begin
			parameter[1]:=i2sc(tmp);
			centerit(g_sysmsg(643));
		end;
	u.gp:=u.gp+tmp;

	tmp:=random(6)+3;
	if
		verbbump
	then
		begin
			parameter[1]:=int2str(tmp);
			centerit(g_sysmsg(644));
		end;
	u.stamina:=u.stamina+tmp;

	tmp:=random(6)+3;
	if
		verbbump
	then
		begin
			parameter[1]:=int2str(tmp);
			centerit(g_sysmsg(645));
		end;
	u.skill:=u.skill+tmp;

	tmp:=random(8)+3;
	tmp:=(tmp*80) div 100;
	tmp:=tmp+1;
	tmp2:=u.knowledge;
	if
		verbbump
	then
		begin
			parameter[1]:=int2str(tmp);
			centerit(g_sysmsg(646));
		end;
	u.knowledge:=u.knowledge+tmp;

	tmp1:=tmp2 shr 1;
	tmp:=tmp1+random(tmp1);
	if
		verbbump
	then
		begin
			parameter[1]:=i2sc(tmp);
			centerit(g_sysmsg(647));
		end;
	u.maxhp:=u.maxhp+tmp;
	u.hp:=u.maxhp;
	tmp:=random(9)+3;
	tmp:=(tmp*70) div 100;
	tmp:=tmp+1;
	tmp2:=u.talent;
	if
		verbbump
	then
		begin
			parameter[1]:=int2str(tmp);
			centerit(g_sysmsg(648));
		end;
	u.talent:=u.talent+tmp;
	tmp1:=tmp2 shr 1;
	tmp:=tmp1+random(tmp1);
	if
		verbbump
	then
		begin
			parameter[1]:=i2sc(tmp);
			centerit(G_sysmsg(649));
		end;
	u.maxcoord:=u.maxcoord+tmp;
	u.coord:=u.maxcoord;
	if verbbump then centerit(' ');
	if
		verbbump
	then
		sysmsg(650);
  if verbbump then sendln('`L');

	if verbbump then updatesbar;
end;

procedure r_mugger;
var x:integer;
		amt:comp;
		y:longint;
    xpa:longint;
begin
  sysmsg(1000);
  x:=random(5);
  case x of
		0: begin
         user.hp:=1;
         parameter[1]:=c2sc(user.gp);
         sysmsg(1001);
         user.gp:=0;
			 end;
    1: begin
         x:=random(user.level*100);
         parameter[1]:=i2sc(x);
         sysmsg(1002);
         user.gp:=user.gp+x;
       end;
    2: sysmsg(1003);
    3: begin
         amt:=user.gp/2;
				 parameter[1]:=c2sc(amt);
         sysmsg(1004);
				 user.gp:=user.gp-amt;
			 end;
    4: begin
         xpa:=longint(user.level*user.level*20+random(user.level*20));
         user.xp:=user.xp+xpa;
         parameter[1]:=i2sc(xpa);
         sysmsg(1005);
       end;
  end;
  y:=random(4);
  if
    (y=0)
  then
    begin
      y:=(random(10)+1)*user.level*100;
      parameter[1]:=i2sc(y); sysmsg(1006);
      user.gp:=user.gp+y;
    end;
  anykey;
end;

procedure r_shellgame;
var tch:char;
		x,y,z:integer;
		l:longint;
begin
	if user.gender=male then parameter[1]:=g_sysmsg(1016) else parameter[1]:=g_sysmsg(1017);
  l:=longint(user.level*user.level*15); parameter[2]:=i2sc(l);
	sysmsg(1010);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
	parameter[1]:=i2sc(l);
	if user.gp<l then begin sysmsg(1018); exit; end;
	user.gp:=user.gp-l;
	x:=random(3)+1;
	parameter[1]:=i2sc(l);
	sysmsg(1011);
	get('123'); tch:=upcase(ctmp); send(tch);
	y:=ord(tch)-48;
	if (y=x) then
		begin
			z:=random(3);
			case z of
				0: begin sysmsg(1012); user.stamina:=user.stamina+5; end;
				1: begin sysmsg(1013); user.skill:=user.skill+5; end;
				2: begin sysmsg(1014); user.knowledge:=user.knowledge+5; end;
			end;
		end
	else
		sysmsg(1015);
end;

procedure r_wallet;
var l:longint;
    minimum:longint;
begin
  minimum:=user.level*100;
  l:=user.level*random(user.level+1)*50;
  if minimum>l then l:=minimum;
	user.gp:=user.gp+l;
  parameter[1]:=i2sc(l);
	sysmsg(1019);
  anykey;
end;

procedure r_hookah;
var tch:char;
		x:integer; y:longint;
begin
	quitnow:=false;
	sysmsg(1020);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
	sysmsg(1021);
	x:=random(10);
	if
		(x<3)
	then
		begin
			y:=random((user.level-1)*10); if y=0 then y:=1;
			if user.maxhp<(user.level*15) then y:=1;
			if user.maxhp<10 then y:=0;
			parameter[1]:=i2sc(y);
			user.maxhp:=user.maxhp-y;
			sysmsg(1022);
		end
	else
		begin
			y:=random((user.level-1)*10); if y=0 then y:=1;
			parameter[1]:=i2sc(y);
			user.maxhp:=user.maxhp+y;
			sysmsg(1023);
		end;
end;

procedure r_laptop;
var x:integer;
		amt:comp;
    y:longint; xpa:longint;
begin
	sysmsg(1025);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
	x:=random(3); {0: got money} {1: got away, no gain or loss}
	case x of  {2: lost money}
		0: begin
         amt:=user.bankgp; if amt<1000 then amt:=1000;
				 parameter[1]:=c2sc(amt);
				 sysmsg(1026);
				 user.bankgp:=user.bankgp+amt;
			 end;
    1: begin
         xpa:=longint(user.level*user.level*20+random(user.level*20));
         user.xp:=user.xp+xpa;
         parameter[1]:=i2sc(xpa);
         sysmsg(1027);
       end;
		2: begin
				 amt:=user.bankgp*0.1;
				 parameter[1]:=c2sc(amt);
				 sysmsg(1028);
         user.bankgp:=user.bankgp-amt;
			 end;
  end;
end;

procedure r_game;
var tch:char;
    x:integer;
begin
  sysmsg(1030);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
  x:=random(2);
  if
    (x=0)
  then
    begin
      x:=random(6)+1;
      parameter[1]:=int2str(x);
      movesleft:=movesleft+x;
      sysmsg(1031);
    end
  else
    begin
      x:=random(3)+1;
      parameter[1]:=int2str(x);
      movesleft:=movesleft-x; if movesleft<0 then movesleft:=0;
      sysmsg(1032);
    end;
end;

procedure r_mags;
var tch:char;
		x,y,z:integer;
		l:longint;
begin
  sysmsg(1035);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
  movesleft:=movesleft-2; if movesleft<0 then movesleft:=0;
  z:=random(3);
  case z of
    0: begin sysmsg(1036); user.stamina:=user.stamina+3; end;
    1: begin sysmsg(1037); user.skill:=user.skill+3; end;
    2: begin sysmsg(1038); user.knowledge:=user.knowledge+3; end;
  end;
end;

procedure r_foundblink;
var x,y:integer;
begin
  sysmsg(1039);
  user.spell[5]:=user.spell[5]+1;
  anykey;
end;

procedure r_ex;
var x,base,exx:integer; xpa:longint;
begin
  xpa:=longint(user.level*user.level*20+random(user.level*20));
  user.xp:=user.xp+xpa;
  if
    user.gender=male
  then
    begin
      if user.orientation=gay then begin base:=1040; exx:=1057; end;
      if user.orientation=straight then begin base:=1052; exx:=1056; end;
      if user.orientation=bi then begin
                                    x:=random(2);
                                    if (x=0) then begin base:=1052; exx:=1056; end
                                             else begin base:=1040; exx:=1057; end;
                                  end;
    end
  else
    begin
      if user.orientation=gay then begin base:=1044; exx:=1056; end;
      if user.orientation=straight then begin base:=1048; exx:=1057; end;
      if user.orientation=bi then begin
                                    x:=random(2);
                                    if (x=0) then begin base:=1048; exx:=1057; end
                                             else begin base:=1044; exx:=1056; end;
                                  end;
    end;
    parameter[1]:=g_sysmsg(base+random(4));
    parameter[2]:=g_sysmsg(exx);
    parameter[3]:=i2sc(xpa);
    sysmsg(1058);
    dec(movesleft); if movesleft<0 then movesleft:=0;
    anykey;
end;

procedure r_ginseng;
var x:integer;
    c:comp;
begin
  sysmsg(1060);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
  sysmsg(1061);
  c:=user.maxhp*1.35;
  user.hp:=trunc(c);
end;

procedure r_condoms;
var x:integer;
begin
  x:=random(29)+2;
  parameter[1]:=int2str(x);
  user.condoms:=user.condoms+x;
  sysmsg(1062);
  anykey;
end;

procedure r_towel;
begin
  sysmsg(1063);
  inc(config.maxjacuzzi,3);
  anykey;
end;

procedure r_smoke;
var x:longint;
begin
  x:=user.maxhp div 2; user.hp:=user.hp+x; if user.hp>user.maxhp then user.hp:=user.maxhp;
  dec(movesleft,2); if movesleft<0 then movesleft:=0;
  parameter[1]:=i2sc(user.hp);
  sysmsg(1064);
  anykey;
end;

procedure r_sextoy;
var x:longint;
begin
  if
    user.weapon>=2000      {Reroll if we're over already!}
  then
    begin
      randomgoodies;
      exit;
    end;
  if
    (user.level>90) and (random(5)=0)  {1 in 5 chance if over L90 that we get MEGA ARMOR}
  then
    begin
      sendln(crlf+crlf+'`P**** `JMEGA DISCOVERY`P ****');
      sendln(crlf+'`MA faint glow in the shadows catches your eye... ');
      sendln(crlf+'`OYou find the '+weaponname(9999)+'`O !!!');
      user.weapon:=9999;
      anykey;
      exit;
    end;
  parameter[1]:=weaponname(user.weapon);
  x:=random(5)+1;
  user.weapon:=user.weapon+x;
  parameter[2]:=weaponname(user.weapon);
  sysmsg(1065);
  anykey;
end;

procedure r_defense;
var x:longint;
begin
  if
    user.armor>=2000      {Reroll if we're over already!}
  then
    begin
      randomgoodies;
      exit;
    end;
  if
    (user.level>90) and (random(5)=0)  {1 in 5 chance if over L90 that we get MEGA WEAPON}
  then
    begin
      sendln(crlf+crlf+'`P**** `JMEGA DISCOVERY`P ****');
      sendln(crlf+'`MA faint glow in the shadows catches your eye... ');
      sendln(crlf+'`OYou find the '+armorname(9999)+'`O !!!');
      user.armor:=9999;
      anykey;
      exit;
    end;
  parameter[1]:=armorname(user.armor);
  x:=random(5)+1;
  user.armor:=user.armor+x;
  parameter[2]:=armorname(user.armor);
  sysmsg(1065); {uses same sysmsg as r_sextoy}
  anykey;
end;

{    writeln('Pull Tab Seller (costs $10*lv, 1 in 3 chance of winning $40x*lv)');}
procedure r_pulltab;
var tch:char;
		x,y,z:integer;
		l:longint;
begin
  l:=10*user.level; parameter[1]:=i2sc(l);
  sysmsg(1067);
	yndefault:=true; tch:=upcase(yn);
	if tch='N' then exit;
  if user.gp<l then begin sendln(crlf+'`LYou don''t have $`P'+i2sc(l)+'`L!!'); exit; end;
  x:=random(3);
  if
    x=0
  then
    begin
      l:=40*user.level; parameter[1]:=i2sc(l);
      user.gp:=user.gp+l;
      sysmsg(1068);
    end
  else
    sysmsg(1069);
end;

procedure r_chalk;
var tch:char;
    tstr:String;
    wrote:boolean;
    fname:String;
label _startchalk;
{}procedure savechalk(s:String);
{}var f:text; t2:string; crap:integer;
{}begin
{}  parameter[1]:='`L'+user.name+'`I:`O';
    while parameter[1,0]<#20 do parameter[1]:=parameter[1]+' ';
    t2:=parameter[1]+s;
{}  if
{}    exist(fname)
{}  then
{}    begin
{}      waitlock(fname);
{}      assign(f,fname);
{}      lock(fname);
{$I-}
{}      append(f); crap:=ioresult;
{}      writeln(f,t2); crap:=ioresult;
{}      flush(f); crap:=ioresult;
{}      close(f); crap:=ioresult;
{}      trimtext(fname,20);
{$I+}
{}      unlock(fname);
{}    end
{}  else
{}    begin
{}      unlock(fname); lock(fname);
{}      assign(f,fname);
{$I-}
{}      rewrite(f); crap:=ioresult;
{}      writeln(f,t2); crap:=ioresult;
{}      flush(f); crap:=ioresult;
{}      close(f); crap:=ioresult;
{$I+}
{}      unlock(fname);
{}    end;
{}end;
begin
  wrote:=false; fname:='CHALKBRD.DAT';
  sysmsg(1070);
_startchalk:
  sysmsg(1076);
  get('rwcq'#13); tch:=upcase(ctmp);
  case tch of
    #13,'Q': begin sysmsg(1073); exit; end;
    'C': begin sendtext('COLORS.TXT'); anykey; end;
    'R': begin
           sysmsg(1071);
           if
             exist(fname)
           then
             begin
               sendln('');
               sendtext(fname);
               sendln('');
               anykey;
             end
           else
             sysmsg(1077);
         end;
    'W': begin
           sysmsg(1072);
           if wrote then begin sysmsg(1079); goto _startchalk; end;
           sysmsg(1074);
           tstr:=getln(60);
           if
             tstr=''
           then
             exit
           else
             begin
               wrote:=true;
               inc(movesleft,2);
               sysmsg(1078);
               savechalk(tstr);
             end;
         end;
  end;
  goto _startchalk;
end;

procedure r_weirdo;
var i:integer;
begin
  i:=random(4)+1;
  parameter[1]:=int2str(keyloc[i]);
  parameter[2]:=g_sysmsg(random(10)+1082);
  parameter[3]:=g_sysmsg(random(10)+1092);
  sysmsg(1081);
  anykey;
end;

procedure randomgoodies;
var x,y,z:integer;
label _randomit;
begin
  newtothisroom:=false;
  updatewhoson;
	{OK, something happened.	Now to decide what.}
_Randomit:
  x:=random(100)+1;
  case x of
		1..5 :	r_mugger;
    8..10:  r_shellgame;  {Weight:3}
    11..13: r_wallet;        {Weight:3}
		16..20: r_hookah;
    21..23,15,6,7: r_laptop;        {Weight:6}
    26..30: r_game;
    31..35: r_mags;
    36,86 : r_foundblink;    {Weight:2}
    14,41..44: r_ex;         {Weight:5}
    45..47: r_ginseng;       {Weight:3}
    51..55: r_chalk;
    56..60: r_condoms;
    61..65: r_towel;
    66..70: r_smoke;
    71..75: r_pulltab;
    76..80: r_sextoy;        {Weight:5}
    81..85: r_defense;       {Weight:5}
    87..100: if config.vkrkey then if not(hasvkrkey) then r_weirdo else goto _randomit;
                   {Weight:19 if user does not have VKR key else none}
  else
    goto _randomit;
  end;

	updatesbar;
end;

begin
end.
