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

uses rgoods,toyinfo;

procedure edituser(prm:word);
procedure default(var tmpuser:userrec);
procedure fryuser(var u:userrec);
function  firstfree:integer; {Returns user number of first deleted userrec, -1 if none, -2 if none available}

implementation

uses dos,crt,bbskv,bbskern,engine2,trade;

type scdat2=array[1..3840] of char;

var user:userrec;
    tstr:string;
    tmp:longint;
    currentuser:word;
    quit:boolean;
    screen:scdat2 absolute $b800:0000;

function firstfree:integer; {Returns user number of first deleted userrec, -1 if none, -2 if none available}
var i:integer;
    found:boolean;
begin
  found:=false; firstfree:=-1;
  for i:=1 to maxuser do if userlog^[i].deleted then begin firstfree:=i; exit; end;
  firstfree:=-1;
  if maxuser>=255 then firstfree:=-2;
end;

procedure paints;
const fname='EDITSCRN.BIN';
var f:file of scdat2;
begin
  assign(f,fname);
  reset(f);
  read(f,screen);
  close(f);
end;

function scomp(s1,s2:string):boolean; {Returns true if S1 is part of S2}
var i,j,k:byte;
    tmp:boolean;
begin
  tmp:=false;
  j:=length(s1); k:=length(s2);
  if j>k then begin scomp:=false; exit; end;
  s1:=upcasestr(s1);
  s2:=upcasestr(s2);
  if j=k then begin scomp:=(s1=s2); exit; end;
  for i:=1 to (k-j) do
    if s1=copy(s2,i,j) then tmp:=true;
  scomp:=tmp;
end;

procedure getu(var u:userrec; x:word);
var fs:longint;
begin
  u:=userlog^[x];
  if x>maxuser then default(u);
end;

procedure updu(var u:userrec; x:word);
var fs:longint;
begin
  if (maxuser=0) or (x>maxuser) then exit;
  u.version:=ver_num;
  u.ident:=game_ident;
  userlog^[x]:=u;
end;

procedure addu(u:userrec);
begin
  u.version:=ver_num;
  u.ident:=game_ident;
  userlog^[currentuser]:=u;
end;

procedure nuku(x:word);
var index:word;
begin
  if x>maxuser then exit;
  fryuser(userlog^[x]);
{  if x=maxuser then begin dec(maxuser); exit; end;
  for index:=x to maxuser-1 do
    userlog^[index]:=userlog^[index+1];
  dec(maxuser);}
end;

procedure updatescreen;
var tstr:string[32];
    tmp:longint;
begin
  window(1,1,80,25);
  tstr:='';
  tmp:=(user.lastplayed);
  tstr:=tstr+convertdate(tmp,2)+'/'
            +convertdate(tmp,3)+'/'
            +convertdate(tmp,7);
  paints;
  textattr:=lightgray; gotoxy(1,1); write(' ');
  gotoxy(1,2); send('`M User #`O'+int2str(currentuser)+'`M of`O '+int2str(maxuser));
  gotoxy(1,3); send('`M Last Played: `O'+tstr);

  textattr:=16*lightgray;
  gotoxy(18,5); write(user.bbsname);
  gotoxy(18,6); w(user.name);
  textattr:=16*lightgray;
  gotoxy(18,7); w('#'+int2str(user.weapon)+' '+weaponname(user.weapon));
  textattr:=16*lightgray;
  gotoxy(18,8); w('#'+int2str(user.armor)+' '+armorname(user.armor));
  textattr:=16*lightgray;
  gotoxy(18,9); write(user.playstoday);
  gotoxy(18,10); write(user.playstotal);
  gotoxy(18,11); write(c2sa(user.gp));
  gotoxy(18,12); write(c2sa(user.bankgp));
  gotoxy(18,13); write(user.condoms);
  gotoxy(18,14); write(user.hp);
  gotoxy(18,15); write(user.maxhp);
  gotoxy(18,16); write(user.jwins);
  gotoxy(18,17); write(user.jlosses);

  gotoxy(18,18); write(user.room);
  gotoxy(57,10); write(c2sa(user.xp));
  gotoxy(57,11); write(user.level);
  gotoxy(57,12); write(user.stamina);
  gotoxy(57,13); write(user.skill);
  gotoxy(57,14); write(user.knowledge);
  gotoxy(57,18); write(user.robotfactor);
  gotoxy(57,15); write(user.talent);
  gotoxy(57,16); write(user.coord);
  gotoxy(57,17); write(user.maxcoord);

  textattr:=lightcyan;
  gotoxy(16,20); if user.robot then write('Yes') else write('No');
  gotoxy(41,20); if user.givenvd then write('Yes') else write('No');
  gotoxy(67,20); if user.recovering then write('Yes') else write('No');

  gotoxy(16,21); write(mixedcase(getgen(user.gender,4)));
  gotoxy(38,21);
  case user.orientation of
    straight: write('Straight');
    gay: write('Gay');
    bi: write('Bisexual');
  end;
  gotoxy(61,21);
  write(user.attackmode,' ('+getamode(user.attackmode)+')');
end;

procedure default(var tmpuser:userrec);
begin

  fillchar(tmpuser,sizeof(tmpuser),#00);
  tmpuser.deleted:=false;
  tmpuser.lastplayed:=ds1970;
  tmpuser.robotfactor:=random(128);
  tmp:=random(100); if tmp<10 then inc(tmpuser.robotfactor,127);

  tmpuser.version:=ver_num;
  tmpuser.ident:=game_ident;

  tmpuser.recovering:=false;
  tmpuser.gender:=female;
  tmpuser.orientation:=bi;
  TmpUser.BBSName := 'NO NAME '+int2str(secondstoday)+int2str(random(1000));

  TmpUser.Name := 'Newly Created Player';
  tmpuser.playstotal:=0;
  tmpuser.playstoday:=0;
  tmpuser.level:=1;
  tmpuser.xp:=100;
  tmpuser.condoms:=5;
  tmpuser.weapon:=1;
  tmpuser.armor:=1;
  tmpuser.gp:=250;
  tmpuser.bankgp:=500;
  tmpuser.hp:=10;
  tmpuser.maxhp:=10;
  tmpuser.coord:=10;
  tmpuser.maxcoord:=10;
  tmpuser.stamina:=10;
  tmpuser.skill:=10;
  tmpuser.knowledge:=10;
  tmpuser.talent:=10;
  tmpuser.jwins:=0;
  tmpuser.jlosses:=0;
  tmpuser.room:=config.startroom;
end;

procedure fryuser(var u:userrec);
begin
  default(u);
  u.deleted:=true;
  u.name:='Deleted User Record';
  u.robot:=false;
  u.xp:=0;
end;

procedure randuser(var tmpuser:userrec);
var t:integer;
begin

  fillchar(tmpuser,sizeof(tmpuser),#00);
  tmpuser.lastplayed:=ds1970;
  tmpuser.deleted:=false;
  tmpuser.robotfactor:=random(128);
  tmp:=random(100); if tmp<10 then inc(tmpuser.robotfactor,127);

  tmpuser.version:=ver_num;
  tmpuser.ident:=game_ident;

  tmpuser.recovering:=false;
  tmpuser.gender:=female;
  tmpuser.orientation:=bi;
  TmpUser.BBSName := 'NO NAME '+int2str(secondstoday)+int2str(random(1000));

  TmpUser.Name := 'Newly Created Player';
  tmpuser.playstotal:=0;
  tmpuser.playstoday:=0;
  tmpuser.level:=1;
  tmpuser.xp:=100;
  tmpuser.condoms:=5;
  tmpuser.weapon:=1;
  tmpuser.armor:=1;
  tmpuser.gp:=250;
  tmpuser.bankgp:=500;
  tmpuser.hp:=10;
  tmpuser.maxhp:=10;
  tmpuser.coord:=10;
  tmpuser.maxcoord:=10;
  tmpuser.stamina:=10;
  tmpuser.skill:=10;
  tmpuser.knowledge:=10;
  tmpuser.talent:=10;
  tmpuser.jwins:=0;
  tmpuser.jlosses:=0;
  tmpuser.room:=config.startroom;
  case config.robotpreference of
    0: tmpuser.orientation:=bi;
    1: begin
         t:=random(3);
         if t=0 then tmpuser.orientation:=bi;
         if t=1 then tmpuser.orientation:=straight;
         if t=2 then tmpuser.orientation:=gay;
       end;
    2: tmpuser.orientation:=straight;
    3: tmpuser.orientation:=gay;
  end;
  case config.robotgender of
    0: tmpuser.gender:=female;
    1: tmpuser.gender:=male;
    2: begin
         t:=random(2);
         if t=0 then tmpuser.gender:=female;
         if t=1 then tmpuser.gender:=male;
       end;
  end;
  tmpuser.name:=synthname(tmpuser.gender);
  tmpuser.robot:=true;
end;

procedure options;
var tstr,tstr2,tstr3:string[80];
    tch,tch2,tch3:char;
    tmp:word;
    tmp2:longint;
    tmp3:byte;
    txet:comp;
    shit:integer;
    found:boolean;
begin
  updatescreen;
  repeat nothing until keypressed;
  tch:=readkey; tch:=upcase(tch);
    case tch of
      #0: begin
            tch2:=readkey;
            case tch2 of
              #71 : begin {Home}
                      currentuser:=1;
                      getu(user,currentuser);
                      updatescreen;
                    end;
              #79 : begin {End}
                      currentuser:=maxuser;
                      getu(user,currentuser);
                      updatescreen;
                    end;
              #82 : begin
                      if
                        maxuser<config.maxuser
                      then
                        begin
                          if
                            (firstfree<>-2)
                          then
                            begin
                              shit:=firstfree;
                              if (shit=-1) then inc(maxuser);
                              randuser(user);
                              if (shit=-1) then currentuser:=maxuser else currentuser:=shit;
                              addu(user);
                              getu(user,currentuser);
                              updatescreen;
                            end;
                        end;
                    end;
              #83 : begin
                      gotoxy(1,1); textattr:=lightred;
                      write('Fry this turkey??? ');
                      tch3:='A';
                      tch3:=yn; tch3:=upcase(tch3);
                      delay(200);
                      if
                        tch3='N'
                      then
                        exit;
                      if
                        maxuser>0
                      then
                        begin
                          nuku(currentuser);
                          if currentuser>maxuser then dec(currentuser);
                          getu(user,currentuser);
                          updatescreen;
                        end;
                      tch:=' ';
                    end;
              #77 : begin
                      inc(currentuser);
                      if currentuser>maxuser then currentuser:=1;
                      getu(user,currentuser);
                    end;
              #75 : begin
                      dec(currentuser);
                      if currentuser=0 then currentuser:=maxuser;
                      getu(user,currentuser);
                    end;
              #62 : begin {F4 - Gender}
                      if
                        user.gender=female
                     then
                        user.gender:=male
                      else
                        user.gender:=female;
                    end;
              #63 : begin {F5 - Preference}
                      if
                        user.orientation=straight
                      then
                        user.orientation:=gay
                      else
                        if
                          user.orientation=gay
                        then
                          user.orientation:=bi
                        else
                          if
                            user.orientation=bi
                          then
                            user.orientation:=straight;
                    end;
              #59 : user.robot:=not(user.robot);
              #61 : user.recovering:=not(user.recovering);
              #60 : user.givenvd:=not(user.givenvd);
              #64 : begin
                      inc(user.attackmode);
                      user.attackmode:=user.attackmode mod 7;
                    end;
              #31 : if
                      maxuser>0
                    then
                      begin {Alt-S Search}
                        gotoxy(1,1); textattr:=lightred; write('Search for: ');
                        tstr3:=upcasestr(getln(35));
                        found:=false;
                        tmp:=1;
                        repeat
                          tstr:=upcasestr(userlog^[tmp].name);
                          tstr2:=upcasestr(userlog^[tmp].bbsname);
                          if
                            scomp(tstr3,tstr)
                          or
                            scomp(tstr3,tstr2)
                          then
                            found:=true
                          else
                            inc(tmp);
                        until (tmp>maxuser) or found;
                        if
                          found
                        then
                          begin
                            updu(user,currentuser);
                            currentuser:=tmp;
                            getu(user,currentuser);
                          end
                        else
                          begin
                            gotoxy(1,1);
                            send('`L`6Not Found!  `O');
                            ansi3dn(' Hit Any Key ');
                            repeat until keypressed;
                            tch3:=readkey;
                            gotoxy(1,1);
                            for index:=1 to 24 do write(' ');
                          end;
                      end;
            end; {case tch2}
          end; {case tch of #0}
      #27,'Q' : begin
              quit:=true;
              updu(user,currentuser);
              exit;
            end;
         '1':begin
               window(18,5,18+35,5); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,5);
               tstr:=getln(35);
               tstr:=upcasestr(tstr);
               if tstr[0]>#00 then user.bbsname:=tstr;
               updatescreen;
             end;
         '2':begin
               window(18,6,18+35,6); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,6);
               tstr:=getln(35);
               if tstr[0]>#00 then user.name:=tstr;
               updatescreen;
             end;
         '6':begin
               window(18,10,18+5,10); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,10);
               tstr:=getln(5);
               if tstr[0]>#00 then user.playstotal:=str2int(tstr);
               updatescreen;
             end;
         '5':begin
               window(18,9,18+5,9); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,9);
               tstr:=getln(5);
               if tstr[0]>#00 then user.playstoday:=str2int(tstr);
               updatescreen;
             end;
         'F':begin
               window(57,10,57+18,10); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,10);
               tstr:=getln(18);
               if tstr[0]>#00 then val(tstr,user.xp,shit);
               updatescreen;
             end;
         'G':begin
               window(57,11,57+3,11); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,11);
               tstr:=getln(3);
               if tstr[0]>#00 then user.level:=str2int(tstr);
               updatescreen;
             end;
         '3':begin
               window(18,7,18+45,7); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,7);
               tstr:=getln(4);
               if tstr[0]>#00 then user.weapon:=str2int(tstr);
               updatescreen;
             end;
         '4':begin
               window(18,8,18+45,8); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,8);
               tstr:=getln(4);
               if tstr[0]>#00 then user.armor:=str2int(tstr);
               updatescreen;
             end;
         '7':begin
               window(18,11,18+18,11); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,11);
               tstr:=getln(18);
               if
                 tstr[0]>#00
               then
                 begin
                   val(tstr,txet,shit);
                   user.gp:=txet;
                 end;
               updatescreen;
             end;
         '8':begin
               window(18,12,18+18,12); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,12);
               tstr:=getln(18);
               if tstr[0]>#00 then val(tstr,user.bankgp,shit);
               updatescreen;
             end;
         '9':begin
               window(18,13,18+5,13); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,13);
               tstr:=getln(5);
               if tstr[0]>#00 then user.condoms:=str2int(tstr);
               updatescreen;
             end;
         'A':begin
               window(18,14,18+12,14); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,14);
               tstr:=getln(12);
               if tstr[0]>#00 then user.hp:=str2int(tstr);
               updatescreen;
             end;
         'B':begin
               window(18,15,18+12,15); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,15);
               tstr:=getln(12);
               if tstr[0]>#00 then user.maxhp:=str2int(tstr);
               updatescreen;
             end;
         'H':begin
               window(57,12,57+12,12); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,12);
               tstr:=getln(12);
               if tstr[0]>#00 then user.stamina:=str2int(tstr);
               updatescreen;
             end;
         'I':begin
               window(57,13,57+12,13); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,13);
               tstr:=getln(12);
               if tstr[0]>#00 then user.skill:=str2int(tstr);
               updatescreen;
             end;
         'J':begin
               window(57,14,57+12,14); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,14);
               tstr:=getln(12);
               if tstr[0]>#00 then user.knowledge:=str2int(tstr);
               updatescreen;
             end;
         'K':begin
               window(57,15,57+12,15); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,15);
               tstr:=getln(12);
               if tstr[0]>#00 then user.talent:=str2int(tstr);
               updatescreen;
             end;
         'L':begin
               window(57,16,57+12,16); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,16);
               tstr:=getln(12);
               if tstr[0]>#00 then user.coord:=str2int(tstr);
               updatescreen;
             end;
         'M':begin
               window(57,17,57+12,17); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,17);
               tstr:=getln(12);
               if tstr[0]>#00 then user.maxcoord:=str2int(tstr);
               updatescreen;
             end;


         'C':begin
               window(18,16,18+5,16); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,16);
               tstr:=getln(5);
               if tstr[0]>#00 then user.jwins:=str2int(tstr);
               updatescreen;
             end;
         'D':begin
               window(18,17,18+5,17); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,17);
               tstr:=getln(5);
               if tstr[0]>#00 then user.jlosses:=str2int(tstr);
               updatescreen;
             end;
         'E':begin
               window(18,18,18+3,18); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(18,18);
               tstr:=getln(3);
               if tstr[0]>#00 then user.room:=str2int(tstr);
               updatescreen;
             end;
         'N':begin
               window(57,18,57+3,18); textattr:=16*red+yellow; clrscr;
               window(1,1,80,25); gotoxy(57,18);
               tstr:=getln(3);
               tmp3:=str2int(tstr) mod 256;
               if tstr[0]>#00 then user.robotfactor:=tmp3;
               updatescreen;
             end;
        end; {case}
        updu(user,currentuser);
end;

procedure edituser(prm:word);
var uf:file of userrec;
    tl:boolean;
begin
  tl:=localmode;
  default(user);
  currentuser:=prm;
  quit:=false;
  getu(user,currentuser);
  repeat
    options;
  until quit;
  textattr:=white;
  clrscr;
  if not editmode then titlebar;
  localmode:=tl;
  writeuser(user.name,user);
  writeuserlog;
end;

begin
end.

