home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol024 / othellin.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  7KB  |  243 lines
  1.  (**********************************************************
  2. *    PART OF OTHELLO.PAS so see that file for details.
  3. ************************************************************)
  4.  
  5.  (* included file for OTHELLO *)
  6.  
  7.  PROCEDURE updatecrt(VAR oldstatus,newstatus: gamestatus);
  8.  FORWARD;
  9.  FUNCTION flipof(oldcolor: color): color;
  10.  FORWARD;
  11.  PROCEDURE makemove(VAR status: gamestatus; VAR move: movedesc; updateadjacent:
  12.  BOOLEAN);
  13.  FORWARD;
  14.  
  15.  SEGMENT PROCEDURE initgame;
  16.  CONST
  17.  backspace = 8;
  18.  VAR
  19.  x,y:         coordinate;
  20.  direc:       direction;
  21.     answer:      CHAR;
  22.  h,l,h0,l0:   INTEGER; (*for testing whether clock is on*)
  23.  
  24.  PROCEDURE defineboard;
  25.  BEGIN
  26.  FOR x := 1 TO 8 DO  FOR y := 1 TO 8 DO  WITH board[x,y] DO BEGIN
  27.  border := (x IN [1,8]) OR (y IN [1,8]);
  28.  corner := (x IN [1,8]) AND (y IN [1,8]);
  29.  incenter4by4 := (x IN [3..6]) AND (y IN [3..6]);
  30.  diagnexttocorner := (x IN [2,7]) AND (y IN [2,7]);
  31.  FOR direc := north TO nw  DO WITH adjacentsq[direc] DO BEGIN 
  32.  CASE direc OF
  33.  north: onboard := x>1;
  34.  ne:    onboard := (x>1) AND (y<8);
  35.  east:  onboard := y<8;
  36.                                 se:    onboard := (x<8) AND (y<8);
  37.  south: onboard := x<8;
  38.  sw:    onboard := (x<8) AND (y>1);
  39.  west:  onboard := y>1;
  40.  nw:    onboard := (x>1) AND (y>1);
  41.  END; (*CASE*)
  42.  IF onboard THEN BEGIN
  43.  CASE direc OF
  44.  north,ne,nw: row := x-1;
  45.  east,west:   row := x;
  46.  south,se,sw: row := x+1;
  47.  END;
  48.  CASE direc OF
  49.  nw,west,sw:  col := y-1;
  50.  north,south: col := y;
  51.  ne,east,se:  col := y+1;
  52.  END;
  53.  END;
  54.  END; (*FOR direc...WITH adjacentsq...*)
  55.  specialbordersq := border AND (NOT corner) AND 
  56.  ( (x IN [2,4,5,7]) OR (y IN [2,4,5,7]) );
  57.  IF specialbordersq THEN BEGIN
  58.  otherofpair.onboard := TRUE;
  59.  between.onboard := TRUE;
  60.  IF x IN [1,8] THEN BEGIN
  61.  otherofpair.row := x;
  62.  between.row := x;
  63.  IF y IN [2,5] THEN BEGIN
  64.  otherofpair.col := y+2;
  65.  between.col := y+1;
  66.  END
  67.  ELSE BEGIN
  68.  otherofpair.col := y-2;
  69.  between.col := y-1;
  70.  END;
  71.  END
  72.  ELSE BEGIN
  73.  otherofpair.col := y;
  74.  between.col := y;
  75.  IF x IN [2,5] THEN BEGIN
  76.  otherofpair.row := x+2;
  77.  between.row := x+1;
  78.  END
  79.  ELSE BEGIN
  80.           otherofpair.row := x-2;
  81.  between.row := x-1;
  82.  END;
  83.  END;
  84.  END; (*IF specialbordersq...*)
  85.  END; (*FOR x:= ... FOR y:= ... WITH board[x,y]...*)
  86.  END; (*defineboard*)
  87.  
  88.  PROCEDURE showemptyboard;
  89.  CONST
  90.  vertdivs = '|     |     |     |     |     |     |     |     |';
  91.  horzdivs = '|-----|-----|-----|-----|-----|-----|-----|-----|';
  92.  colnames = '   A     B     C     D     E     F     G     H   ';
  93.     blanks   = '                              ';
  94.  VAR
  95.  gamerow :    coordinate;
  96.  BEGIN
  97.  GOTOXY(0,0);
  98.  FOR gamerow := 1 TO 8 DO BEGIN
  99.  IF gamerow>1 THEN (* "IF" because no room for topmost border line *)
  100.  writeln(blanks,horzdivs);
  101.  writeln(blanks:29,gamerow,vertdivs);
  102.  writeln(blanks,vertdivs);
  103.  END;
  104.  write(blanks,colnames);
  105.  GOTOXY(4,0);
  106.  WRITELN('Score');
  107.  WRITELN('-----------');
  108.  WRITELN(CHR(whiteascii),'/White:');
  109.  WRITELN(CHR(blackascii),'/Black:');
  110.  END; (*showemptyboard*)
  111.  
  112.     PROCEDURE instructions;
  113.  VAR
  114.  i: INTEGER;
  115.  PROCEDURE page1;
  116.  BEGIN
  117.                                     WRITELN('A move consists of placing  ');
  118.  WRITELN('one of your pieces on an    ');
  119.  WRITELN('unoccupied square which is  ');
  120.  WRITELN('adjacent (vertically, hori- ');
  121.  WRITELN('zontally, or diagonally) to ');
  122.  WRITELN('a square occupied by your   ');
  123.  WRITELN('opponent so that a straight ');
  124.  WRITELN('line starting at your piece ');
  125.  WRITELN('and continuing in the direc-');
  126.  WRITELN('tion of the adjacent oppon- ');
  127.  WRITELN('ent hits one of your other  ');
  128.  WRITELN('pieces before hitting an un-');
  129.  WRITELN('occupied square.  All of the');
  130.  WRITELN('opponent''s pieces which that');
  131.  WRITELN('line crosses are converted  ');
  132.  WRITELN('to become your pieces.  Thus');
  133.  WRITELN('each move "flips" at least  ');
  134.  WRITELN('one opposing piece.         ');
  135.  WRITE  (' (Tap space bar for more...)');
  136.     END; (*page1*)
  137.  PROCEDURE page2;
  138.  BEGIN
  139.  WRITELN('Example:  a legal move for  ');
  140.  WRITELN('white on the first play     ');
  141.  WRITELN('would be 3E, 4F, 6D, or 5C. ');
  142.                                WRITELN('To make a move at, e.g., 3E ');
  143.  WRITELN('you may type any of: 3E, 3e,');
  144.  WRITELN('E3, or e3.                  ');
  145.  WRITELN('If you have no legal move,  ');
  146.  WRITELN('you must pass.  The object  ');
  147.  WRITELN('of the game is to end up    ');
  148.  WRITELN('occupying more squares than ');
  149.  WRITELN('does your opponent.         ');
  150.  WRITELN('Hints on strategy:  Usually ');
  151.  WRITELN('the board position of a move');
  152.  WRITELN('is more important than the  ');
  153.  WRITELN('number of pieces it "flips".');
  154.  WRITELN('Try to occupy the borders   ');
  155.  WRITELN('(especially corners!) and   ');
  156.  WRITELN('avoid giving them to your   ');
  157.  WRITE  ('opponent. (Tap space bar...)');
  158.     END; (*page2*)
  159.  BEGIN (*instructions*)
  160.  GOTOXY(0,5);
  161.  WRITE('Want instructions? (y/n): ');
  162.  READ(answer);
  163.  IF NOT (answer IN ['N','n']) THEN BEGIN
  164.  GOTOXY(0,5);
  165.  page1;
  166.  READ(answer);
  167.  GOTOXY(0,5);
  168.  page2;
  169.  READ(answer);
  170.  GOTOXY(0,5);
  171.  FOR i := 5 TO 22 DO
  172.  WRITELN(spaces);
  173.  WRITE(spaces);
  174.  END
  175.  ELSE BEGIN
  176.         GOTOXY(0,5);
  177.  WRITE(spaces);
  178.  END;
  179.  END; (*instructions*)
  180.  
  181.  BEGIN (*initgame*)
  182.  lastchange := 0;
  183.  TIME(h0,l0);
  184.  defineboard;
  185.  FOR direc := north TO NW DO
  186.  IF odd(ORD(direc)) THEN
  187.        opposdir[direc] := pred(direc)
  188.  ELSE
  189.  opposdir[direc] := succ(direc);
  190.  TIME(h,l);
  191.  IF (h=h0) AND (l=l0) THEN BEGIN
  192.  GOTOXY(20,11);
  193.  WRITE('Please turn on the clock.');
  194.  WHILE l=l0 DO
  195.  TIME(h,l);
  196.  END;
  197.  showemptyboard;
  198.  WITH status DO BEGIN
  199.  score[white] := 0;
  200.  score[black] := 0;
  201.  FOR x := 1 TO 8 DO  FOR y := 1 TO 8 DO WITH boardstatus[x,y] DO BEGIN
  202.     occupied := FALSE;
  203.     adjacentpieces[white] := [];
  204.  adjacentpieces[black] := [];
  205.  END;
  206.  END;
  207.  crtstatus := status;
  208.  move.dirsflipped := [];
  209.  move.points := 0;
  210.  WITH status DO BEGIN
  211.  FOR x := 4 TO 5 DO  FOR y := 4 TO 5 DO BEGIN
  212.  move.moveloc.row := x;
  213.  move.moveloc.col := y;
  214.  IF x=y THEN
  215.  nextmover := white
  216.  ELSE
  217.  nextmover := black;
  218.  makemove(status,move,TRUE);
  219.  updatecrt(crtstatus,status);
  220.        crtstatus := status;
  221.               END; (*FOR...FOR...*)
  222.  nextmover := white;
  223.  END; (*WITH status...*)
  224.  instructions;
  225.  GOTOXY(0,6);
  226.  WRITELN('White goes first -- Which');
  227.  WRITELN('color do you want to play:');
  228.  REPEAT
  229.  GOTOXY(3,8);
  230.     WRITE('W)hite or B)lack?  ',CHR(backspace));
  231.     READ(answer);
  232.  UNTIL answer IN ['W','w','B','b'];
  233.  IF answer IN ['W','w'] THEN
  234.  usercolor := white
  235.  ELSE 
  236.  usercolor := black;
  237.  GOTOXY (0,6);
  238.  WRITELN(spaces); WRITELN(spaces); WRITELN(spaces);
  239.  colorword[white] := 'white';
  240.  colorword[black] := 'black';
  241.  END; (*initgame*)
  242.  
  243.