07-12-2003, 03:56 AM
Ok everyone, here's the challenge. You must make a pureqb paint routine that's as small and simple as can be. The only rule is not to use recursion. On your mark... get--- oh just go...
DECLARE SUB fill (x1%, y1%, fc%)
DEFINT A-Z
TYPE p2d
x AS INTEGER
y AS INTEGER
END TYPE
RANDOMIZE TIMER
SCREEN 13
' Draw some random stuff:
FOR a = 1 TO 13
x1 = INT(RND * 320): y1 = INT(RND * 200)
x2 = INT(RND * 320): y2 = INT(RND * 200)
COLOR INT(RND * 7) + 9
SELECT CASE INT(RND * 4)
CASE 1: CIRCLE (x1, y1), INT(RND * 200) + 1
CASE 2: LINE (x1, y1)-(x2, y2)
CASE 3: LINE (x1, y1)-(x2, y2), , B
END SELECT
NEXT a
' Paint from a random point:
fill INT(RND * 320), INT(RND * 200), 1
END
SUB fill (x1, y1, fc)
IF x1 < 0 OR x1 > 319 OR y1 < 0 OR y1 > 199 THEN EXIT SUB
c = POINT(x1, y1)
IF c = fc THEN EXIT SUB
h = 0
PSET (x1, y1), fc
DIM max AS LONG
max = FRE(-1) \ 4
IF max > 16384 THEN max = 16384
DIM q(1 TO max) AS p2d
s = 1: sm1 = 0: e = 1: q(e).x = x1: q(e).y = y1
DO WHILE e >= s
x = q(s).x: y = q(s).y: sm1 = s: s = s + 1
xm1 = x - 1: ym1 = y - 1: xp1 = x + 1: yp1 = y + 1
IF x > 0 THEN
IF POINT(xm1, y) = c THEN
PSET (xm1, y), fc
e = e + 1
IF e > max THEN
FOR a = s TO max: q(a - sm1) = q(a): NEXT a
e = e - sm1: s = 1: sm1 = 0
END IF
q(e).x = xm1: q(e).y = y
END IF
END IF
IF x < 319 THEN
IF POINT(xp1, y) = c THEN
PSET (xp1, y), fc
e = e + 1
IF e > max THEN
FOR a = s TO max: q(a - sm1) = q(a): NEXT a
e = e - sm1: s = 1: sm1 = 0
END IF
q(e).x = xp1: q(e).y = y
END IF
END IF
IF y > 0 THEN
IF POINT(x, ym1) = c THEN
PSET (x, ym1), fc
e = e + 1
IF e > max THEN
FOR a = s TO max: q(a - sm1) = q(a): NEXT a
e = e - sm1: s = 1: sm1 = 0 ': o = o + 1
END IF
q(e).x = x: q(e).y = ym1
'nh = e - sm1: IF nh > h THEN h = nh
END IF
END IF
IF y < 199 THEN
IF POINT(x, yp1) = c THEN
PSET (x, yp1), fc
e = e + 1
IF e > max THEN
FOR a = s TO max: q(a - sm1) = q(a): NEXT a
e = e - sm1: s = 1: sm1 = 0 ': o = o + 1
END IF
q(e).x = x: q(e).y = yp1
'nh = e - sm1: IF nh > h THEN h = nh
END IF
END IF
LOOP
END SUB
DECLARE SUB fill (array1() AS INTEGER, x AS INTEGER, y AS INTEGER, fillcolor AS INTEGER)
DIM SHARED map(1 TO 40, 1 TO 40) AS INTEGER
SCREEN 13
fill map(), 5, 5, 6 'array must start at 1
FOR y% = 1 TO 40
FOR x% = 1 TO 40
PSET (x%, y%), map(x%, y%)
NEXT x%, y%
SUB fill (array1() AS INTEGER, x0 AS INTEGER, y0 AS INTEGER, fillcolor AS INTEGER)
DIM i AS INTEGER, j AS INTEGER, k AS INTEGER, h AS INTEGER, endk AS INTEGER
floorcolor% = array1(x0, y0)
x.max% = UBOUND(array1, 1)
y.max% = UBOUND(array1, 2)
iteration.max = x.max% * y.max% / 2
DIM path.x(1 TO iteration.max) AS INTEGER, path.y(1 TO iteration.max) AS INTEGER
path.x(1) = x0
path.y(1) = y0
array1(x0, y0) = fillcolor%
j = 1
DO
DO
IF i = iteration.max THEN i = 1 ELSE i = i + 1
x% = path.x(i)
y% = path.y(i) + 1
GOSUB thepudding
y% = y% - 2
GOSUB thepudding
y% = y% + 1
x% = x% - 1
GOSUB thepudding
x% = x% + 2
GOSUB thepudding
IF i = j THEN EXIT DO
LOOP
IF j = k THEN EXIT DO
j = k
i = i - 1
LOOP
ERASE path.x, path.y
EXIT SUB
thepudding:
IF x% < 1 THEN RETURN
IF y% < 1 THEN RETURN
IF x% > x.max% THEN RETURN
IF y% > y.max% THEN RETURN
IF array1(x%, y%) <> floorcolor% THEN RETURN
IF k = iteration.max THEN k = 1 ELSE k = k + 1
path.x(k) = x%
path.y(k) = y%
array1(x%, y%) = fillcolor%
RETURN
END SUB
SUB fill (x, y, c)
DIM r(5000, 1): cb = POINT(x, y): GOSUB fl: IF v2 = 0 THEN EXIT SUB ELSE v4 = 0
fm: x = r(v4, 0): y = r(v4, 1): GOSUB fl: v4 = v4 + 1: IF v4 > (v2 - 1) THEN v2 = 0: EXIT SUB ELSE GOTO fm
fl: v = POINT(x, y): IF v = c THEN RETURN ELSE IF v <> cb AND v <> c THEN RETURN ELSE v1 = 0: v3 = 0: x3 = x: y3 = y: GOTO pa
ch: IF v <> cb AND v <> c THEN GOTO gb ELSE GOTO pa
pa: PSET (x, y), c: GOSUB u: GOSUB d: x = x + 1: IF x > 319 THEN GOTO gb ELSE GOTO ga
ga: v = POINT(x, y): GOTO ch
gb: x = x3: y = y3: v = POINT(x, y)
pb: IF v <> cb AND v <> c THEN RETURN ELSE PSET (x, y), c: GOSUB u: GOSUB d: x = x - 1: IF x < 0 THEN RETURN ELSE v = POINT(x, y): GOTO pb
u: IF y < 1 THEN RETURN ELSE x2 = x: y2 = y - 1: v = POINT(x2, y2): IF v <> cb AND v <> c THEN v1 = 0: RETURN ELSE IF v = c OR v1 = 1 THEN RETURN ELSE r(v2, 0) = x2: r(v2, 1) = y2: v2 = v2 + 1: v1 = 1: RETURN
d: IF y > 198 THEN RETURN ELSE x2 = x: y2 = y + 1: v = POINT(x2, y2): IF v <> cb AND v <> c THEN v3 = 0: RETURN ELSE IF v = c OR v3 = 1 THEN RETURN ELSE r(v2, 0) = x2: r(v2, 1) = y2: v2 = v2 + 1: v3 = 1: RETURN
END SUB
SUB agfill (x, y, clr)
'It proceeds line by line
'it's not recursive
'it uses LINE when it's possible
'does'nt need a huge array
CONST maxx = 199 'use this constant for SCREEN 13
'const maxx = 639 'use this constant for SCREEN 12
CONST bsize = 2000 'enough for screen 12
DIM stack(bsize) AS pix2type, sp AS INTEGER
bkgrnd = POINT(x, y)
iF bkgrnd = clr OR bkgrnd = -1 THEN EXIT SUB
stack(sp).y = y: stack(sp).xl = x: stack(sp).xr = x: stack(sp).dy = 1: sp = sp + 1
stack(sp).y = y + 1: stack(sp).xl = x: stack(sp).xr = x: stack(sp).dy = -1: sp = sp + 1
WHILE sp2 <> sp
'retrieve the data from a previous filled line and jump to the abbkgrnde or bottom line
dy = stack(sp2).dy: y = stack(sp2).y + dy: x1 = stack(sp2).xl: x2 = stack(sp2).xr: sp2 = sp2 + 1
IF sp2 > bsize THEN sp2 = 0
'any points in the abbkgrnde-bottom line in contact with at least a point of it must be filled
'try points left of the left side of the previous line :get a l side
x = x1
WHILE x > -1 AND (POINT(x, y) = bkgrnd): x = x - 1: WEND
IF x >= x1 THEN GOTO skip
l = x + 1
'store this part as filled
IF l < x1 THEN
stack(sp).y = y: stack(sp).xl = l: stack(sp).xr = x1 - 1: stack(sp).dy = -dy: sp = sp + 1
IF sp > bsize THEN sp = 0
END IF
x = x1 + 1
DO
WHILE x <= maxx AND POINT(x, y) = bkgrnd: x = x + 1: WEND
'we have a left and a right point,draw a full line
IF x > l + 2 THEN LINE (l, y)-(x - 1, y), clr ELSE FOR i = l TO x - 1: PSET (i, y), clr: NEXT
stack(sp).y = y: stack(sp).xl = l: stack(sp).xr = x - 1: stack(sp).dy = dy: sp = sp + 1
IF sp > bsize THEN sp = 0
IF x > x2 + 1 THEN
stack(sp).y = y: stack(sp).xl = x2 + 1: stack(sp).xr = x - 1: stack(sp).dy = -dy: sp = sp + 1
IF sp > bsize THEN sp = 0
END IF
skip: x = x + 1: WHILE (x <= x2) AND (POINT(x, y) <> bkgrnd): x = x + 1: WEND
l = x
LOOP WHILE x <= x2
WEND
ERASE stack
END SUB
SCREEN 13
FOR I=2 TO 319 STEP 4
LINE (I,0)-(I,198),15
LINE (I+2,1)-(I+2,199),15
NEXT
for j=0 to 199 step 2
for i=0 to 319 step 4
pset (i,j),15
pset (i+2,j-1),15
next
next