mars.pas

source code for caro game on Java

const
  min_rise      = 1;
  Size          = 19;
  Human         = 1;
  Computer      = 2;
  Limit         = 30000;
  Move_limit    = 1000;
  Max_mark      = 10000;
  win_mark      = 1000;
  defend_mark   = -700;
  Defender      = 10;
  Attacker      = 0;

  max_range     = 17;
  Max_time      : Integer = 10000;

var
  var_maxply : Byte;

const
  ComputerType  = Defender;
  Side : Byte   = Computer;

type
  point = record
    x, y : Integer;
  end;

  Tboard= array[-1..size,-1..size] of ShortInt;

  TMark = record
    mark, xmark: Integer;
    value: array[0..7] of Integer;
    num, num10: Byte;
  end;

  TBoard_mark = array[0..Size-1,0..Size-1] of TMark;

  TInfo = record
    sum: Integer;
    pos: array[0..30] of point;
    sl: Byte;
  end;
  TLine = array[0..max_range] of point;

var
  Board: Tboard;
  Ply, aver_ply: Byte;
  Computer_side, first_side: Byte;

  board_val: TBoard_mark;
  hist_val: array[0..max_range*32] of record
    val : TMark;
    pnt : point;
  end;

  num_val: array[0..max_range] of Integer;

  hist_info: array[0..max_range,1..2] of TInfo;

  next: array[0..size*size-1] of point;
  vt_next: array[0..size-1,0..size-1] of Integer;
  num_next: array[0..max_range] of Integer;

  first_moves: Integer;

  time_start, Eval_count: Longint;
  time_end, eval_tick: longint;

  Cursor: Point;
  Count: Integer;
  moves: array[-400..max_range] of Point;
  Stop : Boolean;
  human_win, computer_win: Integer;
  MainLine: TLine;
  PlayPoint: Point;
  ChuaNghiXong : Boolean;

const
  min_nested    : Byte = 3;       { 3, 3, 3, 3, 3}
  aver_nested   : Byte = 6;       { 3, 4, 5, 6, 6}
  max_nested    : Byte = 15;      { 7, 9,11,13,17}

  ZeroPoint: Point = (x: -1; y: -1);
{---------------------------------------------------------}
function EmptyPoint(p: point): Boolean;
begin
  EmptyPoint := (p.x<0)or(p.y<0);
end;
{---------------------------------------------------------}
procedure Init_para;
var i: Integer;
begin
  side:=Computer;

  Randomize;
  Eval_count := 0;
  Count := 0;
  Stop := False;
  Ply := 0;
  aver_ply := 0;
  Computer_side := Computer;
  Cursor.x := (Size-1) div 2+random(2);
  Cursor.y := (Size-1) div 2+random(2);
  Fillchar(Board, Sizeof(Board), 0);
  Fillchar(next, Sizeof(next), 0);
  Fillchar(vt_next, Sizeof(vt_next), $FF);
  Fillchar(num_next, Sizeof(num_next), 0);
  Fillchar(board_val,Sizeof(board_val), 0);
  Fillchar(num_val,Sizeof(num_val), 0);
  Fillchar(hist_val,Sizeof(hist_val), 0);
  Fillchar(hist_info, Sizeof(hist_info), 0);
  for i := -1 to Size do
  begin
    Board[i, -1] := -1;
    Board[i, Size] := -1;
    Board[-1, i] := -1;
    Board[Size, i] := -1;
  end;
end;
{---------------------------------------------------------}
const
  xy: array[0..7,0..1] of Shortint =
      ((-1,-1),(-1,0),(-1,1),(0,1),
       (0,-1),(1,-1),(1,0),(1,1));

  BMarkOne: array[False..True,False..True,False..True,1..4] of Integer =
  (((
  (0,10,100,1000),
  (0, 2, 20, 200)),
  (
  (0, 2, 20, 200),
  (0, 0,  0,   0))),

  ((
  (0, 2, 20,1000),
  (0, 2, 20, 200)),
  (
  (0, 2, 20, 200),
  (0, 0,  0,   0))));

  BMark: array[1..2,False..True,False..True,1..4,1..4] of Integer =
  (((
  ((  10, 100, 200,1000),
   ( 100, 200, 200,1000),
   ( 200, 200, 200,1000),
   (1000,1000,1000,1000)),
  ((   2,  20, 200, 200),
   (  20, 200, 200, 200),
   ( 200, 200, 200, 200),
   (1000,1000,1000,1000))),
  (
  ((  2,  20, 200,1000),
   ( 20, 200, 200,1000),
   (200, 200, 200,1000),
   (200, 200, 200,1000)),
  ((  0,   0, 200, 200),
   (  0, 200, 200, 200),
   (200, 200, 200, 200),
   (200, 200, 200, 200))
  )),

  ((
  ((  10,  20,  20,  20),
   (  20,  20,  20,  20),
   ( 100, 100, 100, 100),
   (1000,1000,1000,1000)),
  ((   1,  20,  20,  20),
   (  20,  20,  20,  20),
   ( 100, 100, 100, 100),
   (1000,1000,1000,1000))),
  (
  ((   1,  20,  20,  20),
   (  20,  20,  20,  20),
   (  20,  20,  20,  20),
   ( 200, 200, 200, 200)),
  ((   0,  20,  20,  20),
   (  20,  20,  20,  20),
   (  20,  20,  20,  20),
   ( 200, 200, 200, 200))
  )));

{---------------------------------------------------------}
procedure Value(p: point; k: Byte; var Res: TMark);

var
  Len, Len1, Len2, space1, space2: Byte;
  s1, e1, s2, e2: Boolean;
  gt, i1, j1, i2, j2, v1, v2: Integer;
  chan, chan6: Boolean;
//-----------------------------//
procedure Tang_ij;
begin
  i1 := i1+xy[k,0];
  j1 := j1+xy[k,1];
end;
//-----------------------------//
procedure Tang_7ij;
begin
  i2 := i2+xy[7-k,0];
  j2 := j2+xy[7-k,1];
end;
//-----------------------------//
function Bonus(value: Integer; k: Byte): Integer;
begin
  if k in [0,2,5,7] then
    case value of
      10: Bonus := 1;
      20: Bonus := 2;
      100: Bonus := 10;
      200: Bonus := 20;
    else Bonus := 0;
    end
  else Bonus := 0;
end;
//-----------------------------//
begin
  gt := Board[p.x,p.y];
  Len := 1;
  Len1 := 0; Len2 := 0; space1 := 0; space2 := 0;
  s1 := False; e1 := False; s2 := False; e2 := False;
  i2 := P.x+xy[7-k,0];
  j2 := p.y+xy[7-k,1];
  while board[i2,j2]=gt do
    begin
      Inc(Len);
      Tang_7ij;
    end;
  i1 := p.x+xy[k,0];
  j1 := p.y+xy[k,1];
  while board[i1,j1]=gt do
    begin
      Inc(Len);
      Tang_ij;
    end;
  if Len>=5 then
    begin
      Res.value[k] := max_mark;
      Res.value[7-k] := max_mark;
      Exit;
    end;
  if board[i2,j2]<>Empty then
    begin
      s1 := True;
      e2 := True;
    end
  else
    begin
      Tang_7ij;
      space2 := 1;
      if board[i2,j2]=Empty then
        begin
          space2 := 2;
          Tang_7ij;
        end;
      while board[i2,j2]=gt do
        begin
          Inc(Len2);
          Tang_7ij;
        end;
      if (Len2>0)and(board[i2,j2]<>Empty) then e2 := True;
    end;
  if Board[i1,j1]<>Empty then
    begin
      s2 := True;
      e1 := True;
    end
  else
    begin
      Tang_ij;
      space1 := 1;
      if board[i1,j1]=Empty then
        begin
          Tang_ij;
          space1 := 2;
        end;
      while board[i1,j1]=gt do
        begin
          Inc(Len1);
          Tang_ij;
        end;
      if (Len1>0)and(Board[i1,j1]<>Empty) then e1 := True;
    end;
  chan := (Board[i1,j1]<>Empty)and(Board[i2,j2]<>Empty);
  if chan and (abs(i1-i2)<=5)and(abs(j1-j2)<=5) then
    begin
      v1 := 0;
      v2 := 0;
    end
  else
    begin
      chan6 := chan and ((abs(i1-i2)=6)or(abs(j1-j2)=6));
      if len1 >= 5 then len1 := 4;
      if len2 >= 5 then len2 := 4;
      if Len1=0 then
        v1 := BMarkOne[chan6,s1,e1,Len]
      else
        v1 := BMark[space1,s1,e1,Len,Len1];
      if Len2=0 then
        v2 := BMarkOne[chan6,s2,e2,Len]
      else
        v2 := BMark[space2,s2,e2,Len,Len2];
    end;
  if (Len=1)and(Len1=1)and(space1=1)and(Len2=1)and(space2=1) then
    begin
      v1 := 20;
      v2 := 20;
    end;
  v1 := v1+Bonus(v1,k);
  v2 := v2+Bonus(v2,k);
  Res.value[k] := v1;
  Res.value[7-k] := v2;
end;
{---------------------------------------------------------}
procedure Add_pos(p: point);
var
  gt: byte;
  i: integer;
begin
  gt := board[p.x,p.y];
  i := hist_info[ply,gt].sl;
  hist_info[ply,gt].pos[i] := p;
  Inc(hist_info[ply,gt].sl);
end;
{---------------------------------------------------------}
procedure Del_pos(p : point);
var
  gt, i, j: Integer;
begin
  gt := board[p.x,p.y];
  j := hist_info[ply,gt].sl-1;
  for i := j downto 0 do
    if (p.X=hist_info[ply,gt].pos[i].X) and (p.Y=hist_info[ply,gt].pos[i].Y) then
    begin
      hist_info[ply,gt].pos[i] := hist_info[ply,gt].pos[j];
      Dec(hist_info[ply,gt].sl);
      Break;
    end;
end;
{---------------------------------------------------------}
procedure Add_dat(p: point; var Res: TMark);
begin
  hist_val[num_val[ply]].val := board_val[p.x,p.y];
  hist_val[num_val[ply]].pnt := p;
  Inc(num_val[ply]);
end;
{---------------------------------------------------------}
procedure Tinh_info(p: point; var Res: TMark);
var
  gt: Byte;
  n, L: Integer;
begin
  gt := board[p.x,p.y];
  L := board_val[p.x,p.y].xMark;
  N := board_val[p.x,p.y].num;
  if Res.num>=1 then
  begin
    if N<1 then Add_pos(p)
  end else if N>=1 then Del_pos(p);
  Res.xmark := Res.Mark;
  if Res.num>=2 then Res.xmark := Res.mark shl 1 else
  begin
    if Res.num10>=2 then Res.xmark := Res.mark+ComputerType;
    if Res.num10>=3 then Res.xmark := Res.xmark+ComputerType;
  end;
  Inc(hist_info[ply,gt].sum,Res.xmark-L);
end;
{---------------------------------------------------------}
procedure General_mark(p: point; var Res: TMark);
var
  k: Byte;
  v1, v2: Integer;
begin
  Res.Mark := 0; Res.num := 0; Res.num10 := 0;
  for k := 0 to 3 do
  begin
    v1 := Res.value[k];
    v2 := Res.value[7-k];
    if (v1>=100)or(v2>=100) then Inc(Res.num) else
      if (v1>=10)or(v2>=10) then Inc(Res.num10);
    if v1<v2 then
      Res.Mark := Res.Mark+v2
    else
      Res.Mark := Res.Mark+v1;
  end;
  Tinh_info(p, Res);
  Add_dat(p, Res);
  board_val[p.x,p.y] := Res;
end;
{---------------------------------------------------------}
procedure Mark(P: Point);
var
  k: byte;
  Res: TMark;
begin
  for k := 0 to 3 do
  begin
    Value(p, k, Res);
    if Res.value[k]=max_mark then
    begin
      board_val[p.x,p.y].mark := max_mark;
      Exit;
    end;
  end;
  General_mark(p, Res);
end;
{---------------------------------------------------------}
procedure Mark_Part(p: point; k: Byte);
var
  Res: TMark;
begin
  Res := board_val[p.x,p.y];
  Value(p,k,Res);
  General_mark(p,Res);
end;
{---------------------------------------------------------}
procedure Tinh_mark(p: Point);
var
  k: Byte;
  Q, R: point;
  gt: Byte;
  Res: TMark;
//-----------------------------//
procedure Tang_xy;
begin
  q.x := q.x+xy[k,0];
  q.y := q.y+xy[k,1];
end;
//-----------------------------//
procedure Tinh_day(sgt: Byte);
begin
  while board[q.x,q.y]=sgt do
  begin
    Res := board_val[q.x,q.y];
    Res.value[k] := board_val[R.x,R.y].value[k];
    Res.value[7-k] := board_val[R.x,R.y].value[7-k];
    General_mark(q,Res);
    Tang_xy;
  end;
end;
//-----------------------------//
begin
  gt := board[p.x,p.y];
  for k := 0 to 7 do
  begin
    q.x := p.x+xy[k,0];
    q.y := p.y+xy[k,1];
    R := P;
    if board[q.x,q.y]=gt then
    begin
      Tinh_day(gt);
      if board[q.x,q.y]=Empty then
      begin
        Tang_xy;
        if board[q.x,q.y]=Empty then Tang_xy;
        if board[q.x,q.y]=gt then
        begin
          Mark_Part(Q,k);
          R := Q;
          Tang_xy;
          Tinh_day(gt);
        end;
      end;
    end else
    begin
      if board[q.x,q.y]=Empty then
      begin
        Tang_xy;
        if board[q.x,q.y]=Empty then Tang_xy;
      end;
      if board[q.x,q.y]=gt then
      begin
        Mark_part(Q,k);
        R := Q;
        Tang_xy;
        Tinh_day(gt);
      end else
      if board[q.x,q.y]=3-gt then
      begin
        Mark_part(Q,k);
        R := Q;
        Tang_xy;
        Tinh_day(3-gt);
        if board[q.x,q.y]=Empty then
        begin
          Tang_xy;
          if board[q.x,q.y]=Empty then Tang_xy;
          if board[q.x,q.y]=3-gt then
          begin
            Mark_part(Q,k);
            R := Q;
            Tang_xy;
            Tinh_day(3-gt);
          end;
        end;
      end;
    end;
  end;
end;
{---------------------------------------------------------}
const
  value200: array[1..4] of Integer = (200,300,400,500);
  value20: array[0..4] of Integer = (20,20,30,40,50);

procedure Add_next(p: point);
begin
  if vt_next[p.x,p.y]=-1 then
  begin
    vt_next[p.x,p.y] := num_next[ply];
    next[num_next[ply]] := p;
    Inc(num_next[ply]);
  end;
end;
{---------------------------------------------------------}
procedure Del_next(p: point);
var i: Integer;
begin
  i := vt_next[p.x,p.y];
  next[i] := next[num_next[ply]-1];
  vt_next[next[i].x,next[i].y] := i;
  Dec(num_next[ply]);
end;
{---------------------------------------------------------}
procedure do_next(p: point);
var
  k: Byte;
  q: point;
begin