Object of the game is to end up will as little of blocks as possible. Perfect would be all of them gone. Touch groups of color blocks to remove them. There must be at lease two blocks of the same color to remove them (side by side). The blocks will drop down filling in the holes, and move to the left.
It's only for iPad right now, but I'll add rbytes cool all device code when I have more time.
Enjoy. Hope it's not too addicting...
Code: Select all
'GridClear v1.0 (ipad only)
'Coded by Dav DEC/2016
'Based on a old qbasic game
'Try to clear the grid of all color blocks.
'Touch a group of colors to remove that group.
'Blocks will drop down to fill in the holes.
'Blocks move to the left when a column removed.
'Ending up with 5 blocks or less is great.
'Only for ipad right now, but I will probably
'add rbytes cool all-device code later on.
if lowstr$(device_type$())<>"ipad" then
print "Sorry, only designed for iPad."
end
end if
'=== set up screen
graphics
graphics clear 0,0,0
set orientation left
option base 1
set buttons custom
set buttons font size 56
draw color 0,0,0
sw=screen_width()
sh=screen_height()
rows = 11!columns = 7!size =75
dim btn(rows,columns) 'buttons display
'generate random board colors
for r= 1 to rows
for c = 1 to columns
btn(r,c)=rnd(6)
next c
next r
gosub updateboard
do
'get a button press
do
nm=0 'button count
for r= 1 to rows
for c = 1 to columns
nm=nm+1
if button_pressed(str$(nm)) then
old=btn(r,c) 'button color
'only do when non black touched
if old <>6 then
'only do if a neighbor is same
nn=0
if r>1 then
if btn(r-1,c)=old then nn=1
end if
if r<rows then
if btn(r+1,c)=old then nn=1
end if
if c>1 then
if btn(r,c-1)=old then nn=1
end if
if c<columns then
if btn(r,c+1)=old then nn=1
end if
'if a group of colors...
if nn= 1 then
notes set "101:tc7b7a7"
notes play
x=(r*size) ! y=(c*size)
goto selected
end if
end if
end if
next c
next r
slowdown
until 0
selected:
'fill the group...
FloodFill(old, 6, r, c)
'show blacked out colors
gosub updateboard
moved=0 'moving sound flag
'drop down blocks here...
for r= 1 to rows
for c = columns to 2 step -1
if btn(r,c)=6 then
c2=c
do
c2=c2-1
until btn(r,c2)<>6 or c2 = 1
if c2 >0 then
if btn(r,c) <> btn(r,c2) then
moved =1
end if
btn(r,c) = btn(r,c2)
btn(r,c2)=6
end if
end if
next c
next r
'move blocks left here...
for r = 1 to rows -1
if btn(r,columns)=6 then
r2=r
do
r2=r2+1
until btn(r2,columns)<>6 or r2=rows
for c = 1 to columns
if btn(r,c)<>btn(r2,c) then
moved =1
end if
btn(r,c)=btn(r2,c)
btn(r2,c)=6
next c
end if
next r
if moved=1 then
'play sfx for blocks dropping
notes set "122:sc3b2a2"
notes play
end if
'redraw buttons board
gosub updateboard
'see if any groups presently left
dn=0
for r=1 to rows
for c=1 to columns
if btn(r,c)<>6 then
if r>1 then
if btn(r-1,c)=btn(r,c) then dn=1
end if
if r<rows then
if btn(r+1,c)=btn(r,c) then dn=1
end if
if c>1 then
if btn(r,c-1)=btn(r,c) then dn=1
end if
if c<columns then
if btn(r,c+1)=btn(r,c) then dn=1
end if
end if
next c
next r
'count how many blocks left
h=0
for r=1 to rows
for c=1 to columns
if btn(r,c)<>6 then h=h+1
next c
next r
fill color .2,.2,.2
draw color 1,1,1
h$=str$(h)&" blocks left"
set buttons font size 26
button "s" text h$ at 10,10
set buttons font size 56
fill color 0,0,0
draw color 0,0,0
'if no more groups, end...
if dn=0 then
graphics clear
end
end if
until forever
end
'==========================================
' GOSUBS AND FUNCTIONS
'==========================================
'==========
updateboard:
'==========
nm=0
for r= 1 to rows
for c = 1 to columns
j= btn(r,c) ! nm=nm+1
if j=0 then fill color 1,0,0
if j=1 then fill color 0,1,0
if j=2 then fill color 0,0,1
if j=3 then fill color 1,1,0
if j=4 then fill color 1,0,1
if j=5 then fill color 1,.5,0
if j=6 then fill color 0,0,0
x=(r*size) ! y=(c*size)
button str$(nm) text "" at x,y+15 size size,size
next c
next r
return
def FloodFill(old, clr, x, y)
If .btn(x,y) <> old Then
Return
Else
.btn(x,y) = clr
End if
If x > 1 Then FloodFill(old, clr, x-1, y)
If x < .rows Then FloodFill(old, clr, x + 1, y)
If y > 1 Then FloodFill(old, clr, x, y-1)
If y < .columns Then FloodFill(old, clr, x, y+1)
End def
Thanks for the compliment.