04-01-2005, 08:31 AM
Code:
'**************************************
'Crazy Color: A puzzle game that will
'make you crazy. :)
'Copyright 2005, Richard D. Clark
'This is released as freeware. Feel free to tinker.
'** Requires a mouse to play **
'**************************************
'How to Play
'Press S to shuffle the board
'Click on the grey buttons to move tiles:
'Rows:
' Left click moves row left
' Right click move row right
'Column:
' Left click moves column up
' Right click move column down
'Press the hilighted letter in menu to perform action:
' K: set skill level. 1 = 10 moves, 2 = 15 moves, 3 = 20 moves
' S: shuffle board
' R: replay last board
' V: solve puzzle
' Q (or ESC): quit
'Note: Every board can be solved.
'**************************************
option explicit
'$include once:'win\user32.bi'
type soltype
colrow as string * 1
crpos as integer
crdir as integer
end type
const Red = RGB(252, 2, 4)
const Green = RGB(4, 254, 4)
const Blue = RGB(4, 2, 252)
const Yellow = RGB(252, 254, 4)
const White = RGB(255, 255, 255)
const DkGrey = RGB(128, 128, 128)
const Black = RGB(0, 0, 0)
const LeftButton = -1
const RightButton = 1
declare sub InitBoard
declare sub Shuffle
declare sub MoveRow(Row as integer, MDir as integer)
declare sub MoveColumn(Col as integer, MDir as integer)
declare Sub Solve
declare sub DrawBoard
declare sub GetButton(x as integer, y as integer, button as integer)
declare sub SetSkill
declare sub Replay
declare function CheckForWin() as integer
'Working vars
dim shared MovesToSolve as integer
dim shared board(4, 4) as long
dim shared winboard(4, 4) as long
dim shared shuffleboard(4,4) as long
dim shared solution(20) as soltype
dim shared DisplaySolution as string
dim shared Shuffling as integer
dim shared Solving as integer
dim shared ingame as integer
dim shared skill as integer
dim shared CurrentMove as integer
dim shared HasWon as integer
dim mx, my as integer
dim button as integer
dim skey as string
dim exitgame as integer
randomize timer
skill = 1
ingame = False
Shuffling = False
Solving = False
exitgame = False
CurrentMove = 0
HasWon = False
'set up the screen
screen 16, 32, 2
screenset 1, 0
WindowTitle "Crazy Color"
InitBoard
DrawBoard
do while not exitgame
'check for mouse clicks
getmouse mx, my, ,button
'check for left mouse button
if button <> -1 then
'left mouse button pressed
if button and 1 then
GetButton mx, my, LeftButton
end if
'right mouse button pressed
if button and 2 then
GetButton mx, my, RightButton
end if
end if
'check for key press
skey = inkey$
skey = UCase$(skey)
if skey = "S" then
'init the board and shuffle tiles
InitBoard
shuffle
end if
if skey = "V" then
'make sure we have something to solve
if ingame then solve
end if
if skey = "K" then
'only change it after a solve
if not ingame then SetSkill
end if
if skey = "R" then
'set up replay
Replay
end if
if skey = "Q" or skey = Chr$(27) then
'exit game
exitgame = true
end if
loop
end
sub InitBoard
dim i, j as integer
'set the square colors
board(0,0) = Red
board(0,1) = Red
board(1,0) = Red
board(1,1) = Red
board(0,2) = Yellow
board(0,3) = Yellow
board(1,2) = Yellow
board(1,3) = Yellow
board(2,0) = Green
board(2,1) = Green
board(3,0) = Green
board(3,1) = Green
board(2,2) = Blue
board(2,3) = Blue
board(3,2) = Blue
board(3,3) = Blue
'save the current board into the shuffle board
For i = 0 to 3
For j = 0 to 3
shuffleboard(i,j) = board(i, j)
Next j
Next i
'save the win board
For i = 0 to 3
For j = 0 to 3
winboard(i,j) = board(i, j)
Next j
Next i
MovesToSolve = 0
end sub
'Rows are number 0 to 3
'Dir = 1, move right, Dir = -1, move left
Sub MoveRow(Row as integer, MDir as integer)
Dim SaveColor as long
Dim i as integer
'Moving row right
If MDir = 1 Then
'Save the color in last cell
SaveColor = board(Row, 3)
'Move cells down one
For i = 3 to 1 Step -1
board(Row, i) = board(Row, i-1)
Next
'Add in saved color
board(Row, 0) = SaveColor
'Moving row left
Else
'Save the color in last cell
SaveColor = board(Row, 0)
'Move cells down one
For i = 0 to 2
board(Row, i) = board(Row, i+1)
Next
'Add in saved color to top cell.
board(Row, 3) = SaveColor
End If
CurrentMove = CurrentMove + 1
DrawBoard
End Sub
'Columns are number 0 to 3
'Dir = 1, move down, Dir = -1, move up
Sub MoveColumn(Col as integer, MDir as integer)
Dim SaveColor as long
Dim i as integer
'Moving column down
If MDir = 1 Then
'Save the color in last cell
SaveColor = board(3, Col)
'Move cells down one
For i = 3 to 1 Step -1
board(i, Col) = board(i-1, Col)
Next
'Add in saved color to top cell.
board(0, Col) = SaveColor
'Moving column up.
Else
'Save the color in last cell
SaveColor = board(0, Col)
'Move cells up one
For i = 0 to 2
board(i, Col) = board(i+1, Col)
Next
'Add in saved color to top cell.
board(3, Col) = SaveColor
End If
CurrentMove = CurrentMove + 1
DrawBoard
End Sub
'Shuffles the board
'This is treated as playing the game backward.
Sub Shuffle
Dim row, col as integer
Dim i, j as integer
dim mdir as integer
dim mcolrow as integer
'Set the shuffle flag-used in Drawboard
ingame = False
HasWon = False
Shuffling = True
CurrentMove = 0
'Get the number of shuffle moves.
select case skill
case 1: MovesToSolve = 10
case 2: MovesToSolve = 15
case 3: MovesToSolve = 20
end select
For i = 0 to MovesToSolve - 1
'get the move direction
mdir = Int((1 - 0 + 1) * Rnd + 0)
if mdir = 0 then mdir = -1
'get col or row to move
mcolrow = Int((1 - 0 + 1) * Rnd + 0)
if mcolrow = 0 then
'moving column
Col = Int((3 - 0 + 1) * Rnd + 0)
'Save the move
Solution(i).colrow = "C"
Solution(i).crdir = mdir
Solution(i).crpos = Col
MoveColumn(Col, mdir)
else
'Moving row
Row = Int((3 - 0 + 1) * Rnd + 0)
'Save the move
Solution(i).colrow = "R"
Solution(i).crdir = mdir
Solution(i).crpos = Row
MoveRow(Row, mdir)
end if
DrawBoard
sleep 500
Next i
'Save the shuffled board
For i = 0 to 3
For j = 0 to 3
shuffleboard(i,j) = board(i, j)
Next j
Next i
ingame = True
Shuffling = False
CurrentMove = 0
DrawBoard
end sub
Sub Solve
dim i, j as integer
dim ch as string
dim cdir as string
dim newdir as integer
dim crowcol as string
dim RowCol as integer
'Reset the board to suffled board.
Solving = True
ingame = False
'reset board to shuffled board
For i = 0 to 3
For j = 0 to 3
board(i,j) = shuffleboard(i, j)
Next
Next
'Get the soluton parameters.
For i = MovesToSolve - 1 to 0 Step -1
'Get the row or col identifier
ch = Solution(i).colrow
'Get the display move direction
if ch = "C" then
if newdir = 1 then
cdir = " Right"
else
cdir = " Left"
end if
elseif ch = "R" then
if newdir = 1 then
cdir = " Down"
else
cdir = " Up"
end if
end if
'get the col/row position
crowcol = "(" + LTrim$(Str$(Solution(i).crpos + 1)) + ")"
'get the move: we need to move in the opposite
'direction saved to solve puzzle
if Solution(i).crdir = -1 then
newdir = 1
else
newdir = -1
end if
'Add to the display string
DisplaySolution = ch + crowcol + cdir
'Get the row/col number
RowCol = Solution(i).crpos
'If a column, move it
If ch = "C" Then
MoveColumn(RowCol, newdir)
Else
'moving a row
MoveRow(RowCol, newdir)
End If
Sleep 1000 'delay
Next
Solving = False
MovesToSolve = 0
CurrentMove = 0
DrawBoard
End Sub
sub DrawBoard
dim sqcolor as long
'draw the board
color Black, White
cls
'draw the background square
line (2, 2) - (274, 274), Black, BF
'draw the tiles
sqcolor = board(0,0)
line (4, 4) - (68, 68), sqcolor, BF
sqcolor = board(0,1)
line (72, 4) - (136, 68), sqcolor, BF
sqcolor = board(1,0)
line (4, 72) - (68, 136), sqcolor, BF
sqcolor = board(1,1)
line (72, 72) - (136, 136), sqcolor, BF
sqcolor = board(0,2)
line (140, 4) - (204, 68), sqcolor, BF
sqcolor = board(0,3)
line (208, 4) - (272, 68), sqcolor, BF
sqcolor = board(1,2)
line (140, 72) - (204, 136), sqcolor, BF
sqcolor = board(1,3)
line (208, 72) - (272, 136), sqcolor, BF
sqcolor = board(2,0)
line (4, 140) - (68, 204), sqcolor, BF
sqcolor = board(2,1)
line (72, 140) - (136, 204), sqcolor, BF
sqcolor = board(3,0)
line (4, 208) - (68, 272), sqcolor, BF
sqcolor = board(3,1)
line (72, 208) - (136, 272), sqcolor, BF
sqcolor = board(2,2)
line (140, 140) - (204, 204), sqcolor, BF
sqcolor = board(2,3)
line (208, 140) - (272, 204), sqcolor, BF
sqcolor = board(3,2)
line (140, 208) - (204, 272), sqcolor, BF
sqcolor = board(3,3)
line (208, 208) - (272, 272), sqcolor, BF
'draw the buttons
'row 1
line (280, 4) - (300, 68), Black, BF
line (282, 6) - (298, 66), DkGrey, BF
'row 2
line (280, 72) - (300, 136), Black, BF
line (282, 74) - (298, 134), DkGrey, BF
'row 3
line (280, 140) - (300, 204), Black, BF
line (282, 142) - (298, 202), DkGrey, BF
'row 4
line (280, 208) - (300, 272), Black, BF
line (282, 210) - (298, 270), DkGrey, BF
'col 1
line (4, 280) - (68, 300), Black, BF
line (6, 282) - (66, 298), DkGrey, BF
'col 2
line (72, 280) - (136, 300), Black, BF
line (74, 282) - (134, 298), DkGrey, BF
'col 3
line (140, 280) - (204, 300), Black, BF
line (142, 282) - (202, 298), DkGrey, BF
'col 4
line (208, 280) - (272, 300), Black, BF
line (210, 282) - (270, 298), DkGrey, BF
'draw the menu title
color Red, White
locate 1, 46
print "Crazy ";
color Green, White
print "Color"
color Blue, White
locate 3, 46
print "Skill Level:";Str$(skill)
'draw the skill button
color White, Black
locate 5, 48
print " S";
color Yellow, Black
print "k";
color White, Black
print "ill "
'draw the shuffle button
locate 6, 48
color Yellow, Black
print " S";
color White, Black
print "huffle "
locate 7, 48
color Yellow, Black
print " R";
color White, Black
print "eplay "
'draw the solve button
locate 8, 48
color White, Black
print " Sol";
color Yellow, Black
print "v";
color White, Black
print "e "
'draw the quit button
locate 9, 48
color Yellow, Black
print " Q";
color White, Black
print "uit "
'Show the number of moves to solve
color DkGrey, White
locate 21, 2
if MovesToSolve > 0 then
print "Number of moves to solve: ";Str$(MovesToSolve)
end if
locate 23, 2
if Shuffling then
print "Shuffling..."
end if
if Solving then
print "Solving: "; DisplaySolution
end if
if ingame then
print "Current Move Number: ";Str$(CurrentMove)
end if
if HasWon then
print "You solved the board in ";Str$(CurrentMove);" moves!"
end if
'show the new board
screencopy 1, 0
end sub
sub GetButton(x as integer, y as integer, button as integer)
'check to see if row 1 was clicked
if x >= 280 and x <= 300 then
if y >= 4 and y <= 68 then
if ingame then MoveRow 0, button
end if
end if
'check to see if row 2 was clicked
if x >= 280 and x <= 300 then
if y >= 72 and y <= 136 then
if ingame then MoveRow 1, button
end if
end if
'check to see if row 3 was clicked
if x >= 280 and x <= 300 then
if y >= 140 and y <= 204 then
if ingame then MoveRow 2, button
end if
end if
'check to see if row 4 was clicked
if x >= 280 and x <= 300 then
if y >= 208 and y <= 272 then
if ingame then MoveRow 3, button
end if
end if
'check to see if col 1 was clicked
if x >= 4 and x <= 68 then
if y >= 280 and y <= 300 then
if ingame then MoveColumn 0, button
end if
end if
'check to see if col 2 was clicked
if x >= 72 and x <= 136 then
if y >= 280 and y <= 300 then
if ingame then MoveColumn 1, button
end if
end if
'check to see if col 3 was clicked
if x >= 140 and x <= 204 then
if y >= 280 and y <= 300 then
if ingame then MoveColumn 2, button
end if
end if
'check to see if col 4 was clicked
if x >= 208 and x <= 272 then
if y >= 280 and y <= 300 then
if ingame then MoveColumn 3, button
end if
end if
'check to see if we have a win condition
if ingame and CheckForWin then
HasWon = true
ingame = false
DrawBoard
end if
'delay: change this if you get multiple mouse clicks
sleep 150
end sub
sub SetSkill
'increment the skill level
skill = skill + 1
if skill > 3 then skill = 1
'show the new skill level
DrawBoard
end sub
sub Replay
dim i, j as integer
ingame = False
'reset board to shuffled board
For i = 0 to 3
For j = 0 to 3
board(i,j) = shuffleboard(i, j)
Next
Next
HasWon = False
ingame = True
CurrentMove = 0
DrawBoard
end sub
function CheckForWin() as integer
dim ret as integer
dim i, j as integer
'set the default
ret = true
'check the board colors to see if there is a match
For i = 0 to 3
For j = 0 to 3
if board(i, j) <> winboard(i,j) then
ret = false
end if
Next j
Next i
CheckForWin = ret
end function
.