Fast contour fill algorithm?

Here's a fast one, from the early days of Blitz Basic.

You will have to tinker with this a little. Front/Back buffer handling is different in BlitzPlus.

;FastPixelFill 
;Written by Thomas A. Stevenson (wargamer) 
; thomas99@... 
;2/16/01 
;Blitzbasic 1.42 

;This is a super fast floodfill routine that 
;utilizes WritePixelFast and a list of active points 
;to quickly fill any kind of blank area (color 0,0,0) 
;inside or outside a boundry of any non blank color 

;Send me a email if you find it useful 
;but feel free to use it or modify it in any manner 

SeedRnd MilliSecs()

Const scrnw = 800 
Const scrnh = 600 

Global white 
Global currentP,LastP,MaxP=5000,ActiveP,MaxA 
Dim PList(1) 
Dim dirX(8),dirY(8) 
diry(1)=-1 
dirx(2)= 1 
dirY(3)= 1 
dirx(4)=-1 

;main *************************************************** 

Graphics scrnw, scrnh 
SetBuffer FrontBuffer() 

;Draw a hexagon with fractal sides 
xHand=DrawLumb(400,300,200,20,60) 

;Flood the inside on screen 
OnScreenfloodFill(xHand,100,100) 
WaitKey 
;flood the outside on screen 
OnScreenfloodFill(xHand,2,2) 
WaitKey 

;flood the inside off screen 
Pcolor=255 Shl 16+ 10 Shl 8 + 10 
floodFill(xHand,100,100,Pcolor) 
WaitKey 

;flood the outside off screen 
Pcolor=10 Shl 16+ 255 Shl 8 + 10 
floodFill(xHand,10,10,Pcolor) 

WaitKey 
End 

;Functions ************************************************ 


Function OnScreenfloodFill(source,x,y) 

	SetBuffer FrontBuffer() 
	Cls 
	DrawBlock source, 0,0 
	t0=MilliSecs() 
	Dim PList(maxP) 
	
	Pcolor=100 Shl 16+ 100 Shl 8 + 100 
	currentP=0 
	LastP=0 
	Plist(LastP)=y Shl 16 + x 
	LockBuffer 
	WritePixelFast x,y,PColor 
	Repeat 
	Until NextPoint(Pcolor,scrnW,ScrnH)=0 
	UnlockBuffer 
	
	
	t1=MilliSecs() 
	
	Color 255,255,255 
	Text 700,0,"Time "+Str$(t1-t0) 
	;Text 700,20,"MaxA "+Str$(maxA) 

End Function 




Function floodFill(source,x,y,Pcolor) 

	t0=MilliSecs() 
	w=ImageWidth(source) 
	h=ImageHeight(source) 
	SBuffer=ImageBuffer(source) 
	SetBuffer Sbuffer 
	
	Dim PList(maxP) 
	currentP=0 
	LastP=0 
	Plist(LastP)=y Shl 16 + x 
	LockBuffer 
	WritePixelFast x,y,PColor 
	Repeat 
	Until NextPoint(Pcolor,w,h)=0 
	UnlockBuffer 
	t1=MilliSecs() 
	
	SetBuffer FrontBuffer() 
	Cls 
	DrawBlock source,0,0 
	Color 255,255,255 
	Text 700,0,"Time "+Str$(t1-t0) 

End Function 




Function NextPoint(PColor,w,h) 

	;pull a point off the list of active points 
	ActiveP=ActiveP-1 
	x0=PList(currentP) And 65535 
	Y0=PList(currentP) Shr 16 
	;check the four adjacent pixels 
	For i=1 To 4 
		x=x0+dirX(i) 
		y=y0+dirY(i) 
		If x<0 
		ElseIf y<0 
		ElseIf x>W 
		ElseIf y>H 
		ElseIf ( ReadPixelFast( x, y ) And $ffffff ) = 0 Then  ; ****** see NOTE2  
		; if blank, color and add to active list 
		WritePixelFast x,y,PColor 
		LastP=LastP+1 
		ActiveP=ActiveP+1 
		If LastP>maxP Then LastP=0 ;wrap around if at end 
			Plist(LastP)=y Shl 16 + x ;add pixel list 
		EndIf 
	Next 
	
	;If ActiveP>maxA Then maxA=ActiveP ;for debugging 
	
	;set current point to next on list 
	currentP=currentP+1 
	If currentP>MaxP Then currentP = 0 ;if at end wrap around 
	
	Return ActiveP ;we're done when there's no more active points 

End Function 



Function fracture(x0,y0,x2,y2,H, Power#, counter) 
;Recursive routine for roughing up a line 
	If counter<1 
		Line x0,y0,x2,y2 
	Else 
		x1=(x0+x2)/2+H*Rnd(-1,1) 
		y1=(y0+y2)/2+H*Rnd(-1,1) 
		H=H^(power) 
		fracture (x0,y0,x1,y1,H,Power,counter-1) 
		fracture (x1,y1,x2,y2,H,Power,counter-1) 
	EndIf 
End Function 



Function DrawLumb(cx,cy,r,m,ang) 
	Color 255,255,255 
	
	For i=1 To 6 
		x1=cx+r*Sin((i-1)*ang) 
		y1=cy+r*Cos((i-1)*ang) 
		x2=cx+r*Sin(i*ang) 
		y2=cy+r*Cos(I*ang) 
		amp=r/5 
		fracture(x1,y1,x2,y2,amp,0.8,5) 
	Next 

	;saved it as an image 
	xhand=CreateImage(2*r+2*m,2*r+2*m) 
	GrabImage xhand,cx-r-m,cy-r-m 
	Return xhand 
End Function