home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol024 / othell2.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  7KB  |  234 lines
  1. (************************************************************
  2. *    PART OF OTHELLO.PAS see file for details
  3. **************************************************************)
  4.  
  5.  PROCEDURE calcmove( mover: color; VAR status: gamestatus;
  6.                     VAR legallist: movelist; VAR bestmove: movedesc);
  7.  TYPE
  8.  movearray = ARRAY[1..30] OF movedesc;
  9.  VAR
  10.  bestsofar,cornmoves,m,respcornmoves:         INTEGER;
  11.  move,movetemp:                               movedesc;
  12.  aftermove:                                   gamestatus;
  13.  responses:                                   movelist;
  14.  
  15.  PROCEDURE checkposition(VAR legallist: movelist; VAR cornmoves: INTEGER);
  16.  VAR
  17.  m,bestm,bestyet:  INTEGER;
  18.  BEGIN
  19.  bestyet := -MAXINT;
  20.  cornmoves := 0;
  21.  FOR m := 1 TO legallist.movecount DO WITH legallist.okmove[m],
  22.  board[moveloc.row,moveloc.col] DO
  23.     BEGIN
  24.  bordnoncorn := FALSE;
  25.  IF incenter4by4 THEN
  26.  points := points + 10
  27.  ELSE BEGIN
  28.  IF corner THEN BEGIN
  29.  points := points + 60;
  30.  cornmoves := cornmoves + 1;
  31.  END
  32.  ELSE IF border THEN BEGIN
  33.  bordnoncorn := TRUE;
  34.  points := points + 25;
  35.  END
  36.  ELSE IF diagnexttocorner THEN
  37.  points := points - 50;
  38.  END;
  39.                      IF points > bestyet THEN BEGIN
  40.  bestyet := points;
  41.  bestm := m;
  42.  end;
  43.  END; (*FOR m := 1 TO legallist.movecount...*)
  44.  movetemp := legallist.okmove[1];
  45.  legallist.okmove[1] := legallist.okmove[bestm];
  46.  legallist.okmove[bestm] := movetemp;
  47.  END; (*checkposition*)
  48.  
  49.  PROCEDURE sortmoves(VAR okmove: movearray;
  50.                      l,r: INTEGER) (*into descending order by points*) ;
  51.  VAR
  52.     i,j,baseval:      INTEGER;
  53.  BEGIN
  54.  i := l;
  55.  j := r;
  56.  baseval := okmove[(i+j) DIV 2].points;
  57.  REPEAT
  58.  WHILE okmove[i].points > baseval DO
  59.  i := i+1;
  60.  WHILE okmove[j].points < baseval DO
  61.  j := j-1;
  62.  IF i <= j THEN BEGIN
  63.  movetemp := okmove[i];
  64.  okmove[i] := okmove[j];
  65.  okmove[j] := movetemp;
  66.  i := i+1;
  67.  j := j-1;
  68.  END;
  69.  UNTIL i > j;
  70.  IF l < j THEN sortmoves(okmove, l, j );
  71.  IF i < r THEN sortmoves(okmove, i, r )
  72.  END (* sortmoves *) ;
  73.  
  74.  PROCEDURE checkresponses(mover: color; VAR move: movedesc;
  75.                           VAR responses: movelist; bestsofar: INTEGER);
  76.  (*$G+*)
  77.  LABEL 0;
  78.        VAR
  79.  contingent,c,r:                   INTEGER;
  80.  x,y:                              coordinate;
  81.  sq:                               squareloc;
  82.  direc:                            direction;
  83.  oppcolor:                         color;
  84.  afterresp:                        gamestatus;
  85.  cornercounter:                    BOOLEAN;
  86.  respondmove:                      movedesc;
  87.     counterresp:                      movelist;
  88.  BEGIN
  89.  oppcolor := flipof(mover);
  90.  WITH move DO BEGIN
  91.  contingent := 0;
  92.  r := 1;
  93.   REPEAT
  94.  respondmove := responses.okmove[r];
  95.  IF NOT board[moveloc.row,moveloc.col].incenter4by4 THEN
  96.  FOR direc := north TO nw DO  WITH respondmove DO
  97.  IF direc IN dirsflipped THEN  WITH moveloc DO
  98.  IF board[row,col].adjacentsq[direc] = move.moveloc THEN BEGIN
  99.  move.points := move.points - 5;
  100.  IF move.points <= bestsofar THEN
  101.  EXIT(checkresponses);
  102.               END;
  103.  afterresp := aftermove;
  104.  makemove(afterresp,respondmove,FALSE);
  105.  IF bordnoncorn THEN  WITH moveloc DO
  106.                            IF afterresp.boardstatus[row,col].occupier = oppcolor THEN BEGIN
  107.  bordnoncorn := FALSE;
  108.  points := points - 65; (*40, plus the 25 given in checkposition*)
  109.  IF points <= bestsofar THEN
  110.  EXIT(checkresponses);
  111.  END
  112.     ELSE
  113.  contingent := contingent + 8*respondmove.bordrsqsflipped;
  114.  WITH respondmove.moveloc DO
  115.  IF board[row,col].corner THEN BEGIN
  116.  points := points - 55;
  117.  IF cornmoves > 1 THEN
  118.  IF board[moveloc.row,moveloc.col].corner THEN
  119.  points := points -20;
  120.  IF points <= bestsofar THEN
  121.  EXIT(checkresponses);
  122.  END;
  123.  FOR x:=1 TO 8 DO FOR y:=1 TO 8 DO WITH afterresp.boardstatus[x,y] DO
  124.  IF occupied THEN
  125.  IF occupier = mover THEN
  126.  FOR direc := north TO nw DO WITH afterresp DO BEGIN
  127.  sq.row := x;
  128.  sq.col := y;
  129.  REPEAT
  130.  sq := board[sq.row,sq.col].adjacentsq[direc];
  131.  IF NOT sq.onboard THEN
  132.  GOTO 0;
  133.  IF NOT boardstatus[sq.row,sq.col].occupied THEN
  134.  GOTO 0
  135.  UNTIL boardstatus[sq.row,sq.col].occupier = oppcolor;
  136.  END;
  137.  makemove(afterresp,respondmove,TRUE);
  138.                                findlegalmoves(afterresp,counterresp);
  139.  cornercounter := FALSE;
  140.  c := 1;
  141.  WITH counterresp DO
  142.  WHILE ( (c <= movecount) AND (NOT cornercounter) ) DO BEGIN
  143.  WITH okmove[c].moveloc DO
  144.  IF board[row,col].corner THEN
  145.  cornercounter := TRUE;
  146.  c := c + 1;
  147.  END;
  148.  IF NOT cornercounter THEN BEGIN
  149.  points := points -190;
  150.              IF points <= bestsofar THEN
  151.  EXIT(checkresponses);
  152.              END;
  153.  0:
  154.  IF afterresp.score[mover] = 0 THEN BEGIN
  155.  points := -MAXINT+1; (*might be our only choice, so +1*)
  156.  EXIT(checkresponses);
  157.  END;
  158.  r := r + 1;
  159.  UNTIL r > responses.movecount;
  160.  IF bordnoncorn THEN BEGIN
  161.  points := points - contingent;
  162.  WITH board[moveloc.row,moveloc.col] DO
  163.  IF specialbordersq THEN WITH otherofpair,
  164.  status.boardstatus[row,col] DO
  165.  IF occupied THEN
  166.  IF occupier = mover THEN
  167.  WITH status.boardstatus[between.row,between.col] DO
  168.  IF NOT occupied THEN
  169.  points := points - 90;
  170.  END;
  171.        END; (*WITH move...*)
  172.  END; (*checkresponses*)
  173.  
  174.  BEGIN (*calcmove*)
  175.                GOTOXY(0,23);
  176.  WRITE('Calculating move for ',colorword[mover],'...');
  177.  checkposition(legallist,cornmoves);
  178.  IF legallist.movecount > 2 THEN
  179.     sortmoves(legallist.okmove,2,legallist.movecount);
  180.  bestsofar := -MAXINT;
  181.  FOR m := 1 TO legallist.movecount DO BEGIN
  182.  move := legallist.okmove[m];
  183.  aftermove := status;
  184.  makemove(aftermove,move,TRUE);
  185.  findlegalmoves(aftermove,responses);
  186.  WITH move DO BEGIN
  187.  IF responses.movecount = 0 THEN
  188.  points := points + 100
  189.  ELSE
  190.  IF points > bestsofar THEN BEGIN
  191.  checkposition(responses,respcornmoves);
  192.  checkresponses(mover,move,responses,bestsofar);
  193.        END;
  194.  IF points > bestsofar THEN BEGIN
  195.  bestsofar := points;
  196.  bestmove := move;
  197.  END;
  198.  END; (*WITH move...*)
  199.  END; (*FOR m := 1 TO legallist.movecount...*)
  200.  END; (*calcmove*)
  201.  
  202.  PROCEDURE play(mover: color);
  203.  BEGIN
  204.  GOTOXY(0,20+ORD(mover));
  205.  IF legalmoves[mover] > 0 THEN BEGIN
  206.  WRITE(spaces);
  207.  IF mover = usercolor THEN
  208.  inputmove(mover,legallist,move)
  209.  ELSE
  210.                                calcmove(mover,status,legallist,move);
  211.  makemove(status,move,TRUE);
  212.  updatecrt(crtstatus,status);
  213.  crtstatus := status;
  214.  END
  215.  ELSE BEGIN
  216.  WRITE('(No legal moves for ',colorword[mover],')');
  217.  status.nextmover := flipof(mover);
  218.  END;
  219.  END; (*play*)
  220.  
  221.  FUNCTION userquits: BOOLEAN;
  222.  VAR
  223.  playagain:        CHAR;
  224.  BEGIN
  225.  GOTOXY(0,20);
  226.  WRITELN(spaces); WRITELN(spaces); WRITELN; WRITE(spaces);
  227.  GOTOXY(0,23);
  228.  WRITE('Start a new game? (y/n): ');
  229.  READ(playagain);
  230.  userquits := NOT (playagain IN ['Y','y']);
  231.  END; (*userquits*)
  232.  
  233.  
  234.