mars.pas

source code for caro game on Java

  Del_next(p);
  for k := 0 to 7 do
  begin
    q.x := p.x+xy[k,0];
    q.y := p.y+xy[k,1];
    if board[q.x,q.y]=empty then
    begin
      Add_next(q);
      q.x := q.x+xy[k,0];
      q.y := q.y+xy[k,1];
      if board[q.x,q.y]=empty then Add_next(q);
    end;
  end;
end;
{---------------------------------------------------------}
procedure undo_next(p: point);
var i, j: Integer;
begin
  i := vt_next[p.x,p.y];
  for j := num_next[ply]-1 to num_next[ply+1]-1 do
    vt_next[next[j].x,next[j].y] := -1;
  j := num_next[ply]-1;
  if i<j then
  begin
    next[j] := next[i];
    vt_next[next[j].x,next[j].y] := j;
  end;
  next[i] := p;
end;
{---------------------------------------------------------}
procedure undo_val(p: point);
var i: Integer;
begin
{  Fillchar(board_val[p.x,p.y],Sizeof(board_val[p.x,p.y]),0);}
  for i := num_val[ply] to num_val[ply+1]-1 do
    board_val[hist_val[i].pnt.x,hist_val[i].pnt.y] := hist_val[i].val;
end;
{---------------------------------------------------------}
function Make_move(P: Point): Boolean;
begin
  Board[P.x, P.y] := side;
  moves[ply] := P;
  Inc(Ply);
  hist_info[ply] := hist_info[ply-1];
  num_next[ply] := num_next[ply-1];
  num_val[ply] := num_val[ply-1];
  Mark(p);
  if board_val[p.x,p.y].mark=max_mark then Make_move := True else
  begin
    Tinh_mark(p);
    Make_move := false;
  end;
  Do_next(p);
  side := 3-side;
end;
{---------------------------------------------------------}
procedure Unmake_move;
var
  P: Point;
begin
  side := 3-side;
  Dec(Ply);
  P := moves[ply];
  Board[P.x, P.y] := Empty;
  undo_next(p);
  undo_val(p);
end;
{---------------------------------------------------------}
function Around(p: point; gt: Byte): Byte;
var
  i, j, k : Integer;
  BResult : Byte;
begin
  BResult := 0;
  for k := 0 to 7 do
  begin
    i := p.x+xy[k,0];
    j := p.y+xy[k,1];
    if board[i,j]=gt then Inc(BResult);
    if (board[i,j]=gt)or(board[i,j]=Empty) then
      if board[i+xy[k,0],j+xy[k,1]]=gt then Inc(BResult);
  end;
  Around := BResult;
end;
{---------------------------------------------------------}
function TimeExpire: Boolean;
begin
  if GetTickCount-Time_start>max_time then
    begin
      ChuaNghiXong:=True;
      Result:=True;
    end
  else Result:=False;
end;
{---------------------------------------------------------}
function Search(alpha, beta: Integer; depth, aver_depth: Shortint;
         var BestLine: TLine): Integer;
var
  Nextp: point;
  value, best: Integer;
  Nextdepth, NextAver_depth: Shortint;
  Line: TLine;
  gen_type: (Main, normal);
//-----------------------------//
  function Eval: Integer;
  begin
    Eval := hist_info[ply,side].sum-hist_info[ply,3-side].sum;
    Inc(Eval_count);
//    if (time and $F=0)and(time<>eval_tick) then Draw_eval;
  end;
//-----------------------------//
  function LoopSearch: Boolean;
  begin
    LoopSearch := True;
    if best>=beta then Exit;
    if gen_type<>Main then
      if (Nextp.X=BestLine[ply].X) and (Nextp.Y=BestLine[ply].Y) then
      begin
        LoopSearch := False;
        Exit;
      end;
    if ply=0 then Inc(first_moves);
    if ply<max_range then
    begin
      Line[ply+1] := ZeroPoint;
      if Gen_Type=Main then
        Line := BestLine;
    end;
    if Make_move(Nextp) then
    begin
      value := max_mark-ply;
      Inc(eval_count);
    end else
      if (NextDepth=0)or(NextAver_depth=0)or(ply>=var_maxply) then
        value := - Eval
      else
        value := - Search(-beta, -alpha, NextDepth, NextAver_depth, Line);
    Unmake_move;
    if value > best then
    begin
      best := value;
//      if ply=0 then un_test;
      Line[ply] := Nextp;
      BestLine := Line;
      if (ply=0) and (not TimeExpire) then
        begin
//          Draw_best(best);
//          Test;
//          if best>=max_mark-max_nested then Draw_hint(htOreka);
//          if best<=-max_mark+max_nested then Draw_hint(htDisapoint);
          if best>=max_mark-var_maxply then
            var_maxply := max_mark-best-1;
        end
    end;
    if best>alpha then alpha := best;
    if best>=beta then Exit;
    if TimeExpire then Exit;
    LoopSearch := False;
  end; { LoopSearch }
//-----------------------------//
  function AroundSpeGen(P: Point; v: Byte): Boolean;
  var
    gt, k: Byte;
  begin
    AroundSpeGen := False;
    gt := board[p.x,p.y];
    for k := 0 to 7 do
      if board_val[p.x,p.y].value[k]>=v then
      begin
        AroundSpeGen := True;
        Nextp.x := p.x+xy[k,0];
        Nextp.y := p.y+xy[k,1];
        while board[nextp.x,nextp.y]=gt do
        begin
          nextp.x := nextp.x+xy[k,0];
          nextp.y := nextp.y+xy[k,1];
        end;
        if board[nextp.x,nextp.y]=Empty then
          if LoopSearch then Exit;
      end;
  end;
//-----------------------------//
  function Mov4MyGen: Boolean;
  var
    t: Integer;
    info: TInfo;
    P: point;
  begin
    Mov4MyGen := True;
    info := hist_info[ply,side];
    if info.sl>0 then
      for t := info.sl-1 downto 0 do
      begin
        p := info.pos[t];
        if board_val[p.x,p.y].mark>=value200[board_val[p.x,p.y].num] then
          if AroundSpeGen(p, 200) then Exit;
      end;
    Mov4MyGen := False;
  end;
//-----------------------------//
  function Mov4OppGen: Boolean;
  var
    t: Integer;
    Info: TInfo;
    P: point;
  begin
    Mov4OppGen := True;
    info := hist_info[ply,3-side];
    if info.sl>0 then
      for t := info.sl-1 downto 0 do
      begin
        p := info.pos[t];
        if board_val[p.x,p.y].mark>=value200[board_val[p.x,p.y].num] then
        begin
//          if ply=0 then Draw_eval;

          if AroundSpeGen(p, 200) then Exit;
        end;
      end;
    Mov4OppGen := False;
  end;
//-----------------------------//
  function Mov3MyGen: Boolean;
  var
    info: TInfo;
  begin
    info := hist_info[ply,side];
    if info.sl>0 then
    begin
      Mov3MyGen := True;
      AroundSpeGen(info.pos[0],100);
    end else Mov3MyGen := False;
  end;
//-----------------------------//
  function Mov3OppGen: Boolean;
  var
    i: Integer;
    {P, }p1, p2, p3: point;

    function GenOpp100: Boolean;
    var
      P: point;
      gt, k: Byte;

      procedure Tang_next;
      begin
        nextp.x := nextp.x+xy[k,0];
        nextp.y := nextp.y+xy[k,1];
      end;

    begin
      GenOpp100 := True;
      Fillchar(p1,Sizeof(p1),$FF);
      Fillchar(p2,Sizeof(p2),$FF);
      Fillchar(p3,Sizeof(p3),$FF);
      P := hist_info[ply,3-side].pos[0];
      gt := board[p.x,p.y];
      for k := 0 to 7 do
        if board_val[p.x,p.y].value[k]>=100 then
        begin
          nextp.x := p.x+xy[k,0];
          nextp.y := p.y+xy[k,1];
          while board[nextp.x,nextp.y]=gt do Tang_next;
          if board[nextp.x,nextp.y]=Empty then
          begin
            p1 := nextp;
            if LoopSearch then Exit;
            Tang_next;
            if board[nextp.x,nextp.y]=gt then
            begin
              while board[nextp.x,nextp.y]=gt do Tang_next;
              if board[nextp.x,nextp.y]=Empty then
              begin
                p2 := nextp;
                if LoopSearch then Exit;
              end;
            end;
          end;
          nextp.x := p.x+xy[7-k,0];
          nextp.y := p.y+xy[7-k,1];
          while board[nextp.x,nextp.y]=gt do
          begin
            nextp.x := nextp.x+xy[7-k,0];
            nextp.y := nextp.y+xy[7-k,1];
          end;
          if board[nextp.x,nextp.y]=Empty then
          begin
            p3 := nextp;
            if LoopSearch then Exit;
          end;
          Break;
        end;
      GenOpp100 := False;
    end; { GenOpp100 }
//-----------------------------//
    function GenMy20: Boolean;
    var
      k: Byte;
      P: point;
    begin
      GenMy20 := True;
      for k := 0 to 7 do
      begin
        p.x := nextp.x+xy[k,0];
        p.y := nextp.y+xy[k,1];
        if board[p.x,p.y]=Empty then
        begin
          p.x := p.x+xy[k,0];
          p.y := p.y+xy[k,1];
        end;
        if (board[p.x,p.y]=side)and(board_val[p.x,p.y].value[7-k]>=20) then
        begin
          if LoopSearch then Exit;
          Break;
        end;
      end;
      GenMy20 := False;
    end; { GenMy20 }
//-----------------------------//
  begin
    if hist_info[ply,3-side].sl>0 then
    begin
      Mov3OppGen := True;
      if ply>=min_rise then NextAver_Depth := Aver_Depth-1;
      if GenOpp100 then Exit;
      for i := num_next[ply]-1 downto 0 do
      begin
        nextp := next[i];
        if ((nextp.X<>p1.X) or (nextp.Y<>p1.Y)) and ((nextp.X<>p2.X) or (nextp.Y<>p2.Y))
          and ((nextp.X<>p3.X) or (nextp.Y<>p3.Y)) then
          if GenMy20 then Exit;
      end;
    end else Mov3OppGen := False;
  end; { Mov3OppGen }
//-----------------------------//
  procedure OtherSearch;
  var
    i: Integer;
  begin
    NextDepth := Depth-1;
    for i := num_next[ply]-1 downto 0 do
    begin
      nextp := next[i];
      if LoopSearch then Exit;
    end;
  end;
//-----------------------------//
label QuitSearch;

begin
  best := -Limit;
  if ply>=Min_rise then NextDepth := Depth else NextDepth := Depth-1;
  NextAver_Depth := Aver_depth;
  if (not EmptyPoint(BestLine[ply])) and
    (board[Bestline[ply].x,BestLine[ply].y]=Empty) then
  begin
    Gen_type := Main;
    Nextp := BestLine[ply];
    if LoopSearch then goto QuitSearch;
  end;
  Gen_type := Normal;
  if Mov4MyGen then goto QuitSearch;
  if Mov4OppGen then goto QuitSearch;
  if Mov3MyGen then goto QuitSearch;
  if Mov3OppGen then goto QuitSearch;
  OtherSearch;
QuitSearch:
  Search := best;
end; {Search}
{---------------------------------------------------------}
const
  Book1: array[0..7] of point = (
    (x: -1; y: -1),
    (x: -1; y:  1),
    (x:  1; y: -1),
    (x:  1; y:  1),
    (x: -2; y:  0),
    (x:  2; y:  0),
    (x:  0; y: -2),
    (x:  0; y:  2));

  min_count = 0;
{---------------------------------------------------------}
function SearchMove(TickLimit: Integer): Integer;
var
  best: Integer;
  min_var: Integer;
begin
  Time_start := GetTickCount;
  max_time := TickLimit;
  var_maxply := max_nested;
  min_var := 0;
  MainLine[0] := ZeroPoint;
  repeat
    Inc(min_var);
    if min_var>1 then min_var := min_nested;
    first_moves := 0;
    best := Search(-Limit,Limit,min_var,aver_nested,MainLine);
  until (first_moves<=1)or(abs(best)>=max_mark-max_nested)
    or(min_var=min_nested);
  SearchMove := best;
end;
{---------------------------------------------------------}
procedure Computer_think;
var
  i{, best} : Integer;
begin
  Eval_count := 0;
  ChuaNghiXong:=False;
  time_start := GetTickCount;
  case Count of
    0: begin
      PlayPoint := Cursor;
      ShowMessage('Chet toi');
//      best := 0;
{    end;
    0: begin}
      repeat
        i := Random(8);
        PlayPoint.x := moves[-1].x+Book1[i].x;
        PlayPoint.y := moves[-1].y+Book1[i].y;
        if (board[PlayPoint.x,PlayPoint.y]<>-1) then
          Break;
      until False;
//      best := 0;
    end;
  else
{    best := }SearchMove(max_time);
    PlayPoint := MainLine[0];
  end;
  time_end := GetTickCount;
end;
{---------------------------------------------------------}
procedure QSort(L, R: Integer);
var
  i, j, x: Integer;
  p: point;
begin
  i := L; j := R;
  p := next[(L+R) shr 1];
  x := board_val[p.x,p.y].mark;
  repeat
    while board_val[next[i].x,next[i].y].mark < x do Inc(i);
    while board_val[next[j].x,next[j].y].mark > x do Dec(j);
    if i<=j then
    begin
      p := next[i];
      next[i] := next[j];
      next[j] := p;
      Inc(i);
      Dec(j);
    end;
  until i>j;
  if L<j then QSort(L, j);
  if i<R then QSort(i, R);
end;
{---------------------------------------------------------}
procedure Next_start;
var
  t, i, j: Integer;
  p: point;
  saved_val: TBoard_mark;
begin
  Inc(ply);
  hist_info[ply] := hist_info[ply-1];
  saved_val := board_val;
  for t := 0 to num_next[ply-1]-1 do
  begin
    p := next[t];
    board[p.x,p.y] := side;
    Mark(p);
    i := board_val[p.x,p.y].mark;
    board[p.x,p.y] := 3-side;
    Mark(p);
    j := board_val[p.x,p.y].mark;
    if j<i then board_val[p.x,p.y].mark := i;
    board[p.x,p.y] := Empty;
    num_val[ply] := 0;
  end;
  QSort(0,num_next[ply-1]-1);
  for t := 0 to num_next[ply-1]-1 do
    vt_next[next[t].x,next[t].y] := t;
  Dec(ply);
  board_val := saved_val;
end;
{---------------------------------------------------------}
function Update_move: Boolean;
var
  i : Integer;
  P : Point;
  L : Integer;
begin
  P := PlayPoint;

  NewMove.Row:=P.X+1;
  NewMove.Col:=P.Y+1;

  Board[p.x,p.y] := side;
  Mark(p);
  Tinh_mark(p);
  if count=0 then
  begin
    num_next[ply] := 1;
    vt_next[p.x,p.y] := 0;
    next[0] := p;
  end;
  num_val[ply] := 0;
  L := board_val[p.x,p.y].mark;
  Update_move := L=max_mark;
  for i:=1 to count do Moves[-count-1]:=Moves[-count];
  moves[-1] := P;
  Inc(Count);
  do_next(p);
  next_start;
end;
{---------------------------------------------------------}
procedure Mars;
begin
  Computer_think;
  Update_move;
  side := 3-side;
  first_side := side;
  if ChuaNghiXong then MainForm.ListBox.Items.Add('- Danger -');
end;
{---------------------------------------------------------}