unit miscplay;
{$O+,F+}
{$N+,E+}
interface

var
    rank10:boolean;


Procedure Rankings;
Procedure YourStats;
procedure lookroom;
procedure peekstats;
procedure banner;
procedure userlist(restrict:boolean);
procedure viewdescription(rn:integer);

implementation

uses dos,crt,bbskv,bbskern,engine2,rgoods,toyinfo,miscpl2,miscpl3,miscpl4,miscpl5,sys_msg,bldmaze,nanocore;

procedure viewdescription(rn:integer);
  label _notfound;
  var f:text;
      found:boolean;
      rno:integer;
begin
  send('`K');
  if not exist('MAZEDESC.TXT') then goto _notfound;
  assign(f,'MAZEDESC.TXT');
  reset(f); found:=false;
  repeat
    readln(f,linein);
    parse; rno:=str2int(parses[1]);
    if (rno=rn) then begin found:=true; sendln(restofline); end;
  until(eof(f)) or (found and (rno<>rn));
  close(f);
  if found then exit;
_notfound:
  sendln('`,`NThere''s nothing special about this place.'+crlf);
end;

Procedure Rankings;
{Print User list and their scores}
type rankrec=record
               un:integer;
               us:longint;
             end;
const testcomp=-69;
Var
    rank:array[1..256] of rankrec;
    tags:array[1..256] of integer;
    rtmp:rankrec;
    etmp:comp;
    wtmp:longint;
    vtmp:integer;
    lines:longint;
    i,j,k,l,m:word;
    sorted:boolean;
    xxx:byte;
    r:real;
label _endloop;
begin
  nomore:=FALSE;
  writeuser(user.name,user);
  fillchar(rank,sizeof(rank),#00);
  if maxuser=0 then exit;
  if maxuser>128 then sysmsg(386);
  for i:=1 to 256 do tags[i]:=-1;
  For     {copy relevant user data to tmp array}
    I:=1 to maxuser
  do
    begin
      rank[i].un:=i;
      r:=raisepower(userlog^[i].xp,0.3333)*1000;
      rank[i].us:=trunc(r);
      if userlog^[i].deleted then rank[i].us:=$80000001;
    end;
  xxx:=wherex;
  for i:=1 to maxuser do
    begin
      wtmp:=-1;
      for j:=1 to maxuser do
        if
          rank[j].us<>testcomp
        then
          if
            rank[j].us>wtmp
          then
            begin
              wtmp:=rank[j].us;
              vtmp:=rank[j].un;
            end;
      tags[i]:=vtmp;
      rank[vtmp].us:=testcomp;
    end;

  updatesbar;
  lines:=1;
  sysmsg(387); {rankings header}

  abort:=false;
  j:=0;
  For I:=1 to maxuser do
    begin
      m:=tags[i];
      if rank[i].us=$80000001 then goto _endloop;
      inc(j);
      parameter[1]:=int2str(j);
      parameter[2]:=(userlog^[m].name);
      if userlog^[m].robot then parameter[2]:=mixedcase(parameter[2]);
      parameter[3]:=int2str(rank[m].un);
      parameter[4]:=c2sc(userlog^[m].xp);
      parameter[5]:=int2str(userlog^[m].level);
      parameter[6]:=c2sc(userlog^[m].gp);

      case i of
        1:parameter[8]:='`P`6';
        2,3:parameter[8]:='`7`P';
        4,5,6,7:parameter[8]:='`7`L';
        8,9,10,11,12:parameter[8]:='`7`J';
      else
        parameter[8]:='`7`B';
      end;

      sysmsg(388);
      inc(lines);
      if (rank10) and (lines>10) then begin sysmsg(389); exit; end;
      if abort then begin abort:=false; sysmsg(389); exit; end;
(*      if (lines mod 20)=0 then if not(more) then exit;*)
_endloop:
    end;
  sysmsg(389); {rankings footer}
  anykey;
end;

Procedure YourStats;
{Print out stats}
var s1,s2,s3,s4:string[8];
begin
  updatesbar;
  parameter[1]:=user.name;
  parameter[2]:=mixedcase(user.bbsname);
  if user.orientation=straight then parameter[3]:=g_sysmsg(390); {Str.}
  if (user.orientation=gay) and (user.gender=female) then parameter[3]:=g_sysmsg(391); {Les.}
  if (user.orientation=gay) and (user.gender=male) then parameter[3]:=g_sysmsg(392); {Gay}
  if user.orientation=bi then parameter[3]:=g_sysmsg(393); {bi}
  parameter[4]:=mixedcase(getgen(user.gender,4));
  parameter[5]:=c2sc(user.xp); parameter[6]:=int2str(user.level);
  parameter[7]:=c2sc(nextlevelxp(user.level));
  parameter[8]:=c2sc(user.gp); parameter[9]:=c2sc(user.bankgp);
  parameter[10]:=i2sc(user.hp); parameter[11]:=i2sc(user.maxhp);
  parameter[12]:=i2sc(user.stamina); parameter[13]:=i2sc(user.skill);
  parameter[14]:=i2sc(user.knowledge); parameter[15]:=i2sc(user.talent);
  parameter[16]:=int2str(user.weapon); parameter[17]:=int2str(user.armor);
  parameter[18]:=weaponname(user.weapon); parameter[19]:=armorname(user.armor);
  parameter[20]:=i2sc(user.condoms); parameter[21]:=i2sc(user.coord);
  parameter[22]:=i2sc(user.maxcoord); parameter[23]:=i2sc(user.jwins);
  parameter[24]:=i2sc(user.jlosses);
  parameter[25]:=i2sc(user.stamina+user.skill+user.jwins-user.jlosses);
  sysmsg(394); {Main "Your Stats" Display}

  newsbar;
  sysmsg(395);
  ctmp:=yn;
  if
    ctmp='Y'
  then
    begin
      sendln('');
      for index:=1 to maxspell do
      begin
        parameter[1]:=spellname(index);
        parameter[2]:=int2str(user.spell[index]);
        parameter[3]:=int2str(index);
        sysmsg(396);
      end;
    end;
  sendln('');
  anykey;
end;

procedure lookroom;

procedure dpeople(thisroom:word);
var index:word;
    gotit:boolean;
    hits:word;
    t3,tstr,tstr2:string[90];
begin
  gotit:=false; tstr:=''; tstr2:='';
  index:=0; hits:=0;
  sendln('`,');
  for index:=1 to 255 do
  begin
    if
      (userlog^[index].room=thisroom)
    and
      not(index=thisusernumber)
    then
      begin
        parameter[1]:=int2str(index);
        parameter[2]:=userlog^[index].name;
        t3:=g_sysmsg(397);
        tstr2:=tstr+t3;
        if
          tstr2[0]>chr(85)
        then
          begin
            sendln(tstr);
            tstr:=t3;
          end
        else
          tstr:=tstr+t3;
        gotit:=true;
      end;
  end;
  if gotit then sendln(tstr);
  if
    not(gotit)
  then
    sysmsg(398);
end;

var rlook:word;
    tstr:string[80];
    word1:string;
    index:word;
    using16a:boolean;
begin
  using16a:=using16; using16:=false;
  sysmsg(399);
  get('nsweud'+#13);
  case upcase(ctmp) of
    #13: begin
           sysmsg(400);
           exit;
         end;
    'W': begin
           sysmsg(93);
           if
             room^[user.room].room_west=0
           then
             begin
               sysmsg(401);
               exit;
             end;
           rlook:=room^[user.room].room_west;
         end;
    'N': begin
           sysmsg(90);
           if
             room^[user.room].room_north=0
           then
             begin
               sysmsg(402);
               exit;
             end;
           rlook:=room^[user.room].room_north;
         end;
    'S': begin
           sysmsg(91);
           if
             room^[user.room].room_south=0
           then
             begin
               sysmsg(403);
               exit;
             end;
           rlook:=room^[user.room].room_south;
         end;
    'E': begin
           sysmsg(92);
           if
             room^[user.room].room_east=0
           then
             begin
               sysmsg(404);
               exit;
             end;
           rlook:=room^[user.room].room_east;
         end;
    'U': begin
           sysmsg(94);
           if
             room^[user.room].room_up=0
           then
             begin
               sysmsg(405);
               exit;
             end;
           rlook:=room^[user.room].room_up;
         end;
    'D': begin
           sysmsg(95);
           if
             room^[user.room].room_down=0
           then
             begin
               sysmsg(406);
               exit;
             end;
           rlook:=room^[user.room].room_down;
         end;
  end;
  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;
  if
    ((room^[rlook].attr and $40)=0)
  or
    using16a
  then
    begin
      parameter[1]:=tstr; parameter[2]:=int2str(rlook);
      sysmsg(407);
      with room^[rlook] do
      begin
        if room_north>0 then sysmsg(84);
        if room_south>0 then sysmsg(85);
        if room_east>0 then sysmsg(86);
        if room_west>0 then sysmsg(87);
        if room_up>0 then sysmsg(88);
        if room_down>0 then sysmsg(89);
      end;
      dpeople(rlook);
    end
  else
    sysmsg(408);
  anykey;
end;

procedure peekstats;
var
    amt:longint;
    tch:char;
label _bopeek;
begin
  repeat
    begin
_bopeek:
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      parameter[1]:=int2str(maxuser);
      sysmsg(409);
      tstr:=''; tch:=#00;
      tstr:=getln(35);
      tstr:=upcasestr(tstr);
      if (tstr='X') or (tstr='') or (tstr='Q') then exit;
      if (tstr='?') or (tstr='H') then
                                    begin
                                    sendln('`K');
                                    userlist(false);
                                    sendln('');
                                    goto _bopeek;
                                    end;
      amt:=lookupuser(tstr);
      if (amt=-1) then exit;
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      if
        (amt=0) or (amt>maxuser)
      then
        sysmsg(410)
      else
        if amt>0 then
        begin
          user2:=userlog^[amt];
          parameter[1]:=user2.name;
          parameter[2]:=int2str(user2.level);
          parameter[3]:=i2sc(user2.maxhp);
          parameter[4]:=i2sc(user2.stamina+user2.skill+user2.jwins-user2.jlosses);
          parameter[5]:=weaponname(user2.weapon);
          parameter[6]:=int2str(user2.weapon);
          parameter[7]:=armorname(user2.armor);
          parameter[8]:=int2str(user2.armor);
          sysmsg(411);
        end;
    end;
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  until quitnow or lostcarrier;
end;

procedure banner;
begin
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  sendln('Version...`O'+crlf);
  ansi3d('           Rancho Nevada '+version+'          ');
  ansi3d(' Copyright 1993-1998 Whirlwind Software ');
  sendln(crlf+'`LConceived and Written by Gerald T. Albion');
  sendln(crlf+'`GCheri & Additional code (C) 1992,1993 Allen Walker');
  sendln(crlf+'`LALL RIGHTS RESERVED.');
  sendln(crlf+'`PThis is a work of interactive fiction.  Any similarity between characters');
  sendln('portrayed herein and any person living or deceased is purely coincidental.'+crlf);
  sendln('`BThis information last updated 98/10/17'+crlf);
  sendln('`MMemory Available:`P'+i2sc(memavail)+'   '+'`MFree Stack      :`P'+i2sc(sptr));
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  anykey;
end;

procedure userlist(restrict:boolean);
var
    tstr:string;
    j:longint;
    temp:longint;
    index:word;
    diff:integer;
    modmo:word;
begin
  totallines:=0;
  abort:=false;
  sysmsg(412);
  J := 1; k:=1;
  index:=1;
  repeat
    begin
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      if
        (not(index>maxuser))
      then
        begin
          tmpuser:=userlog^[index];
          temp:=0;
          if user.level>tmpuser.level then temp:=user.level-tmpuser.level;
          if
            (not((tmpuser.bbsname=username) and restrict))
          and
            (not((badbutter(user,tmpuser) and restrict)))
          and
            (not((temp>config.maxdiff) and restrict))
          then
            begin
              parameter[1]:=int2str(k);
              parameter[2]:=tmpuser.name;
              parameter[3]:=int2str(tmpuser.level);
  if tmpuser.orientation=straight then parameter[4]:=g_sysmsg(390); {Str.}
  if (tmpuser.orientation=gay) and (tmpuser.gender=female) then parameter[4]:=g_sysmsg(391); {Les.}
  if (tmpuser.orientation=gay) and (tmpuser.gender=male) then parameter[4]:=g_sysmsg(392); {Gay}
  if tmpuser.orientation=bi then parameter[4]:=g_sysmsg(393); {bi}
              parameter[5]:=getgen(tmpuser.gender,4);
              sysmsg(413);
              if
                spymode
              then
                sendln('`EBBS Name: `M'+tmpuser.bbsname+crlf);
              Inc(J);
            end;
          inc(k);
        end;
    end;
    inc(index);
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  until (index>maxuser) or quitnow or abort or lostcarrier;
  abort:=false;
  sendln('');
  if not lostcarrier then anykey;
end;

begin
end.
