program tedit;

type
  str=string[160];
  string1=string[66];

const
  currentfile='tradewar\TWDATA.DAT';
  item:array[1..3] of str=('Ore.......','Organics..','Equipment.');
  b:array[1..3] of integer=(10,20,35);

type
  users=record
    name                   :string[41];
    realname               :string[41];
    fb,fc,fd,fe,ff,fg      :integer;
    fh,fi,fj,fk,fl,fr,fp   :integer;
    fm,fo,fq,ft,fv         :integer;
    trophypts              :real;
  end;

  small_message_record=record
     message:str;
     destin:integer;
  end;


var
    smallmsg                                   :file of small_message_record;
    pnn                                        :string[41];
    year,a,month,day,go,playernumber,
    pd,s2,st,g2,prr                            :integer;
    ay,tt,lp,ls,lt1,ll1                        :integer;
    userf                                      :file of users;
    userr,usert                                :users;
    e                                          :array[1..6] of integer;
    m1,n,pub,c1                                :array[0..3] of real;
    sectors                                    :array[0..200,0..1] of integer;
    srr                                        :array[0..3,0..1] of real;
    g                                          :array[0..9,0..1]   of integer;
    ended,done                                 :boolean;
    aim,thisline                               :str;
    msger                                      :text;



function addblank(b:str;l:integer): str;
begin
  while length(b)<l do b:=' '+b;
  addblank:=b;
end;

function tch(i:string1):string1;
begin
  if length(i)>2 then i:=copy(i,length(i)-1,2)
  else
    if length(i)=1 then i:='0'+i;
  tch:=i;
end;

function value(i:str):integer;
var n,n1:integer;
begin
  val(i,n,n1);
  if n1<>0 then begin
    i:=copy(i,1,n1-1);
    val(i,n,n1)
  end;
  value:=n;
  if i='' then value:=0;
end;

function time:string1;
var reg:record
          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
        end;
    h,m,s:string[4];
begin
  reg.ax:=$2c00;
  intr($21,reg);
  str(reg.cx shr 8,h);
  str(reg.cx mod 256,m);
  str(reg.dx shr 8,s);
  time:=tch(h)+':'+tch(m)+':'+tch(s);
end;

procedure readch(var answer:str);
var
    i : integer;
begin
    readln(answer);
    for i := 1 to length(answer) do
      answer[i] := upcase(answer[i]);
end;

function date:str;
var reg:record
          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
        end;
    m,d,y:string[4];
begin
  reg.ax:=$2a00;
  msdos(reg);
  str(reg.cx,y);
  str(reg.dx mod 256,d);
  str(reg.dx shr 8,m);
  date:=tch(m)+'/'+tch(d)+'/'+tch(y);
end;



function cstr(i:integer):str;
var c:str;
begin
  str(i,c);
  cstr:=c;
end;

function mln(i:str; l:integer):str;
begin
  while length(i)<l do i:=i+' ';
  mln:=i;
end;

function cstrr(rl:real; base:integer):str;
var c1,c2,c3:integer;
    i:str;
    r1,r2:real;
begin
  i:='';
  if rl=0.0 then cstrr:='0'
  else begin
    if rl<0.0 then begin
      i:='-';
      rl:=-rl;
    end;
    r1:=ln(rl)/ln(1.0*base);
    r2:=exp(ln(1.0*base)*(trunc(r1)));
    while (r2>0.999) do begin
      c1:=trunc(rl/r2);
      i:=i+copy('0123456789ABCDEF',c1+1,1);
      rl:=rl-c1*r2;
      r2:=r2/(1.0*base);
    end;
    cstrr:=i;
  end;
end;


function mn(i,l:integer):str;
begin
  mn:=mln(cstr(i),l);
end;

function oks(n:integer):string1;
begin
  if n=1 then oks:='' else oks:='s';
end;


function sgn(i:integer): integer;
begin
  if i>0
    then
      sgn:=1
    else
      if i<0
        then
          sgn:=-1
        else
          sgn:=0;
end;

procedure ynq(i:str);
begin
  textcolor(2);
  write(i);
end;


function inkey:char;
var c:char;
begin
  c:=chr(0);
  inkey:=chr(0);
  if keypressed then begin
    read(kbd,c);
    if c=chr(27) then
      if keypressed then begin
        read(kbd,c);
        if c=#68 then c:=#1
        else c:=#0;
      end;
    inkey:=c;
  end;
end;



function yn:boolean;
var c:char;
begin
    textcolor(3);
    repeat
      c:=inkey;
      c:=upcase(c);
    until (c='Y') or (c='N') or (c=chr(13));
    if c='Y' then begin
      writeln('Yes'); yn:=true;
    end else begin
      writeln('No'); yn:=false;
    end;
end;


procedure readin(i:integer;var user:users);
begin
  seek(userf,i);
  read(userf,user);
end;

procedure writeout(i:integer;user:users);
begin
  seek(userf,i);
  write(userf,user);
end;


procedure getint(var i:integer);
var s:string[5];
begin
  readln(s);  {input(s,5);}
  if s<>'' then i:=value(s);
end;






procedure getdate;
var a,code:integer;
    datea:str;


begin
  datea:=date;
  val(copy(datea,7,4),year,code);
  val(copy(datea,1,2),month,code);
  val(copy(datea,4,2),day,code);
  if (year/4=int(year/4)) and (month>2) then day:=day+1;
  case month of
  2:day:=day+31;
  3:day:=day+59;
  4:day:=day+90;
  5:day:=day+120;
  6:day:=day+151;
  7:day:=day+181;
  8:day:=day+212;
  9:day:=day+243;
  10:day:=day+273;
  11:day:=day+304;
  12:day:=day+334;
  end; {case}
  if year<ay then year:=year+100;
  if year<>ay then
    for a:=ay to year-1 do begin
      day:=day+365;
      if a/4=int(a/4) then day:=day+1;
    end;
end;

procedure removeship(p:integer);
var r,b:integer;
    done:boolean;
begin
  r:=usert.ff;
  if a<>0 then begin
    readin(lp+r,userr);
    a:=userr.fi;
    if a=p then begin
      readin(a,userr);
      b:=userr.fo;
      readin(lp+r,userr);
      userr.fi:=b;
      writeout(lp+r,userr);
    end else begin
      done:=false;
      readin(a,userr);
      repeat
        if userr.fo=p then begin
          b:=a;
          done:=true;
        end;
        a:=userr.fo;
        readin(a,userr);
      until done;
      a:=userr.fo;
      readin(b,userr);
      userr.fo:=a;
      writeout(b,userr);
    end;
  end;
end;

procedure rsm;
var sr:small_message_record;
    i:integer;
begin
  {$I-} reset(smallmsg); {$I+}
  if ioresult=0 then begin
    i:=0;
    while (i<=filesize(smallmsg)-1) do begin
      seek(smallmsg,i);
      read(smallmsg,sr);
      if sr.destin=playernumber then begin
        writeln(sr.message);
        sr.destin:=-1;
        seek(smallmsg,i); write(smallmsg,sr);
      end;
      i:=i+1;
    end;
    close(smallmsg);
  end else writeln('Error opening Trade Wars small message file.');
end;


procedure delete(p: integer);
var l:integer;
begin
  writeln;
  writeln('Deleting '+usert.name+'...');
  removeship(p);
  usert.realname:='Unused Player Record';
  usert.fm:=0;
  for l:=lp+1 to ls do begin
    readin(l,userr);
    if userr.fm=p then begin
      userr.fm:=0;
      userr.fl:=0;
      writeout(l,userr);
    end;
    if userr.fb=p then begin
      userr.fc:=-98;
      writeout(l,userr);
    end;
  end;
  playernumber:=p;
  rsm;
end;

procedure addship(p:integer);
var r,b:integer;
    done:boolean;
begin
  r:=usert.ff;
  if r<>0 then begin
    readin(lp+r,userr);
    b:=userr.fi;
    userr.fi:=p;
    writeout(lp+r,userr);
    usert.fo:=b;
  end;
end;

procedure upport(p2:integer);
var c,l,code,mn:integer;
    temp,dim:real;
begin
  readin(p2,usert);
  n[1]:=usert.fd+usert.fr/10000;
  n[2]:=usert.fe+usert.fo/10000;
  n[3]:=usert.ff+usert.fp/10000;
  pub[1]:=usert.fg;
  pub[2]:=usert.fh;
  pub[3]:=usert.fi;
  c1[1]:=usert.fj;
  c1[2]:=usert.fk;
  c1[3]:=usert.fl;
  getdate;
  c:=day;
  mn:=value(copy(time,1,2))*60+value(copy(time,4,2));
  dim:=day-usert.fc+(mn-usert.fq)/1440;
  if dim>=0 then begin
    if dim>10 then dim:=10.0;
    for l:=1 to 3 do begin
      n[l]:=n[l]+pub[l]*dim;
      if n[l]>pub[l]*10 then n[l]:=pub[l]*10;
    end;
  end;
  for l:=1 to 3 do m1[l]:=int(b[l]*(1-c1[l]*n[l]/pub[l]/1000)+0.5);
  readin(p2,usert);
  usert.fc:=c;
  usert.fd:=trunc(n[1]);
  usert.fe:=trunc(n[2]);
  usert.ff:=trunc(n[3]);
  for l:=1 to 3 do begin
    srr[l,0]:=int((n[l]-int(n[l]))*10000+0.5);
    n[l]:=int(n[l]);
  end;
  usert.fr:=trunc(srr[1,0]);
  usert.fo:=trunc(srr[2,0]);
  usert.fp:=trunc(srr[3,0]);
  usert.fq:=mn;
  writeout(p2,usert);
end;

procedure port;
var c,l,portnum,i:integer;
    st:str;
    x:str;
    dim:real;
    done:boolean;

  function buysell(t:real):string1;
  begin
    if t>=0.0 then buysell:='  <-- Selling'
    else buysell:='  <-- Buying';
  end;

begin
  done:=false;
  writeln('Edit which port: "####" (sector number) or "P###" (port number)');
  write('Port ID: (<CR>=Abort): ');
  readch(st);
  writeln;
  if st='' then exit;
  if (st[1]='P') or (st[1]='p') then portnum:=value(copy(st,2,4))
  else begin
    i:=value(st);
    if (i<2) or (i>ls-lp) then begin
      writeln('Illegal sector number.');
      exit;
    end;
    readin(i+lp,usert);
    portnum:=usert.fh;
    if portnum=0 then begin
      writeln('No port in that sector.');
      exit;
    end;
  end;

  writeln('portnum is ',portnum);
  portnum:=portnum+ls;
  if (portnum<ls+1) or (portnum>ls+400) then begin
    writeln('Illegal port number:',portnum);
    exit;
  end;
  upport(portnum);
  repeat
    writeln('Port number: '+cstr(portnum-ls));
    writeln('<A> Name: '+usert.name);
    writeln('<B> Class: '+cstr(usert.fb));
    writeln('<C> Ore: '+mn(usert.fd,5)+' (Price='+mn(trunc(m1[1]),3)+')'+
          buysell(usert.fj));
    writeln('<D> Org: '+mn(usert.fe,5)+' (Price='+mn(trunc(m1[2]),3)+')'+
          buysell(usert.fk));
    writeln('<E> Equ: '+mn(usert.ff,5)+' (Price='+mn(trunc(m1[3]),3)+')'+
          buysell(usert.fl));
    writeln('Productivity (units per day)');
    writeln('   <F> Ore: '+cstr(usert.fg)+'   <G> Org: '+cstr(usert.fh)+
          '   <H> Equ: '+cstr(usert.fi));
    writeln('Maximum change in cost (percent)');
    writeln('   <I> Ore: '+cstr(usert.fj)+'   <J> Org: '+cstr(usert.fk)+
          '   <K> Equ: '+cstr(usert.fl));
    writeln;
    writeln('WARNING: I do not recommended changing values <F> though <K>!');
    writeln;
    write('Port editor: (Q=Quit): ');
    readch(x);
    writeln;
    case x of
    'Q',#13:done:=true;
    'A':begin
          write('New name: ');
          {input(st,41);}
          readln(st);
          if st<>'' then usert.name:=st;
          USERT.FM := LENGTH(ST);
        end;
    'B':begin
          write('New class: ');
          getint(usert.fb);
        end;
    'C':begin
          write('New amount of ore: ');
          getint(usert.fd);
          if usert.fd>usert.fg*10.0 then
            writeln('WARNING: Normal range is 0 to '+cstr(usert.fg*10)+'.');
        end;
    'D':begin
          write('New amount of organics: ');
          getint(usert.fe);
          if usert.fe>usert.fh*10.0 then
            writeln('WARNING: Normal range is 0 to '+cstr(usert.fh*10)+'.');
         end;
    'E':begin
          write('New amount of equipment: ');
          getint(usert.ff);
          if usert.ff>usert.fi*10.0 then
            writeln('WARNING: Normal range is 0 to '+cstr(usert.fi*10)+'.');
        end;
    'F':begin
          write('Productivity (units/day) for ore: ');
          getint(usert.fg);
          if usert.fg>3000 then writeln('WARNING: Safe range in 0 to 3000.');
        end;
    'G':begin
          write('Productivity (units/day) for organics: ');
          getint(usert.fh);
          if usert.fh>3000 then writeln('WARNING: Safe range in 0 to 3000.');
        end;
    'H':begin
          write('Productivity (units/day) for equipment: ');
          getint(usert.fi);
          if usert.fi>3000 then writeln('WARNING: Safe range in 0 to 3000.');
        end;
    'I':begin
          writeln('Max change in cost for ore (%): ');
          getint(usert.fj);
        end;
    'J':begin
          writeln('Max change in cost for organics (%): ');
          getint(usert.fk);
        end;
    'K':begin
          writeln('Max change in cost for equipment (%): ');
          getint(usert.fl);
        end;
    end; {case}
    writeout(portnum,usert);
  until done;
end;


procedure init;
var l:integer;
    done:boolean;
begin
  writeln;
  assign(msger,'tradewar\TWOPENG.DAT');
  reset(msger);
  append(msger);
  assign(smallmsg,'tradewar\TWSMF.DAT');
  ended:=false;
  assign(userf,'tradewar\TWDATA.DAT');
  reset(userf);
  readin(1,userr);
  with userr do begin
    ay:=fc;
    tt:=fd;
    lp:=fe;
    ls:=ff;
    lt1:=fg;
    ll1:=fo;
  end;
  getdate;
  pd:=day;
end;

procedure userlist;
var r:integer;
    abort,next:boolean;
begin
  writeln; abort:=false;
  writeln('Player status as of: '+date+' '+time);
  writeln;
  textcolor(10);
  writeln('ID# User Name                         Sec TL  Fght CH  Ore Org Equ Crdts DP');
  textcolor(15);
  writeln('--- --------------------------------- --- --- ---- --- --- --- --- ----- -----');
  textcolor(7);
  r:=2;
  abort:=false;
  repeat
    readin(r,usert);
      writeln(addblank(cstr(r),3)+' '+mln(usert.name,33)+' '+
            addblank(cstr(usert.ff),3)+' '+addblank(cstr(usert.fd),3)+' '+
            addblank(cstr(usert.fg),4)+' '+addblank(cstr(usert.fh),3)+' '+
            addblank(cstr(usert.fi),3)+' '+addblank(cstr(usert.fj),3)+' '+
            addblank(cstr(usert.fk),3)+' '+addblank(cstr(usert.fl),5)+' '+
            addblank(cstrr(usert.trophypts,10),5));
    r:=r+1;
  until abort or (r+1>lp);
textcolor(2);
end;

procedure getuser(var p:integer; a:str);
var c:char;
label option;

begin
  p:=2;
  if a='' then p:=0
  else
    if value(a)<>0 then p:=value(a)
    else begin
      repeat
        readin(p,usert);
        if usert.name=a then exit;
        p:=p+1;
      until p>lp;
      p:=2;
      repeat
        readin(p,usert);
        if pos(a,usert.name)<>0 then begin
          writeln;
          writeln('Incomplete match: '+usert.name+' (#'+cstr(p)+')');
      option:
          write('Option: (Y,N,Q,?): ');
          read(c);
          case c of
          '?':begin
                writeln('(Y)es - This is the correct user');
                writeln('(N)o  - Look for next matching user');
                writeln('(Q)uit search'); writeln;
                goto option;
              end;
          'Y':exit;
          'Q':p:=lp+1;
          'N':p:=p+1;
          end; {case}
        end else p:=p+1;
      until p>lp;
      writeln('Unknown user.');
    end;
end;

procedure uedit;
var i:str;
    p,e:integer;
    done2:boolean;

  procedure checkwarning;
  begin
    if usert.fi+usert.fj+usert.fk>usert.fh then
      writeln('WARNING: Amount of cargo is greater than number of cargo holds.');
  end;

begin
  writeln;
  write('Enter user number: ');
  readln(i);  {input(i,41);}
  getuser(playernumber,i);
  if playernumber<>0 then
    if (playernumber<2) or (playernumber>lp) then
      writeln('Invalid user number.')
    else begin
      done2:=false;
      readin(playernumber,usert);
      while not done2 do begin
        writeln;
        write('<A> Name: ');
        if usert.fm=0 then writeln('<Player record not used>')
        else writeln(usert.name+' (#'+cstr(playernumber)+')');
        write('<W> Weal Name : ');
        writeln(usert.realname);
        write('<B> Last day on: ');
        getdate;
        e:=usert.fb;
        day:=day-e;
        if day=0 then writeln('Today')
        else
          if day>0 then writeln(cstr(day)+' day'+oks(day)+' ago')
          else writeln('Will be allowed on in '+cstr(-day)+' day'+oks(-day));
        a:=usert.fc;
        write('<C> Killed by: ');
        if a=0 then writeln('<No one>')
        else
          if a=-99 then writeln('<To be initialized>')
          else
            if a=-98 then writeln('<A person who has been deleted>')
            else
              if a=-1 then writeln('<Cabel>')
              else
                if (a<2) or (a>lp) then writeln('<Unknown value: '+cstr(a)+'>')
                else begin
                  readin(a,userr);
                  writeln(userr.name+' (#'+cstr(a)+')');
                end;
        writeln('<D> Turns left: '+cstr(usert.fd));
        writeln('<E> Location: Sector '+cstr(usert.ff));
        writeln('<F> Fighters: '+cstr(usert.fg));
        writeln('<G> Total cargo holds: '+cstr(usert.fh));
        writeln('<H>    Ore: '+cstr(usert.fi));
        writeln('<I>    Org: '+cstr(usert.fj));
        writeln('<J>    Eqp: '+cstr(usert.fk));
        writeln('<K> Credits: '+cstr(usert.fl));
        writeln('<L> Last room in: '+cstr(usert.