Wednesday Workshop - BlitzCoder.net

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0|510|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Znaxish

by mike_g for Workshop #085
Find rectangles whose corners are 4 alike shapes.
Mouse
AppTitle "Znaxish"
Graphics 640, 480, 8, 2
SeedRnd MilliSecs()

Dim grid(12, 12)
Dim sel_x(4), sel_y(4)
Global x_pos, y_pos
Global num_select = 1
Global removal
Global score, hiscore=2000 
Global state 
Const  game_time=180000

Global tiles = CreateImage(96, 32)
SetBuffer ImageBuffer(tiles)
Color 150, 30, 30
Rect 0, 0, 95, 31
Color 30, 150, 30
;Tile 1
Oval 2, 2, 27, 27, 1
;Tile 2
Rect 34, 2, 12, 12, 1
Rect 34, 16, 12, 12, 1
Rect 48, 2, 12, 12, 1
Rect 48, 16, 12, 12, 1
;Tile 3
For x = 0 To 25   	
	Line 80-(x/2), 28-x, 80+(x/2), 28-x 
Next

INITIALIZE()
SetBuffer BackBuffer()
font = LoadFont("Verdana", 16, True, False, False) 
SetFont font 

While Not KeyHit(1)
	Cls 
	If state = 0		;TITLE SCREEN
		TITLE_SCREEN()
		start_time = MilliSecs()
	Else If state = 1	;IN GAME
		DRAW_BLOCKS()
		MOUSE_CLICK()
		DISPLAY_TEXT(start_time)
	Else 				;GAME OVER
		GAME_OVER()
	EndIf 
	Flip 
Wend 

FreeImage tiles
FreeFont font
End 

;--------------------------;
Function INITIALIZE()
For x = 1 To 12
	For y = 1 To 12
		grid(x, y) = Rand(0, 2)
	Next
Next	
End Function
;--------------------------;
Function DRAW_BLOCKS()

;IF SQUARES ARE BEING REMOVED GET START AND END X/Y POSITIONS
If removal > 0
	start_x = 100
	end_x = 0
	For i = 1 To 4
		If sel_x(i) < start_x Then start_x = sel_x(i)
		If sel_x(i) > end_x Then end_x = sel_x(i)
	Next 

	start_y = 100
	end_y = 0
	For i = 1 To 4
		If sel_y(i) < start_y Then start_y = sel_y(i)
		If sel_y(i) > end_y Then end_y = sel_y(i)
	Next 
EndIf 

;FOR EACH SQUARE: DRAW IT!
Color 150, 30, 30
For x = 1 To 12
	For y = 1 To 12
		If grid(x, y) = 0 
			;Color 150, 30, 30
			frame = 0
		Else If grid(x, y) = 1
			frame = 1
			;Color 150, 150, 30
		Else
			frame = 2
			;Color 50, 150, 30
		EndIf 
			
		
		If removal = 0
			For i = 1 To 4
				If sel_x(i) = x And sel_y(i)= y
					selected = 1
					Exit
				EndIf 	
			Next	
			If selected = 1
				Rect 20+(x*32), 20+(y*32), 30, 30, 0					
				Rect 21+(x*32), 21+(y*32), 28, 28, 0
				Rect 22+(x*32), 22+(y*32), 26, 26, 0				
			Else
				DrawImageRect tiles, 20+(x*32), 20+(y*32), frame*32, 0, 30, 30 
			EndIf
		Else 
			;If in an area to remove
			If x >= start_x And x <= end_x And y >= start_y And y <= end_y		
				Rect 20+(x*32)+removal, 20+(y*32)+removal, 30-(removal*2), 30-(removal*2), 1
			Else
				DrawImageRect tiles, 20+(x*32), 20+(y*32),frame*32, 0, 32, 32 
				;Rect 20+(x*32), 20+(y*32), 30, 30, 1
			EndIf		
		EndIf 	
		selected =0 
	Next
Next 

If removal > 0
	removal = removal + 1
	If removal > 15 
		RESET_SELECT()
		GENERATE_NEW(start_x, end_x, start_y, end_y)
		removal = 0 
	EndIf 
EndIf 


End Function 
;-------------------------;
Function MOUSE_CLICK()
If MouseHit(1)
	x_pos = ((MouseX() - 20)/32)
	y_pos = ((MouseY() - 20)/32)
	

	If x_pos > 0 And x_pos < 13 And y_pos > 0 And y_pos < 13
		If num_select = 1
			sel_x(1) = x_pos
			sel_y(1) = y_pos
			num_select=2
		Else If num_select = 2
			sel_x(2) = x_pos
			sel_y(2) = y_pos			
			;Check if tile is same colour as previously selected tile 
			If CHECK_COLOUR(num_select) = True 
				num_select = 3
			Else 
				RESET_SELECT()
			EndIf 
		Else If num_select = 3
			sel_x(3) = x_pos
			sel_y(3) = y_pos				
			;Check if tile is same colour as previously selected tile 
			If CHECK_COLOUR(num_select) = True 
				num_select = 3
			Else 
				RESET_SELECT()
				Return False
			EndIf 
			
			;Check if tile is aligned in square in relation to other selections
			If sel_x(3) = sel_x(1) And sel_x(3) <> sel_x(2)
				If DIAGONAL() = True
					If sel_y(3) = sel_y(2) And sel_y(3) <> sel_y(1)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else 
					num_select = 4
				EndIf 			
			Else If sel_x(3) = sel_x(2) And sel_x(3) <> sel_x(1)
				If DIAGONAL() = True
					If sel_y(3) = sel_y(1) And sel_y(3) <> sel_y(2)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 					
				Else
					num_select = 4				
				EndIf 
			Else If sel_y(3) = sel_y(1) And sel_y(3) <> sel_y(2)
				If DIAGONAL() = True
					If sel_x(3) = sel_x(2) And sel_x(3) <> sel_y(1)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else
					num_select = 4				
				EndIf 			
			Else If sel_y(3) = sel_y(2) And sel_y(3) <> sel_y(1)	
				If DIAGONAL() = True
					If sel_x(3) = sel_x(1) And sel_x(3) <> sel_x(2)
						num_select = 4
					Else
						RESET_SELECT()
						Return False					
					EndIf 
				Else
					num_select = 4				
				EndIf 
			Else 
				RESET_SELECT()
				Return False			
			EndIf 
		Else If num_select = 4
			sel_x(4) = x_pos
			sel_y(4) = y_pos
			If CHECK_COLOUR(num_select) = True
				If GET_MISSING_X() = True And GET_MISSING_Y() = True 
					;REMOVE SELECTION
					removal = 1
					;SCORE POINTS
				Else  
					RESET_SELECT()
				EndIf 			
			Else 
				RESET_SELECT()
			EndIf 		
		EndIf 		
	EndIf 
EndIf 
End Function

Function CHECK_COLOUR(i)
If grid(sel_x(1), sel_y(1)) = grid(sel_x(i), sel_y(i)) Return True 
End Function 

Function RESET_SELECT()
For i = 1 To 4
	sel_x(i)=0
	sel_y(i)=0
Next
num_select = 1
End Function 

Function DIAGONAL()
If sel_x(1) <> sel_x(2) And sel_y(1) <> sel_y(2) Return True 
End Function 

Function GET_MISSING_X()
If sel_x(1) = sel_x(2) And sel_x(3) = sel_x(4) 
	Return True
Else If sel_x(2) = sel_x(3) And sel_x(1) = sel_x(4)
	Return True
Else If sel_x(1) = sel_x(3) And sel_x(2) = sel_x(4)
	Return True 
Else  
	Return False
EndIf 
End Function

Function GET_MISSING_Y()
If sel_y(1) = sel_y(2) And sel_y(3) = sel_y(4) 
	Return True
Else If sel_y(2) = sel_y(3) And sel_y(1) = sel_y(4)
	Return True
Else If sel_y(1) = sel_y(3) And sel_y(2) = sel_y(4)
	Return True 
Else  
	Return False
EndIf 
End Function 

Function GENERATE_NEW(x1, x2, y1, y2)
For y = y1 To y2
	For x = x1 To x2
		grid(x, y) = Rand(0, 2)
	Next
Next

x_squares = x2-x1+1
y_squares = y2-y1+1
score = score + (x_squares * y_squares)
End Function 

Function DISPLAY_TEXT(start_time)
seconds_left = ((start_time+game_time-MilliSecs())/1000)
If seconds_left <= 0 
	state = 2
	FlushMouse()
EndIf 
minutes_left = seconds_left /60
seconds_left = seconds_left Mod 60
Color 150, 30, 30
If seconds_left > 9
	Text 480, 60, "TIME   "+minutes_left+":"+seconds_left
Else 
	Text 480, 60, "TIME   "+minutes_left+":0"+seconds_left
EndIf 
Text 480, 80, "HIGH   "+hiscore
Color 30, 150, 30
Text 480, 100, "SCORE  "+score
End Function 

Function TITLE_SCREEN()
Color 30, 150, 30
Text 100, 100, "AIM OF THE GAME:"
Color 150, 30, 30
Text 100, 120, "Select tiles by clicking on them with the mouse."
Text 100, 140, "Form a rectangle by selecting 4 tiles of the same colour."
Text 100, 160, "Only the corners of the rectangle need to be the same colour."
Text 100, 180, "Tiles in between can be of any colour."
Text 100, 200, "When this is done tiles within the rectangle will be removed."
Text 100, 220, "You score 1 point for each tile removed."
Text 100, 240, "Removed tiles are then replaced by new tiles."
Text 100, 260, "When the time is up the game ends." 
Color 30, 150, 30
Text 100, 320, "CLICK MOUSE TO BEGIN!"
Flip
WaitMouse 
state = 1
FlushMouse
End Function 

Function GAME_OVER()
Color 150, 30, 30
Text 100, 100, "GAME OVER"	
Color 30, 150, 30
Text 100, 120, "YOU SCORED: "+score+" POINTS"
If score > hiscore Then hiscore = score
Flip 
WaitMouse
INITIALIZE()
RESET_SELECT()
state = 0
score = 0
removal = 0
FlushMouse
End Function