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

interface

var temps2,temps:string;

function weaponprice(x:longint):comp;
function armorprice(x:longint):comp;
procedure buycondoms;
procedure listwprice;
procedure listaprice;
procedure sextoys;
procedure defenses;
procedure slots;

implementation

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

function armorprice(x:longint):comp;
begin
  armorprice:=weaponprice(x);
end;

function weaponprice(x:longint):comp;
var temp1,temp2,scratch:comp;
    s:real;
begin
  if (x=0) then begin weaponprice:=0; exit; end;
  temp1:=x;
  scratch:=(((x-1)*(x-1))/2)+1;
  scratch:=raisepower(scratch,2.2);
  temp2:=scratch*100;
  temp2:=temp2+((x-1)*100);
  s:=room^[user.room].parm; if (s<=0) or (s>2000) then s:=100;
  s:=s/100; temp2:=temp2*s;
  weaponprice:=temp2;
end;

procedure buycondoms;
var qty:longint;
    tstr:string[8];
    cost:comp;
    afford:longint;
    af2:extended;
    machine:boolean;
begin
  machine:=rgoods.usingmachine; rgoods.usingmachine:=false;
  sysmsg(414);
  cost:=user.level*20; if machine then cost:=user.level*50;
  af2:=user.gp/cost; if af2>2000000000 then afford:=2000000000 else afford:=trunc(af2);
  repeat
    begin
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      parameter[1]:=c2sc(cost); parameter[2]:=c2sc(user.gp); parameter[3]:=i2sc(afford);
      sysmsg(415);
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      tstr:=getln(4); qty:=str2int(tstr);
      sendln('');
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      if
        qty<1
      then
        begin
          sysmsg(419);
          exit;
        end;
      if
        qty>afford
      then
        sysmsg(416)
      else
        begin
          user.condoms:=user.condoms+qty;
          user.gp:=user.gp-(cost*qty);
          newsbar;
          parameter[1]:=i2sc(user.condoms); parameter[2]:=c2sc(user.gp);
          parameter[3]:=i2sc(qty);
          sysmsg(417);
          exit;
        end;
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    end;
  until quitnow or lostcarrier;
end;

procedure listwprice;
var inq2:string[4];
    start:integer;
begin
  sysmsg(418);
  inq2:=getln(4);
  sysmsg(420);
  start:=str2int(inq2);
  for index:=start to start+16 do
  begin
    if weaponprice(index)<0 then exit;
    if index>1999 then exit;
    temps2:=int2str(index);
    parameter[1]:=int2str(index);
    parameter[2]:=weaponname(index);
    parameter[3]:=c2sc(weaponprice(index));
    parameter[4]:='`K';
    if
      (weaponprice(index)>user.gp)
    then
      begin
        parameter[4]:='`B';
        if (user.gp+user.bankgp)>=weaponprice(index) then parameter[4]:='`L';
      end;
    sysmsg(421);
  end;
end;

procedure listaprice;
var inq2:string[4];
    start:integer;
begin
  sysmsg(418);
  inq2:=getln(4);
  sendln('`O');
  start:=str2int(inq2);
  for index:=start to start+16 do
  begin
    if armorprice(index)<0 then exit;
    if index>1999 then exit;
    temps2:=int2str(index);
    parameter[1]:=int2str(index);
    parameter[2]:=armorname(index);
    parameter[3]:=c2sc(armorprice(index));
    parameter[4]:='`K';
    if
      (armorprice(index)>user.gp)
    then
      begin
        parameter[4]:='`B';
        if (user.gp+user.bankgp)>=armorprice(index) then parameter[4]:='`L';
      end;
    sysmsg(421);
  end;
end;

procedure sextoys;
var comd,c2:char;
    inq:string[4];
    item:longint;
    weight:real;
begin
  weight:=room^[user.room].parm; if (weight<=0) or (weight>2000) then weight:=100;
  weight:=weight/100;
  sendln('');
  repeat
    begin
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      sysmsg(422);
      get('bsq'#13); comd:=upcase(ctmp);
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      case comd of
        #13,'Q' : begin sysmsg(423); exit; end;
        'S' : begin
                sysmsg(424);
                if
                  user.weapon=9999
                then
                  begin
                    parameter[1]:=weaponname(user.weapon); sysmsg(425);
                    exit;
                  end;
                if
                  user.weapon=0
                then
                  begin
                    sysmsg(426);
                    exit;
                  end;
                parameter[1]:=c2sc((weaponprice(user.weapon)/weight)/2);
                parameter[2]:=weaponname(user.weapon);
                parameter[3]:=int2str(user.weapon);
                sysmsg(427);
                if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                c2:=yn;
                if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                if
                  c2='Y'
                then
                  begin
                    {Parameters carried from sysmsg 427!}
                    sysmsg(428);
                    user.gp:=user.gp+(weaponprice(user.weapon)/weight)/2;
                    user.weapon:=0;
                    updatesbar;
                    exit;
                  end
                else
                  begin
                    sysmsg(429);
                    exit;
                  end;
              end;
        'B' : begin
                sysmsg(430);
                if
                  user.weapon=9999
                then
                  begin
                    parameter[1]:=weaponname(user.weapon); sysmsg(431);
                    exit;
                  end;
                sysmsg(432);
                repeat
                  begin
                    parameter[1]:=c2sc(user.gp); sysmsg(433);
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    inq:=getln(4);
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    if
                      upcase(inq[1])='Q'
                    then
                      begin
                        sysmsg(434);
                        exit;
                      end;
                    if
                      (inq[1]='?')
                    then
                      listwprice
                    else
                      begin
                        item:=str2int(inq);
                        if
                          (item<=0) or (item>=2000)
                        then
                          begin
                            sysmsg(435);
                            exit;
                          end;
                        parameter[1]:=weaponname(item);
                        parameter[2]:=c2sc(weaponprice(item));
                        parameter[3]:=int2str(item);
                        sysmsg(436);
                        if
                          weaponprice(item)>user.gp
                        then
                          begin
                            sysmsg(437);
                            exit;
                          end
                        else
                          begin
                            sysmsg(438);
                            if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                            c2:=yn;
                            if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                            if
                              c2='N'
                            then
                              begin
                              end
                            else
                              begin
                                user.weapon:=item;
                                user.gp:=user.gp-weaponprice(item);
                                updatesbar;
                                sysmsg(439);
                                exit;
                              end;
                          end;
                      end;
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                  end;
                until quitnow or lostcarrier;
              end;
      end; {case}
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    end; {repeat}
  until quitnow or lostcarrier;
end;

procedure defenses;
var comd,c2:char;
    inq:string[4];
    item:longint;
    weight:real;
begin
  weight:=room^[user.room].parm; if (weight<=0) or (weight>2000) then weight:=100;
  weight:=weight/100;
  sendln('');
  repeat
    begin
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      sysmsg(422);
      get('bsq'#13); comd:=upcase(ctmp);
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      case comd of
        #13,'Q' : begin sysmsg(423); exit; end;
        'S' : begin
                sysmsg(424);
                if
                  user.armor=9999
                then
                  begin
                    parameter[1]:=armorname(user.armor); sysmsg(425);
                    exit;
                  end;
                if
                  user.armor=0
                then
                  begin
                    sysmsg(426);
                    exit;
                  end;

                parameter[1]:=c2sc((armorprice(user.armor)/weight)/2);
                parameter[2]:=armorname(user.armor);
                parameter[3]:=int2str(user.armor);
                sysmsg(427);
                if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                c2:=yn;
                if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                if
                  c2='Y'
                then
                  begin
                    {Parameters carried from sysmsg 427!}
                    sysmsg(428);
                    user.gp:=user.gp+((armorprice(user.armor)/weight)/2);
                    user.armor:=0;
                    newsbar;
                    exit;
                  end
                else
                  begin
                    sysmsg(429);
                    exit;
                  end;
              end;
        'B' : begin
                sysmsg(430);
                if
                  user.armor=9999
                then
                  begin
                    parameter[1]:=armorname(user.armor); sysmsg(431);
                    exit;
                  end;
                sysmsg(432);
                repeat
                  begin
                    parameter[1]:=c2sc(user.gp); sysmsg(433);
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    inq:=getln(4);
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    if
                      upcase(inq[1])='Q'
                    then
                      begin
                        sysmsg(434);
                        exit;
                      end;
                    if
                      (inq[1]='?')
                    then
                      listaprice
                    else
                      begin
                        item:=str2int(inq);
                        if
                          (item<=0) or (item>=2000)
                        then
                          begin
                            sysmsg(435);
                            exit;
                          end;

                        parameter[1]:=armorname(item);
                        parameter[2]:=c2sc(armorprice(item));
                        parameter[3]:=int2str(item);
                        sysmsg(436);
                        if
                          armorprice(item)>user.gp
                        then
                          begin
                            sysmsg(437);
                            exit;
                          end
                        else
                          begin
                            sysmsg(438);
                            if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                            c2:=yn;
                            if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                            if
                              c2='N'
                            then
                              begin
                              end
                            else
                              begin
                                user.armor:=item;
                                user.gp:=user.gp-armorprice(item);
                                newsbar;
                                sysmsg(439);
                                exit;
                              end;
                          end;
                      end;
                  end;
                until quitnow or lostcarrier;
              end;
      end; {case}
    end; {repeat}
  until quitnow or lostcarrier;
end;

procedure slotlosemessage;
var crap:integer;
begin
  sysmsg(876);
  if
    not registree
  then
    crap:=random(2)
  else
    crap:=1;
  if
    crap=0
  then
    begin
      crap:=random(3);
      case crap of
        0: begin
             sendln('`OAn indicator on the machine that you didn''t notice before starts flashing.');
             sendln('`B*** `OIt says: `J`6Tell your sysop to register Rancho Nevada today!`7');
           end;
        1: begin
             sendln('`GA plain looking, middle aged woman with a bible approaches you.  You think');
             sendln('`B*** `Gthat she is about to lecture you on gambling, but instead she says:');
             sendln('`B*** `L"Blessed are the righteous for they have registered `PRancho Nevada!`L"');
           end;
        2: begin
             sendln('`LA high-roller looks over your shoulder and says, "`PI bet that machine would');
             sendln('`B*** be looser if the sysop would `Jregister Rancho Nevada!');
           end;
      end; {case}
      exit;
    end;
    crap:=random(11); sysmsg(883+crap);
end;

procedure dreelcode(x:integer);
begin
  case x of
    1: sysmsg(861);
    2: sysmsg(862);
    3: sysmsg(863);
    4: sysmsg(864);
    5: sysmsg(865);
  end;
end;

function dslot:integer; {Integer is win level 1=3 bells 2=3 bars 3=3 cherries 4=4 plums 5=5 lemons}
var reel1,reel2,reel3:integer;
    x:integer;
begin
  x:=random(15);
  case x of 0: reel1:=1; 1,2:reel1:=2; 3,4,5:reel1:=3; 6,7,8,9:reel1:=4; else reel1:=5; end;
  x:=random(15);
  case x of 0: reel2:=1; 1,2:reel2:=2; 3,4,5:reel2:=3; 6,7,8,9:reel2:=4; else reel2:=5; end;
  x:=random(15);
  case x of 0: reel3:=1; 1,2:reel3:=2; 3,4,5:reel3:=3; 6,7,8,9:reel3:=4; else reel3:=5; end;
  dreelcode(reel1);
  delay(750); dreelcode(reel2);
  delay(750); dreelcode(reel3);
  writeln;
  dslot:=0;
  if
    (reel1=reel2) and (reel2=reel3)
  then
    dslot:=reel1;
end;

procedure slots;
var wincode:integer;
    winnings,bet:comp;
    tch:char;
    tstr:string[18];
    crap:integer;
label _playprompt,_betprompt;
begin
  sysmsg(866);
_playprompt:
  if movesleft<=0 then exit;
  if lostcarrier or quitnow then exit;
  sysmsg(867);
  tch:=upcase(getchr);
  case tch of
    'Q': begin sysmsg(869); exit; end;
    #13,'P': sysmsg(868);
  else
    goto _playprompt;
  end;

_betprompt:
  if lostcarrier or quitnow then exit;
  parameter[1]:=c2sc(user.gp); sysmsg(870);
  tstr:=getln(18); val(tstr,bet,crap);
  if (bet=0) or (tstr='') then begin sendln(''); exit; end;
  if
    bet>user.gp
  then
    begin
      sysmsg(871);
      if
        (bet<=(user.gp+user.bankgp))
      then
        sysmsg(872);
      goto _betprompt;
    end;
  if
    bet<0
  then
    begin
      sendln('');
      sendln('`JNice try cheating.  You lose `P5`J moves!');
      dec(movesleft,5);
      exit;
    end;

  user.gp:=user.gp-bet;
  sysmsg(873);
  delay(1000);
  sysmsg(874);
  delay(1000);
  sysmsg(875);
  delay(1000);

  winnings:=0;
  wincode:=dslot;
  case wincode of
    0: slotlosemessage;
    1: begin winnings:=bet*10000; parameter[1]:=c2sc(winnings); sysmsg(877); end;
    2: begin winnings:=bet*1500; parameter[1]:=c2sc(winnings); sysmsg(878); end;
    3: begin winnings:=bet*350; parameter[1]:=c2sc(winnings); sysmsg(879); end;
    4: begin winnings:=bet*150; parameter[1]:=c2sc(winnings); sysmsg(880); end;
    5: begin winnings:=bet*20; parameter[1]:=c2sc(winnings); sysmsg(881); end;
  else
    winnings:=0;
  end;

  user.gp:=user.gp+winnings;
  if random(2)=1 then dec(movesleft);

end;

begin
end.
