Qbasicnews.com

Qbasicnews.com > QbasicNews.Com > Challenges > The simplest paint routine.
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

Rokkuman

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...

whitetiger0990

07-12-2003, 04:08 AM
whats a paint routine?

toonski84

07-12-2003, 04:31 AM
http://qbasicnews.com/qboho/qckpaint.shtml <- that's a paint routine, silly Big Grin

Sterling Christensen

07-12-2003, 06:54 AM
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

Agamemnus

07-12-2003, 07:10 AM
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

Plasma

07-12-2003, 07:53 AM
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

Antoni Gual

07-12-2003, 02:25 PM
NO RECURSION??? Sad
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... Big Grin

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

Plasma

07-12-2003, 08:04 PM
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...)

Agamemnus

07-12-2003, 08:14 PM
I can recode it to use less memory...

Antoni Gual

07-14-2003, 01:32 PM
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
Qbasicnews.com > QbasicNews.Com > Challenges > The simplest paint routine.