Qbasicnews.com
April 09, 2020, 08:09:29 AM
 Pages: [1]
 Author Topic: modified minesweeper algorithm  (Read 2125 times)
Agamemnus
x/ \z

Posts: 3491

 « on: March 08, 2003, 10:56:01 PM »

I know this may be too much to ask, but does anyone here have any ideas on how to figure out separated "landmasses" using iteration ::

The landmasses are stored as an x, y array. A complete, separated, landmass means that the array represents all the points of the landmass as one number and that each point is only connected to points from the same landmass.
 Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
toonski84
__/--\__

Posts: 2567

 « Reply #1 on: March 08, 2003, 11:41:33 PM »

well, you want a flood fill routine.  you can use qb's paint for this if you're clever enough and know a few hacks but chances are you're going to want to make your own.  the best way in any other language usually is recursive, which works some thing like this:

Code:
sub floodfill (x, y)
x = point(x, y)
pset (x, y)
if point (x, y + 1) = x then floodfill (x, y + 1)
if point (x, y - 1) = x then floodfill (x, y - 1)
if point (x - 1, y) = x then floodfill (x - 1, y)
if point (x + 1, y) = x then floodfill (x + 1, y)
end sub

i once made something that used an array as stack and did the same thing, but it's just a slower this with a limitation of a few thousand pixels and doesnt crash after the 4th iteration.  i know somebody made some sort of scanning floodfill that used some kind of pointer that moved around, but i dont know who did it and how he did it.
 Logged

i]"I know what you're thinking. Did he fire six shots or only five? Well, to tell you the truth, in all this excitement, I've kinda lost track myself. But being as this is a .44 Magnum ... you've got to ask yourself one question: 'Do I feel lucky?' Well, do ya punk?"[/i] - Dirty Harry
na_th_an
*/-\*

Posts: 8244

 « Reply #2 on: March 09, 2003, 12:19:30 AM »

I posted a while ago a floodfill which used scanlines. Sadly, the forum was hacked and blah blah blah...

I'll look for the code. Meanwhile, the idea is very simple. It works just like toonski's approach, but instead of filling just one pixel, it draws a line to the right until it reaches the limit, and then to the right. That way, the number of recursive sub calls are reduced dramatically. It uses a simple stack to check which points should be double-checked in case your polygon is convex.

I'll look for it.
 Logged

SCUMM (the band) on Myspace!
ComputerEmuzone Games Studio
underBASIC, homegrown musicians
[img]http://www.ojodepez-fanzine.net/almacen/yoghourtslover.png[/i
Plasma
Na_th_an

Posts: 1770

 « Reply #3 on: March 09, 2003, 02:32:17 AM »

Well here's "my" flood-fill...(I didn't write it of course...it's translated from an old BASIC book, which explains the GOSUBs and GOTOs...)

Code:
DEFINT A-Z
'\$DYNAMIC

DECLARE SUB Fill (FillX, FillY, CurrentColor)

CONST FillBuffer = 1000  'Increase for more complicated fills
CONST MinX = 0
CONST MinY = 0
CONST MaxX = 319
CONST MaxY = 199

SCREEN 13
CIRCLE (100, 50), 40
LINE (50, 50)-(200, 150), 4, B
Fill 50, 40, 1
Fill 100, 40, 9
Fill 60, 60, 2
Fill 100, 60, 12

SUB Fill (FillX, FillY, CurrentColor)

IF FillX < MinX OR FillX > MaxX THEN EXIT SUB
IF FillY < MinY OR FillY > MaxY THEN EXIT SUB

DIM Refs(FillBuffer, 1)
x2 = 0
y2 = 0
x3 = 0
y3 = 0
v = 0
v1 = 0
v2 = 0
v3 = 0
v4 = 0
cb = POINT(FillX, FillY)

GOSUB FillLine

IF v2 = 0 THEN EXIT SUB
v4 = 0

FillSomeMore:
FillX = Refs(v4, 0)
FillY = Refs(v4, 1)
GOSUB FillLine
v4 = v4 + 1
IF v4 > (v2 - 1) THEN
v2 = 0
EXIT SUB
ELSE
GOTO FillSomeMore
END IF

FillLine:
v = POINT(FillX, FillY)
IF v = CurrentColor THEN RETURN
IF v <> cb AND v <> CurrentColor THEN RETURN
v1 = 0: v3 = 0
x3 = FillX
y3 = FillY
GOTO PlotA

Check:
IF v <> cb AND v <> CurrentColor THEN
GOTO GetB
ELSE
GOTO PlotA
END IF

PlotA:
PSET (FillX, FillY), CurrentColor
GOSUB LookUp
GOSUB LookDown
FillX = FillX + 1
IF FillX > MaxX THEN
GOTO GetB
ELSE
GOTO GetA
END IF

GetA:
v = POINT(FillX, FillY)
GOTO Check

GetB:
FillX = x3: FillY = y3
v = POINT(FillX, FillY)

PlotB:
IF v <> cb AND v <> CurrentColor THEN RETURN
PSET (FillX, FillY), CurrentColor
GOSUB LookUp
GOSUB LookDown
FillX = FillX - 1
IF FillX < MinX THEN RETURN
v = POINT(FillX, FillY)
GOTO PlotB

LookUp:
IF FillY < MinY + 1 THEN RETURN
x2 = FillX
y2 = FillY - 1
v = POINT(x2, y2)
IF v <> cb AND v <> CurrentColor THEN
v1 = 0
RETURN
END IF
IF v = CurrentColor THEN RETURN
IF v1 = 1 THEN RETURN
Refs(v2, 0) = x2
Refs(v2, 1) = y2
v2 = v2 + 1
v1 = 1
RETURN

LookDown:
IF FillY > MaxY - 1 THEN RETURN
x2 = FillX
y2 = FillY + 1
v = POINT(x2, y2)
IF v <> cb AND v <> CurrentColor THEN
v3 = 0
RETURN
END IF
IF v = CurrentColor THEN RETURN
IF v3 = 1 THEN RETURN
Refs(v2, 0) = x2
Refs(v2, 1) = y2
v2 = v2 + 1
v3 = 1
RETURN

END SUB
 Logged
Agamemnus
x/ \z

Posts: 3491

 « Reply #4 on: March 12, 2003, 11:51:05 AM »

Sigh... well I finally figured out something that works nicely. All it needs is a temporary array the size of the map. Now I just have to reorder the landmasses...

SUB get.landmasses

t1b! = TIMER
FOR x% = 1 TO x.max%: FOR y% = 1 TO y.max%
IF map.array%(x%, y%) = 6 THEN
j = j + 1
DO
map.array1(x%, y%) = j
y% = y% + 1
LOOP UNTIL map.array(x%, y%) <> 6
END IF
NEXT y%, x%
DIM conv(x.max% * y.max%) AS INTEGER

DO: j = 0
FOR x% = 1 TO x.max%: FOR y% = 1 TO y.max%
IF map.array(x%, y%) = 6 THEN
IF map.array1(x% - 1, y%) > map.array1(x%, y%) THEN
j = 1: conv%(map.array1(x%, y%)) = map.array1(x% - 1, y%)
ELSE
IF map.array1(x% + 1, y%) > map.array1(x%, y%) THEN
j = 1: conv%(map.array1(x%, y%)) = map.array1(x% + 1, y%)
END IF
END IF
END IF
NEXT y%, x%

DO: I = 0
FOR x% = 1 TO x.max%: FOR y% = 1 TO y.max%
IF conv%(map.array1(x%, y%)) <> 0 THEN I = 1: map.array1(x%, y%) =
conv%(map.array1(x%, y%))
NEXT y%, x%
LOOP UNTIL I = 0 OR INKEY\$ <> ""
FOR x% = 1 TO x.max%: FOR y% = 1 TO y.max%
PSET (x%, y%), map.array1(x%, y%)
NEXT y%, x%
LOOP UNTIL j = 0
t2b! = TIMER
PRINT t2b! - t1b!
ERASE conv
'normalize on 2...
SYSTEM
 Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
 Pages: [1]