Cezna's Connect 4

Cezna · **Posted:** Thu Jun 17, 2010 2:12 pm

A few people expressed interest in seeing this, so here it is.
If anyone wants to improve it or help me put AI into it, please post back.

Turing:

setscreen ("graphics:600;610, position:center;center, offscreenonly, nobuttonbar, title:Connect 4")
var board, piece1, piece2, mousex, mousey, button, turn, column, board_clr, background_clr, player_1_clr,
player_2_clr : int
var column_height : array 1 .. 7 of int := init (0, 0, 0, 0, 0, 0, 0)
var clicked : boolean := false
var keys : array char of boolean
var win_font := Font.New ("Comic Sans MS:30")

%%% CUSTOMIZABLE PREDEFS %%%
board_clr := 43
background_clr := white
player_1_clr := brightred
player_2_clr := brightblue

forward proc Main

Main

proc DrawPictures
colourback (background_clr)
cls
% BOARD %
drawfillbox (0, 0, 600, 515, board_clr)
drawbox (0, 0, 600, 515, black)
for x : 1 .. 7
for y : 1 .. 6
drawfilloval (x * 85 - 40, y * 85 - 40, 40, 40, background_clr)
drawoval (x * 85 - 40, y * 85 - 40, 40, 40, black)
end for
end for
board := Pic.New (0, 0, 700, 585)
cls
% PIECES %
drawfilloval (100, 100, 40, 40, player_1_clr)
drawoval (100, 100, 40, 40, black)
piece1 := Pic.New (60, 60, 140, 140)
drawfilloval (200, 200, 40, 40, player_2_clr)
drawoval (200, 200, 40, 40, black)
piece2 := Pic.New (160, 160, 240, 240)
end DrawPictures

proc Win (clr : int)
if clr = player_1_clr then
Font.Draw ("RED WINS", 193, 550, win_font, player_1_clr)
elsif clr = player_2_clr then
Font.Draw ("BLUE WINS", 182, 550, win_font, player_2_clr)
end if
View.Update
% frees image IDs so pictures can be redrawn
Pic.Free (board)
Pic.Free (piece1)
Pic.Free (piece2)
loop
Mouse.Where (mousex, mousey, button)
exit when button = 1 or hasch
end loop
Main
end Win

proc CheckForLines (x, y, clr : int)
var scan_dist := 85
var line := 1
%% CHECK FOR VERTICAL LINES %%
if y div 85 <= 3 then
loop
if whatdotcolour (x, y + scan_dist) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
scan_dist := 85
line := 1
%% CHECK FOR HORIZONTAL LINES %%
if x div 85 <= 4 then
loop
if whatdotcolour (x + scan_dist, y) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
scan_dist := 85
line := 1
%% CHECK FOR UP/RIGHT DIAGONAL LINES %%
if x div 85 <= 4 and y div 85 <= 3 then
loop
if whatdotcolour (x + scan_dist, y + scan_dist) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
scan_dist := 85
line := 1
%% CHECK FOR DOWN/RIGHT DIAGONAL LINES %%
if x div 85 <= 4 and y div 85 >= 4 then
loop
if whatdotcolour (x + scan_dist, y - scan_dist) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
scan_dist := 85
line := 1
%% CHECK FOR DOWN/LEFT DIAGONAL LINES %%
if x div 85 >= 4 and y div 85 >= 4 then
loop
if whatdotcolour (x - scan_dist, y - scan_dist) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
scan_dist := 85
line := 1
%% CHECK FOR UP/LEFT DIAGONAL LINES %%
if x div 85 >= 4 and y div 85 <= 3 then
loop
if whatdotcolour (x - scan_dist, y + scan_dist) = clr then
line += 1
scan_dist += 85
else
exit
end if
if line = 4 then
Win (clr)
end if
end loop
end if
end CheckForLines

proc Scan
var clr : int
for x : 1 .. 7
for y : 1 .. 6
clr := whatdotcolour (x * 85 - 40, y * 85 - 40)
if clr not= white then
CheckForLines (x * 85 - 40, y * 85 - 40, clr)
end if
end for
end for
end Scan

proc PieceDraw (piece, x, y : int)
if piece = 1 then
Pic.Draw (piece1, x, y, picMerge)
elsif piece = 2 then
Pic.Draw (piece2, x, y, picMerge)
end if
end PieceDraw

proc Drop (x, column : int)
var y : real := 525
loop
PieceDraw (turn, x, round (y))
Pic.Draw (board, 0, 0, picMerge)
y -= 15
Time.DelaySinceLast (1)
View.Update
cls
exit when y <= 5 + (85 * column_height (column))
end loop
y := 5 + (85 * column_height (column))
cls
PieceDraw (turn, x, round (y))
Pic.Draw (board, 0, 0, picMerge)
View.Update
Pic.Free (board)
board := Pic.New (0, 0, 700, 585)
Scan
% next turn
if turn = 1 then
turn := 2
elsif turn = 2 then
turn := 1
end if
end Drop

proc PickSpot
var x, y : int
y := 525
Mouse.Where (mousex, mousey, button)
if mousex >= 0 and mousex <= 580 then
for count : 1 .. 7
if mousex < count * 85 then
x := count * 85 - 80
column := count
exit
end if
end for
elsif mousex < 0 then
x := 5
elsif mousex > 580 then
x := 515
end if
if button = 1 then
if not clicked then
if column_height (column) < 6 then
Drop (x, column)
column_height (column) += 1
end if
end if
clicked := true
else
clicked := false
end if
/* % Keyboard Controls (mouse controls must be disabled to use)
Input.KeyDown (keys)
if keys (KEY_LEFT_ARROW) and x > 5 then
x -= 85
end if
if keys (KEY_RIGHT_ARROW) and x < 515 then
x += 85
end if
if keys (KEY_DOWN_ARROW) then
Drop (x, column)
end if
*/
PieceDraw (turn, x, y)
end PickSpot

body proc Main
loop % full loop (for restarting the game)
DrawPictures
randint (turn, 1, 2)
loop % main loop (for playing)
cls
Pic.Draw (board, 0, 0, picMerge)
PickSpot
View.Update
end loop
end loop
end Main

copthesaint · **Posted:** Thu Jun 17, 2010 2:53 pm

Your game still needs some work

Posted Image, might have been reduced in size. Click Image to view fullscreen.

Cezna · **Posted:** Thu Jun 17, 2010 3:01 pm

How did you do that?

If I don't know what order you put the pieces in, or what exactly happened, I can't fix it (or confirm that there is in fact a problem).

copthesaint · **Posted:** Thu Jun 17, 2010 3:35 pm

just play the game, lol you get the error everytime.

InfectedWar · **Posted:** Thu Jun 17, 2010 4:21 pm

Yeah Cezna copthesaint is right =d, this glitch only seems to happen on the restart of the game. The new game still thinks my pieces from the last game are still there (But they don't draw on screen). So probably you are not resetting all of your variables at the restart.

Cezna · **Posted:** Thu Jun 17, 2010 4:22 pm

Ohhhhhh, now I know what the problem is.
There are integer values representing the height of the columns.

Thank you InfectedWar and copthesaint.

+ 2 bits each

EDIT: fixed the problem, here is an updated version of the game

InfectedWar · **Posted:** Thu Jun 17, 2010 4:30 pm

I'm just noticing that diagonals don't work. Is this feature un-complete or did I just find a bug?

Edit* I tested diagonals again a diff way and they worked???

Edit** Good looking program asides for these small kinks that can be fixed easily i bet =d

Monduman11 · **Posted:** Thu Jun 17, 2010 4:37 pm

hey nice game, kinda lags on my pc though and it has a few bugs but overal its good.. btw i upgraded my game if you want to check it out... its at the globox adventures thread Razz

Cezna · **Posted:** Thu Jun 17, 2010 4:48 pm

@ Monduman11
I will check you game out as soon as I get enough time to go through the code (hopefully soon! Smile

)

Monduman11 · **Posted:** Thu Jun 17, 2010 4:51 pm

Cezna @ Thu Jun 17, 2010 4:48 pm wrote:

@ Monduman11
I will check you game out as soon as I get enough time to go through the code (hopefully soon! Smile

)

kk lol

Cezna · **Posted:** Thu Jun 17, 2010 4:57 pm

Here is another updated version (apparently I suck at testing, because I found no bugs, lol).

Please keep up the bug checking (pictures are much appreciated), as it is a big help!

InfectedWar · **Posted:** Thu Jun 17, 2010 5:22 pm

A fix if it's a stalemate lol =d I knew this was going to happen it was just hard not to accidentally win while trying to get this condition to happen (hehe) =d

Cezna · **Posted:** Thu Jun 17, 2010 5:26 pm

Lol, ok thank you InfectedWar, I will fix this problem, but since this one not a glitch just an embarassing lack of foresight, I will wait and see if any more bugs are found, and then include the update for stalemate with the update for the bug, too keep from posting too many downloads.

Cezna · **Posted:** Tue Jun 22, 2010 2:40 pm

Since no one else has posted any bugs, this is hopefully the final version of my connect 4, now with the possibility of a tie, and a few other fixes.

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members