program noughts_and_crosses; {ver 2.8} {started 28/10/04}
{$M 32000,0,10000}


{ final working version. before the auto wait for player }

{ needs to be in noughts folder or in the folder where the bgi files are
  to compile.  }

{
   this here happens when first user logs in. it deletes the name.dat and
   move1.txt and move2.txt from the c:\windows\temp\noughts folder. it
   deletes the move1.txt and move2.txt from the webspace. i still have to
   run fix.bat each time, to delete name.dat on the webspace.

   on 2nd game of 2 player link up. if a player hasnt finished his last game,
   it will delete its final move, when the other player is starting his new
   game. connect_again_script;

   if you edit names on 2 player link up and when you play a 2nd game. it doesn't use the
   same names.(might not be the same problem but its similar).

   when disconnecting, maybe reset the stats for 2 player link up

   fix names

   i can't disconnect and theres no disconnect colour, when 1st player
   logs in. this is because the connected variable is false.

   when 1 player disconnects(F5) and a new player tries and joins the game.
   it won't work work.

   check graphresult precedure to see how to do the errTest

   when waiting player presses F10(restart) and when other players makes
   move. it does restart and then waiting_for_move. minor problem



   remove disconnected name when signing out

   move main menu into a proc

   when playing in 2 player mode. at the end of game it will mention
   about remote playing has disconnected.

   save the history between the 2 same players
   add a return key for the controls
   i havent added a pause in the game
}


{
   player 1 plays crosses and player 2 plays noughts
   with 1..3,1..3. top left is 1,1. top right is 3,1. bottom left is 1,3. etc.

   store array 1..3,1..3 of byte
   stores the noughts and crosses
   0 - nothing in box, 1 - crosses, 2 - noughts

   list array 1..3,1..3 of x and y
   the x and y of the noughts, crosses and marker in each box

   col,row
   used with store and list. going through the positions 1..3,1..3

   winner
   0 - draw, 1 - player1 wins, 2 - player2 wins, 3 - quit game
   4 - remote player has ended game

   mode
   1: 2 Player   2: 1 Player vs Cpu   3: Cpu vs Cpu   4: 2 Player Link up

   done (game procedure)
   exits game when 3-in-a-row is found, or draw or escape pressed.
   also used to exit shot (used with 2 repeat loops)

   current
   relates to player. 1 would be the 1st player signing in and 2 is the 2nd.
   so 1 would also be player 1 and 2 would be player 2.
   also current is the person whos making a move. when a player isn't current
   they are waiting for a move to be taken.

   connected
   this is when your connected to the webspace. false means you have
   disconnected.

   playing
   similar to connected. this is when your connected to the same remote player.
   also used when playing player again using the F1 to play again.
   false means you have stopped playing them.

   names array[1..8]
   relates to player variable


   theres 4 ways of ending the 2 player link up.
   (1) pressing escape.
   this disconnects and exits the game

   (2) pressing F5(disconnect). similar to (1).
   this disconnects and returns to main menu

   (3) pressing F10(restart). similar to (4).
   keeps connected. returns to menu and pressing F1 plays remote player again.

   (4) at end of game.
   keeps connected. returns to menu and pressing F1 plays remote player again.
}

uses
   dos,crt,graph,bgidriv,bgifont;

const
   LT  = #75;
   RT  = #77;
   UP  = #72;
   DN  = #80;
   CR  = #13;
   ESC = #27;
   SP  = #32;
   TAB = #9;
   BS  = #8;
   F1  = #59;
   F2  = #60;
   F3  = #61;
   F4  = #62;
   F5  = #63;
   {F6  = #64;}
   F10 = #68;

(* AUTOTIME = {25}20; {time in secs, when receiving move}*)
   MAX_NAME = 15;
   TMPDIR   = 'c:\windows\temp\noughts';
   DEST     = 'noughts'; {folder on webspace}
   ID_LEN   = 13;

   p1_col        = 11; {both these are the marker colours}
   p2_col        = 12;
   noughts_col   = 14;
   board_col     = 13;
   highlight_col = 9;

   comspec   : string = '';
   ftp       : string = '';
   os        : byte = 1; {1 for windows 95. 2 for windows XP}
   connected : boolean = false;
   playing   : boolean = false;

   level_types : array[1..3] of string[6] =
   ('Easy','Medium','Hard');

   mode_types  : array[1..4] of string[16] =
   ('2 Player','1 Player vs Cpu','Cpu vs Cpu','2 Player Link up');

type
   listRecType =
   RECORD
      x,y : word;
   END;

   statsRec =
   RECORD
      won,draw,lost : byte;
   END;

   nameRec =
   RECORD
      id : string[ID_LEN];
   END;

   storeType = array[1..3,1..3] of byte;
   statsType = array[1..8] of statsRec;
   namesType = array[1..2] of string[MAX_NAME];
   pos1Type  = array[1..4,1..3] of listRecType;
   idType    = array[1..8] of string[MAX_NAME];
   idArrayType = array[1..{MAX_USERS}5] of string[ID_LEN];


const
   list : array[1..3,1..3] of listRecType =
   (((x:192; y:110), {1st column}
     (x:192; y:185),
     (x:192; y:265)),

    ((x:297; y:110), {2nd column}
     (x:297; y:185),
     (x:297; y:265)),

    ((x:402; y:110),
     (x:402; y:185),
     (x:402; y:265)));


procedure writeto
(
    size   : byte;
    font   : byte;
    text   : string;
    x,y    : integer;
    colour : byte
);

begin
   SetTextStyle(font, HorizDir, size);
   setcolor(colour);
   outtextxy(x,y,text);
end;


procedure writecrt(txt : string;
                   row : byte;
                colour : byte);

begin
   textcolor(colour);
   gotoxy(40-(length(txt) div 2),row);
   write(txt);
end;


procedure clear;

begin
   textcolor(black);
   clrscr;
end;


procedure clrwin(x1,y1,x2,y2 : integer);

begin
   setviewport(x1,y1,x2,y2,false);
   clearviewport;
   SetViewPort(0, 0, GetMaxX, GetMaxY, True);
end;


function rnd_limits(min,max : word) : word;

var
   rnd : word;

begin
   repeat
      rnd := random(max+1);
   until rnd >= min;
   rnd_limits := rnd;
end;


procedure getkey(

var key : char
);

begin
   key := readkey;
   if key = #0 then
      key := readkey;
end;


function cv(number : integer) : string;

var
   tmpstr : string[10];

begin
   str(number,tmpstr);
   cv := tmpstr;
end;


function uppercase
(
    txt1 : string
) : string;

var
   a : byte;

begin
   for a := 1 to length(txt1) do
      txt1[a] := upcase(txt1[a]);
   uppercase := txt1;
end;


procedure check_keys(choices : string;
                     var key : char);
var
   i  : byte;
   ok : boolean;

begin
   ok := false;
   repeat
      getkey(key);
      key := upcase(key);

      for i := 1 to length(choices) do
         if choices[i] = key then
            ok := true;
   until ok;
end;


procedure writexy(

{
   font type

   1 TriplexFont
   2 SmallFont
   3 SansSerifFont
   4 GothicFont
}

    size   : byte;
    font   : byte;
    text   : string;
    row    : integer;
    colour : byte
);

var
   column : integer;

begin
   SetTextStyle(font, HorizDir, size);
   setcolor(colour);
   column := (GetMaxX - textwidth(text) + 1) div 2;
   outtextxy(column,row,text);
end;


procedure press_space;

var
   ch : char;

begin
   writecrt('Press SPACE to continue',14,13);
   repeat
      getkey(ch);
   until ch = SP;
end;


procedure underline(txt : string;
                  x1,y1 : integer);

var
   x,y : word;

begin
   x := textwidth(txt);
   y := textheight(txt);

   SetLineStyle(SolidLn, 0, 1);
   line(x1,y1+y+4,x1+x-3,y1+y+4);
   SetLineStyle(SolidLn, 0, ThickWidth);
end;


function file_exists(filename : string) : boolean;

var
   F : file;

begin
   file_exists := false;

   assign(F,filename);
   {$I-} reset(F); {$I+}

   if IOResult = 0 then
   begin
      file_exists := true;
      close(F);
   end;
end;


procedure run
(
    comspec,cmdline : string
);

begin
{  gotoxy(1,17);}

   swapvectors;
   exec(comspec,cmdline);
   swapvectors;

   if (DosExitCode <> 0) or (doserror <> 0) then
   begin
      textcolor(black);
      clrscr;
      textcolor(10);
      gotoxy((80-(length(comspec)+14)) div 2,12);
      write('Error loading '+comspec);
      press_space;
      clrscr;
   end;
end;


procedure limits(var num : byte;
                 min,max : byte;
              wraparound : boolean);

begin
   if wraparound then
      if num < min then
         num := max
      else
      if num > max then
         num := min
   else;
      if num < min then
         num := min
      else
      if num > max then
         num := max;
end;


procedure errTest;

var
   tmpio : integer;

begin
   tmpio := IOresult;
end;


procedure delete_name_dat;

var
   T : text;
   i : byte;

begin
   assign(T,TMPDIR+'\name.dat');
   {$I-} erase(T); {$I+}
   errTest;

   for i := 1 to 2 do
   begin
      assign(T,TMPDIR+'\move'+cv(i)+'.txt');
      {$I-} erase(T); {$I+}
      errTest;

      assign(T,TMPDIR+'\tmp'+cv(i));
      {$I-} erase(T); {$I+}
      errTest;

      assign(T,TMPDIR+'\script'+cv(i)+'.txt');
      {$I-} erase(T); {$I+}
      errTest;
   end;
end;


procedure draw_cursor(type1 : byte;
                        x,y : word);

begin
   {textheight 12, textwidth 8. this is the size of each character, of the
   text on the same line as the arrows}
   case type1 of
      1:
      begin
         line(x+4,y+2,x+4,y+10); {up arrow}
         line(x+4,y+2,x+0,y+6);
         line(x+4,y+2,x+8,y+6);
      end;
      2:
      begin
         line(x+4,y+2,x+4,y+10); {down arrow}
         line(x+4,y+10,x+0,y+6);
         line(x+4,y+10,x+8,y+6);
      end;
      3 :
      begin
         line(x+0,y+6,x+8,y+6); {right arrow}
         line(x+8,y+6,x+4,y+2);
         line(x+8,y+6,x+4,y+10);
      end;
      4 :
      begin
         line(x+0,y+6,x+8,y+6); {left arrow}
         line(x+0,y+6,x+4,y+2);
         line(x+0,y+6,x+4,y+10)
      end;
   end;
end;


procedure game_halts;

var
   wait : char;

begin
   textcolor(black);
   clrscr;
   textcolor(9);
   gotoxy(1,1);
   write('The graphics files are needed for Noughts & Crosses to run');
   textcolor(12);
   gotoxy(1,2);
   write('Press any key to quit');
   getkey(wait);
   halt;
end;


procedure open_graphics_library;

procedure abort(msg : string);

var
   wait : char;

begin
   textcolor(0);
   clrscr;
   textcolor(9);
   Writeln(msg, ': ', GraphErrorMsg(GraphResult));
   getkey(wait);
   Halt(1);
end;

var
   grDriver : Integer;
   grMode   : Integer;
   ErrCode  : Integer;

begin
   { Register all the drivers }
   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
      abort('EGA/VGA');

   { Register all the fonts }
   if RegisterBGIfont(@GothicFontProc) < 0 then
      abort('Gothic');
   if RegisterBGIfont(@SansSerifFontProc) < 0 then
      abort('SansSerif');
   if RegisterBGIfont(@SmallFontProc) < 0 then
      abort('Small');
   if RegisterBGIfont(@TriplexFontProc) < 0 then
      abort('Triplex');

   grDriver := Detect;
   InitGraph(grDriver, grMode,''{'c:\progra~1\tp\bgi'});
   ErrCode := GraphResult;
   if ErrCode <> grOk then
      game_halts;
end;


procedure test_for_draw
(
    store  : storeType;
var winner : byte;
var done   : boolean
);

var
   tmp : byte;
   a,b : byte;

begin
   { tests if all 9 moves have been moved and still no winner }
   tmp := 0;
   for a := 1 to 3 do
      for b := 1 to 3 do
         if store[a,b] <> 0 then
            inc(tmp);

   if tmp = 9 then
   begin
      done := true; {exits game}
      winner := 0;
   end;
end;


procedure horiz
(
var pos1   : pos1Type;
    store  : storeType;
var winner : byte;
var done   : boolean;
    player : byte;
var tmp    : byte
);

var
   a,b,n,m : byte;
   ok      : boolean;
   count   : array[1..4] of byte;

begin
   ok := false;
   {checks 3 horizontal and 3 vertical lines for 3-in-a-row}
   for a := 1 to 3 do
   begin
      for m := 1 to 4 do
         count[m] := 0;

      for n := 1 to 4 do
         for m := 1 to 3 do
         begin
            pos1[n,m].x := 0;
            pos1[n,m].y := 0;
         end;

      for b := 1 to 3 do
      begin
         if store[a,b] = 1 then {checks vertical column}
         begin
            inc(count[1]);
            pos1[1,b].x := a; {stores x and y to highlight winning row}
            pos1[1,b].y := b;
         end;
         if store[a,b] = 2 then
         begin
            inc(count[2]);
            pos1[2,b].x := a;
            pos1[2,b].y := b;
         end;
         if store[b,a] = 1 then {checks horizontal row}
         begin
            inc(count[3]);
            pos1[3,b].x := b;
            pos1[3,b].y := a;
         end;
         if store[b,a] = 2 then
         begin
            inc(count[4]);
            pos1[4,b].x := b;
            pos1[4,b].y := a;
         end;
      end;

      for m := 1 to 4 do {used with displaying 3-in-a-row and pos1}
         if count[m] = 3 then
            tmp := m;

      for m := 1 to 4 do
         if count[m] = 3 then {found 3-in-a-row}
         begin
            winner := player; {saves both of these for game procedure}
            done := true;
            ok := true;
            break;
         end;
      if ok then break;
   end;
end;


procedure diagonal
(
    store  : storeType;
var pos1   : pos1Type;
var done   : boolean;
var winner : byte;
var tmp    : byte
);

var
   m : byte;

begin
   {tests both players for diagonal 3-in-a-row}
   if not done then
   for m := 1 to 2 do         {left to right}
      if (store[1,1] = m) and (store[2,2] = m) and (store[3,3] = m) then
      begin
         winner := m;
         done := true;
         tmp := m;
         pos1[m,1].x := 1; {stores this for highlight row}
         pos1[m,1].y := 1;
         pos1[m,2].x := 2;
         pos1[m,2].y := 2;
         pos1[m,3].x := 3;
         pos1[m,3].y := 3;
      end;

   if not done then
   for m := 1 to 2 do         {right to left}
      if (store[3,1] = m) and (store[2,2] = m) and (store[1,3] = m) then
      begin
         winner := m;
         done := true;
         tmp := m;
         pos1[m,1].x := 3;
         pos1[m,1].y := 1;
         pos1[m,2].x := 2;
         pos1[m,2].y := 2;
         pos1[m,3].x := 1;
         pos1[m,3].y := 3;
      end;
end;


procedure highlight
(
    pos1   : pos1Type;
    winner : byte;
    tmp    : byte
);

var
   m : byte;

begin
   {highlights winning 3-in-a-row}
   setcolor(highlight_col);
   for m := 1 to 3 do
      with list[pos1[tmp,m].x,pos1[tmp,m].y] do
         if winner = 1 then
         begin
            line(0+x,0+y,50+x,50+y);
            line(50+x,0+y,0+x,50+y);
         end else
         if winner = 2 then
            circle(25+x,25+y,25);
end;


procedure check_3_in_a_row
(
    store  : storeType;
var winner : byte;
var done   : boolean;
    player : byte
);


var
   pos1 : pos1Type;
   tmp  : byte; {used with highlight}

begin
   horiz(pos1,store,winner,done,player,tmp);
   diagonal(store,pos1,done,winner,tmp);

   if not done then {3-in-a-row not found, so exits}
      exit;

   highlight(pos1,winner,tmp);
end;


procedure display_noughts_crosses
(
    store : storeType
);

var
   a,b : byte;

begin
   setcolor(noughts_col);  {updates the noughts and crosses}
   for a := 1 to 3 do
      for b := 1 to 3 do
         with list[a,b] do
         begin
            if store[a,b] = 1 then {checks player 1}
            begin
               line(0+x,0+y,50+x,50+y);
               line(50+x,0+y,0+x,50+y);
            end;
            if store[a,b] = 2 then {checks player 2}
               circle(25+x,25+y,25);
         end;
end;


procedure clear_bottom_text;

begin
   clrwin(130,335,530,365);
end;


procedure display_players_turn
(
    player : byte;
    names  : namesType
);

var
   tmp  : byte;
   num  : word;
   x,x1 : word;

begin
   clear_bottom_text;
   if player = 1 then
      tmp := p1_col
   else
      tmp := p2_col;

   SetTextStyle(1, HorizDir, 3);

   num := textwidth(names[player]+'''s turn')+25;
   x1 := (GetMaxX - num + 1) div 2; {for players turn text}
   x := x1+num-25; {for noughts+crosses}

   writeto(3,1,names[player]+'''s turn',x1,335,tmp);

   setcolor(noughts_col); {draws small noughts & crosses}
   if player = 1 then
   begin
      line(0+x+10,340,15+x+10,355); {small cross}
      line(15+x+10,340,0+x+10,355);
   end
   else
      circle(0+x+20,347,8);
end;


procedure init_game
(
var store     : storeType;
var winner    : byte;
var col,row   : byte;
var player    : byte;
var done      : boolean;
var Scol,Srow : byte;
var incsec    : boolean
);

var
   a,b : byte;

begin
   for a := 1 to 3 do
      for b := 1 to 3 do
         store[a,b] := 0;

   winner := 0;
   col := 1;
   row := 1;
   player := {rnd_limits(1,2)}1;
   done := false;
   Scol := 1;
   Srow := 1;
   incsec := false;
end;


procedure display_game_bkground;

begin
   SetLineStyle(SolidLn, 0, ThickWidth);
   setcolor(board_col);

   {horizontal lines}
   line(172,170,472,170);
   line(172,250,472,250);

   {vertical lines}
   line(272,100,272,320);
   line(372,100,372,320);
end;


procedure work_out_players_move
(
var store   : storeType;
    player  : byte;
var wait    : char;
    col,row : byte
);

begin
   if store[col,row] <> 0 then {prevents same shot}
      wait := #0
   else
   begin
      if store[col,row] = 0 then {when player takes turn}
         with list[col,row] do
            if player = 1 then
               store[col,row] := 1
            else
               store[col,row] := 2;
   end;
end;


procedure work_out_stats
(
var stats   : statsType;
    winner  : byte;
    statsno : byte
);

begin
   if winner = 3 then {pressed escape}
      exit;

   case winner of
      0 :
      begin
         inc(stats[statsno].draw);
         inc(stats[statsno+1].draw);
      end;
      1 :
      begin
         inc(stats[statsno].won);
         inc(stats[statsno+1].lost);
      end;
      2 :
      if winner = 2 then
      begin
         inc(stats[statsno+1].won);
         inc(stats[statsno].lost);
      end;
   end;
end;


procedure display_stats
(
    stats   : statsType;
    names   : namesType;
    statsno : byte;
    mode    : byte
);

var
   y   : word;
   a   : byte;
   tmp : byte;

begin
(* if winner = 3 then {pressed escape} add this back in
      exit;*)

   clrwin(522,20,639,145);
   writeto(7,2,'Stats',522,-5,11);
   underline('Stats',522,-5);

   writeto(4,2,'('+mode_types[mode]+')',522,20,10);

   y := 40;
   tmp := 1;
   for a := statsno to statsno+1 do
   begin
      writeto(5,2,names[tmp],522,y,14);
      writeto(5,2,'Won Draw Lost',522,y+15,10);
      with stats[a] do
      begin
         writeto(5,2,cv(won),522,y+30,10);
         writeto(5,2,cv(draw),554,y+30,10);
         writeto(5,2,cv(lost),594,y+30,10);
      end;
      inc(y,60);
      inc(tmp);
   end;
end;


procedure winner_text
(
    winner  : byte;
    player  : byte;
var stats   : statsType;
    names   : namesType;
    statsno : byte;
    mode    : byte;
    msg     : byte
);

begin
   if winner <> 3 then {if escape was pressed}
      clear_bottom_text;

   work_out_stats(stats,winner,statsno);
   display_stats(stats,names,statsno,mode);

   case winner of
      0   : writexy(3,1,'Draw',335,10);
      1,2 : writexy(3,1,names[player]+' wins',335,10);
   end;

   case msg of
      1 : writexy(2,1,'Remote player has disconnected',335,10);
      2 : writexy(2,1,'Remote player has restarted game',335,10);
   end;
end;


procedure check_horiz
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte;
    num     : byte
);

var
   a,b,m : byte;
   count : byte;

begin
   if found then
      exit;

   for a := 1 to 3 do
   begin
      count := 0;
      for b := 1 to 3 do
      begin
         if store[a,b] = num then
            inc(count);
         if count = 2 then  {2 in 3 chance of cpu making right shot}
            if (level = 2) or ((level = 1) and (rnd_limits(0,2) <> 0)) then
               for m := 1 to 3 do
                  if store[a,m] = 0 then
                  begin
                     col := a;
                     row := m;
                     found := true;
                     exit;
                  end;
      end;
   end;
end;


procedure check_vertical
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte;
    num     : byte
);

var
   a,b,m : byte;
   count : byte;

begin
   if found then
      exit;

   for a := 1 to 3 do
   begin
      count := 0;
      for b := 1 to 3 do
      begin
         if store[b,a] = num then
            inc(count);
         if count = 2 then
            if (level = 2) or ((level = 1) and (rnd_limits(0,2) <> 0)) then
               for m := 1 to 3 do
                  if store[m,a] = 0 then
                  begin
                     col := m;
                     row := a;
                     found := true;
                     exit;
                  end;
      end;
   end;
end;


procedure check_diagonal_left_right
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte;
    num     : byte
);

var
   a,b,m : byte;
   count : byte;

begin
   if found then
      exit;

   count := 0;
   for a := 1 to 3 do
   begin
      if store[a,a] = num then
         inc(count);
      if count = 2 then
         if (level = 2) or ((level = 1) and (rnd_limits(0,2) <> 0)) then
            for m := 1 to 3 do
               if store[m,m] = 0 then
               begin
                  col := m;
                  row := m;
                  found := true;
                  exit;
               end;
    end;
 end;


procedure check_diagonal_right_left
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte;
    num     : byte
);

var
   a,b,m : byte;
   count : byte;
   tmp   : byte;

begin
   if found then
      exit;

   count := 0;
   tmp := 0;
   for a := 3 downto 1 do
   begin
      inc(tmp);
      if store[a,tmp] = num then
         inc(count);
      if count = 2 then
         if (level = 2) or ((level = 1) and (rnd_limits(0,2) <> 0)) then
         begin
            tmp := 0;
            for m := 3 downto 1 do
            begin
               inc(tmp);
               if store[m,tmp] = 0 then
               begin
                  col := m;
                  row := tmp;
                  found := true;
                  exit;
               end;
            end;
         end;
   end;
end;


procedure work_out_cpu_move
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte
);

begin
   {make cpu look for its 2-in-a-row and my 2-in-a-row.
   it would go for its 2-in-a-row first.}
   found := false;

   {this checks for two cpu noughts}
   check_horiz(store,col,row,found,level,2);
   check_vertical(store,col,row,found,level,2);
   check_diagonal_left_right(store,col,row,found,level,2);
   check_diagonal_right_left(store,col,row,found,level,2);

   {this checks for two player 1's crosses}
   check_horiz(store,col,row,found,level,1);
   check_vertical(store,col,row,found,level,1);
   check_diagonal_left_right(store,col,row,found,level,1);
   check_diagonal_right_left(store,col,row,found,level,1);
end;


procedure check_escape_during_cpu_move
(
var done   : boolean;
var winner : byte;
var wait   : char
);

var
   ch : char;

begin
   if keypressed then
   begin
      getkey(ch);
      case ch of
         F10 :
         begin
            done := true;
            winner := 3;
         end;
         ESC : wait := ESC;
      end;
   end;
end;


procedure readto
(
var txt1   : string;
    x,y    : word;
    colour : byte;
    max    : byte
);

var
   key      : char;
   done     : boolean;
   position : byte;
   savex    : word;
   tmp      : word;

begin
   txt1 := '';
   done := false;
   position :=  0;
   savex := x;
   clrwin(x,y,x+300,y+30);
   setcolor(colour);
   repeat
      getkey(key);
      case key of
         ESC :
         begin
            txt1 := 'x';
            done := true;
         end;
         CR  : done := true;
         TAB :
         begin
            clrwin(savex,y,savex+300,y+30);
            position := 0;
            txt1 := '';
            x := savex;
         end;
         BS :
         if position > 0 then
         begin
            tmp := textwidth(txt1[position]);
            dec(x,tmp);
            clrwin(x-1,y,x+tmp,y+30);
            delete(txt1,position,1);
            dec(position);
         end;
         SP..#127,#156 :
         if position < max then
         begin
            writeto(2,3,key,x,y,colour);
            inc(x,textwidth(key));
            inc(position);
            txt1 := concat(txt1 + key);
         end;
      end;
(*      if ((txt1 = '') and done)
        and (key <> ESC) then {prevents return on its own}
         done := false;*)
   until done;
end;


procedure type_name
(
var names : namesType;
    num   : byte
);

var
   i      : byte;
   tmpstr : string{[MAX_NAME]};

begin
   cleardevice;
   for i := 1 to num do
   begin
      writexy(1,3,'Press RETURN to use default name',350,11);
      writexy(1,3,'Press ESCAPE to exit',375,11);

      writeto(2,3,'Please type Player '+cv(i)+'''s name: ',20,200,10);
      readto(tmpstr,320,200,14,MAX_NAME);

      if tmpstr = 'x' then
      begin
         names[1] := 'Player 1';
         break;
      end;

      if tmpstr = '' then {uses default names}
         tmpstr := 'Player '+cv(i);

      if i = 1 then
      begin
         clrwin(20,200,320,230);
         names[1] := tmpstr
      end
      else
         names[2] := tmpstr;
   end;
   cleardevice;
end;


procedure arrow_keys(colour : byte);

begin
   setcolor(colour);
   SetLineStyle(SolidLn, 0, 1);
   draw_cursor(1,0,154);
   draw_cursor(2,10,154);
   draw_cursor(3,25,154);
   draw_cursor(4,36,154);
   SetLineStyle(SolidLn, 0, 3);
end;


procedure display_user_online_txt
(
    names  : namesType;
    listno : byte;
    mode   : byte
);

var
   a : byte;

begin
   writeto(7,2,'Users',522,160,11);
   underline('Users',522,160);

   if not connected then
   begin
      writeto(5,2,'None',522,185,10);
      exit;
   end;

   for a := 1 to listno do
      writeto(5,2,names[a],522,190+(a*15)-15,10);
end;


procedure display_chatroom;

begin
   setcolor(12);
   SetLineStyle(SolidLn, 0, 1);
   rectangle(0,380,639,445);
   rectangle(0,455,639,479);
   SetLineStyle(SolidLn, 0, 3);

   writeto(5,2,'Type: ',10,457,10);

{   writeto(5,2,'John: Hi there',10,381,9);
   writeto(5,2,'Fraser: Hi',10,396,13);
   writeto(5,2,'John: How ru',10,411,9);
   writeto(5,2,'Fraser: good thx',10,426,13);}
end;


procedure display_mode_txt
(
    mode : byte
);

var
   a   : byte;
   tmp : byte;

begin
   writeto(7,2,'Mode',0,175,11);
   underline('Mode',0,175);
   for a := 1 to 4 do
   begin
      if mode = a then
         tmp := 12
      else
         tmp := 10;
      writeto(5,2,mode_types[a],0,205+(a*15)-15,tmp);
   end;
end;


procedure display_cpu_level_txt
(
    level : byte
);

var
   a   : byte;
   tmp : byte;

begin
   writeto(7,2,'Cpu Level',0,275,11);
   underline('Cpu Level',0,275);

   for a := 1 to 3 do
   begin
      if level = a then
         tmp := 12
      else
         tmp := 10;
      writeto(5,2,level_types[a],0,305+(a*15)-15,tmp);
   end;
end;


procedure display_controls_txt(type1 : byte);

var
   c1,c2,c3,c4 : byte;

begin
   case type1 of
      1 : {main menu colours}
      begin
         c1 := 10;
         c2 := 8;
         c3 := 8;
      end;
      2 : {in game menu colours. player makes move}
      begin
         c1 := 8;
         c2 := 10;
         c3 := 10;
      end;
      3 : {in game menu colours. computer makes move}
      begin
         c1 := 8;
         c2 := 10;
         c3 := 8;
      end;
   end;

   if connected then {disconnect colour}
      c4 := 10
   else
      c4 := 8;

   writeto(7,2,'Controls',0,-5,11);
   underline('Controls',0,-5);
   writeto(5,2,'F1  New Game',0,25,c1);
   writeto(5,2,'F2  Mode',0,40,c1);
   writeto(5,2,'F3  Cpu Level',0,55,c1);
   writeto(5,2,'F4  Edit Names',0,70,c1);
   writeto(5,2,'F5  Disconnect',0,85,c4);
   writeto(5,2,'F10 Restart',0,100,c2);
   writeto(5,2,'Escape - Exit',0,115,10); {escape is always there}
   writeto(5,2,'Return - Make Move',0,{130}137,c3);
   writeto(5,2,'- Move Marker',54,{145}152,c3);

   arrow_keys(c3);
end;


procedure display_status
(
    listno : byte;
    names  : namesType;
    mode   : byte
);

begin
   writeto(7,2,'Status',522,235,11);
   underline('Status',522,235);

   if not connected then
   begin
      writeto(5,2,'Not connected',522,260,10);
      exit;
   end;

   if listno = 1 then
      writeto(5,2,'No remote user',522,260,10)
   else
      writeto(5,2,{'Successful'}'Connected',522,260,10);

   writeto(5,2,cv(listno)+' user(s) online',522,275,10);
end;


procedure display_text
(
    mode    : byte;
    level   : byte;
    listno  : byte;
    names   : namesType;
    stats   : statsType;
    statsno : byte;
    type1   : byte
);

var
   a : shortint;

begin
   cleardevice;
   {note. font heigth for normal text is 15 pixels}

   for a := -15 to -13 do
      writexy(5,3,'Noughts',a,12);

   for a := 23 to 25 do
      writexy(5,3,'& Crosses',a,12);

   display_controls_txt(type1);
   display_mode_txt(mode);
   display_cpu_level_txt(level);
   display_chatroom;
   display_stats(stats,names,statsno,mode);
   display_game_bkground;

   {for mode 4}
   display_user_online_txt(names,listno,mode);
   display_status(listno,names,mode);
end;


procedure display_game_gfx
(
    player : byte;
    names  : namesType;
    store  : storeType
);

begin
   display_players_turn(player,names);
   display_noughts_crosses(store);
end;


procedure clear_table;

var
   a,b : byte;

begin
   for a := 1 to 3 do
      for b := 1 to 3 do
         with list[a,b] do
            clrwin(0+x-1,0+y-1,50+x+1,50+y+1);
end;


procedure send_move_to_remote_user
(
    current : byte;
    player  : byte;
    type1   : byte {1 is for normal send move. 2 is when restarting game}
);

var
   F     : text;
   tmp,
   tmp1  : string[9];
   ostmp : string;

begin
   assign(F,TMPDIR+'\script'+cv(current)+'.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

   tmp := 'move'+cv(current)+'.txt';
   tmp1 := 'move'+cv(player);

   {writeln(F,'verbose');}
   writeln(F,'user fraserking computer');
   if type1 = 1 then
   begin
      writeln(F,'recv '+DEST+'/name.dat '+TMPDIR+'\name.dat');
      writeln(F,'recv '+DEST+'/'+tmp1+'.txt '+TMPDIR+'\'+tmp1+'.bak');
   end;
   writeln(F,'send '+TMPDIR+'\'+tmp+' '+DEST+'/'+tmp);
   writeln(F,'quit');

   close(F);

   if os = 1 then {windows 95}
      ostmp := TMPDIR+'\tmp'+cv(current)
   else
      ostmp := 'nul'; {windows XP}

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script'+cv(current)+'.txt ftp.tripod.com >'+ostmp);
end;


procedure wait_for_remote_users_shot
(
    player  : byte
);

var
   F     : text;
   tmp   : string[9];
   ostmp : string;

begin
   assign(F,TMPDIR+'\script'+cv(player)+'.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

   tmp := 'move'+cv(player)+'.txt';

{   writeln(F,'verbose');}
   writeln(F,'user fraserking computer');
   writeln(F,'recv '+DEST+'/'+tmp+' '+TMPDIR+'\'+tmp);
   writeln(F,'recv '+DEST+'/name.dat '+TMPDIR+'\name.dat');
   writeln(F,'quit');

   close(F);

   if os = 1 then
      ostmp := TMPDIR+'\tmp'+cv(player)
   else
      ostmp := 'nul';

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script'+cv(player)+'.txt ftp.tripod.com >'+ostmp);
end;


procedure receive_names_script(num : byte);

var
   F     : text;
   ostmp : string;

begin
   assign(F,TMPDIR+'\script.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

{  writeln(F,'verbose');}
   writeln(F,'user fraserking computer');
   if num = 1 then
      writeln(F,'mkdir '+DEST);
   writeln(F,'recv '+DEST+'/name.dat '+TMPDIR+'\name.dat');
   writeln(F,'quit');

   close(F);

   if os = 1 then
      ostmp := TMPDIR+'\tmp'
   else
      ostmp := 'nul';

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script.txt ftp.tripod.com >'+ostmp);
end;


procedure connect_again_script;

var
   F     : text;
   ostmp : string;

begin
   assign(F,TMPDIR+'\script.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

   {writeln(F,'verbose');}
   writeln(F,'user fraserking computer');
   writeln(F,'prompt');
   writeln(F,'cd '+DEST);
   writeln(F,'mdelete move1.txt move2.txt');
   writeln(F,'recv name.dat '+TMPDIR+'\name.dat');
   writeln(F,'quit');

   close(F);

   if os = 1 then
      ostmp := TMPDIR+'\tmp'
   else
      ostmp := 'nul';

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script.txt ftp.tripod.com >'+ostmp);
end;


procedure disconnect_script(count : byte);

var
   F     : text;
   ostmp : string;

begin
   assign(F,TMPDIR+'\script.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

{  writeln(F,'verbose');}
   writeln(F,'user fraserking computer');

   if count = 1 then {this is the only place where it deletes name.dat}
      writeln(F,'delete '+DEST+'/name.dat');

   if count = 2 then
      writeln(F,'send '+TMPDIR+'\name.dat '+DEST+'/name.dat');

   writeln(F,'quit');

   close(F);

   if os = 1 then { the >nul doesn't work with windows 95. so I need this code}
      ostmp := TMPDIR+'\tmp'
   else
      ostmp := 'nul';

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script.txt ftp.tripod.com >'+ostmp);
end;


procedure disconnect(var current : byte;
                       var names : namesType);

var
   T      : text;
   i      : byte;
   namesT : namesType;
   count  : byte;

begin
   RestoreCrtMode;

   clear;
   writecrt('Disconnecting...Please wait',13,10);

   receive_names_script(2);

   assign(T,TMPDIR+'\name.dat');
   {$I-} reset(T); {$I+}
   errTest;

   count := 0; {read names to get the count number}
   while not eof(T) do
   begin
      inc(count);
      readln(T,namesT[count]);
   end;

   {write names back, without the disconnecting player}

   {$I-} rewrite(T); {$I+}
   errTest;

   for i := 1 to count do
      if current <> i then
         writeln(T,names[i]);

   close(T);

   disconnect_script(count);
   SetGraphMode(GetGraphMode);

   current := 0;
   connected := false;
   playing := false;
end;


procedure check_for_logout
(
var count   : byte;
    names   : namesType;
    current : byte;
var namesT  : namesType;
    type1   : byte
);

var
   T : text;

begin
   assign(T,TMPDIR+'\name.dat');
   {$I-} reset(T); {$I+}
   errTest;

   count := 0; {read names}
   while not eof(T) do
   begin
      inc(count);
      readln(T,namesT[count]);
   end;

   close(T);

   namesT[1] := names[current]; {does this so i don't have to open name.dat again}
   namesT[2] := 'Player 2';
end;


procedure delay_time(var incsec : boolean);

var
   h,m,s,hund : word;

begin
   gettime(h,m,s,hund);
      if s in [17..19,37..39,57..59] then
         incsec := true;
end;


procedure send_move
(
    mode    : byte;
    level   : byte;
var listno  : byte;
var names   : namesType;
var current : byte;
    col,row : byte;
    player  : byte;
    store   : storeType;
    stats   : statsType;
    statsno : byte;
var done    : boolean;
var winner  : byte;
var msg     : byte;
var incsec  : boolean;
var id      : idType
);

var
   T      : text;
   count  : byte;
   namesT : namesType;

begin
   if (mode = 4) and (current = player) then
   begin
      delay(2000);
      assign(T,TMPDIR+'\move'+cv(current)+'.txt');
      {$I-} rewrite(T); {$I+}
      errTest;

      writeln(T,col);
      writeln(T,row);
      close(T);

      RestoreCrtMode; {leaves graphics mode}
      clear;
      writecrt('Sending move',13,10);

      send_move_to_remote_user(current,player,1);
      SetGraphMode(GetGraphMode);

      display_text(mode,level,listno,names,stats,statsno,2);
      display_game_gfx(player,names,store);

      delay_time(incsec); {prevents running 2 exec's in a row}

      {----check for remote player signing out----}

      check_for_logout(count,names,current,namesT,1);

      if (count = 1) and (listno = 2) then
      begin
         winner := 4; {these 2 are to display the error message}
         msg := 1; {stores message number for winner_text proc}
         done := true;
         dec(listno);
         current := 1;
         playing := false;

         names := namesT;
         id[7] := names[1];
         id[8] := names[2];

         clrwin(522,185,639,290);
         display_user_online_txt(names,listno,mode);
         display_status(listno,names,mode);

         exit;
      end;

      {----check for remote player restarting----}

      assign(T,TMPDIR+'\move'+cv(player)+'.bak');
      {$I-} reset(T); {$I+}

      if IOresult <> 0 then
         exit;

      while not eof(T) do
         readln(T,col);

      close(T);

      {$I-} erase(T); {$I+}
      errTest;

      if col = 0 then {test if remote player restarted game}
      begin
         msg := 2;
         done := true;
         winner := 4;
      end;
   end;
end;


procedure receive_move
(
    mode    : byte;
    level   : byte;
var listno  : byte;
var names   : namesType;
    player  : byte;
var current : byte;
var row,col : byte;
var wait    : char;
    store   : storeType;
    stats   : statsType;
    statsno : byte;
var done    : boolean;
var winner  : byte;
var msg     : byte;
var incsec  : boolean;
var id      : idType
);

var
   recv    : boolean;
   T       : text;
   h,m,s,
   hund    : word;
   ch      : char;
   count   : byte;
   restart : boolean;
   namesT  : namesType;

begin
   if not ((mode = 4) and (player <> current)) then
      exit;

   recv := false;
   repeat {receive move}
      display_controls_txt(3); {highlights menu}
      gettime(h,m,s,hund);

      if keypressed then {press escape during waiting for move}
      begin
         getkey(ch);
         if ch in [F5,F10,ESC] then {host player disconnects here}
         begin
            wait := ch;
            exit;
         end;
      end;

      if incsec then
      begin
         dec(s,3);
         incsec := false;
      end;

      if {s mod AUTOTIME}s in [0,19,39,59] then
      begin
         RestoreCrtMode; {leaves graphics mode}

         clear;
         writecrt('Waiting for remote users move',13,10);

         wait_for_remote_users_shot(player);
         SetGraphMode(GetGraphMode);

         {----tests name.dat on webspace to see if remote player has signed out----}

         check_for_logout(count,names,current,namesT,2);

         if (count = 1) and (listno = 2) then
         begin
            names := namesT;
            id[7] := names[1];
            id[8] := names[2];

            dec(listno);
            playing := false;
            msg := 1; {these 2 are to display the error message}
            winner := 4;
            done := true;
            current := 1;

            display_text(mode,level,listno,names,stats,statsno,2);
            display_game_gfx(player,names,store);

            exit;
         end;

         {----makes move----}

         assign(T,TMPDIR+'\move'+cv(player)+'.txt');
         {$I-} reset(T); {$I+}
         errTest;

         col := 0;
         row := 0;

         restart := false;
         while not eof(T) do
         begin
            readln(T,col);
            readln(T,row);
            if col = 0 then {test if remote player restarted game}
               restart := true;
         end;
         close(T);

         display_text(mode,level,listno,names,stats,statsno,2);
         display_game_gfx(player,names,store);

         if restart then {if remote player has restarted, then display msg}
         begin
            msg := 2;
            done := true;
            winner := 4;
            exit;
         end;

         if (col in [1..3]) or (row in [1..3]) then {tests if remote player moved}
         begin
            recv := true;
            wait := CR;
         end;
      end;
   until recv;
end;


procedure restarting_game
(
    mode    : byte;
    level   : byte;
    listno  : byte;
    names   : namesType;
    stats   : statsType;
    statsno : byte;
    player  : byte;
    store   : storeType;
var current : byte;
var done    : boolean;
var winner  : byte
);

var
   T : text;

begin
   if mode = 4 then
   begin
      assign(T,TMPDIR+'\move'+cv(current)+'.txt');
      {$I-} rewrite(T); {$I+}
      errTest;

      writeln(T,0); {sends 0 in move.txt to say the person has restarted}
      writeln(T,0);
      close(T);

      RestoreCrtMode; {leaves graphics mode}

      clear;
      writecrt('Restarting',13,10);

      send_move_to_remote_user(current,player,2);
      SetGraphMode(GetGraphMode);

      display_text(mode,level,listno,names,stats,statsno,2);
      display_game_gfx(player,names,store);
      current := 0;
   end;
   done := true;
   winner := 3;
end;


procedure player_makes_move
(
    player    : byte;
    mode      : byte;
    current   : byte;
    Scol,Srow : byte;
var col,row   : byte;
var wait      : char
);

begin
   if ((player = 1) and (mode = 2)) or (mode = 1) or
     ((mode = 4) and (player = current)) then
   begin
      if mode = 2 then
      begin
         col := Scol;
         row := Srow;
      end;

      with list[col,row] do {display marker rectangle}
         rectangle(0+x,0+y,50+x,50+y);

      check_keys(UP+DN+LT+RT+CR+ESC+F10+F5,wait);

      with list[col,row] do
         clrwin(0+x-1,0+y-1,50+x+1,50+y+1);
   end;
end;


procedure cpu_makes_move
(
    store   : storeType;
var col,row : byte;
var found   : boolean;
    level   : byte;
    mode    : byte;
    player  : byte;
var wait    : char;
var done    : boolean;
var winner  : byte
);

begin
   if ((mode = 2) and (player = 2)) or (mode = {4}3) then
   begin
      work_out_cpu_move(store,col,row,found,level);
      if not found then
      repeat
         col := rnd_limits(1,3);
         row := rnd_limits(1,3);
      until store[col,row] = 0;
      wait := CR;
      delay(1000); {first cpu pause during move}
      check_escape_during_cpu_move(done,winner,wait);
   end;
end;


procedure highlight_options(player : byte;
                              mode : byte;
                           current : byte);


begin
   if ((player = 1) and (mode = 2)) or (mode = 1) or
     ((mode = 4) and (player = current)) then
      display_controls_txt(2);

   if ((mode = 2) and (player = 2)) or (mode = 3) then
      display_controls_txt(3);

   if (mode = 4) and (player = current) then
      display_controls_txt(2) {send move}
end;


procedure exit_game(current : byte;
                      names : namesType);

begin
   if connected then
      disconnect(current,names);
   closegraph;
   delete_name_dat;
   halt;
end;


procedure game
(
    mode    : byte;
var stats   : statsType;
    names   : namesType;
    level   : byte;
    listno  : byte;
    current : byte;
    statsno : byte;
var id      : idType
);

var
   wait      : char;
   col,row   : byte;
   store     : storeType;
   player    : byte;
   done      : boolean;
   winner    : byte;
   Scol,Srow : byte;
   found     : boolean;
   msg       : byte;
   incsec    : boolean;

begin
   init_game(store,winner,col,row,player,done,Scol,Srow,incsec);
   delay_time(incsec);
   repeat
      display_players_turn(player,names);
      highlight_options(player,mode,current);
      repeat
         if mode in [1,4] then
         begin
            if player = 1 then {changes marker colour for each player}
               setcolor(p1_col)
            else
               setcolor(p2_col);
         end else
            setcolor(p1_col);

         receive_move {for 2 player link up}
         (mode,level,listno,names,player,current,row,col,wait,store,stats,statsno,done,winner,msg,incsec,id);

         player_makes_move(player,mode,current,Scol,Srow,col,row,wait);

         cpu_makes_move(store,col,row,found,level,mode,player,wait,done,winner);

         case wait of
            LT : dec(col);
            RT : inc(col);
            UP : dec(row);
            DN : inc(row);
            CR : work_out_players_move(store,player,wait,col,row);
            F5 : {this is when the host player logs out}
            if connected then
            begin
               disconnect(current,names);

               display_text(mode,level,listno,names,stats,statsno,1);
               display_game_gfx(player,names,store);

               done := true;
               winner := 3;
            end;
            F10 : restarting_game {this is when the host player logs out}
            (mode,level,listno,names,stats,statsno,player,store,current,done,winner);
            ESC : exit_game(current,names);
         end;

         display_noughts_crosses(store);

         limits(col,1,3,false);
         limits(row,1,3,false);

         if (player = 1) and (mode = 2) then
         begin
            Scol := col; {saves this before computer takes turn}
            Srow := row;
         end;
         if ((player = 2) and (mode = 2)) or (mode = {4}3) then
         begin
            delay(1000); {second cpu pause during move}
            check_escape_during_cpu_move(done,winner,wait);
            if wait = ESC then
               exit_game(current,names);
         end;
      until (wait = CR) or done; {end of move}

      {for 2 player link up}
      if not done then
         send_move(mode,level,listno,names,current,col,row,player,store,stats,statsno,done,winner,msg,incsec,id);

      check_3_in_a_row(store,winner,done,player);
      if not done then
         test_for_draw(store,winner,done);

      if not done then {if game isnt ending}
         if player = 1 then {changes players turn}
            player := 2
         else
            player := 1;

   until done; {end of game}

   winner_text(winner,player,stats,names,statsno,mode,msg);

   if winner = 3 then {after press escape}
   begin
      clear_table;
      clear_bottom_text;
   end;

   if winner = 4 then {if remote player ends game}
   begin
      clear_table;
      if msg = 1 then {updates the status text}
      begin
         clrwin(522,185,639,290);
         display_user_online_txt(names,listno,mode);
         display_status(listno,names,mode);
      end;
   end;
end;


procedure send_names_script
(
    listno  : byte
);

var
   F     : text;
   ostmp : string;

begin
   assign(F,TMPDIR+'\script.txt');
   {$I-} rewrite(F); {$I+}
   errTest;

   {writeln(F,'verbose');}
   writeln(F,'user fraserking computer');
   writeln(F,'cd '+DEST);

   if listno = 1 then {name.dat gets deleted when disconnecting}
   begin
      writeln(F,'prompt');
      writeln(F,'mdelete name.dat move1.txt move2.txt');
   end;

   writeln(F,'send '+TMPDIR+'\name.dat name.dat');
   writeln(F,'quit');

   close(F);

   if os = 1 then
      ostmp := TMPDIR+'\tmp'
   else
      ostmp := 'nul';

   run(comspec,'/c '+ftp+' -n -s:'+TMPDIR+'\script.txt ftp.tripod.com >'+ostmp);
end;


procedure connect
(
var names   : namesType;
var listno  : byte;
{var errmsg : byte;}
var current : byte
);

var
   T        : text;
   tmpArray : idArrayType;
   i        : byte;

begin
   {$I-} mkdir(TMPDIR); {$I+}
   errTest;

   RestoreCrtMode; {leaves graphics mode}

   clear;
   writecrt('Connecting...Please wait',13,10);

   if not {connected}playing then
      receive_names_script(1) {start new 2 player link up}
   else
      connect_again_script; {play remote user again}

   assign(T,TMPDIR+'\name.dat');
   {$I-} reset(T); {$I+}
   errTest;

{  errmsg := 0;}
   listno := 0;
   while not eof(T) do
   begin
      inc(listno);
      readln(T,tmpArray[listno]);

      {if uppercase(tmpArray[listno]) = uppercase(names[1]) then
         errmsg := 1;}
   end;

   if {connected}playing then {play remote user again}
   begin
      SetGraphMode(GetGraphMode);
      close(T);
      {names[1] := tmpArray[1];
      names[2] := tmpArray[2];}
      delete_name_dat;
      exit;
   end;

   case listno of {before current name added}
      0 : current := 1;
      1 :
      begin
         names[2] := names[1]{names[2]};
         names[1] := tmpArray[1]; {first player sign in}
         current := 2;
         connected := true;
         playing := true;
      end;
      2 :
      begin
         names[1] := tmpArray[1];
         names[2] := tmpArray[2];
         connected := true;
         playing := true;
         SetGraphMode(GetGraphMode);
         close(T);
         exit;
      end;
   end;

   inc(listno);

   {$I-} rewrite(T); {$I+}
   errTest;

   for i := 1 to listno do
      writeln(T,names[i]);

   close(T);

   send_names_script(listno);
   delete_name_dat;

   SetGraphMode(GetGraphMode);
end;


procedure check_os;

begin
   if file_exists('c:\command.com') then
   begin
      comspec := 'c:\command.com';
      ftp := 'c:\windows\ftp';
      os := 1;
   end;
   if file_exists('c:\windows\system32\cmd.exe') then
   begin
      comspec := 'c:\windows\system32\cmd.exe';
      ftp := 'c:\windows\system32\ftp';
      os := 2;
   end;
end;


procedure initialise
(
var mode    : byte;
var statsno : byte;
var level   : byte;
var current : byte;
var names   : namesType;
var id      : idType
);

begin
   setbkcolor(0);
   randomize;
   delete_name_dat;

   mode := 1;
   statsno := (mode*2)-1;

   level := 1;
   current := 0;
{   names[1] := 'Player 1';}
   names[2] := 'Player 2';  {player 1's name is set in type_name}

   id[1] := names[1];
   id[2] := names[2];
   id[3] := names[1];
   id[4] := 'Cpu';
   id[5] := 'Cpu 1';
   id[6] := 'Cpu 2';
   id[7] := names[1];
   id[8] := names[2];
end;


{   start of main program   }


var
   option   : char;
   finished : boolean;
   mode     : byte;
   stats    : statsType;
   names    : namesType;
   level    : byte;
   listno   : byte;
{  errmsg   : byte;}
   current  : byte;
   statsno  : byte;
   id       : idType;

begin
   open_graphics_library;
   type_name(names,1);
   initialise(mode,statsno,level,current,names,id);
   check_os;
   display_text(mode,level,listno,names,stats,statsno,1);
   repeat
      check_keys(F1+F2+F3+F4+F5+ESC,option);
      case option of
         F1 :
         begin
            if mode = 4 then
            begin
               connect(names,listno,{errmsg,}current);

               id[7] := names[1];
               id[8] := names[2];

               display_text(mode,level,listno,names,stats,statsno,1);
               display_status(listno,names,mode);
            end;
            clear_table;

            if ((mode = 4) and (listno = 2)) or (mode in [1..3]) then
            begin
               display_stats(stats,names,statsno,mode);
               game(mode,stats,names,level,listno,current,statsno,id);
            end;

            display_controls_txt(1);
         end;
         F2 :
         begin
            inc(mode);
            limits(mode,1,4,true);
            statsno := (mode*2)-1;
            names[1] := id[statsno];
            names[2] := id[statsno+1];
            display_mode_txt(mode);
            display_stats(stats,names,statsno,mode);
         end;
         F3 :
         begin
            inc(level);
            limits(level,1,3,true);
            display_cpu_level_txt(level);
         end;
         F4 :
         begin
            type_name(names,2);

            id[1] := names[1]; {saves names for switching between modes}
            id[2] := names[2];
            id[3] := names[1];
            id[7] := names[1];
            id[8] := names[2];

            display_text(mode,level,listno,names,stats,statsno,1);
         end;
         F5  :
         if connected then
         begin
            disconnect(current,names);
            display_text(mode,level,listno,names,stats,statsno,1);
         end;
         ESC : finished := true;
      end;
   until finished;
   exit_game(current,names);
   closegraph;
end.


{   end of main program   }