Qbasicnews.com
April 09, 2020, 06:41:21 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: modified minesweeper algorithm  (Read 2124 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 :Huh:

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



WWW
« 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


WWW
« 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]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!