Minesweeper / MS Treasure Hunter clone (WIP)

Community Forums/Showcase/Minesweeper / MS Treasure Hunter clone (WIP)

loofadawg

(Posted 2016) [#1]

I made some changes to the Minesweeper / Microsoft Treasure Hunt code.. it can actually be played and won now.

The walls are there for when I add the player sprite and path-finding so that you can only clear areas that are accessible.

Generally cleaning things up and fixing other stuff.

On MS Treasure Hunt, clicking on a dirt tile will move your player to that square and reveal only a small portion of the whole level. About 2 tiles all around the player. So I will be adding that next.

This isn't meant to look great but I will add better graphics at later date. I also hope others will be able to learn from this project as much as I do while I hack away at this.

If you have suggestions for tidier code please post !!

Woof !!


Global xs = 32
Global ys = 20
Global dirt = 1
Global mine = 2
Global number = 3
Global wall	 = 4
Global flag = 5

Difficulty = 25
ts = 32*ys

MinesVisability = 1

Type fill
	Field x
	Field y
	Field z
End Type

Graphics 32*xs,32*ys+108,32,2

SetBuffer BackBuffer()

Dim grid(xs,ys,6)
Dim OnOff$(2) 
OnOff$(0) = "Off"
OnOff$(1) = "On"

While Not KeyDown(1)
	mx = MouseX()
	my = MouseY()
	
	If my > ts - 32
		my = ts - 32
	End If
	
	tx = Int(mx / 32)
	ty = Int(my / 32)
	
	If MouseHit(1) And grid(tx,ty,flag) = 0
		If grid(tx,ty,mine) = 1 
			Boom = Boom + 1
			BoomX = tx
			BoomY = ty
		Else 
			ClearDirt(tx,ty)
		End If
		If Boom = 2 Then Boom = 0
	End If
	
	If MouseHit(2)
		If grid(tx,ty,dirt)
			grid(tx,ty,flag) = Not grid(tx,ty,flag)
		End If
	End If
	
	If KeyHit(32) ; D: Toggle dirt placement
		ToggleSquare(tx,ty,dirt,mine)
	End If
	
	If KeyHit(50) ; M: Toggle mine placement
		ToggleSquare(tx,ty,mine,dirt)
	End If
	
	If KeyHit(17) ; W: Toggle Wall Placement
		ToggleSquare(tx,ty,wall,0)
	End If
		
	If KeyHit(207) ; End: Remove All Mines
		FillGrid(mine,0)
	End If
	
	If KeyHit(60) ; End: Fill All With Dirt
		FillGrid(dirt,1)
	End If
	
	If KeyHit(199) ; Home: Remove All Dirt
		FillGrid(dirt,0)
	End If
	
	If KeyHit(59) ; F1: Toggle Mines Visablity
		MinesVisability = Not MinesVisability
	End If
	
	If KeyHit(28) ; Place Game !
		While TotalMines < Difficulty
			x = Rnd(xs-1)
			y = Rnd(ys-1)
			grid(x,y,2) = 1
			TotalMines = CalculateMines()
		Wend
	End If
	
	If KeyHit(210)
		Difficulty = Difficulty + 1
	End If
	
	If KeyHit(211) And difficulty > 0
		Difficulty = Difficulty - 1
	End If
	
	DrawGrid()
	DrawDirt()
	If MinesVisability Then DrawMines()
	TotalFlags = DrawFlags()
	TotalMines = CalculateMines()
	DrawNumbers()
	DrawWalls()
	DrawGridCursor(tx,ty)
	
	Color 127,255,0
	Text 0,ts,   "D:     Toggle dirt placement     M:   Toggle mine placement     W:     Toggle wall placement"
	Text 0,ts+16, "Enter: Place random "+Difficulty+" Mines"
	Text 264,ts+16,"Insert/Delete Change number of random mines to be placed"
	Text 0,ts+32,"F1:    Toggle Mines Visability ["+OnOff$(MinesVisability)+"]"
	Text 0,ts+48,"Home:  Remove All Dirt         F2:  Fill with Dirt"
	Text 0,ts+64,"End:   Remove All Mines"
	Text 0,ts+80,"Mines: "+TotalMines
	Text 96,ts+80,"Flags: "+TotalFlags
	Text 192,ts+80,"Mines Left?: "+(TotalMines-TotalFlags)
	Text 0,ts+96,"TX: "+tx
	Text 96,ts+96,"TY: "+ty
	
	If WinCheck()+TotalMines = xs*ys 
		Text 192,ts+96,"Winner !!"
	End If

	If Boom
		Color Rnd(31)*8+7,0,0
		Rect BoomX*32,BoomY*32,32,32
		Text MouseX(),MouseY(),"BOOM !!"
	End If
	
	VWait
	Flip
Wend

End


; Functions ###############################################
;			###############################################
; #########################################################

Function ToggleSquare(x,y,toggleitem,ignoreitem)
	grid(x,y,toggleitem) = Not grid(x,y,toggleitem)
	For i = 1 To 5
		If i >< ignoreitem And i><toggleitem
			grid(x,y,i) = 0
		End If
	Next
End Function


Function FillGrid(item,num)
	For x = 0 To xs-1
		For y = 0 To ys-1
			grid(x,y,item) = num
		Next
	Next
End Function


Function WinCheck()
	For x = 0 To xs-1
		For y = 0 To ys-1
			If grid(x,y,dirt) = 0 And grid(x,y,mine) = 0
				tally = tally + 1
			End If
		Next
	Next
	Return tally
End Function
			

Function CalculateMines()
	TotalMines = 0
	For x = 0 To xs-1
		For y = 0 To ys-1
			mt = 0
			TotalMines = TotalMines + grid(x,y,mine)
			For xt = -1 To 1 Step 1
				For yt = -1 To 1 Step 1
					If (xt><0 Or yt><0)
						nx = x + xt
						ny = y + yt
						If nx>-1 And nx<(xs) 
							If ny>-1 And ny<(ys) 
								mt = mt + grid(nx,ny,mine)
							End If
						End If
					End If
				Next
			Next
			grid(x,y,number) = mt
		Next
	Next
	Return TotalMines
End Function


Function DrawGridCursor(tx,ty)
	Color 255,Rnd(127)+128,Rnd(127)+128
	Rect tx*32,ty*32,32,32,0
	Rect tx*32+1,ty*32+1,32-2,32-2,0
End Function


Function DrawGrid()
    Cls
	Color 163,163,163
	For x=0 To xs-1
		For y=0 To ys-1
			Rect x*32,y*32,32,32,0
		Next
	Next
End Function


Function DrawDirt()
    Color 163,115,31
	For x=0 To xs-1
		For y=0 To ys-1
			If grid(x,y,dirt) = 1
				Rect x*32+1,y*32+1,32-2,32-2,1
			End If
		Next
	Next
End Function


Function DrawWalls()
    Color 117,117,127
	For x=0 To xs-1
		For y=0 To ys-1
			If grid(x,y,wall) = 1
				Rect x*32+1,y*32+1,32-2,32-2,1
			End If
		Next
	Next
End Function


Function DrawMines()
    Color 64,64,64
	For x=0 To xs-1
		For y=0 To ys-1
			If grid(x,y,mine) = 1
				Oval x*32+2,Y*32+2,28,28,1
			End If
		Next
	Next
End Function


Function DrawFlags()
	TotalFlags = 0
    Color 255,0,0
	For x=0 To xs-1
		For y=0 To ys-1
			TotalFlags = TotalFlags + grid(x,y,flag)
			If grid(x,y,flag) = 1
				Line x*32+1,y*32+1,(x+1)*32-2,(y+1)*32-2
				Line (x+1)*32-2,y*32+1,x*32+1,(y+1)*32-2
			End If
		Next
	Next
	Return TotalFlags
End Function


Function DrawNumbers()
    Color 0,255,0
	For x=0 To xs-1
		For y=0 To ys-1
			If grid(x,y,number)>0 And grid(x,y,dirt)=0
				Text x*32+8,y*32+8,grid(x,y,number)
			End If
		Next
	Next
End Function

		
Function ClearDirt(x,y)
	If grid(x,y,number) = 0 And grid(x,y,wall)=0
		done = False
		flood.fill = New fill
		flood\x = x
		flood\y = y
	Else If grid(x,y,wall) = 1
		done = True
	Else If grid(x,y,dirt) = 1
		done = True
		grid(x,y,dirt)=0
	End If
	
	While done = False
		done = True
		
		For flood.fill = Each fill
			done = False
			x = flood\x
			y = flood\y
			Delete flood
			If x>-1 And x<xs And y>-1 And y<ys
				If (grid(x,y,dirt)=1 And grid(x,y,mine)=0 And grid(x,y,wall)=0) 
					grid(x,y,dirt)=0
					If grid(x,y,3)=0 
						flood.fill = New fill
						flood\x = x
						flood\y = y-1
						
						flood.fill = New fill
						flood\x = x+1
						flood\y = y
																
						flood.fill = New fill
						flood\x = x
						flood\y = y+1
						
						flood.fill = New fill
						flood\x = x-1
						flood\y = y
						
						
						flood.fill = New fill
						flood\x = x-1
						flood\y = y-1
						
						flood.fill = New fill
						flood\x = x+1
						flood\y = y+1
																
						flood.fill = New fill
						flood\x = x+1
						flood\y = y-1
						
						flood.fill = New fill
						flood\x = x-1
						flood\y = y+1
					End If
				End If
			End If
		Next
	Wend
End Function

RustyKristi

(Posted 2016) [#2]

nice. If you have the time to convert it to MonkeyX Free, you could build to html5/js and post it online using dropbox :-)

loofadawg

(Posted 2016) [#3]

True. I have Monkey but it was on my old computer which bit the dust. I am using my wife's laptop and a thumb drive to work on this until I build a new PC.

Yue	(Posted 2016) [#4]

Got email notice from dropbox that they are discontinuing HTML rendering. This is going to cause major issues for my wife since she uses this to distribute info and files to her students. We are running a basic account and would be willing to upgrade to a paid account to retain this feature, but this policy seems to be across all account levels.
Any advice on alternatives?

xlsior

(Posted 2016) [#5]

It looks like you can also run an HTML website from the free Google Drive, which is similar to Dropbox. -- if you look online you can probably find the steps, the first few I found are all videos in English how to do it which probably wouldn't be helpful to you.

loofadawg

(Posted 2016) [#6]

I have nothing to show for an update but I have made some good progress. I did a total rewrite to make things more versatile. The changes I made should make it easier to add features and level design.

I have quite a few ideas to innovate my clone from original.

Some of my ideas are borrowed from other games such as Chip's Challenge, Sokoban (warehouse), Zelda and 8 bit Ultima. Maybe a little Boulder Dash.

Lastly, an overworld map, multi-level/room dungeons is something I would like to attempt too.

It will be open-source in hopes some of you will take a stab at innovating the minesweeper genre.

In a couple weeks I will try to get an initial demo (with source code) of the game playing very similar to Microsoft's Treasure Hunt. It won't have the polish yet but I think I have something special in works.