-------------------------------------------------------------- -- Connect Four (TM) GNAPPLET -- -- By: Barry Fagin and Martin Carlisle -- US Air Force Academy, Department of Computer Science -- mailto:carlislem@acm.org -- -- This is free software; you can redistribute it and/or -- modify without restriction. We do ask that you please keep -- the original author information, and clearly indicate if the -- software has been modified. -- -- This software is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty -- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -------------------------------------------------------------- with Java.Lang.String; use Java.Lang.String; with Java; use Java; with Java.Applet.Applet; use Java.Applet.Applet; with Java.Awt.Color; with Java.Awt.Dimension; with Java.Awt.Graphics; use Java.Awt.Graphics; with Java.Net.Url; with Java.Awt.Component; package body Connectfour is ------------------------ -- Local Types & Data -- ------------------------ Num_Rows : constant := 6; Num_Columns : constant := 7; -- Constants for the board size type Player_Kind is (None, Computer, User); -- None means that neither the computer, nor the user have selected that -- circle, Computer indicates that the circle has been selected by the -- computer and User means that the circle has been selected by the user. type Board_Type is array (1 .. Num_Rows, 1 .. Num_Columns) of Player_Kind; Board : Board_Type := (others => (others => None)); -- Maintains the global status of the game Computer_Won : Boolean := False; User_Won : Boolean := False; Tie : Boolean := False; Ignore_Turn : Boolean := False; -- If the user clicks in full column, the computer should not take a turn type Column_Breaks_Array_Type is array (1 .. Num_Columns) of Integer; Invalid_Player : exception; -- The following constants are used to define the layout of the -- board. They define the horizontal and vertical spacing of the -- circles drawn on the screen. Ytop : constant := 20; -- highest pos on screen Ybottom : constant := 279; -- lowest pos on screen Xleft : constant := 0; -- leftmost pos on screen Xright : constant := 499; -- rightmost pos on screen Title_Offset : constant := 4; -- left move from center of column Title_Height : constant := 12; -- height of column numbers -- Both horizontally and vertically, there are circles and intervals -- (or spaces) between the circles. -- If there is half an interval on the left and right ends, then -- there are 7 full intervals (because there are 6 full intervals -- not counting the ends) horizontally -- Now, assuming the intervals are 1/4th as wide as the circles -- (The 1/4th is completely arbitrary), -- then we need 7 + 7/4 (8 3/4) circles worth of space across the -- screen. Circle_Width : constant := Float (Xright - Xleft + 1) / 8.75; X_Space : constant := Float (Xright - Xleft + 1) / 7.0; -- the horizontal space between circle centers X_First : constant := Xleft + Integer (0.625 * Circle_Width); -- the first x coordinate is to the middle of the first circle, -- which is 1/8 circle size + 1/2 circle size (5/8) -- Similarly, vertically there will be 6 full intervals, and again -- assuming an interval is 1/4 as tall as the space for the circle, -- we get 6 + 6/4 (7 1/2) circles vertically on the screen Circle_Height : constant := Float (Ybottom - Ytop + 1) / 7.5; Y_Space : constant := Float (Ybottom - Ytop + 1) / 6.0; Y_First : constant := Ytop + Integer (0.625 * Circle_Height); -- column_breaks holds the x coordinates where the transition from -- one column to the next occurs -- That is, column_breaks(1) is the rightmost x coordinate where -- you can click and still be in column 1 Column_Breaks : constant Column_Breaks_Array_Type := (Integer (1.25 * Circle_Width), Integer (2.5 * Circle_Width), Integer (3.75 * Circle_Width), Integer (5.00 * Circle_Width), Integer (6.25 * Circle_Width), Integer (7.5 * Circle_Width), Integer (8.75 * Circle_Width)); ------------------------------------------------------------------------ -- -- Name : Place_Disk -- Description : Determines the row in the given column at which -- who's disk should be placed (in the lowest empty -- row, where a lower row has a higher index). Puts -- who at that row/column in the board, then calls -- Draw_Position to update the screen. -- ------------------------------------------------------------------------ procedure Place_Disk (Board : in out Board_Type; Column : in Integer; Row : out Integer; Who : in Player_Kind) is begin Row := 1; while Row <= Num_Rows and then Board (Row, Column) = None loop Row := Row + 1; end loop; Row := Row - 1; Board (Row, Column) := Who; end Place_Disk; --------------- -- Check_Won -- --------------- -- Checks to see if Who won procedure Check_Won (Board : in Board_Type; Who : in Player_Kind; Won : out Boolean) is begin Won := False; for Row in Board'Range (1) loop for Column in Board'Range (2) loop -- Checking row to the right if Column <= Num_Columns - 3 then if Board (Row, Column) = Who and Board (Row, Column + 1) = Who and Board (Row, Column + 2) = Who and Board (Row, Column + 3) = Who then Won := True; end if; end if; -- Checking column down if Row <= Num_Rows - 3 then if Board(Row, Column) = Who and Board(Row + 1, Column) = Who and Board(Row + 2, Column) = Who and Board(Row + 3, Column) = Who then Won := True; end if; end if; -- Checking diagonal up to right if Row >= 4 and Column <= Num_Columns - 3 then if Board(Row, Column) = Who and Board(Row - 1, Column + 1) = Who and Board(Row - 2, Column + 2) = Who and Board(Row - 3, Column + 3) = Who then Won := True; end if; end if; -- Checking diagonal down to right if Row <= Num_Rows - 3 and Column <= Num_Columns - 3 then if Board(Row, Column) = Who and Board(Row + 1, Column + 1) = Who and Board(Row + 2, Column + 2) = Who and Board(Row + 3, Column + 3) = Who then Won := True; end if; end if; end loop; end loop; end Check_Won; --------------- -- Check_Tie -- --------------- -- Checks to see if the game has ended in a tie (all columns are full) procedure Check_Tie (Board : Board_Type; Is_Tie : out Boolean) is begin Is_Tie := True; for Column in Board'Range (2) loop if Board (1, Column) = None then Is_Tie := False; end if; end loop; end Check_Tie; ------------------- -- Computer_Turn -- ------------------- -- Uses lookahead and live tuple heuristic procedure Computer_Turn (Board : in Board_Type; Column : out Integer) is Lookahead_Depth : constant Integer := 5; type Value_Type is --need two ties for symmetry (Illegal, Win_For_User, Tie_For_User, Unknown, Tie_For_Computer, Win_For_Computer); type Value_Array_Type is array (1 .. Num_Columns) of Value_Type; ------------------------------------------------------------------------ -- -- Name : Trial_Place_Disk -- Description : Determines the row in the given column at which -- who's disk should be placed (in the lowest empty -- row, where a lower row has a higher index). Puts -- who at that row/column in the board. -- ------------------------------------------------------------------------ procedure Trial_Place_Disk (Board : in out Board_Type; Column : in Integer; Who : in Player_Kind) is Row : Integer; begin Row := 1; while Row <= Num_Rows and then Board (Row,Column) = None loop Row := Row + 1; end loop; Board (Row - 1, Column) := Who; end Trial_Place_Disk; -------------------- -- Make_New_Board -- -------------------- procedure Make_New_Board (New_Board : out Board_Type; Board : in Board_Type; Who : Player_Kind; Column : Integer) is begin for I in 1..Num_Rows loop for J in 1..Num_Columns loop New_Board(I,J) := Board(I,J); end loop; end loop; Trial_Place_Disk (New_Board, Column, Who); end Make_New_Board; ---------------------- -- Find_Best_Result -- ---------------------- function Find_Best_Result (Evaluations : in Value_Array_Type; Who : Player_Kind) return Value_Type is Best_Result : Value_Type; begin if Who = Computer then --find "largest" move Best_Result := Win_For_User; for I in 1..Num_Columns loop if Evaluations(I) > Best_Result and Evaluations(I) /= Illegal then Best_Result := Evaluations(I); end if; end loop; else --Who = User, find "smallest" move Best_Result := Win_For_Computer; for I in 1..Num_Columns loop if Evaluations(I) < Best_Result and Evaluations(I) /= Illegal then Best_Result := Evaluations(I); end if; end loop; end if; return Best_Result; end Find_Best_Result; ------------------------ -- Weighting_Function -- ------------------------ function Weighting_Function (Arg : Integer) return Integer is begin return Arg * Arg * Arg; -- Use cubic for now end Weighting_Function; ---------------------------- -- Evaluate_Unknown_Board -- ---------------------------- function Evaluate_Unknown_Board (Board : Board_Type) return Integer is Owner : Player_Kind; Cell : Player_Kind; User_Count, Computer_Count, Board_Value : Integer; Dead : Boolean; begin Board_Value := 0; for Row in Board'Range (1) loop for Column in Board'Range (2) loop -- Checking horizontal tuples if Column <= Num_Columns - 3 then Owner := None; User_Count := 0; Computer_Count := 0; Dead := False; for I in 0..3 loop Cell := Board(Row, Column+I); if Owner = None and Cell /= None then Owner := Cell; end if; if (Cell = User and Owner = Computer) or (Cell = Computer and Owner = User) then User_Count := 0; Computer_Count := 0; Dead := True; end if; if Cell = User and not Dead then User_Count := User_Count+1; elsif Cell = Computer and not Dead then Computer_Count := Computer_Count+1; end if; end loop; -- Computer count is positive, User count is negative -- so that larger values are better for computer Board_Value := Board_Value + Weighting_Function (Computer_Count) - Weighting_Function (User_Count); end if; -- Checking vertical tuples if Row <= Num_Rows - 3 then Owner := None; User_Count := 0; Computer_Count := 0; Dead := False; for I in 0..3 loop Cell := Board(Row+I, Column); if Owner = None and Cell /= None then Owner := Cell; end if; if (Cell = User and Owner = Computer) or (Cell = Computer and Owner = User) then User_Count := 0; Computer_Count := 0; Dead := True; end if; if Cell = User and not Dead then User_Count := User_Count+1; elsif Cell = Computer and not Dead then Computer_Count := Computer_Count+1; end if; end loop; Board_Value := Board_Value + Weighting_Function (Computer_Count) - Weighting_Function (User_Count); end if; -- Checking diagonal tuples up to right if Row >= Num_Rows/ 2 + 1 and Column <= Num_Columns - 3 then Owner := None; User_Count := 0; Computer_Count := 0; Dead := False; for I in 0..3 loop Cell := Board(Row-I, Column+I); if Owner = None and Cell /= None then Owner := Cell; end if; if (Cell = User and Owner = Computer) or (Cell = Computer and Owner = User) then User_Count := 0; Computer_Count := 0; Dead := True; end if; if Cell = User and not Dead then User_Count := User_Count+1; elsif Cell = Computer and not Dead then Computer_Count := Computer_Count+1; end if; end loop; Board_Value := Board_Value + Weighting_Function (Computer_Count) - Weighting_Function (User_Count); end if; -- Checking diagonal tuples down to right if Row <= Num_Rows - 3 and Column <= Num_Columns -3 then Owner := None; User_Count := 0; Computer_Count := 0; Dead := False; for I in 0..3 loop Cell := Board(Row+I, Column+I); if Owner = None and Cell /= None then Owner := Cell; end if; if (Cell = User and Owner = Computer) or (Cell = Computer and Owner = User) then User_Count := 0; Computer_Count := 0; Dead := True; end if; if Cell = User and not Dead then User_Count := User_Count+1; elsif Cell = Computer and not Dead then Computer_Count := Computer_Count+1; end if; end loop; Board_Value := Board_Value + Weighting_Function (Computer_Count) - Weighting_Function (User_Count); end if; end loop; end loop; return Board_Value; end Evaluate_Unknown_Board; -------------------- -- Evaluate_Board -- -------------------- function Evaluate_Board ( Board : in Board_Type; Who_Just_Moved : Player_Kind; Current_Depth : in Integer ) return Value_Type is Computer_Won, User_Won, Is_Tie : Boolean; Value : Value_Type; Who_Moves_Next : Player_Kind; New_Board : Board_Type; Evaluations : Value_Array_Type; begin Check_Won ( Board => Board, Who => Computer, Won => Computer_Won); if not Computer_Won then Check_Won( Board => Board, Who => User, Won => User_Won); if not User_Won then Check_Tie(Board,Is_Tie); end if; end if; if Computer_Won then Value := Win_For_Computer; elsif User_Won then Value := Win_For_User; elsif Is_Tie and Who_Just_Moved = User then Value := Tie_For_User; elsif Is_Tie and Who_Just_Moved = Computer then Value := Tie_For_Computer; elsif Current_Depth = 1 then Value := Unknown; else --Not a terminal node or end of lookahead, so recurse if Who_Just_Moved = Computer then Who_Moves_Next := User; else --Who_Just_Moved = User Who_Moves_Next := Computer; end if; for Col in 1..Num_Columns loop Evaluations(Col) := Illegal; end loop; for Col in 1..Num_Columns loop if Board(1,Col) = None then Make_New_Board(New_Board,Board,Who_Moves_Next,Col ); Evaluations(Col) := Evaluate_Board(New_Board, Who_Moves_Next ,Current_Depth-1); --a/b pruning if Evaluations(Col) = Win_For_Computer and Who_Moves_Next = Computer then exit; elsif Evaluations(Col) = Win_For_User and Who_Moves_Next = User then exit; end if; else Evaluations(Col) := Illegal; end if; end loop; Value := Find_Best_Result(Evaluations, Who_Moves_Next) ; end if; return Value; end Evaluate_Board; -------------------- -- Find_Best_Move -- -------------------- function Find_Best_Move (Evaluations : in Value_Array_Type; Who : Player_Kind) return Integer is Best_Move : Integer; Best_Result : Value_Type; begin if Who = Computer then --find "largest" move Best_Result := Win_For_User; for I in 1..Num_Columns loop if Evaluations(I) > Best_Result and Evaluations(I) /= Illegal then Best_Result := Evaluations(I); Best_Move := I; end if; end loop; else --Who = User, find "smallest" move Best_Result := Win_For_Computer; for I in 1..Num_Columns loop if Evaluations(I) < Best_Result and Evaluations(I) /= Illegal then Best_Result := Evaluations(I); Best_Move := I; end if; end loop; end if; return Best_Move; end Find_Best_Move; ----------------------- -- Find_All_Unknowns -- ----------------------- procedure Find_All_Unknowns ( Evaluations : in Value_Array_Type; Moves : out Column_Breaks_Array_Type; Count : out Integer ) is begin Count := 0; for I in 1..Num_Columns loop if Evaluations(I) = Unknown then Count := Count + 1; Moves(Count) := I; end if; end loop; end Find_All_Unknowns; --variables and body for "Computer_Turn" New_Board : Board_Type; Evaluations : Value_Array_Type; Moves_To_Unknown : Column_Breaks_Array_Type; Count_Unknowns : Integer; Value, Max_Value, Best_Move : Integer; begin for Col in 1..Num_Columns loop Evaluations(Col) := Illegal; end loop; for Col in 1..Num_Columns loop if Board(1,Col) = None then Make_New_Board(New_Board,Board,Computer,Col); Evaluations(Col) := Evaluate_Board(New_Board,Computer, Lookahead_Depth ); --a/b pruning if Evaluations(Col) = Win_For_Computer then exit; end if; else Evaluations(Col) := Illegal; end if; end loop; Column := Find_Best_Move(Evaluations,Computer); --Check if trapped, if so take best move at shallower depth --and hope for a mistake if Evaluations(Column) = Win_For_User then for Col in 1..Num_Columns loop if Board(1,Col) = None then Make_New_Board(New_Board,Board,Computer,Col); Evaluations(Col) := Evaluate_Board(New_Board,Computer ,2); else Evaluations(Col) := Illegal; end if; end loop; Column := Find_Best_Move(Evaluations,Computer); elsif Evaluations(Column) = Unknown then --If choosing from multiple unknown boards, apply heuristics. --This is where most of the strategy is. Find_All_Unknowns(Evaluations,Moves_To_Unknown,Count_Unknowns ); Max_Value := -1000; for I in 1..Count_Unknowns loop Make_New_Board(New_Board,Board,Computer,Moves_To_Unknown (I)); Value := Evaluate_Unknown_Board(New_Board); if Value > Max_Value then Max_Value := Value; Best_Move := Moves_To_Unknown(I); end if; end loop; --unknown boards Column := Best_Move; end if; --picking from multiple unknown boards exception when others => Column := 1; loop exit when Board(1,Column) = None; Column := Column + 1; end loop; end Computer_Turn; ---------- -- Init -- ---------- procedure Init ( This : access Typ ) is procedure Adainit; pragma Import (Ada, Adainit, "ada_connectfour.adainit"); begin Adainit; -- The above call is needed for elaboration This.User_Turn := True; Addmouselistener (This, This.I_Mouselistener); Computer_Won := False; User_Won := False; Tie := False; Ignore_Turn := False; end Init; ----------- -- Paint -- ----------- procedure Paint (This : access Typ; G1 : access Java.Awt.Graphics.Typ'Class ) is D : Java.Awt.Dimension.Ref := Getsize (This); Xoff : Int := D.Width / 3; Yoff : Int := D.Height / 3; procedure Display_Text ( X : in Integer; Y : in Integer; Text : in String ) is begin Setcolor(G1,Java.Awt.Color.Black); Drawstring(G1,+Text,X,Y); end Display_Text; procedure Draw_Line ( X1 : in Integer; Y1 : in Integer; X2 : in Integer; Y2 : in Integer; Hue : in Java.Awt.Color.Ref ) is begin Setcolor(G1,Hue); Drawline(G1,X1,Y1,X2,Y2); end Draw_Line; procedure Draw_Circle ( X : in Integer; Y : in Integer; Radius : in Integer; Hue : in Java.Awt.Color.Ref; Filled : in Boolean ) is begin Setcolor(G1,Hue); if Filled then Filloval(G1,X-Radius,Y-Radius,2*Radius,2*Radius); else Drawoval(G1,X-Radius,Y-Radius,2*Radius,2*Radius); end if; end Draw_Circle; procedure Draw_Box ( X1 : in Integer; Y1 : in Integer; X2 : in Integer; Y2 : in Integer; Hue : in Java.Awt.Color.Ref; Filled : in Boolean ) is begin Setcolor(G1,Hue); if Filled then Fillrect(G1,X1,Y1,X2-X1,Y2-Y1); else Drawrect(G1,X1,Y1,X2-X1,Y2-Y1); end if; end Draw_Box; ------------------------------------------------------------------------ -- -- Name : Draw_Position -- Description : Draws a disk with the appropriate color for the -- given player at the given row and column -- ------------------------------------------------------------------------ procedure Draw_Position (Who : Player_Kind; Row : Integer; Column : Integer) is Animate : constant Boolean := True; -- for later Color : Java.Awt.Color.Ref; -- color of disk Circle_Radius : Integer; -- radius of disk begin -- Determine radius based on minimum of possible height/width if Circle_Width < Circle_Height then Circle_Radius := Integer(Circle_Width * 0.5); else Circle_Radius := Integer(Circle_Height * 0.5); end if; -- Determine color of disk if Who = None then Color := Java.Awt.Color.White; elsif Who = Computer then Color := Java.Awt.Color.Red; elsif Who = User then Color := Java.Awt.Color.Blue; else raise Invalid_Player; end if; Draw_Circle( X => X_First + Integer (Float (Column - 1) * X_Space), Y => Y_First + Integer (Float (Row - 1) * Y_Space), Radius => Circle_Radius, Hue => Color, Filled => True); end Draw_Position; ------------------------------------------------------------------------ -- -- Name : Print_Board -- Description : Prints the board for the start of the game. This -- procedure should NOT be called repeatedly. Rather, -- this procedure is called once to draw the game board, -- then draw_position is used to add player's disks as -- the game progresses. -- ------------------------------------------------------------------------ procedure Print_Board ( Board : in Board_Type) is begin Draw_Box( X1 => 0, Y1 => 0, X2 => 499, Y2 => 299, Hue => Java.Awt.Color.Lightgray, Filled => True); -- Print column numbers for Column in 1 .. Num_Columns loop Display_Text( X => X_First + Integer (Float (Column - 1) * X_Space) - Title_Offset, Y => Title_Height, Text => Character'Val (Column + 48) & ""); -- Draw vertical line between columns if Column < Num_Columns then Draw_Line( X1 => Column_Breaks (Column), Y1 => Ytop, X2 => Column_Breaks (Column), Y2 => Ybottom, Hue => Java.Awt.Color.Black); end if; for Row in 1 .. Num_Rows loop Draw_Position( Who => Board (Row, Column), Row => Row, Column => Column); end loop; end loop; if Computer_Won then Display_Text( X => 0, Y => 285, Text => "You lose! - Press left mouse button"); end if; if Tie then Display_Text( X => 0, Y => 285, Text => "Tie Game! - Press Left Mouse Button"); end if; if User_Won then Display_Text( X => 0, Y => 285, Text => "You win! - Press left mouse button"); end if; end Print_Board; begin Print_Board(Board); Showstatus(This, + "Connect Four (TM) by Barry Fagin and Martin Carlisle"); end Paint; ------------ -- Update -- ------------ procedure Update ( This : access Typ; G : access Java.Awt.Graphics.Typ'Class ) is begin Paint (This, G); end Update; ------------------- -- GetAppletInfo -- ------------------- function Getappletinfo ( This : access Typ ) return Java.Lang.String.Ref is begin return +("This Connect Four (TM) game was coded in Ada95, " & "and compiled with the JGNAT compiler"); end Getappletinfo; ------------------- -- mouseReleased -- ------------------- procedure Mousereleased ( This : access Typ; E : access Java.Awt.Event.Mouseevent.Typ'Class ) is X : Int := Java.Awt.Event.Mouseevent.Getx (E); Y : Int := Java.Awt.Event.Mouseevent.Gety (E); D : Java.Awt.Dimension.Ref := Getsize (This); Column, Row : Integer; begin -- need to do this before checking won, since we use -- this for user won. if Ignore_Turn then return; end if; if User_Won or Computer_Won or Tie then Board := (others => (others => None)); Computer_Won := False; User_Won := False; Tie := False; Ignore_Turn := False; if This.User_Turn then This.User_Turn := False; Showstatus(This, +"I am thinking..."); -- Let computer take turn Computer_Turn ( Board => Board, Column => Column); -- Place computer disk in the column Place_Disk ( Board => Board, Column => Column, Who => Computer, Row => Row); else This.User_Turn := True; end if; Repaint(This); return; end if; Showstatus(This, +"I am thinking..."); -- Let computer take turn Computer_Turn ( Board => Board, Column => Column); -- Place computer disk in the column Place_Disk ( Board => Board, Column => Column, Who => Computer, Row => Row); -- Check if computer won Check_Won ( Board => Board, Who => Computer, Won => Computer_Won); -- Check for a Tie Check_Tie ( Board => Board, Is_Tie => Tie); Repaint(This); end Mousereleased; -- The functions below do nothing, but are required to override the ones -- defined in the interface we are implementing (when they abstract). -- Otherwise, the JVM would complain. ------------------ -- mouseClicked -- ------------------ procedure Mouseclicked ( This : access Typ; P1 : access Java.Awt.Event.Mouseevent.Typ'Class ) is begin null; end Mouseclicked; ------------------ -- mouseEntered -- ------------------ procedure Mouseentered ( This : access Typ; P1 : access Java.Awt.Event.Mouseevent.Typ'Class ) is begin null; end Mouseentered; ----------------- -- mouseExited -- ----------------- procedure Mouseexited ( This : access Typ; P1 : access Java.Awt.Event.Mouseevent.Typ'Class ) is begin null; end Mouseexited; ------------------ -- mousePressed -- ------------------ procedure Mousepressed ( This : access Typ; E : access Java.Awt.Event.Mouseevent.Typ'Class ) is X : Int := Java.Awt.Event.Mouseevent.Getx (E); Y : Int := Java.Awt.Event.Mouseevent.Gety (E); D : Java.Awt.Dimension.Ref := Getsize (This); Column, Row : Integer; begin -- don't place disk if game over if User_Won or Computer_Won or Tie then Ignore_Turn := False; return; end if; -- look to see if this is a valid click location -- if not, just ignore this click. Column := -1; for I in 1..Num_Columns loop if X <= Column_Breaks(I) then if Board(1,I) = None then Column := I; end if; exit; end if; end loop; if Column <= 0 then Ignore_Turn := True; return; else Ignore_Turn := False; end if; -- Place user disk in the column Place_Disk ( Board => Board, Column => Column, Who => User, Row => Row); -- Check if user won Check_Won ( Board => Board, Who => User, Won => User_Won); if User_Won then Ignore_Turn := True; end if; Repaint(This); end Mousepressed; end Connectfour;