Rem Project: BLOCKS
Rem Created: Monday, December 21, 2015
Rem ***** Main Source File *****
set display mode 1920,1080,32
sync rate 60 : sync on : set window off :randomize timer()
global play_game = 0
global falling = 0
global level = 1
global time as float
GLOBAL possibles = 0 rem used to count the number of possibles
global b = 1 rem for holding bonus 1 =on , 0 = off
global r = 1 rem for holding deleting a row
global c = 1 rem for holding deleting a column
global h = 1 rem hint
global hs `high score
global cs `current score
global white : white = rgb(255,255,255)
global black : black = rgb(0,0,0)
global red : red = rgb(255,0,0)
global green : green = rgb(0,255,0)
global show_hint
global speed = 1
global number_of_hints
global pos_line = 11 `image for possible
dim color(8) as string
color(1) = "Red "
color(2) = "Green "
color(3) = "blue "
color(4) = "Cyan "
color(5) = "Pink "
color(6) = "Yellow"
color(7) = "Grey "
color(8) = "White "
rem sounds
global bg_wav = 1
global level_wav = 2
global block_wav = 3
global error_wav = 4
load sound "media\music.wav",bg_wav
load sound "media\level.wav",level_wav
load sound "media\block.wav",block_wav
load sound "media\error.wav",error_wav
type positions
x
y
img
destory
endtype
rem LOAD Images
for i = 1 to 10
load image "media\"+str$(i)+".png",i,1
NEXT
load image "media\line.png",pos_line
global selected as positions
global swap as positions
bonus as positions
global pos_selected=0
global swapped = 0
mouse_up = 0
engame = 1
show_hint = 0
rem MAIN GAME
while escapekey() = 0
hide mouse
if (inkey$() = "n" or inkey$() = "N") and playgame = 0
new_game()
playgame = 1
else
cls
set text size 120
text 500,200,"Press n for new game"
text 600,380," Game by MS"
text 0,540,"Using free music from: http://www.freesound.org/"
endif
while playgame = 1
show mouse
cls
if cs > hs then hs = cs
if sound playing (bg_wav) = 0 then play sound bg_wav
check3()
move_positions()
x_pos = mousex()/80
y_pos = mousey()/80
if x_pos < 11 and y_pos < 11
`check for new selection
if pos_selected = 0 and mouseup = 0 and mouseclick() = 1
selected.x = x_pos
selected.y = y_pos
mouseup = 1
pos_selected = 1
swapped = 0
endif
`check for deselection
if pos_selected = 1 and mouseup = 0 and mouseclick() = 1 and selected.x = x_pos and selected.y = y_pos
selected.x = 0
selected.y = 0
mouseup = 1
pos_selected = 0
swapped = 0
endif
`check for swap
if pos_selected = 1 and mouseup = 0 and mouseclick() = 1 and swapped = 0
if ((selected.x = x_pos-1 or selected.x = x_pos+1) and selected.y = y_pos) or ((selected.y = y_pos-1 or selected.y = y_pos+1) and selected.x = x_pos)
swap.x = x_pos
swap.y = y_pos
swapped = 1
mouseup = 1
endif
endif
endif
rem swap position
if swapped = 1 then swap()
rem level up
if ts = 0
play sound level_wav
inc level
set text size 128
text 1000,500,"Level UP!!"
text 1000,600,"Level "+str$(level)
sync
set text size 30
wait 1000
b = 1
time = 1000
h = 1
show_hint = 0
for i= 1 to 8
score(i) = level
NEXT
ENDIF
mouseup =mouseclick()
dec time,(speed+level)
if time < 0 then end_game()
if inkey$() = "h" and h = 1
h = 0
show_hint = 1
ENDIF
if show_hint = 1 then hint(possibles)
rem draw positions
GOSUB update_screen
sync
rem waiting for n to be pressed
endwhile
sync
rem EXIT GAME
ENDWHILE
REM GOSUBS
update_screen:
rem update timer
box 890,1000-time,910,1000
if h = 1
text 1200,200,"Press H for hint"
else
text 1200,200,"Hint used"
ENDIF
rem show what colours are left
ts =0
set text size 30
text 1000,0,"Colours left"
for i= 1 to 7
if score(i) > 0
text 1000,i*30,color(i)+" "+str$(score(i))
ts = ts + score(i)
endif
NEXT
rem scores
text 1300,0,"High :"+str$(hs)
text 1300,30,"Score :"+str$(cs)
text 1300,60,"Level :"+str$(level)
rem blocks
if pos_selected = 1 then paste image 10,(selected.x*80),(selected.y*80)
for x = 1 to 10
for y = 1 to 10
if position(x,y).img > 0 then paste image position(x,y).img,position(x,y).x+3,position(x,y).y+3
next
next
rem bonuses
if b = 1
bonus.img = rnd(6)+1
text 940,930,"Bonus Available"
else
text 940,930,"Bonus used for"
endif
paste image bonus.img,12*80,12*80
if mouseclick() = 1 and x_pos = 12 and y_pos = 12 and b = 1
b = 0
for x = 1 to 10
for y = 1 to 10
if position(x,y).img = bonus.img then position(x,y).destory = 1
next
NEXT
move_positions()
endif
sync
return
REM FUNCTIONS
FUNCTION end_game()
hint(r)
if possibles = 0 `new possible wins so reset needed
for x = 1 to 9
for y = 1 to 9
position(x,y).img = rnd(6)+1
next
next
text 1200,650,"no possible Lines - free reset"
text 1200,600,"Press upkey to continue"
while upkey() = 0
gosub update_screen
ENDWHILE
time = 1000
playgame = 1
else
if sound playing(bg_wav) = 1 then stop sound bg_wav
text 1200,600,"!!! GAME OVER !!!"
ink rgb(255,255,255),rgb(0,0,0)
text 1150,660,"Press upkey fror new game"
gosub update_screen
while upkey() = 0
gosub update_screen
ENDWHILE
new_game()
endif
ENDFUNCTION
FUNCTION SWAP()
show_hint = 0
temp = position(swap.x,swap.y).img
position(swap.x,swap.y).img = position(selected.x,selected.y).img
position(selected.x,selected.y).img = temp
check3()
ok = 1
for x = 1 to 10
for y = 1 to 10
if position(x,y).img = 9 then ok =0
NEXT
next
if ok = 1
temp = position(selected.x,selected.y).img
position(selected.x,selected.y).img =position(swap.x,swap.y).img
position(swap.x,swap.y).img = temp
ENDIF
if ok = 1 then play sound error_wav
pos_selected = 0
swapped = 0
swap.x = 0
swap.y =0
selected.x = 0
selected.y = 0
ENDFUNCTION
FUNCTION move_positions()
for x =1 to 10 `coloumns
for y = 10 to 2 step -1 `go from bottom coloumn up
if position(x,y).img = 9
while position(x,y).img = 9
for i = y to 1 step -1
position(x,i).img = position(x,i-1).img
GOSUB update_screen
next
new_image(x)
endwhile
endif
next
NEXT
for x = 1 to 10
if position(x,1).img = 9 then new_image(x)
NEXT
ENDFUNCTION
FUNCTION new_image(x)
position(x,1).img = rnd(6)+1
position(x,1).destory = 0
ENDFUNCTION
function check3()
r = 0
for x = 1 to 10
for y = 10 to 2 step -1
if position(x,y).img = position(x,y-1).img and position(x,y).img = position(x,y-2).img and position(x,y).img <> 9
dec score(position(x,y).img)
position(x,y).destory = 1
position(x,y-1).destory = 1
position(x,y-2).destory = 1
inc time,40
inc cs,30
if time > 1000 then time = 1000
if sound playing (block_wav) = 0 then play sound block_wav
endif
next
next
for x = 1 to 8
for y = 10 to 1 step -1
if position(x,y).img = position(x+1,y).img and position(x,y).img = position(x+2,y).img and position(x,y).img <> 9
dec score(position(x,y).img)
position(x,y).destory = 1
position(x+1,y).destory = 1
position(x+2,y).destory = 1
inc time,40
inc cs,30
if time > 1000 then time = 1000
if sound playing (block_wav) = 0 then play sound block_wav
endif
next
next
for x = 1 to 10
for y = 1 to 10
if position(x,y).destory = 1 then position(x,y).img = 9 : position(x,y).destory = 0
next
NEXT
ENDFUNCTION
FUNCTION new_game
cs = 0
level = 1
b = 1
r = 1
c = 1
playgame = 1
dim score(9)
for i = 1 to 7
score(i) = 1
next
time = 1000
dim position(10,10) as positions
for x = 1 to 10
for y = 1 to 10
position(x,y).destory = 0
position(x,y).x = x*80
position(x,y).y = y*80
position(x,y).img = rnd(6)+1
paste image position(x,y).img,position(x,y).x+3,position(x,y).y+3
NEXT
next
selected.x = 0
selected.y = 0
swap.x = 0
swap.y = 0
pos_selected = 0
pos_swap =0
ENDFUNCTION
FUNCTION Hint(r)
set text size 30
ink rgb(255,0,0),rgb(0,0,0)
rows = 0
for x = 1 to 7
for y = 1 to 10
if position(x,y).img = position(x+1,y).img and position(x,y).img =position(x+3,y).img
paste image pos_line,position(x,y).x,position(x,y).y
paste image pos_line,position(x+1,y).x,position(x+1,y).y
paste image pos_line,position(x+2,y).x,position(x+2,y).y
paste image pos_line,position(x+2,y).x,position(x+3,y).y
inc rows
ENDIF
NEXT
NEXT
text 1200,500,"Available in Rows:"+str$(rows)
columns = 0
for x = 1 to 10
for y = 1 to 7
if position(x,y).img = position(x,y+1).img and position(x,y).img =position(x,y+3).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x,y+1).x,position(x,y+1).y
paste image 10,position(x,y+2).x,position(x,y+2).y
paste image 10,position(x,y+2).x,position(x,y+3).y
inc columns
ENDIF
NEXT
NEXT
shapes = 0
for x = 1 to 9
for y = 1 to 8
if position(x,y).img = position(x,y+2).img and position(x,y).img =position(x+1,y+1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x,y+2).x,position(x,y+2).y
paste image 10,position(x+1,y+1).x,position(x+1,y+1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 1 to 9
for y = 1 to 8
if position(x,y).img = position(x,y+2).img and position(x,y).img =position(x-1,y-1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x,y+2).x,position(x,y+2).y
paste image 10,position(x-1,y-1).x,position(x-1,y-1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 2 to 8
for y = 1 to 9
if position(x,y).img = position(x-1,y+1).img and position(x,y).img =position(x+1,y+1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x-1,y+1).x,position(x-1,y+1).y
paste image 10,position(x+1,y+1).x,position(x+1,y+1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 2 to 8
for y = 2 to 10
if position(x,y).img = position(x-1,y-1).img and position(x,y).img =position(x+1,y-1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x+1,y-1).x,position(x+1,y-1).y
paste image 10,position(x-1,y-1).x,position(x-1,y-1).y
inc shapes
ENDIF
NEXT
NEXT
rem reverse P
for x = 1 to 9
for y = 1 to 8
if position(x,y).img = position(x+1,y+1).img and position(x,y).img =position(x+1,y+2).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x+1,y+1).x,position(x+1,y+1).y
paste image 10,position(x+1,y+2).x,position(x+1,y+2).y
inc shapes
ENDIF
NEXT
NEXT
rem P
for x = 2 to 10
for y = 1 to 8
if position(x,y).img = position(x-1,y+1).img and position(x,y).img =position(x-1,y+2).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x-1,y+1).x,position(x-1,y+1).y
paste image 10,position(x-1,y+2).x,position(x-1,y+2).y
inc shapes
ENDIF
NEXT
NEXT
rem d
for x = 1 to 9
for y = 10 to 2 step - 1
if position(x,y).img = position(x+1,y-1).img and position(x,y).img =position(x+1,y-2).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x+1,y-1).x,position(x+1,y-1).y
paste image 10,position(x+1,y-2).x,position(x+1,y-2).y
inc shapes
ENDIF
NEXT
NEXT
rem b
for x = 2 to 10
for y = 10 to 2 step - 1
if position(x,y).img = position(x-1,y-1).img and position(x,y).img =position(x-1,y-2).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x-1,y-1).x,position(x-1,y-1).y
paste image 10,position(x-1,y-2).x,position(x-1,y-2).y
inc shapes
ENDIF
NEXT
NEXT
rem the four on the side
for x = 3 to 10
for y = 10 to 2 step - 1
if position(x,y).img = position(x-1,y-1).img and position(x,y).img =position(x-2,y-1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x-1,y-1).x,position(x-1,y-1).y
paste image 10,position(x-2,y-1).x,position(x-2,y-1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 1 to 8
for y = 10 to 2 step - 1
if position(x,y).img = position(x+1,y-1).img and position(x,y).img =position(x+2,y-1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x+1,y-1).x,position(x+1,y-1).y
paste image 10,position(x+2,y-1).x,position(x+2,y-1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 3 to 10
for y = 9 to 1 step - 1
if position(x,y).img = position(x-1,y+1).img and position(x,y).img =position(x-2,y+1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x-1,y+1).x,position(x-1,y+1).y
paste image 10,position(x-2,y+1).x,position(x-2,y+1).y
inc shapes
ENDIF
NEXT
NEXT
for x = 1 to 8
for y = 9 to 2 step - 1
if position(x,y).img = position(x+1,y+1).img and position(x,y).img =position(x+2,y+1).img
paste image 10,position(x,y).x,position(x,y).y
paste image 10,position(x+1,y+1).x,position(x+1,y+1).y
paste image 10,position(x+2,y+1).x,position(x+2,y+1).y
inc shapes
ENDIF
NEXT
NEXT
text 1200,500,"Available in Rows:"+str$(rows)
text 1200,530,"Available in Columns:"+str$(columns)
text 1200,560,"Available in Shapes:"+str$(shapes)
ink rgb(255,255,255),rgb(0,0,0)
possibles = rows+columns+shapes
endfunction possibles