FloodFill

Between them these routines can fill a regular or irregular shape with a colour, texture, or even an image.

FFILL Demo

Portrait was made with Portait_bas included in the zip file. Image by Cristian from an official portait of QE II.

Let's start with the simplest one, which is great for filling in a small shape with a single colour without taking up a lot of code space, and end up with an all-singing, all-dancing version.

These routines, as they stand, are all for GD2 (high colour) systems only, although the algorithms should work just as well for traditional QL colour systems given some different toolkit commands and a little elbow grease. I have only gone to the trouble of making the final routine compatible with all GD2 modes. The others will only work in 16 bit modes without some changes.

For a discussion of the matter and to see how this all came about see this topic on QL Forum.

The first Flood Fill routine that turned up was this little number from Tomas (tcat). It was written in Pascal (see the remarks at the end of the code for the original code) and translated to SBASIC by me.

FILLS fills a shape with a single colour. It runs as intended in mode 32, but may possibly work in mode 33 without change too. It could be made to work in any QL mode with a different function to read the pixels. RPIX% is for GD2 only.

100 rem + ------------------------------------------------------------------------ +
102 rem |<                                 Fills                                  >|
104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
106 rem |                   An early, recursive, attempt by tcat                   |
108 rem |                                                                          |
110 rem | Written in Pascal and translated to SBASIC by pjw. For details see:      |
112 rem | https://qlforum.co.uk/viewtopic.php?f=3&t=2817&start=40#p28465           |
114 rem |                                                                          |
116 rem | While it looks nice, simple and logical, it spends a lot of time         |
118 rem | backtracking and eats a lot of memory. Great for small, simple shapes    |
120 rem | in a compact routine.                                                    |
122 rem |                                                                          |
124 rem | I havent spent much time adapting, "universalising" or error trapping    |
126 rem | this code. This is left as an excercise for anyone who needs it!         |
128 rem |                                                                          |
130 rem | Dependency: RPIX%                                                        |
132 rem + ------------------------------------------------------------------------ +
134 rem | V0.00, tcat, 2019 Jun 21                                                 |
136 rem | V0.00, pjw, 2019 Jun 29, translated and adapted                          |
138 rem + ------------------------------------------------------------------------ +
140 :
142 DEFine PROCedure Fills(chn, tgc%, rpc%, x%, y%)
144 rem tgc%, rpc% - target, replacement colour
146 :
148 rem PAUSE 1: rem remove to see the action
150 IF tgc% = RPIX%(#chn; x%, y%) THEN
152  rem RPIX% = pick colour at x,y coord
154  BLOCK#chn; 1, 1, x%, y%, rpc%     : rem no clip
156  Fills#chn; tgc%, rpc%, x%, y% - 1 : rem south
158  Fills#chn; tgc%, rpc%, x%, y% + 1 : rem north
160  Fills#chn; tgc%, rpc%, x% - 1, y% : rem west
162  Fills#chn; tgc%, rpc%, x% + 1, y% : rem east
164 END IF
166 END DEFine Fills
168 :
170 :
172 rem  PROCEDURE Fill*(tgc, rpc, x, y: INTEGER);
174 rem    VAR c: INTEGER; (*tgc, rpc - target, replacement colour*)
176 rem  BEGIN
178 rem    (*c = pick colour at x,y coord *)
180 rem    IF c = tgc THEN
182 rem      Display.Dot(rpc, x, y, Display.replace); (*no clip*)
184 rem      Fill(tgc, rpc, x, y-1); (*south*)
186 rem      Fill(tgc, rpc, x, y+1); (*north*)
188 rem      Fill(tgc, rpc, x-1, y); (*west*)
190 rem      Fill(tgc, rpc, x+1, y); (*east*)
192 rem    END
194 rem  END Fill;
  

To test it LRESPR the included toolkit, FFLILL_bin, and LRUN Fills_bas in the standard SBASIC console or a daughter SBASIC. (Actually, in a daughter SBASIC you have to LOAD the demo first, then LRESPR the toolkit, and then RUN the program.)

The next one up is from Tobias (tofro):

100 rem + ------------------------------------------------------------------------ +
102 rem |<                              FloodFill V0                              >|
104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
106 rem |        This is the original FloodFill by Tobias Fröschle                 |
108 rem |                                                                          |
110 rem | See https://qlforum.co.uk/viewtopic.php?f=3&t=2817&p=28590#p28593        |
112 rem |                                                                          |
114 rem | Ive tweaked it slightly: integer variables and stack, added LOCals,      |
116 rem | replaced SCR_XLIM/YLIM with WINDSZ, etc. Any errors are mine.            |
118 rem |                                                                          |
120 rem | Dependencies: RPIX%, WINDSZ from Knoware.no/toolkits or just use the     |
122 rem | included FFILL_bin. Other toolkits may provide the same. WINDSZ can be   |
124 rem | replaced by adding the known window metrics, eg scrlx% = 256: scrly%     |
126 rem | = 202                                                                    |
128 rem |                                                                          |
130 rem | LRUN in standard SBASIC console                                          |
132 rem + ------------------------------------------------------------------------ +
134 rem | V0.00, tofro, 2019 Jun 30                                                |
136 rem | V0.01, pjw, 2022 Oct 30                                                  |
138 rem + ------------------------------------------------------------------------ +
140 :
142 rem The scanline floodfill algorithm using a stack
144 DEFine PROCedure FloodFill (channel, oldColor%, newColor%, x, y)
146   LOCal stackLoop, leftLoop, rightLoop
148   LOCal spanAbove, spanBelow, stack% (128), stackCtr%
150   LOCal x%, y%, scrlx%, scrly%
152   :
154   IF oldColor% = newColor% THEN
156     rem Nothing to do
158     RETurn
160   END IF
162   WINDSZ#channel; scrlx%! scrly%, x%, y%
164   x% = x: y% = y
166   stackCtr% = 0
168   stack% (stackCtr%) = x% : stackCtr% = stackCtr% + 1 : stack% (stackCtr%) = y% : stackCtr% =  >>
    stackCtr% + 1
170   rem PRINT#0,"Push:", x%, y%, stackCtr%
172   rem PAUSE #0,-1
174   rem Loop until stack empty
176   REPeat stackLoop
178     IF stackCtr% <= 0 THEN
180       EXIT stackLoop
182     END IF
184     stackCtr% = stackCtr% - 1 : y% = stack% (stackCtr%) : stackCtr% = stackCtr% - 1 : x% =  >>
    stack% (stackCtr%)
186     rem PRINT #0; "Pop:", x%, y%, stackCtr%
188     rem PAUSE #0, -1
190     :
192     rem search left boundary
194     REPeat leftLoop
196       IF x% < 0 : EXIT leftLoop
198       IF RPIX% (#channel; x%, y%) <> oldColor% THEN
200         EXIT leftLoop
202       ELSE
204         x% = x% - 1
206       END IF
208     END REPeat leftLoop
210     x% = x% + 1
212     spanAbove = 0
214     spanBelow = 0
216     rem search right boundary
218     REPeat rightLoop
220       IF x% >= scrlx% : EXIT rightLoop
222       IF RPIX% (#channel; x%, y%) <> oldColor% THEN
224         EXIT rightLoop
226       END IF
228       BLOCK #channel, 1, 1, x%, y%, newColor%
230       rem look into scanline above
232       IF y% > 0 THEN
234         IF spanAbove = 0 THEN
236           IF RPIX% (#channel; x%, y% - 1) = oldColor% THEN
238             stack% (stackCtr%) = x% :stackCtr% = stackCtr% + 1 : stack% (stackCtr%) = y% - 1 :  >>
    stackCtr% = stackCtr% + 1
240             rem PRINT#0,"Push:", x%, y% - 1, stackCtr%
242             spanAbove = 1
244           END IF
246         ELSE
248           IF RPIX%(#channel; x%, y% - 1) <> oldColor% THEN
250             spanAbove = 0
252           END IF
254         END IF
256       END IF
258       IF y% < (scrly% - 1) THEN
260         IF spanBelow = 0 THEN
262           IF RPIX%(#channel; x%, y% + 1) = oldColor% THEN
264             stack% (stackCtr%) = x% :stackCtr% = stackCtr% + 1 : stack% (stackCtr%) = y% + 1 :  >>
    stackCtr% = stackCtr% + 1
266             rem PRINT #0, "Push: ", x%, y% + 1, stackCtr%
268             spanBelow = 1
270           END IF
272         ELSE
274           IF RPIX% (#channel; x%, y% + 1)  <> oldColor% THEN
276             spanBelow = 0
278           END IF
280         END IF
282       END IF
284       x% = x% + 1
286     END REPeat rightLoop
288   END REPeat stackLoop
290 END DEFine FloodFill
  

Load the toolkit as above and LRUN the demo program FloodFill_bas to test it.

This routine fills any enclosed shape with a single colour. See the code blurb for details. It runs in all GD2 system in 16-bit modes 32 and 33. But note that the colour codes are all in NATIVE format, so the same number normally represent different colours in mode 32 and 33.

One way to get the native colour you want is to use this cheat:

   COLOUR_QL
   BLOCK 1, 1, 0, 0, 6: REMark Yellow
   yellow% = RPIX%(0, 0)
   :
   REMark Proof?
   COLOUR_NATIVE: BLOCK#2; 50, 50, 0, 0, yellow%

Since the built-in FILL command in SBASIC does pretty much the same as both programs above, I haven't spent much time making them generally useful. The only problem with the built-in FILL is that it crashes the system if the screen size is larger than 1280x768 (I don't know the exact value but up to 1280x768 is fine, while 1680x1050 is not). This is still true as of SMSQ/E V3.36, but by the time you read this it may have been fixed.

Finally there is FFILL, which is based on the above but adapted to use a bitmap rather than a single colour for the colour replacement. This allows textures and even whole images to be used to fill the shape. Ie you could use this to, for example, draw an oval frame and fit a portrait inside it. (Which I then did in about ten minutes and put the result up top!)

1000 rem + ------------------------------------------------------------------------ +
1002 rem |<                                 FFILL                                  >|
1004 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1006 rem |                Scanline floodfill algorithm using a stack                |
1008 rem |                                                                          |
1010 rem | Based on an algorithm implemented by Tobias Fröschle:                    |
1012 rem | See https://qlforum.co.uk/viewtopic.php?f=3&t=2817&p=28590#p28593        |
1014 rem |                                                                          |
1016 rem | It guarantees that every pixel to be filled is only visited exactly      |
1018 rem | once. The drawing could be made faster, though, eg by drawing            |
1020 rem | complete lines rather than single pixels..                               |
1022 rem |                                                                          |
1024 rem | This version uses a bitmap to fill the shape with, so you could use an   |
1026 rem | image or some pattern or texture to fill the shape. The bitmap needs     |
1028 rem | to be in the form of a standard PIC of the same mode as the display.     |
1030 rem |                                                                          |
1032 rem | This is a "skeleton routine", ie the source code needs to be modified    |
1034 rem | for any particular use.                                                  |
1036 rem |                                                                          |
1038 rem | GD2 only, modes 16, 32, and 33 - which also implies SMSQ/E only          |
1040 rem |                                                                          |
1042 rem | Dependencies: RPIX%, WPIX, WINDSZ (, PCBO%); Push, Pop, Eliminate        |
1043 rem | GLOBal mode%                                                             |
1044 rem + ------------------------------------------------------------------------ +
1046 rem | V0.00, tofro, 2019 Jun 30                                                |
1048 rem | V0.01, pjw, 2022 Oct 27, bitmap implementation, optimisation & packaging |
1050 rem | V0.02, pjw, 2022 Nov 01, all GD2 modes                                   |
1052 rem + ------------------------------------------------------------------------ +
1054 :
1056 DEFine PROCedure FFILL (channel, oldColour%, bitmap, x, y)
1058   LOCal stackLoop, leftLoop, rightLoop
1060   LOCal spanAbove, spanBelow, stack%(128), stackCtr%
1062   LOCal x%, y%, scrx%, scry%, newColour%
1064   LOCal xb, yb, yinc
1066   :
1068   rem   Get inside window dimensions & line increment
1070   WINDSZ#channel; scrx%! scry%, x%, y%
1072   yinc = PEEK_W(bitmap + 6)
1074   x% = x: y% = y
1076   :
1078   stackCtr% = 0: Push x%, y%
1080   :
1082   rem        Loop until stack empty
1084   REPeat stackLoop
1086     IF KEYROW(1) = 8: EXIT stackLoop:       rem Get me outta here!
1088     IF stackCtr% <= 0: EXIT stackLoop
1090     Pop x%, y%
1092     :
1094     rem      Search left boundary
1096     REPeat leftLoop
1098       IF x%< 0 : EXIT leftLoop
1100       IF RPIX% (#channel; x%, y%) <> oldColour% THEN
1102         EXIT leftLoop
1104       ELSE
1106         x%= x% - 1
1108       END IF
1110     END REPeat leftLoop
1112     x%= x%+ 1
1114     spanAbove = 0
1116     spanBelow = 0
1118     :
1120     rem      Search right boundary
1122     REPeat rightLoop
1124       IF x%>= scrx% : EXIT rightLoop
1126       IF RPIX% (#channel; x%, y%) <> oldColour% THEN
1128         EXIT rightLoop
1130       END IF
1132       :
1134       rem       Select replacement colour from bitmap location
1136       xb = x% MOD PEEK_W(bitmap + 2)
1138       yb = y% MOD PEEK_W(bitmap + 4)
1140       IF mode% = 16 THEN
1142        newColour% = PEEK(bitmap + 10 + yb * yinc + xb)
1144       ELSE
1146        xb = xb + xb:                               rem modes 32 & 33 2bpp
1148        newColour% = PEEK_W(bitmap + 10 + yb * yinc + xb)
1150       END IF
1152       rem If you want ALPHA_BLEND or OVER, use BLOCK instead of WPIX
1154       rem Then you also need PCBO% in mode 32
1156       rem if mode% = 32: PCBO% newColour%:      rem Switch byte order
1158       rem BLOCK #channel, 1, 1, x%, y%, newColour%
1160       WPIX #channel; x%, y%, newColour%
1162       :
1164       rem    Look into scanline above
1166       IF y% > 0 THEN
1168         IF spanAbove = 0 THEN
1170           IF RPIX% (#channel; x%, y% - 1) = oldColour% THEN
1172             Push x%, y% - 1
1174             spanAbove = 1
1176           END IF
1178         ELSE
1180           IF RPIX%(#channel; x%, y% - 1) <> oldColour% THEN
1182             spanAbove = 0
1184           END IF
1186         END IF
1188       END IF
1190       IF y% < (scry% - 1) THEN
1192         IF spanBelow = 0 THEN
1194           IF RPIX%(#channel; x%, y% + 1) = oldColour% THEN
1196             Push x%, y% + 1
1198             spanBelow = 1
1200           END IF
1202         ELSE
1204           IF RPIX% (#channel; x%, y% + 1)  <> oldColour% THEN
1206             spanBelow = 0
1208           END IF
1210         END IF
1212       END IF
1214       x%= x%+ 1
1216     END REPeat rightLoop
1218   END REPeat stackLoop
1220 END DEFine FFILL
1222 :
1224 DEFine PROCedure Push(x, y)
1226 stack%(stackCtr%) = x
1228 stack%(stackCtr% + 1) = y
1230 stackCtr% = stackCtr% + 2
1232 END DEFine Push
1234 :
1236 DEFine PROCedure Pop(x, y)
1238 stackCtr% = stackCtr% - 1
1240 y = stack%(stackCtr%)
1242 stackCtr% = stackCtr% - 1
1244 x = stack%(stackCtr%)
1246 END DEFine Pop
1248 :
1250 :
1252 rem + ------------------------------------------------------------------------ +
1254 rem |<                               Eliminate                                >|
1256 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1258 rem |                          Eliminate paper colour                          |
1260 rem |                                                                          |
1262 rem | If paper colour found in pattern, alter it slightly so as not to         |
1264 rem | confuse the algorithm.                                                   |
1266 rem |                                                                          |
1268 rem | Dependency: PCBO%                                                        |
1270 rem + ------------------------------------------------------------------------ +
1272 rem | V0.01, pjw, 2022 Oct 29                                                  |
1274 rem | V0.02, pjw, 2022 Nov 01, all GD2 modes                                   |
1276 rem + ------------------------------------------------------------------------ +
1278 :
1280 DEFine PROCedure Eliminate(ad, fl, pa%)
1282 LOCal a, p%, f%, m%
1284 m% = DISP_TYPE
1286 :
1288 IF fl > 200000: BEEP 2000, 10:     rem Warn of delay
1290 p% = pa%
1292 SELect ON m%
1294  = 32, 33
1296   IF m% = 32: PCBO% p%
1298   SELect ON pa%
1300    = -32768,  0 TO  32766: f% = pa% + 1
1302    =  32767, -32767 TO -1: f% = pa% - 1
1304   END SELect
1306   :
1308   FOR a = ad + 10 TO ad + fl - 2 STEP 2
1310    IF PEEK_W(a) = p%: POKE_W a, f%
1312   END FOR a
1314 = 16
1316   IF pa% = 0: f% = 1: ELSE : f% = pa% - 1
1318   FOR a = ad + 10 TO ad + fl - 1
1320    IF PEEK(a) = p%: POKE a, f%
1322   END FOR a
1324 END SELect
1326 :
1328 IF fl > 200000: BEEP 2000, 40
1330 END DEFine Eliminate
  

To run the demo you need to EXecute the SBASIC program thus:

        EX <path>FFILL; <bitmap path and file name>

or alter the parameters you want and execute it directly via the SBAS/QD Thing in QD.

If rendering takes too long for your taste press ESC to abort. Press Q to quit.

The bitmap must be in the form of a PIC (the native QL image format) of the same mode as the display mode, whether it be 16, 32, or 33.

Note that if you want to use various effects like ALPHA_BLEND or OVER you need to change line 1160 to use BLOCK instead of WPIX. In the case of mode 32 (QPC2, SMSQmulator) you also have to swap the colour code's bytes around. You can use the included PCBO% (PC Byte Order). An explanation for this swapping around can be found here.

The latter routine cheats a bit in that the paper colour given (oldColour%) is used to determine whether a pixel has been visited, so a pixel of the same colour in the pattern would confuse it. Hence the pre-processing routine Eliminate, which slows things down. However, if you know that there are no pixels in the patterns of the same colour as the paper colour (eg because you already scanned the bitmap and saved the result) you can skip Eliminate. On the other hand if the bitmap is small the speed penalty will hardly be noticeable.

Finally, to produce the portrait shown at the top, the following code was added to the basic FFILL routine in place of the test harness. This should also give some ideas as to how the routine could be used:

10 EXT_PROC 'WINDSZ', 'WPIX', 'PCBO%'
11 EXT_FN 'FFILL%', 'RPT%', 'RPIX%'
12 IF NOT FFILL%: LRESPR HOME_DIR$ & 'FFILL_bin':       rem Load if not loaded
13 :
14 :
100 rem + ------------------------------------------------------------------------ +
102 rem |<                                Portrait                                >|
104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
106 rem |               Create an oval frame and fill in a portrait                |
108 rem |                                                                          |
110 rem | EXecute this program with a suitable PICture as the parameter:           |
112 rem |                                                                          |
114 rem |        EX <path>Portait; '<path>Mother_pic'                              |
116 rem |                                                                          |
118 rem | Note: The PIC must be in the same mode as the display and must not be    |
120 rem | larger than the screen.                                                  |
122 rem + ------------------------------------------------------------------------ +
124 rem | V0.01, pjw, 2022 Nov 02                                                  |
126 rem | V0.02, pjw, 2022 Nov 04, All GD2 modes                                   |
128 rem + ------------------------------------------------------------------------ +
130 :
132 COLOUR_QL
134 mode% = DISP_TYPE
136 paper% = 7:                     rem White paper in QL mode
138 :
140 rem     Get a portrait off command line or use default
142 fnm$ = CMD$
144 IF fnm$ = '': fnm$ = HOME_DIR$ & 'pat_' & mode% & '_QEIImini_pic'
146 :
148 rem     Convert QL colour to NATIVE
150 ch = FOPEN("con")
152 BLOCK#ch; 1, 1, 0, 0, paper%
154 paper% = RPIX%(#ch; 0, 0):      rem This is NATIVE Paper colour
156 :
158 rem     Load some patterns and portrait, and initialise
160 pic  = LoadPat(fnm$, paper%): ERT pic
162 pat0 = LoadPat("win1_prg_drw_fil_pat_" & mode% & "_pat0_pic", paper%): ERT pat0
164 pat8 = LoadPat("win1_prg_drw_fil_pat_" & mode% & "_pat8_pic", paper%): ERT pat8
166 :
168 rem     Get metrics for Window
170 xs% = PEEK_W(pic + 2)
172 ys% = PEEK_W(pic + 4)
174 :
176 scx% = SCR_XLIM(#ch)
178 OUTLN#ch; xs% + 4, ys% + 2, (scx% - xs%) / 2, 30
180 INK#ch; 0
182 :
184 COLOUR_24: BORDER#ch; 2, $2F4F4F:                rem DarkSlateGray
186 COLOUR_NATIVE:                                   rem Switch colour traps to NATIVE
188 PAPER#ch; paper%: CLS#ch
190 :
192 rem     Draw portrait frame
194 ELLIPSE#ch; 50 * xs% / ys%, 50, 33, 1.5, PI/2
196 ELLIPSE#ch; 50 * xs% / ys%, 50, 30, 1.5, PI/2
198 :
200 rem     Fill sourroundings. Sometimes frame hits border and divides area..
202 FloodFill#ch; paper%, pat0, 10, 10
204 FloodFill#ch; paper%, pat0, xs% - 10, 10:        rem In case area divided
206 :
208 rem     Find & fill frame outline.
210 y% = ys% / 2:                   rem Middle
212 FOR x% = 2 TO xs% / 2 STEP 2
214  IF RPIX%(#ch; x%, y%) = paper% THEN
216   FloodFill#ch; paper%, pat8, x%, y%
218   EXIT x%
220  END IF
222 END FOR x%
224 :
226 rem     Fit portrait into frame
228 FloodFill#ch; paper%, pic, xs% / 2, y%
230 :
232 rem     Done. Here the result could be saved..
234 PAUSE#ch
236 IF JOBID: QUIT: ELSE : RECHP adr: STOP
238 :
240 :
242 rem     Load pattern and initialise
244 DEFine FuNction LoadPat(nm$, pap%)
246 LOCal fln, adr
248 fln = FLEN(\ nm$)
250 adr = ALCHP(fln): LBYTES nm$, adr
252 IF PEEK(adr + 8) <> DISP_TYPE: RECHP adr: RETurn -19
254 Eliminate adr, fln, pap%:     rem Eliminate paper colour from pattern!
256 RETurn adr
258 END DEFine LoadPat
260 :
262 :

The complete demo can be found as Portrait_bas. EXecute it with a suitable image on the commandline. (The one included is a poor miniature to save space.)

All the code, toolkits and an assortment of bitmaps for you to try can be downloaded by clicking on the link below. Simply unzip the file to a suitable location like RAM1_ to test the demos. You may need to LRESPR the FFILL_BIN toolkit first, except for the FFILL demos which load and unload the toolkit as required.


Generated with sb2htm on 2022 Nov 03
©pjwitte 2oo1 - 2o22