TGC Codebase Backup



Minesweeper, redone in DBC(no media) by Sven B

6th Mar 2005 12:07
Summary

Minsesweeper redone in DarkBasic Classic. If someone can find a faster and better code, please post it in this base... No media required



Description

Left Click to activate the field.
Right Click to mark the field.

the field is 10X15 with 20 bombes. you can change the values by changing:
size(1) -> x-value
size(2) -> y-value
bombes -> nr of bombes

that's it...
enjoy



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `*************************************************
`minesweeper
`*************************************************
`coded by Sven Boulanger
`*************************************************

sync on : sync rate 60

restart:

`set vars
bombes=20

`dim command
dim size(2)
size(1)=10
size(2)=15
xsize=size(1)
ysize=size(2)

dim board(10,25)
dim checked(2,10,25)

`random bombes in the field
for i=1 to bombes
	repeat
		x=1+rnd(size(1)-1)
		y=1+rnd(size(2)-1)
	until board(x,y)=0
	board(x,y)=1
next i

`calculate surrounding bombes
for x=1 to size(1)
	for y=1 to size(2)

		if board(x,y)=0
			surr_check(x,y)	
		endif

		checked(2,x,y)=0

	next y
next x		
				 
`loop
do

	`clear screen
	cls
	total=0

	`handle bombes
	for x=1 to size(1)
		for y=1 to size(2)

		`check if field is activated
		if checked(2,x,y)=1

			`display 3Dbox
			3Dbox_in(x*15,y*15)
			inc total

			`when activated field=1 and there's a bomb, go to dead:
			if board(x,y)>0 then goto dead

			`if field=0 then clear surrounding fields too
			if checked(1,x,y)=0
				if x>1
					checked(2,x-1,y)=1
					if y>1 then checked(2,x-1,y-1)=1
					if y<size(2) then checked(2,x-1,y+1)=1
				endif
				if x<size(1)
					checked(2,x+1,y)=1
					if y>1 then checked(2,x+1,y-1)=1
					if y<size(2) then checked(2,x+1,y+1)=1
				endif
				if y>1 then checked(2,x,y-1)=1
				if y<size(2) then checked(2,x,y+1)=1
			else
				`display surrounding bombes when nr is not 0
				ink rgb(0,0,0),0 : center text x*15+7,y*15,str$(checked(1,x,y))
			endif
		else
			`display 3Dbox
			3Dbox_out(x*15,y*15)

			`check if clicked on field
			if check(x*15,y*15)=1 and hold=0 then checked(2,x,y)=1 : hold=1

			`mark bombes
			if check(x*15,y*15)=2 and hold=0
				hold=1
				if checked(2,x,y)=0
					checked(2,x,y)=2
				else
					checked(2,x,y)=0
				endif
			endif
				
		endif

		`display marked bombes
		ink rgb(255,0,0),0
		if checked(2,x,y)=2 then center text x*15+7,y*15,"X"

		next y
	next x

	`HUD
	ink rgb(200,200,200),0
	box 0,size(2)*15+20,100,size(2)*15+50
	message$=str$(total)+" / "+str$(size(1)*size(2)-bombes)
	ink rgb(0,0,0),0
	text 9,size(2)*15+26,message$
	ink rgb(255,255,255),0
	text 10,size(2)*15+27,message$
	if total=size(1)*size(2)-bombes then goto win

	if mouseclick()=0 then hold=0

	sync
loop

dead:

`undim
undim checked
undim board

`clear screen
cls

`display "you lost" message
ink rgb(255,255,255),0
center text 320,240,"you lost"

suspend for key

`restart the game
goto restart

win:

`undim
undim checked
undim board

`clear screen
cls

`display "you win" message
ink rgb(255,255,255),0
center text 320,240,"you win"

suspend for key

`restart the game
goto restart

`*********
`functions
`*********

`draw 3Dbox1
function 3Dbox_out(x,y)
	ink rgb(255,255,255),0
	box x,y,x+13,y+13
	ink rgb(25,25,25),0
	box x+1,y+1,x+14,y+14
	ink rgb(200,200,200),0
	box x+1,y+1,x+13,y+13
endfunction

`draw 3Dbox2
function 3Dbox_in(x,y)
	ink rgb(25,25,25),0
	box x,y,x+13,y+13
	ink rgb(255,255,255),0
	box x+1,y+1,x+14,y+14
	ink rgb(200,200,200),0
	box x+1,y+1,x+13,y+13
endfunction

`check mouse-over
function check(x,y)
	check=0
	if mousex()>x and mousex()<x+14
		if mousey()>y and mousey()<y+14
			if mouseclick()=1 then check=1
			if mouseclick()=2 then check=2
		endif
	endif
endfunction check


`checks surrounding fields
`*******************************
`*         *         *         *
`* x-1,y-1 * x  ,y-1 * x+1,y-1 *
`*         *         *         *
`*******************************
`*         *         *         *
`* x-1,y   * x  ,y   * x+1,y   *
`*         *         *         *
`*******************************
`*         *         *         *
`* x-1,y+1 * x  ,y-1 * x+1,y+1 *
`*  		  *			*			 *
`*******************************
function surr_check(x,y)

	if x>1
		checked(1,x,y)=checked(1,x,y)+board(x-1,y)
		if y>1
			checked(1,x,y)=checked(1,x,y)+board(x-1,y-1)
		endif
		if y<size(2)
			checked(1,x,y)=checked(1,x,y)+board(x-1,y+1)
		endif
	endif

	if x<size(1)
		checked(1,x,y)=checked(1,x,y)+board(x+1,y)
		if y>1
			checked(1,x,y)=checked(1,x,y)+board(x+1,y-1)
		endif
		if y<size(2)
			checked(1,x,y)=checked(1,x,y)+board(x+1,y+1)
		endif
	endif

	if y>1
		checked(1,x,y)=checked(1,x,y)+board(x,y-1)
	endif

	if y<size(2)
		checked(1,x,y)=checked(1,x,y)+board(x,y+1)
	endif
endfunction