home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / games / volume1 / othello1 / part01 / othello.mod < prev    next >
Text File  |  1987-06-08  |  11KB  |  422 lines
  1. IMPLEMENTATION MODULE othello;
  2.  
  3. (*************************************************************************)
  4. (* OTHELLO.  (c) 1987 Robert Silvers.  All rights reserved.              *)
  5. (*                                                                       *)
  6. (* This is the main set of routines that runs the othello game.  The     *)
  7. (* game is controlled from the driver.  The procedures in this section   *)
  8. (* set up the board, get the moves, check if it is valid, if so, flip    *)
  9. (* the pieces.  It then counts the pieces, and redraws the board.        *)
  10. (*************************************************************************)
  11.  
  12. FROM types           IMPORT
  13.    PIECES, BOARD, TEMP, field, temp, flipped, Passed;
  14.  
  15. FROM InOut           IMPORT
  16.    Read, WriteInt;
  17.  
  18. FROM InOutExtensions IMPORT
  19.    GetEscapeSequence, GetOneChar, ReadLn;
  20.  
  21. FROM regis           IMPORT
  22.    Reset, Position, ClearScreen, Plot, DrawTo, Circle, Box, Color, SetFill,
  23.    TextSize, WriteNum, WriteText, UnsetFill, BGColor, TextSlant, WriteChr,
  24.    Scroll, TextDirection;
  25.  
  26. FROM move            IMPORT
  27.    CanPass, Validate, Count, HowMany;
  28.  
  29. (*************************************************************************)
  30. (* This function gets the game choice with the opening menu.             *)
  31. (* RETURNS the number of players.                                        *)
  32. (*************************************************************************)
  33. PROCEDURE Menu(VAR choice: CHAR);
  34.  
  35. VAR 
  36.    x: INTEGER;
  37.  
  38. BEGIN
  39.  
  40.    choice:= ' ';
  41.  
  42.    ClearScreen;
  43.  
  44.    (* (* Alternative opening screen *)
  45.    TextSlant(-1);
  46.    Color("R");
  47.    FOR x:= 1 TO 10 BY 2 DO
  48.       Position(80 + (x * 15), x * x * 3); 
  49.       TextSize(x);
  50.       WriteText("OTHELLO");
  51.    END;
  52.    TextSlant(0);
  53.    *)
  54.  
  55.    Position(80, 0); (* Draw word OTHELLO 3 times. *)
  56.    TextSize(10);
  57.    Color("R");
  58.    WriteText("OTHELLO");
  59.  
  60.    Position(80, 120);
  61.    TextSize(10);
  62.    Color("G");
  63.    WriteText("OTHELLO");
  64.  
  65.    Position(80, 240);
  66.    TextSize(10);
  67.    Color("B");
  68.    WriteText("OTHELLO");
  69.  
  70.    Position(80, 400);
  71.    Color("G");
  72.    TextSize(2);
  73.    WriteText("Enter the number of players (0-2) : ");
  74.  
  75.    (* Get the number of players. *)
  76.    REPEAT
  77.       Read(choice);
  78.    UNTIL ((choice >= '0') AND (choice <= '2')) OR (choice= 'q');
  79.  
  80. END Menu;
  81.  
  82.  
  83. (*************************************************************************)
  84. (* This procedure sets all of the places to empty, except the center     *)
  85. (* four.                                                                 *)
  86. (*************************************************************************)
  87. PROCEDURE InitBoard();
  88.  
  89. VAR x, y: INTEGER;(* Position on the surface.*)
  90.  
  91. BEGIN
  92.  
  93.    FOR x:= 1 TO 8 DO    (* Set all spaces to empty. *)
  94.       FOR y:= 1 TO 8 DO
  95.      field[x][y]  := none;
  96.      flipped[x][y]:= FALSE;
  97.       END;
  98.    END; 
  99.  
  100.    field   [4][4]:= white; (* Put in first four pieces. *)
  101.    field   [5][4]:= black;
  102.    field   [4][5]:= black;
  103.    field   [5][5]:= white;
  104.  
  105.    flipped [4][4]:= TRUE;  (* Turn on flipped flag.     *)
  106.    flipped [5][4]:= TRUE;
  107.    flipped [4][5]:= TRUE;
  108.    flipped [5][5]:= TRUE;
  109.  
  110. END InitBoard; 
  111.  
  112.  
  113. (*************************************************************************)
  114. (* This procedure draws the opening graphics.                            *)
  115. (*************************************************************************)
  116. PROCEDURE DrawBoard;
  117.  
  118. VAR
  119.    x, y: INTEGER;
  120.  
  121. BEGIN
  122.  
  123.    Reset;            (* Set all to default.     *)
  124.    BGColor('D');     (* Set background to black.*) 
  125.    ClearScreen;
  126.  
  127.    Color('B');       (* Draw blue border.       *)
  128.    Position(0, 0);
  129.    SetFill(150);  
  130.    Box(410, 411);
  131.    UnsetFill;
  132.  
  133.    Color('G');       (* Draw green background.  *)
  134.    Position(10, 9);
  135.    SetFill(150);     
  136.    Box(390,391);
  137.    UnsetFill;
  138.  
  139.    Color("D"); (* A touch of shadow. *)
  140.    Plot(9, 402);
  141.    DrawTo(399, 402);
  142.    Plot(9, 10);
  143.    DrawTo(9, 402);
  144.    
  145.  
  146.    Color('D');       (* Draw black lines.*)
  147.    FOR x:= 55 TO 400 BY 50 DO
  148.       Plot(x, 9);
  149.       DrawTo(x, 400);
  150.       Plot(409 - x , 9);
  151.       DrawTo(409 - x, 400);
  152.       Plot(9, x);
  153.       DrawTo(400, x);
  154.       Plot(9, 409 - x);
  155.       DrawTo(400, 409-  x);
  156.    END; (* FOR *)
  157.  
  158.    Position(419, 3); (* Write OTHELLO    *)
  159.    TextSize(5);
  160.    Color('B');
  161.    WriteText('OTHELLO');
  162.    Position(421, 1); 
  163.    TextSize(5);
  164.    Color('G');
  165.    WriteText('OTHELLO');
  166.    Position(422, 0); 
  167.    TextSize(5);
  168.    Color('R');
  169.    WriteText('OTHELLO');
  170.  
  171.    TextSize(1);      (* Give credit where credit is due. *)
  172.    Color('B');
  173.    Position(646, 64);
  174.    TextSlant(-10); 
  175.    WriteText('By Robert Silvers');
  176.    TextSlant(0); 
  177.  
  178.    Color('R');       (* Write out score board. *)
  179.    Position(420, 90);
  180.    WriteText('Blue: ');
  181.    Position(512, 90);
  182.    WriteText('Black: ');
  183.  
  184.    Color('B');       (* Give basic instructions. *)
  185.    Position(420, 350);
  186.    WriteText('Use arrow keys to move.  RETURN to enter.');   
  187.    Color('B'); 
  188.    Position(420, 370);
  189.    WriteText('1 drops a blue, 2 a black, 3 to remove.');
  190.    Color('B'); (* Blue. *)
  191.    Position(420, 390);
  192.    WriteText('Press S to show moves.  P to pass.');
  193.  
  194. END DrawBoard;
  195.  
  196.  
  197. (*************************************************************************)
  198. (* This procedure flips the pieces for the player after a move.          *)
  199. (*************************************************************************)
  200. PROCEDURE Flip (player : PIECES; xcords, ycords: INTEGER);
  201.  
  202. BEGIN
  203.  
  204.    Flipper(player, xcords, ycords, 1, 0);
  205.    Flipper(player, xcords, ycords, -1, 0);
  206.    Flipper(player, xcords, ycords, 0, 1);
  207.    Flipper(player, xcords, ycords, 0, -1);
  208.    Flipper(player, xcords, ycords, 1, -1);
  209.    Flipper(player, xcords, ycords, 1, 1);
  210.    Flipper(player, xcords, ycords, -1, 1);
  211.    Flipper(player, xcords, ycords, -1, -1);
  212.  
  213. END Flip; 
  214.  
  215.  
  216. PROCEDURE Flipper(player: PIECES; xcords, ycords, xdir, ydir: INTEGER);
  217.  
  218. VAR
  219.    opplayer: PIECES ; (* The opposite player.                 *)
  220.    x       : INTEGER; (* Used for loop counters.              *)
  221.    y       : INTEGER;
  222.    foundop : BOOLEAN; (* Found opposite player.               *)
  223.    canflip : BOOLEAN; (* TRUE is at least one flip is needed. *)
  224.    founds  : BOOLEAN; (* Found space.                         *) 
  225.    foundp  : BOOLEAN; (* Found player.                        *) 
  226.  
  227. BEGIN
  228.  
  229.    IF player= white THEN     (* Get the other player's color. *)
  230.       opplayer:= black
  231.    ELSE
  232.       opplayer:= white;   
  233.    END; 
  234.  
  235.    foundop:= FALSE; (* Flip from right to left and up. *)
  236.    canflip:= FALSE;
  237.    founds := FALSE;
  238.    foundp := FALSE;
  239.    x:= xcords;
  240.    y:= ycords;
  241.    LOOP
  242.       IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
  243.      EXIT;
  244.       END; (* IF *)
  245.       IF (field[x][y]= opplayer) THEN
  246.       foundop:= TRUE;
  247.       END; (* IF *);
  248.       IF ((field[x][y]= none)) AND ((foundop= FALSE) OR
  249.           (foundp= FALSE)) THEN
  250.        founds:= TRUE;
  251.       END; (* IF *);
  252.       IF (field[x][y]= player) AND (foundop) AND (founds= FALSE) THEN
  253.       canflip:= TRUE;
  254.       END; (* IF *);
  255.       x:= x + xdir;
  256.       y:= y + ydir;
  257.    END; (* LOOP *)
  258.    x:= xcords;
  259.    y:= ycords;
  260.    IF canflip THEN
  261.       LOOP
  262.          x:= x + xdir;
  263.          y:= y + ydir;
  264.       IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
  265.         EXIT;
  266.          END; (* IF *)
  267.          IF (field[x][y]= player) THEN
  268.         EXIT;
  269.          END; (* IF *);
  270.          IF (field[x][y]= opplayer) THEN
  271.         field[x][y]:= player;
  272.         flipped[x][y]:= TRUE;
  273.          END; (* IF *);
  274.       END; (* LOOP *)
  275.    END; (* IF *)
  276.  
  277. END Flipper;
  278.  
  279.  
  280. (*************************************************************************)
  281. (* This procedure updates the board after a move.                        *)
  282. (* It used a boolean field to only ReDraw where a piece has been changed.*)
  283. (*************************************************************************)
  284. PROCEDURE ReDraw;
  285.  
  286. VAR
  287.    x   : INTEGER; (* Coordinates. *)
  288.    y   : INTEGER;       
  289.    wnum: INTEGER; (* Number of each player on board. *)
  290.    bnum: INTEGER;    
  291.  
  292. BEGIN
  293.  
  294.    Count(wnum, bnum); (* Update the number of pieces on the screen. *)
  295.  
  296.    Position(470, 90); (* Draw new number of pieces.                 *)
  297.    Color('D') ;
  298.    SetFill(90);
  299.    Box(20, 15);
  300.    UnsetFill  ;
  301.    Color('R') ; 
  302.    WriteNum(wnum);
  303.  
  304.    Position(570, 90);
  305.    Color('D') ;
  306.    SetFill(90);
  307.    Box(20, 15);
  308.    UnsetFill  ;
  309.    Color('R') ; 
  310.    WriteNum(bnum);
  311.  
  312.    FOR y:= 1 TO 8 DO; (* Go to every square and flip if TRUE.        *)
  313.       FOR x:= 1 TO 8 DO;
  314.      IF flipped[x][y]  = TRUE  THEN (* If the piece has changed. *)
  315.         IF field[x][y] = black THEN (* Set color of piece.       *)
  316.            Color('D')                                  (* Black. *)
  317.             ELSIF field[x][y] = white THEN
  318.            Color('B')                                  (* Red.   *)
  319.             ELSE                               (* field[x][y]:= none *)
  320.            Color('G');                                 (* Green. *)
  321.             END; (* IF *)
  322.         Position((x * 50) - 20, (y * 50) - 20); (* Draw circle.  *)
  323.         SetFill ((y * 50) - 20);
  324.         Circle(13, 13);
  325.         UnsetFill;
  326.         flipped[x][y]:= FALSE; (* Reset to FALSE *)
  327.          END; (* IF *)
  328.       END; (* FOR *)
  329.    END; (* FOR *)
  330.  
  331. END ReDraw;
  332.  
  333.  
  334. (* Shows what moves are open to player.  Tells them how many pieces *)
  335. (* they would get if they move there also.                          *)
  336. PROCEDURE ShowMoves(player: PIECES);
  337.  
  338. VAR
  339.    x, y  : INTEGER;
  340.    number: INTEGER; (* Number of flips possible *)
  341.    dummy : INTEGER; (* Absorbs extra parameter. *)
  342.  
  343. BEGIN
  344.  
  345.    TextSize(1);
  346.    FOR y:= 1 TO 8 DO
  347.       FOR x:= 1 TO 8 DO
  348.          IF Validate(player, x, y) THEN
  349.         Color("R");
  350.         Position((x * 50) -20, (y * 50) - 20);
  351.         SetFill ((y * 50) -20);
  352.         Circle(7, 7);         (* Draws red circle where valid. *)
  353.         UnsetFill;
  354.         Color("D");
  355.         HowMany(player, x, y, number, dummy); (* Get number of flips *)
  356.         Position((x * 50) -25, (y * 50) - 28);
  357.         WriteNum(number);          (* Display number of flips. *)
  358.         flipped[x][y]:= TRUE;
  359.          END; (* IF *)
  360.       END; (* FOR *)
  361.    END; (* FOR *)
  362.  
  363. END ShowMoves;
  364.  
  365.  
  366. (* Returns TRUE if the game is over.       *)
  367. PROCEDURE GameOver (computer: BOOLEAN): BOOLEAN;
  368.  
  369. VAR
  370.    whitenum, blacknum: INTEGER; (* Used to see who won. *)
  371.    
  372. BEGIN
  373.  
  374.    (* Game is over if both players have no moves. *)
  375.    IF CanPass(black) AND CanPass(white) THEN
  376.       Position(420, 150);
  377.       Color("G");
  378.       TextSize(3);
  379.       WriteText("Game Over.");
  380.       TextSize(2);
  381.       Count(whitenum, blacknum);
  382.       IF whitenum > blacknum THEN
  383.      Position(420, 200);
  384.      Color("R");
  385.      WriteText("Blue wins.")
  386.       ELSIF blacknum > whitenum THEN
  387.      Position(420, 200);
  388.      Color("R");
  389.      WriteText("Black wins.");
  390.      IF computer THEN (* Computer played in game. *)
  391.         Color("B");
  392.         TextSize(1);
  393.         Position(420, 240);
  394.         WriteText("Artificial intelligence is better");
  395.         Position(420, 260);
  396.         WriteText("than none at all...");
  397.  
  398.         Color("R"); (* Redraw with different color. *)
  399.         Position(421, 239);
  400.         WriteText("Artificial intelligence is better");
  401.         Position(421, 259);
  402.         WriteText("than none at all...");
  403.          END (* IF *)
  404.       ELSE
  405.      Position(420, 200);
  406.      Color("R");
  407.      WriteText("Its a tie!")
  408.       END; (* IF *)
  409.       Position(180, 180);
  410.       RETURN TRUE   (* Game over.     *)
  411.    END; (* IF *)
  412.  
  413.    RETURN FALSE;    (* Game not over. *)
  414.  
  415. END GameOver;
  416.  
  417.  
  418. END othello.
  419.  
  420.  
  421.  
  422.