/* Connect 4, by Joey Robert
* Backup Final Project for ICS 3M1 - May 19 - 20/2006
*/
% VARIABLE DECLARATION
const ROWS := 6
const COLUMNS := 7
var Pieces : array 1 .. ROWS, 1 .. COLUMNS of int
var Names : array 1 .. 2 of string
var Score : array 1 .. 2 of real := init (0, 0)
var counter, Focus, Turn, Value, FontVar : int
var PlayAgain : string (1)
FontVar := Font.New ("sans serif:10:Bold")
% FUNCTION/PROCEDURE DECLARATION
procedure TurnColour (player, rule : int)
var Holder : string
if player = 1 then
drawfillbox (0, maxy - 40, maxx, maxy - 25, red)
elsif player = 2 then
drawfillbox (0, maxy - 40, maxx, maxy - 25, blue)
end if
if rule = 1 then
Holder := Names (1) + ": " + realstr (Score (1), 0) + " " + Names (2) + ": " + realstr (Score (2), 0)
Draw.Text (Holder, 4, maxy - 37, FontVar, white)
end if
end TurnColour
/* Format for Position: 21
* 2 as in Row, 1 as in Column
*/
procedure DisplayScreen
for i : 1 .. ROWS
for j : 1 .. COLUMNS
if Pieces (i, j) = 1 then
drawfilloval ((50 * j), (50 * i), 20, 20, red)
elsif Pieces (i, j) = 2 then
drawfilloval ((50 * j), (50 * i), 20, 20, blue)
else
drawfilloval ((50 * j), (50 * i), 20, 20, gray)
end if
end for
Draw.Text (intstr (i), 8, (50 * i) - 4, FontVar, black)
end for
for i : 1 .. COLUMNS
Draw.Text (intstr (i), (50 * i) - 4, 8, FontVar, black)
end for
end DisplayScreen
procedure RawInsert (player : int)
var x, y, btnNumber, btnUpDown : int
Mouse.ButtonWait ("up", x, y, btnNumber, btnUpDown)
Value := ((x + 25) div 50)
end RawInsert
procedure Insert (player : int)
put Names (player), ", Select a column to input it in."
RawInsert (player)
loop
if Value > COLUMNS or Value < 1 then
cls
TurnColour (player, 1)
DisplayScreen
put Names (player), ", Incorrect Selection. Choose Again."
RawInsert (player)
elsif Pieces (ROWS, Value) not= 0 then
cls
TurnColour (player, 1)
DisplayScreen
put Names (player), ", Row is full. Choose Again."
RawInsert (player)
else
exit
end if
end loop
for i : 1 .. ROWS
if Pieces (i, Value) = 0 then
Pieces (i, Value) := player
counter := i
Music.PlayFile ("check.WAV")
exit
end if
end for
for decreasing j : ROWS .. 1 + counter
if player = 1 then
drawfilloval ((50 * Value), (50 * j), 20, 20, red)
elsif player = 2 then
drawfilloval ((50 * Value), (50 * j), 20, 20, blue)
end if
delay (50)
drawfilloval ((50 * Value), (50 * j), 20, 20, gray)
end for
end Insert
% Rules = 0 to exclude k, 1 to add k, and -1 to minus k.
function RawLineCheck (player, istart, iend, jstart, jend, rule1, rule2 : int) : boolean
for i : istart .. iend
for j : jstart .. jend
counter := 0
for k : 0 .. 3
if Pieces (i + (rule1 * k), j + (rule2 * k)) = player then
counter := counter + 1
end if
if counter = 4 then
result true
end if
end for
end for
end for
result false
end RawLineCheck
% Result 0 = NO WIN
% Result 1 = Win
% FYI - The reason it minus's 3 for the for loops is because you can't
% connect 4 if there is only 3 spaces available.
function LineCheck (player : int) : int
if RawLineCheck (player, 1, ROWS, 1, COLUMNS - 3, 0, 1) then % HORIZONTAL
result 1
elsif RawLineCheck (player, 1, ROWS - 3, 1, COLUMNS, 1, 0) then % VERTICAL
result 1
elsif RawLineCheck (player, 1, ROWS - 3, 1, COLUMNS - 3, 1, 1) then % DIAGONAL /
result 1
elsif RawLineCheck (player, 1, ROWS - 3, 4, COLUMNS, 1, -1) then % DIAGONAL \
result 1
else
counter := 0
for i : 1 .. COLUMNS
if Pieces (ROWS, i) not= 0 then
counter := counter + 1
end if
end for
if counter = COLUMNS then
result 2
end if
end if
result 0
end LineCheck
procedure ClearBoard
for j : 1 .. ROWS
for k : 1 .. COLUMNS
Pieces (j, k) := 0
end for
end for
end ClearBoard
% GAME CODE
ClearBoard
setscreen ("graphics:400;400, nobuttonbar")
Turn := 1
TurnColour (1, 0)
DisplayScreen
put "What is Player One's Name?"
get Names (1)
cls
TurnColour (2, 0)
DisplayScreen
put "What is Player Two's Name?"
get Names (2)
loop
cls
DisplayScreen
TurnColour (Turn, 1)
Insert (Turn)
cls
if LineCheck (Turn) = 1 then
DisplayScreen
TurnColour (Turn, 1)
put Names (Turn), " Wins! Play Again? (n to exit)"
Score (Turn) := Score (Turn) + 1
delay (100)
elsif LineCheck (Turn) = 2 then
DisplayScreen
TurnColour (Turn, 1)
put "Draw Game! Play Again? (n to exit)"
Score (1) := Score (1) + 0.5
Score (2) := Score (2) + 0.5
delay (100)
end if
if LineCheck (Turn) not= 0 then
getch (PlayAgain)
if PlayAgain = 'n' then
exit
else
ClearBoard
end if
end if
if Turn = 1 then
Turn := 2
elsif Turn = 2 then
Turn := 1
end if
end loop
|