# Qbasicnews.com

Full Version: The simplest paint routine.
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3
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...
whats a paint routine?
http://qbasicnews.com/qboho/qckpaint.shtml <- that's a paint routine, silly Is it fair to post something you wrote previously?

This one doesn't work like QB's (which stops only at the border color you give it) - it's more like the flood fill tool an image editor might have, which stops at any other color besides the one it's filling over.

Code:
```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```
The benchmark, gentlemen:

Code:
```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```
Eat my spaghetti code.

Code:
```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```
NO RECURSION??? In this case i'm gonna critizise oter people's entries.

Plasma: Yours goes out of space even with the simpler tests, in screen 13.

Agamemnus: Not so bad, once I have adapted it to work directly to screen, so i can preset a test pattern. The fastest one so far. Only it eats memory, can't be used in screen 12 due to memory limits.

Sterling: Great work, passes all my tests in screen 12 and 13

And now I'm gonna beat you all... Code:
```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```
eh? Mine works with everything I've tried it on. Show me your "simple" test. (You might try using DEFINT A-Z and \$DYNAMIC if you're not already...)
I can recode it to use less memory...
Some time ago i built a test set for floodfillers, to help DanCo build his drawing program...

Plasma: I re-dimensioned your array up to 15000 items and still fails on
Vertical lines test:
Code:
```SCREEN 13 FOR I=2 TO 319 STEP 4 LINE (I,0)-(I,198),15 LINE (I+2,1)-(I+2,199),15 NEXT```

Dots test:
Code:
```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```

Agamemnus:
It would be interesting to use less memory. now your program is limited to screen 13.
Pages: 1 2 3