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

interface

procedure drinking;
procedure avterm;
procedure jacuzzi;
procedure shower;
procedure terminal;
function  population(roomno:integer):integer;
procedure scatter;
procedure do_safe;
procedure masseuse;

implementation

uses dos,crt,bbskv,bbskern,engine2,rgoods,toyinfo,miscpl5,gelin,
     miscpl3,miscpl2,miscplay,message1,cheri2,ranchlin,sys_msg;

var tstr:string;
    showermode:boolean;

function population(roomno:integer):integer;
var i:integer;
    total:integer;
begin
  total:=0;
  for i:=1 to maxuser do
    if not(userlog^[i].deleted) then if userlog^[i].room=roomno then inc(total);
  population:=total;
end;

procedure scatter;
var i,j:integer;
begin
  if population(user.room)<=8 then exit;
  for i:=1 to maxuser do
    if
      not(i=thisusernumber)
    then
      if
        not(userlog^[i].deleted)
      then
        if
          userlog^[i].room=user.room
        then
          begin
            repeat j:=random(800) until goodroom(j);
            if population(user.room)>8 then userlog^[i].room:=j;
          end;
  userlog^[thisusernumber]:=user;
  writeuserlog;
end;

procedure drinking;
var dt,dt2:longint;
    amt:longint;
    tch:char;
    surprise,done:boolean;
    minushp:longint;
    action:integer;
    tmpxp:longint;
    disease:boolean;
    distemp:longint;
    shots:integer;
    wins,wins2:longint;
    prize:longint;
    rantemp:longint;
    diff:integer;
    s1,s2:longint;
    r1,r2:real;
label _whoprompt;
begin
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  if
    joustsleft<1
  then
    begin
      parameter[1]:=int2str(config.maxjoust);
      sysmsg(475);
      exit;
    end;
  updatesbar;
  dt:=user.skill+user.stamina+user.jwins-user.jlosses;
  shots:=0;
  sendln('');
  done:=false;
  repeat
    begin
_whoprompt:
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      parameter[1]:=int2str(maxuser); sysmsg(476);
      tstr:='';
      amt:=maxuser;
      tstr:=getln(35);
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      if (tstr='') or (tstr='Q') or (tstr='X') then exit;
      if (tstr='H') or (tstr='?') then begin sendln('`K'); userlist(false); sendln('`,'); goto _whoprompt; end;
      amt:=lookupuser(tstr);
      if (amt=-1) then exit;
      if
        (amt=0) or (amt>maxuser)
      then
        sysmsg(477)
      else
        if
          (amt>0)
        and
          (amt<>-1)
        and
          (amt<=maxuser)
        then
          begin
            user2:=userlog^[amt];
            done:=true;
            if
              user.level>user2.level
            then
              begin
                diff:=user.level-user2.level;
                if
                  diff>config.maxdiff
                then
                  begin
                    parameter[1]:=user2.name;
                    sysmsg(478);
                    exit;
                  end;
              end;
            if {User specified himself}
              upcasestr(user.name)=upcasestr(user2.name)
            then
              begin
                sysmsg(479);
                exit;
              end;
          end;
    end;
  until done or quitnow or lostcarrier;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  {Okay, we now know WHO we want to joust... He's in USER2}
  dt2:=user2.skill+user2.stamina+user2.jwins-user2.jlosses;
  updatesbar;
  parameter[1]:=user2.name; parameter[2]:=i2sc(dt2);
  sysmsg(480);
  tch:=yn;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  if
    tch='N'
  then
    begin
      sysmsg(481);
      exit;
    end;
{We have established that we WILL joust this person; decrement available jousts}
  dec(joustsleft);

  parameter[1]:=user2.name;
  sysmsg(482);

  wins:=0; wins2:=0; shots:=0;
  repeat
    updatesbar;
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    sysmsg(483);
    get('qd'#13);
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    ctmp:=upcase(ctmp);
    if
      ctmp='Q'
    then
      begin
        sysmsg(484);
        exit;
      end;
    sysmsg(485);
    inc(shots);
    parameter[1]:=user2.name;
    sysmsg(486);
    delay(750);
    r1:=random*(dt div 2); r2:=random*(dt2 div 2);
    s1:=trunc(r1); s2:=trunc(r2);
    s1:=s1+dt; s2:=s2+dt2;
    if
      (s1>=s2)
    then
      begin
        rantemp:=random(10)+1;
        parameter[1]:=user2.name;
        {the order of these two parameter settings is critical!  #2 depends on #3 so don't re-invert them!}
        parameter[3]:=getgen(user2.gender,2);
        parameter[2]:=g_sysmsg(486+rantemp);
        sysmsg(497);
        inc(wins);
      end
    else
      begin
        rantemp:=random(10)+1;
        parameter[1]:=user2.name;
        parameter[3]:=getgen(user2.gender,2);
        parameter[2]:=g_sysmsg(497+rantemp);
        sysmsg(508);
        inc(wins2);
      end;
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  until (wins=3) or (wins2=3) or quitnow or lostcarrier;
  if
    wins=3
  then
    begin
      updatesbar;
      prize:=(user.level*user.level);
      prize:=prize*60;
      parameter[1]:=i2sc(prize);
      sysmsg(509);
      user.gp:=user.gp+prize;
      user.jwins:=user.jwins+1;
      updatesbar;
      user2.jlosses:=user2.jlosses+1;
      user2.jls:=user2.jls+1;
      if
        ((user.jwins mod 20)=0)
      then
        begin
          parameter[1]:=user.name;
          parameter[2]:=i2sc(user.jwins);
          log(g_sysmsg(510));

          parameter[1]:=i2sc(user.jwins);
          sysmsg(511);
          user.stamina:=user.stamina+5;
          user.skill:=user.skill+5;
          user.knowledge:=user.knowledge+5;
          user.talent:=user.talent+5;
          updatesbar;
        end;
    end
  else
    begin
      tempevent.name:=user2.name;
      sysmsg(512);
      prize:=(user.level*user.level);
      prize:=prize*60;
      user2.gp:=user2.gp+prize;
      user2.jwins:=user2.jwins+1;
      user2.jws:=user2.jws+1;
      user.jlosses:=user.jlosses+1;
      updatesbar;
      if
        ((user2.jwins mod 20)=0)
      then
        begin
          parameter[1]:=user2.name;
          parameter[2]:=i2sc(user2.jwins);
          log(g_sysmsg(513));

          if
            not(user2.robot)
          then
            begin
              parameter[1]:=i2sc(user2.jwins);
              tempevent.txt:=g_sysmsg(514);
              addevent(tempevent);
            end;

          user2.stamina:=user2.stamina+5;
          user2.skill:=user2.skill+5;
          user2.knowledge:=user2.knowledge+5;
          user2.talent:=user2.talent+5;
        end;
    end;
  WriteUser(user2.name,user2);
  writeuser(user.name,user);
  updatesbar;
end;

procedure avterm;
var cost:longint;
    tch:char;
    gotit:boolean;
    points:longint;
begin
  points:=random(3)+4;
  gotit:=false;
  if
    school>=config.maxschool
  then
    begin
      parameter[1]:=int2str(config.maxschool);
      sysmsg(515);
      exit;
    end;
  cost:=(user.level*user.level);
  if user.level>5 then cost:=cost*250 else cost:=cost*100;
  if user.level>40 then cost:=cost*2;
  if user.level>90 then cost:=cost*2;
  parameter[1]:=i2sc(cost);
  sysmsg(516);
  if
    cost>user.gp
  then
    begin
      sysmsg(517);
      exit;
    end;
  sysmsg(518);
  tch:=yn;
  if
    tch='N'
  then
    exit;
  user.gp:=user.gp-cost;
  inc(school);
  sysmsg(519);
  get('1234'#13);
  case ctmp of
    #13: begin
           sysmsg(520);
           dec(school);
           user.gp:=user.gp+cost;
         end;
    '1': begin
           sendln('`N');
           sendtext('AV-ST.ASC');
           parameter[1]:=int2str(points);
           sysmsg(521);
           user.stamina:=user.stamina+points;
         end;
    '2': begin
           sendln('`N');
           sendtext('AV-SK.ASC');
           parameter[1]:=int2str(points);
           sysmsg(522);
           user.skill:=user.skill+points;
         end;
    '3': begin
           sendln('`N');
           sendtext('AV-KN.ASC');
           parameter[1]:=int2str(points);
           sysmsg(523);
           user.knowledge:=user.knowledge+points;
         end;
    '4': begin
           sendln('`N');
           sendtext('AV-TA.ASC');
           parameter[1]:=int2str(points);
           sysmsg(524);
           user.talent:=user.talent+points;
         end;
      end; {case}
    sendln('');
    anykey;
  updatesbar;
end; {procedure avterm}

procedure jacuzzi;
var time1,time2:longint;
    success:byte;
    tmp:byte;
    t2:byte;
    doshower:boolean;
begin
  doshower:=showermode; showermode:=false;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  if
    timesjacuzzi>=config.maxjacuzzi
  then
    begin
      parameter[1]:=int2str(config.maxjacuzzi);
      sysmsg(525);
      exit;
    end
  else
    inc(timesjacuzzi);
  success:=random(100); if doshower then success:=success div 2; {Twice as lucky in shower}
  if doshower then sysmsg(1129) else sysmsg(526);
  time1:=sec70;
  repeat time2:=sec70 until ((time2-time1)>2) or quitnow or lostcarrier; {pause 2 sec}
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  if
    success<config.jacuzziluck
  then
    begin
      if
        user.hp<=0
      then
        begin
          sysmsg(527);
          user.hp:=(user.maxhp div 2)+1;
          writeuser(user.name,user);
          updatesbar;
          exit;
        end;
      if
        user.hp<(user.maxhp div 2)
      then
        begin
          sysmsg(528);
          user.hp:=user.hp+(user.maxhp div 3);
          writeuser(user.name,user);
          updatesbar;
          exit;
        end;
      if
        user.hp=user.maxhp
      then
        begin
          tmp:=random(user.maxhp div 30)+random(3)+1;
          parameter[1]:=getgen(user.gender,5);
          parameter[2]:=i2sc(tmp);
          sysmsg(529);
          user.maxhp:=user.maxhp+tmp;
          writeuser(user.name,user);
          updatesbar;
          exit;
        end;
      t2:=random(4)+1;
      tmp:=random(4)+1;
      if doshower then sysmsg(1134) else sysmsg(530);
      repeat time2:=sec70 until ((time2-time1)>2) or quitnow or lostcarrier; {pause 2 sec}
      case t2 of
        1: begin inc(tmp,2); user.stamina:=user.stamina+tmp; parameter[1]:=i2sc(tmp); sysmsg(531); end;
        2: begin user.skill:=user.skill+tmp; parameter[1]:=i2sc(tmp); sysmsg(532); end;
        3: begin inc(tmp,1); user.knowledge:=user.knowledge+tmp; parameter[1]:=i2sc(tmp); sysmsg(533); end;
        4: begin tmp:=((tmp*3) div 2); user.talent:=user.talent+tmp; parameter[1]:=i2sc(tmp); sysmsg(534); end;
      end;
      if doshower then if random(4)=0 then begin sysmsg(1133); user.hp:=longint((user.hp*10) div 100)+1; end;
      exit;
    end;
  if doshower then sysmsg(1120) else sysmsg(535);
end;

procedure shower;
begin
  showermode:=true;
  jacuzzi;
end;

function descroom(rlook:integer):string;
var tstr,word1:String;
    index:integer;
begin
  tstr:=room^[rlook].description;
  if
    tstr[0]>#0
  then
    repeat
      if tstr[1]=' ' then tstr:=copy(tstr,2,length(tstr)-1);
    until (tstr[1]<>' ') or (tstr[0]=#0);
  word1:=''; index:=1;
  repeat
    word1:=word1+tstr[index];
    inc(index);
  until (index>length(tstr))
     or (tstr[index]=' ');
  word1:=upcasestr(word1);
  if
    (word1='AT')
  or
    (word1='IN')
  or
    (word1='ON')
  then
    begin
      repeat
        tstr:=copy(tstr,2,length(tstr)-1)
      until (tstr[1]=' ') or (tstr[0]=#00);
      repeat
        if tstr[1]=' ' then tstr:=copy(tstr,2,length(tstr)-1);
      until tstr[1]<>' ';
    end;
  descroom:=tstr;
end;

procedure terminal;
var tmp,cost:longint;
    c2,tch:char;
    quitpay:boolean;
    gotit:boolean;
    i:integer;
label _locateprompt;
begin
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  repeat
    begin
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      quitpay:=false; gotit:=false;
      sysmsg(536);
      checkemail;
      get('123q'#13);
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      ctmp:=upcase(ctmp);
      case ctmp of
        #13,
        'Q' : begin
                sysmsg(537);
                exit;
              end;
        '3' : begin
                sysmsg(538);
                peekstats;
                sendln('');
              end;
        '1' : begin
                sysmsg(539);
                userlist(true);
                sendln('');
              end;
        '2' : begin
                tmp:=user.level*25; cost:=tmp;
                parameter[1]:=i2sc(tmp);
                sysmsg(540);
                if
                  user.gp<tmp
                then
                  begin
                    sysmsg(541);
                    exit;
                  end;
                sysmsg(542);
                yndefault:=true;
                c2:=yn;
                if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                c2:=upcase(c2);
                if
                  c2='Y'
                then
                  begin
                    user.gp:=user.gp-tmp;
                    updatesbar;
                    gotit:=false;
                    fillchar(tempevent,sizeof(tempevent),#00);
                    repeat  {until gotit}
                      begin
_locateprompt:
                        sysmsg(543);
                        tstr:=getln(35); tmp:=maxuser;
                        if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                        tstr:=upcasestr(tstr);
                        if (tstr='H') or (tstr='?') then
                          begin
                            sendln('`K');
                            userlist(false);
                            sendln('');
                            goto _locateprompt;
                          end;

                        tmp:=lookupuser(tstr);
                        if tmp=-1 then goto _locateprompt;

                          begin
                            sendln('');
                            tempevent.name:=userlog^[tmp].name;
                            parameter[1]:=user.name;
                            parameter[2]:=i2sc(cost);
                            tempevent.txt:=g_sysmsg(544);
                            if
                              (tmp>0) and (tmp<=maxuser)
                            then
                              begin
                                gotit:=true;
                                if not(tmpuser.robot) then addevent(tempevent);
                                parameter[1]:=userlog^[tmp].name;
                                parameter[2]:=int2str(userlog^[tmp].room);
                                parameter[3]:=descroom(userlog^[tmp].room);
                                sysmsg(545);
                              end
                            else
                              begin
                                sysmsg(546);
                                gotit:=false;
                              end;

                            sendln('');
                          end;
                      end;
                    until gotit or quitnow or lostcarrier;
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                  end; {if c2}
              end; {case of 2}
      end; {case}
    end; {repeat until quitnow}
  until quitnow or lostcarrier;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end; {procedure terminal}

procedure do_safe;
var reward:longint;
begin
  if
    movesleft<=0
  then
    begin
      sendln(crlf+'`KYou don''t have time for this...');
      exit;
    end;
  sendln(crlf+'`NYou try the lock...');
  delay(1800);
  case random(1000) of
    1: begin
         reward:=longint(2500*user.level);
         sendln(crlf+'`KSUCCESS!  `PYOU HAVE OPENED THE SAFE!!!');
         sendln(crlf+'`LYou get $`P'+i2sc(reward)+'`L!!'+crlf);
         user.gp:=user.gp+reward;
         anykey;
       end;
    2..11: begin
         reward:=longint(500*user.level);
         sendln(crlf+'`KSUCCESS!  `PYOU HAVE OPENED THE SAFE!!!');
         sendln(crlf+'`JHowever, it was only yesterday cleared out for weekly deposit.');
         sendln(crlf+'`LYou still get $`P'+i2sc(reward)+'`L!!'+crlf);
         user.gp:=user.gp+reward;
         anykey;
       end;
    12..31: begin
         reward:=longint(250*user.level);
         sendln(crlf+'`KSUCCESS!  `PYOU HAVE OPENED THE SAFE!!!');
         sendln(crlf+'`JHowever, it was just this morning cleared out for weekly deposit.');
         sendln(crlf+'`LYou still get $`P'+i2sc(reward)+'`L!!'+crlf);
         user.gp:=user.gp+reward;
         anykey;
       end;
    32..51: begin
              sendln(crlf+'`JOh, NO!  A burly `Lsecurity guard`J with a `Lshotgun`J shows');
              sendln('up!  He grabs you by the arm and throws you out the back door!  You are');
              sendln('expelled from Rancho Nevada for the day!!!'+crlf);
              user.playstoday:=9999;
              anykey;
              quitnow:=true;
            end;
    52..251: begin
               dec(movesleft);
               sendln(crlf+'`OYou have no luck, and you notice how long this is taking...');
             end;
  else
    begin
      sendln(crlf+'`OYou have no luck.');
    end;
  end;
end;

procedure masseuse;
var ctmp:char; maxallowed,amt:longint; cost,cost1:comp; stmp:string;
    afford:longint; need:longint;
begin
  cost1:=raisepower(user.level,2)*5;
  afford:=trunc(user.gp/cost1);
  need:=user.maxhp-user.hp; if need<0 then need:=0;
  maxallowed:=afford; if maxallowed>need then maxallowed:=need;
  parameter[1]:=c2sc(cost1);
  sysmsg(1114);
  yndefault:=true;
  ctmp:=upcase(yn);
  if (ctmp='N') then begin sysmsg(1116); exit; end;
  sysmsg(1115);
  if need<=0 then begin sysmsg(1124); exit; end;
  parameter[1]:=i2sc(maxallowed);
  sysmsg(1123);
  if (afford<=0) then begin sysmsg(1125); exit; end;
  stmp:=getln(12);
  if
    stmp=''
  then
    begin
      amt:=maxallowed;
      cost:=amt*cost1;
    end
  else
    begin
      amt:=str2int(stmp);
      if amt>afford then begin sysmsg(1126); exit; end;
    end;
  if amt<0 then exit;
  if amt>user.maxhp then exit;
  sysmsg(1117); delay(2000);
  sysmsg(1118+random(5)); delay(2000);
  user.hp:=user.hp+amt;
  user.gp:=user.gp-cost;
  parameter[1]:=i2sc(amt);
  sysmsg(1128);
end;

begin
  showermode:=false;
end.

