Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
The simplest paint routine.
#1
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...
Reply
#2
whats a paint routine?
[Image: sig.php]
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Reply
#3
http://qbasicnews.com/qboho/qckpaint.shtml <- that's a paint routine, silly Big Grin
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
Reply
#4
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
Reply
#5
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
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.
Reply
#6
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
Reply
#7
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
Antoni
Reply
#8
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...)
Reply
#9
I can recode it to use less memory...
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.
Reply
#10
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.
Antoni
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)