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

interface

var whoosh:boolean;

procedure usespecial;
function  spellprice(n:byte):comp;
procedure listsprice;
procedure spells;
procedure sexshoppe;
procedure bank;
procedure handlevd;

implementation

uses dos,crt,bbskv,bbskern,engine2,rgoods,toyinfo,miscpl5,miscpl4,miscpl2,miscplay,sys_msg,gelin;

procedure do_tori;
var tch:char;
		s:String;
begin
	user.tori:=true;
	tch:=upcase(getchr);
	if tch<>'O' then exit;
	tch:=upcase(getchr);
	if tch<>'R' then exit;
	tch:=upcase(getchr);
	if tch<>'I' then exit;
	sysmsg(800); {Tori? What is she?}
	s:=upcasestr(getln(10));
	sendln('');
	if (s='GODDESS') or (s='GODESS') then
		begin
			sysmsg(801);
			inc(config.maxschool,2);
			exit;
		end;
  if (s='SEXY') or (s='GORGEOUS') or (s='BEAUTIFUL') or (s='BABE') or (s='SEXPOT') then
		begin
			sysmsg(802);
			inc(config.maxjacuzzi,3);
			exit;
		end;
	if (s='REDHEAD') then
		begin
			sysmsg(803);
			inc(config.maxjacuzzi,1);
			exit;
		end;
	if (s='SINGER') then
		begin
			sysmsg(804);
			inc(config.maxjacuzzi,1);
			exit;
		end;
	if (s='MUSICIAN') or (s='PIANIST') or (s='ARTIST') then
		begin
			sysmsg(805);
			inc(config.maxjacuzzi,1);
			exit;
		end;
	if (s='WOMAN') or (s='GIRL') or (s='FEMALE') or (s='LADY') then
		begin
			sysmsg(806);
			inc(user.condoms,12);
			exit;
		end;
  if (s='UGLY') or (s='DOG') or (s='PIG') or (s='COW') or
     (s='BITCH') or (s='SLUT') or (s='WHORE') or (s='CUNT') or
     (s='SKANK') or (s='HO') or (s='DUMB') or (s='STUPID')
   then
		begin
      sysmsg(999);
      user.hp:=1;
			exit;
		end;
end;

function greaterof(v1,v2:longint):longint;
begin
  if v1>v2 then greaterof:=v1 else greaterof:=v2;
end;

function consumption(i:byte):longint;
var umc:longint;
begin
  consumption:=0; umc:=user.maxcoord;
	case i of
    1: begin consumption:=greaterof(200,longint(umc div 6)); end;
    2: begin consumption:=greaterof(200,longint(umc div 6)); end;
    3: begin consumption:=greaterof(200,longint(umc div 4)); end;
    4: begin consumption:=greaterof(200,longint(umc div 4)); end;
    5: begin consumption:=greaterof(50,user.level*3); end;
    6: begin consumption:=user.level*3; end;
    7: begin consumption:=greaterof(3400,longint(umc div 3)); end;
    8: begin consumption:=greaterof(7200,longint((umc*3) div 4)); end;
    9: begin consumption:=greaterof(1600,longint((umc div 4)+50)); end;
   10: begin consumption:=greaterof(5000,longint((umc div 3)+100)); end;
   11: begin consumption:=greaterof(200,longint(umc div 8)); end;
   12: begin consumption:=greaterof(3750,longint(umc div 3)); end;
   13: begin consumption:=0; end;
   14: begin consumption:=user.level*5; end;
   15: begin consumption:=user.level*5; end;
   16: begin consumption:=user.level*5; end;
	end;
end;

function canspecial(i:byte):boolean;
var tmp,tmp2:boolean;
		tx:longint;
begin
	tmp:=true; tmp2:=true;
	tx:=consumption(i);
	tmp:=user.coord>=tx;
	tmp2:=user.maxcoord>=tx;
	parameter[1]:=spellname(i);
	parameter[2]:=int2str(i);
	parameter[3]:=i2sc(tx);
	parameter[4]:=i2sc(user.coord);
	parameter[5]:=i2sc(user.maxcoord);
	if
		not(tmp2)
	then
		sysmsg(440)
	else
		if
			not(tmp)
		then
			sysmsg(441);
	canspecial:=tmp;
end;

procedure usespecial;
var stmp,ttmp:string;
		i,j:byte;
		gotit:boolean;
		ltmp:longint;
begin
	gotit:=false;
	repeat
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		parameter[1]:=int2str(maxspell);
		sysmsg(442);
		stmp:=upcasestr(getln(2));
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		gotit:=true;
		if
			stmp='?'
		then
			begin
				sysmsg(443);
				for index:=1 to maxspell do
				begin
					if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
					parameter[1]:=int2str(index);
					if
						spellpriv[index]
					then
						begin
							parameter[2]:=g_sysmsg(444);
							parameter[5]:=g_sysmsg(447);
						end
					else
						begin
							parameter[2]:=g_sysmsg(445);
							parameter[5]:=g_sysmsg(448);
						end;
					parameter[3]:=spellname(index);
					parameter[4]:=int2str(user.spell[index]);

					sysmsg(446);

					gotit:=false;
				end;
				if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			end;
		until gotit or quitnow or lostcarrier;
		if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	if
		stmp='Q'
	then
		begin
			sysmsg(449);
			exit;
		end;
	i:=str2int(stmp);
	if
		(i>maxspell)
	or
		(i<1)
	then
		begin
			sysmsg(450);
			exit;
		end;
	if
		user.spell[i]<=0
	then
		begin
			parameter[1]:=spellname(i);
			sysmsg(451);
			exit;
		end;
	if
		not(spellpriv[i])
	then
		begin
			parameter[1]:=spellname(i);
			sysmsg(452);
			exit;
		end;
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	if
		canspecial(i)
	then
		begin
			parameter[1]:=spellname(i);
			sysmsg(453);
			case i of
				1: begin
						 if
							 user.hp>=user.maxhp
						 then
							 begin
								 sysmsg(810);
								 exit;
							 end;
						 dec(user.spell[1]);
						 user.coord:=user.coord-consumption(i);
						 user.hp:=user.maxhp;
						 parameter[1]:=i2sc(user.hp);
						 sysmsg(811);
					 end;
				2: begin
						 ltmp:=user.level; ltmp:=ltmp*user.level;
						 ltmp:=ltmp+bigrnd(ltmp div 2);
						 user2.hp:=user2.hp-ltmp;
						 dec(user.spell[2]);
						 user.coord:=user.coord-consumption(i);
						 parameter[1]:=i2sc(ltmp);
						 sysmsg(812);
						 giveupturn:=true;
					 end;
				3: begin
						 giveupturn:=true;
						 j:=random(100)+1;
						 dec(user.spell[3]);
						 user.coord:=user.coord-consumption(i);
						 if
							 j<35
						 then
							 begin
								 parameter[1]:=user2.name; parameter[2]:=getgen(user2.gender,3);
								 sysmsg(813);
								 user2.givenvd:=true;
							 end
						 else
							 begin
								 parameter[1]:=mixedcase(getgen(user2.gender,1));
								 sysmsg(814);
							 end;
						 j:=random(100);
						 if
							 j<10
						 then
							 begin
								 sysmsg(815);
								 handlevd;
							 end;
					 end;
				4: begin
						 ltmp:=user2.hp shr 1;
						 user2.hp:=user2.hp-ltmp;
						 dec(user.spell[4]);
						 user.coord:=user.coord-consumption(i);
						 parameter[1]:=i2sc(ltmp);
						 sysmsg(816);
						 giveupturn:=true;
					 end;
				5: begin
             if
               invkr
             then
               begin
                 sysmsg(817);
                 exit;
               end
             else
              begin
                dec(user.spell[5]);
                repeat user.room:=random(800) until goodroom(user.room);
                user.coord:=user.coord-consumption(i);
                parameter[1]:=int2str(user.room);
                sysmsg(818);
              end;
					 end;
				6: begin
						 sysmsg(819);
						 dec(user.spell[6]);
						 user.coord:=user.coord-consumption(i);
					 end;
				7: begin
						 ltmp:=user2.hp*9; ltmp:=ltmp div 10;
						 user2.hp:=user2.hp-ltmp;
						 dec(user.spell[7]);
						 user.coord:=user.coord-consumption(i);
						 parameter[1]:=i2sc(ltmp);
						 sysmsg(820);
						 giveupturn:=true;
					 end;
				8: begin
						 giveupturn:=true;
						 j:=random(100)+1;
						 dec(user.spell[8]);
						 user.coord:=user.coord-consumption(i);
						 if
							 j<80
						 then
							 begin
                 parameter[1]:=user2.name; parameter[2]:=getgen(user2.gender,3);
								 sysmsg(821);
								 user2.givenvd:=true;
							 end
						 else
							 begin
								 parameter[1]:=mixedcase(getgen(user2.gender,1));
								 sysmsg(822);
							 end;
						 j:=random(100);
						 if
							 j<4
						 then
							 begin
                 sysmsg(823);
								 handlevd;
							 end;
					 end;
				9: begin
						 dec(user.spell[9]);
						 user.coord:=user.coord-consumption(i);
						 user.hp:=user.maxhp*2;
						 parameter[1]:=i2sc(user.hp);
						 sysmsg(824);
					 end;
			 10: begin
						 dec(user.spell[10]);
						 user.coord:=user.coord-consumption(i);
						 user.hp:=user.maxhp*5;
						 parameter[1]:=i2sc(user.hp);
						 sysmsg(825);
					 end;
			 11: begin
						 gotit:=false;
						 repeat
							if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
							 sysmsg(826);
							 ttmp:=getln(3);
							 if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
							 if
								 upcase(ttmp[1])='Q'
							 then
								 begin
									 sysmsg(827);
									 exit;
								 end;
							 ltmp:=str2int(ttmp);
							 if
								 (ltmp<1)
							 or
								 (ltmp>255)
							 or
								 (not(goodroom(ltmp)))
							 then
								 sysmsg(828)
							 else
								 begin
									 gotit:=true;
									 parameter[1]:=ttmp;
									 sysmsg(829);
                   saywhoosh;
                   user.room:=ltmp;
									 dec(user.spell[11]);
									 user.coord:=user.coord-consumption(i);
                   updatewhoson;
                   saycame;
								 end;
						 until gotit or quitnow or lostcarrier;
					 end;
			 12: begin
             location:=location+5;
						 parameter[1]:=int2str(location);
						 sysmsg(830);
						 whoosh:=true;
						 dec(user.spell[12]);
						 user.coord:=user.coord-consumption(i);
					 end;
			 13: begin
						 payphone;
					 end;
			 14: begin
						 user.coord:=user.coord-consumption(i);
						 bank;
					 end;
			 15: begin
						 user.coord:=user.coord-consumption(i);
						 terminal;
					 end;
			 16: begin
						 user.coord:=user.coord-consumption(i);
						 using16:=true; lookroom;
					 end;
			end;
			WriteUser(Username,user);
		end;
end;

function spellprice(n:byte):comp;
var tmp:comp;
		ulvl:comp;
begin
	tmp:=0; ulvl:=user.level;
	if (n<1) or (n>maxspell) then begin spellprice:=tmp; exit; end;
	case n of
		1: tmp:=100*ulvl*ulvl;
		2: tmp:=100*ulvl*ulvl;
		3: tmp:=200*ulvl*ulvl*ulvl;
		4: tmp:=300*ulvl*ulvl;
		5: tmp:=400*ulvl*ulvl;
		6: tmp:=900*ulvl*ulvl;
		7: tmp:=1000*ulvl*ulvl;
		8: tmp:=600*ulvl*ulvl*ulvl;
		9: tmp:=1500*ulvl*ulvl;
	 10: tmp:=3500*ulvl*ulvl;
	 11: tmp:=250*ulvl*ulvl;
	 12: tmp:=466*ulvl*ulvl*ulvl;
   13: tmp:=100*ulvl;
   14..15: tmp:=200*ulvl*ulvl;
	 16: tmp:=33*ulvl*ulvl*ulvl;
	end;
	spellprice:=tmp;
end;

procedure listsprice;
var tmp: comp;
begin
	sysmsg(831);
	for index:=1 to maxspell do
		begin
      parameter[1]:=int2str(index); parameter[2]:=c2sc(spellprice(index));
      parameter[3]:=spellname(index);
      tmp:=spellprice(index); parameter[4]:=c2sc(tmp);
      sysmsg(832);
		end;
	sendln('');
	anykey;
end;

procedure spells;
var comd,c2:char;
		inq,inq2:string;
		item:longint;
(*		afford:comp;*)
		afford:longint;
		cost:comp;
		helpon:boolean;
    tch:char;
begin
	sendln('');
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	repeat
		begin
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      sysmsg(833);
			repeat
				begin
					if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
          parameter[1]:=c2sc(user.gp);
          sysmsg(834);
					helpon:=false;
          sysmsg(835);
					inq:=getln(3);
					if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
					if
						upcase(inq[1])='H'
					then
						begin
							helpon:=true;
							sendtext('SPECITEM.ASC');
						end;
					if
            (inq='')
          or
            (upcase(inq[1])='Q')
					then
						begin
              sysmsg(836);
							exit;
						end;
					if
						(inq[1]='?')
					then
						listsprice
					else
						if
							not(helpon)
					 then
						begin
							item:=str2int(inq);
							if
								(item<=0)
							or
								(item>maxspell)
							then
								begin
                  sysmsg(837);
									exit;
								end;
              if
                ((item in [13..16]) and (user.spell[item]<>0))
              then
                begin
                  parameter[1]:=spellname(item);
                  sysmsg(797);
                  exit;
                end;
              parameter[1]:=spellname(item); parameter[2]:=c2sc(spellprice(item));
              sysmsg(838);
							afford:=trunc(user.gp/spellprice(item));
              if
                (item in [1..12])
              then
                begin
                  parameter[1]:=c2sc(afford);
                  sysmsg(839);
                end;
							if
								spellprice(item)>user.gp
							then
								begin
                  sysmsg(840);
									exit;
								end
							else
								begin
                  if
                    (item in [1..12])
                  then
                    begin
                      sysmsg(841);
                      stmp:=getln(4);
                      ltmp:=str2int(stmp);
                    end
                  else
                    begin
                      parameter[1]:=c2sc(spellprice(item));
                      sysmsg(796);
                      yndefault:=yes;
                      tch:=upcase(yn);
                      if tch='N' then exit;
                      ltmp:=1;
                    end;
									cost:=ltmp*spellprice(item);
									if
										(upcase(stmp[0])='Q')
									or
										(ltmp<=0)
									then
										begin
                      sysmsg(842);
											exit;
										end;
									if
										cost>user.gp
									then
										begin
                      sysmsg(843);
											exit;
										end
									else
										begin
											user.spell[item]:=user.spell[item]+ltmp;
											user.gp:=user.gp-cost;
											newsbar;
                      sysmsg(844);
											exit;
										end;
								end;
						end;
				end;
			until quitnow or lostcarrier;
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
		end; {repeat}
	until quitnow or lostcarrier;
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

procedure sexshoppe;
var weight:real;
begin
	repeat
		begin
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			sysmsg(460);
      checkemail;
      get('tcdiqs?'#13);
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			case upcase(ctmp) of
				'T' : if
								user.tori
							then
                sysmsg(845)
							else
								do_tori;
        #13,'Q' : begin sysmsg(461); exit; end;
				'?' : if ansi then sendtext('SEXSHOP.ANS') else sendtext('SEXSHOP.ASC');
				'I' : spells;
				'C' : buycondoms;
				'D' : defenses;
				'S' : sextoys;
			end;
		end;
	until quitnow or lostcarrier;
end;

procedure bank;
var amount:comp; amt,crap:integer;
    tstr:string;
    done:boolean;
label xferwho,_enter;
begin
	repeat
_enter:
		begin
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			sysmsg(462);
      checkemail;
      get('tdqw?'#13);
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			case upcase(ctmp) of
        #13,'Q' : begin sysmsg(463); exit; end;
        'T' : begin
                sysmsg(900);
              done:=false;
              repeat
                begin
xferwho:
                  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                  parameter[1]:=int2str(maxuser);
                  sysmsg(901);
                  tstr:=''; amt:=maxuser;
                  tstr:=getln(35);
                  tstr:=upcasestr(tstr);
                  if (tstr='?') or (tstr='H') then begin sendln('`K'); userlist(false); sendln('`,'); goto xferwho; 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;

              parameter[1]:=c2sc(user.bankgp);
              sysmsg(902);
              tstr:=getln(32);
              val(tstr,amount,crap);
              if (amount<0) then goto _enter;
              if
                (amount>user.bankgp)
              then
                begin
                  sysmsg(903);
                  if
                    (amount<(user.bankgp+user.gp))
                  then
                    sysmsg(904);
                  goto _enter;
                end;

              if
                exist('USER-'+int2str(amt)+'.ON')
              then    {Other user is online}
                begin
                  readuserlog;
                  user.bankgp:=user.bankgp-amount;
                  writeuserlog;
                  parameter[1]:=userlog^[amt].name; parameter[2]:=getgen(userlog^[amt].gender,3);
                  sysmsg(906);
                  tonum:=amt; tousername:=userlog^[amt].name;
                  fromnum:=thisusernumber; fromusername:=user.name;
                  parameter[1]:=user.name; parameter[2]:=c2sc(amount); parameter[3]:=c2s(amount);
                  sysmsg2message(907);
                end
              else    {Not online, write directly to userfile}
                begin
                  readuserlog;
                  userlog^[amt].bankgp:=userlog^[amt].bankgp+amount;
                  user.bankgp:=user.bankgp-amount;
                  userlog^[thisusernumber]:=user;
                  tonum:=amt; tousername:=userlog^[amt].name;
                  fromnum:=thisusernumber; fromusername:=user.name;
                  parameter[1]:=user.name; parameter[2]:=c2sc(amount);
                  sysmsg2message(908);
                  writeuserlog;
                end;
                parameter[1]:=c2sc(amount);
                parameter[2]:=userlog^[amt].name;
                sysmsg(905);
              end;
				'W' : begin
								parameter[1]:=c2sc(user.bankgp);
								sysmsg(464);
								if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                tstr:=getln(32);
								if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                val(tstr,amount,crap);
								if tstr='' then nothing;
								if
									amount<0
								then
									begin
										sysmsg(465);
										exit;
									end;
								if
									amount>user.bankgp
								then
									sysmsg(466)
								else
									begin
										if
											tstr=''
										then
											begin
												user.gp:=user.gp+user.bankgp;
												user.bankgp:=0;
											end
										else
											begin
												user.gp:=user.gp+amount;
												user.bankgp:=user.bankgp-amount;
											end;

										parameter[1]:=c2sc(user.gp);
										parameter[2]:=c2sc(user.bankgp);
										sysmsg(467);
										newsbar;
										exit;
									end;
							end;
				'D' : begin
								parameter[1]:=c2sc(user.gp);
								sysmsg(468);
								if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                tstr:=getln(32);
								if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                val(tstr,amount,crap);
								if tstr='' then nothing;
								if
									amount<0
								then
									begin
										sysmsg(465);
										exit;
									end;
								if
									amount>user.gp
								then
									sysmsg(469)
								else
									begin
										if
											tstr=''
										then
											begin
												user.bankgp:=user.bankgp+user.gp;
												user.gp:=0;
											end
										else
											begin
												user.gp:=user.gp-amount;
												user.bankgp:=user.bankgp+amount;
											end;

										parameter[1]:=c2sc(user.gp);
										parameter[2]:=c2sc(user.bankgp);
										sysmsg(467);
										newsbar;


										exit;
									end;
							end;
			end;
		end;
	until quitnow or lostcarrier;
end;

procedure handlevd;
begin
	if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
	if
		user.spell[6]>0
	then
		begin
			sysmsg(470);
      yndefault:=yes;
			ctmp:=yn;
			if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
			if
				ctmp='Y'
			then
				begin
					sysmsg(471);
					dec(user.spell[6]);
					inc(user.playstoday);
					user.givenvd:=false;
					exit;
				end;
		end;
	sysmsg(472);
	user.playstoday:=65535;
	if (not(invkr)) and (not(pregame)) then WriteUser(user2.name,user2);
	writeuser(user.name,user);
	quitnow:=true;
end;

begin
	whoosh:=false;
end.
