## a very very basic contour finder :)

Posts: 130
Joined: May 28, 2009 20:07

### a very very basic contour finder :)

Code: Select all

type vector
x as single
y as single
end type

declare function FindNext (source as vector, byref dest as vector) as integer

screenres 640,480,32

dim shared as integer scrw,scrh
screeninfo scrw,scrh

dim shared as uinteger background,border,foundcolor,pixel,prevpixel,nextpixel
background=&HFFFFFFFF
border=&HFFFF0000
foundcolor=&HFF008800
dim shared as vector destoffsets(7)
destoffsets(0).x=0
destoffsets(0).y=-1
destoffsets(1).x=1
destoffsets(1).y=-1
destoffsets(2).x=1
destoffsets(2).y=0
destoffsets(3).x=1
destoffsets(3).y=1
destoffsets(4).x=0
destoffsets(4).y=1
destoffsets(5).x=-1
destoffsets(5).y=1
destoffsets(6).x=-1
destoffsets(6).y=0
destoffsets(7).x=-1
destoffsets(7).y=-1

dim shared as uinteger destcolors(7)

'1.***
locate(1,1)
print "original shape... press key"
sleep

'2.***
for y as integer=0 to 599
for x as integer=0 to 799
if x>0 then prevpixel=point(x-1,y) else prevpixel=background
if x<799 then nextpixel=point(x+1,y) else nextpixel=background
pixel=point(x,y)
if prevpixel=background or nextpixel=background then
if pixel<>background then pset(x,y),border
end if
next x
next y
for x as integer=0 to 799
for y as integer=0 to 599
if x>0 then prevpixel=point(x,y-1) else prevpixel=background
if x<799 then nextpixel=point(x,y+1) else nextpixel=background
pixel=point(x,y)
if prevpixel=background or nextpixel=background then
if pixel<>background then pset(x,y),border
end if
next y
next x

locate(1,1)
print "highlight outer pixel of shape... press key"
sleep

'3.***
dim as integer exitloop,findstatus,direction
dim as vector startpos,nextpos
direction=0
startpos.x=96
startpos.y=120

exitloop=0
do
sleep 10
pset(startpos.x,startpos.y),foundcolor
locate (1,1)
print startpos.x,startpos.y,"tracing the line"
findstatus=FindNext (startpos,nextpos)
if findstatus>-1 then
swap startpos,nextpos
else
exitloop=1
end if

loop until exitloop
beep

'******************************************************************************
'******************************************************************************
'******************************************************************************
function FindNext (source as vector, byref dest as vector) as integer
dim as vector tmp
dim as integer count,found,startsearch
for i as integer=0 to 7
tmp.x=source.x + destoffsets(i).x
tmp.y=source.y + destoffsets(i).y
if (tmp.x>=0) and (tmp.x<scrw) and (tmp.y>=0) and (tmp.y<scrh) then
destcolors(i)=point(tmp.x,tmp.y)
if destcolors(i)=background then startsearch=i
else
destcolors(i)=background
end if
next i

count=startsearch
found=-1
do
count = (count+1) mod 8
if destcolors(count)=border then
found=count
dest.x=source.x + destoffsets(count).x
dest.y=source.y + destoffsets(count).y
end if
loop until (found>-1) or (count=startsearch)
function=found
end function

and the horse:

Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

### Re: a very very basic contour finder :)

Impressive, it finds also capshole contours (i've tried with an other picture). But I fail to figure out how it works..
dodicat
Posts: 6547
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: a very very basic contour finder :)

Here's an alternative, just outline the horse.

Code: Select all

Function Filter(Byref tim As Uinteger Pointer,_
byval destroy As Integer=1,_
byval fade As Integer=0) As Uinteger Pointer
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
Type p2
As Integer x,y
As Uinteger col
End Type
#macro ppoint(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
(colour)=*pixel
#endmacro
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro
#macro average()
ar=0:ag=0:ab=0:inc=0
For y1 As Integer=-ymin To ymax
For x1 As Integer=-xmin To xmax
inc=inc+1
ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
ab=ab+(NewPoints(x+x1,y+y1).col And 255)
Next x1
Next y1
averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
Else
averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
End If
#endmacro
Dim As Integer _x,_y
Imageinfo tim,_x,_y
Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
Dim As Integer pitch
Dim  As Any Pointer row
Dim As Uinteger Pointer pixel
Dim As Uinteger col
Imageinfo tim,,,,pitch,row
Dim As p2 NewPoints(_x-1,_y-1)
For y As Integer=0 To (_y)-1
For x As Integer=0 To (_x)-1
ppoint(x,y,col)
NewPoints(x,y)=Type<p2>(x,y,col)
Next x
Next y
Dim As Uinteger averagecolour
Dim As Integer ar,ag,ab
Dim As Integer xmin,xmax,ymin,ymax,inc
Imageinfo im,,,,pitch,row
For y As Integer=0 To _y-1
For x As Integer=0 To _x-1
average()
ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
Next x
Next y
If destroy Then Imagedestroy tim: tim = 0
Function= im
End Function

Sub GetSize(bmp As String,byref x as integer,byref y as integer,byref b as integer=0) 'get bitmap width/height/ colour resolution
Open bmp For Binary access read As #1
Get #1, 19, X
Get #1, 23, Y
get #1, 29, b
Close #1
End sub

'=========================================
screen 19,32
dim as integer w,h
'step 1 get the bitmap dimensions
GetSize("horse.bmp",w,h)

dim as any ptr im=imagecreate(w,h)
'Step 2
'Step 3
'filter image (Blur to one pixel thick)
im=filter(im,1)
put(0,0),im,pset
draw string(20,500),"Press a key"
sleep

color ,rgb(255,255,255)
cls
'Step 4
'pset (or perhaps save), what is not black or white.
for y as integer=0 to h-1
for x as integer=0 to w-1
var p=point(x,y,im)
if p<>rgb(255,255,255) and p<>rgb(0,0,0) then pset(x,y),rgb(0,0,0)
next x
next y
draw string(20,500),"Done",0
sleep
imagedestroy im

BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: a very very basic contour finder :)

Code: Select all

screenres 640,480,32

dim as any ptr horse,temp
horse = imagecreate(640,480)
temp  = imagecreate(640,480)
put (0,0),horse,pset            'place on display
put (1,0),horse,xor             'xor x shifted version onto display
put temp,(0,1),horse,xor    'xor  y shifted version onto temp
put (0,0),temp,or               'or shifted versions together onto display

sleep

Of course the original reason to traverse a blob was to reduce the data set OR for contour analysis which would output not the outline of the horse but rather that is was a horse and not a rabbit or some other silhouette.
Posts: 130
Joined: May 28, 2009 20:07

### Re: a very very basic contour finder :)

second trial:

a black shape and a bug on the waltz, no inner outline nor outer inline

Code: Select all

#include "fbgfx.bi"

'some types
type vector
x as single
y as single
end type

type crawldata
searchstate   as integer'0=stop searching, 1=search for firstpos, 2= search newpos in contour
foundnew      as integer'0 no newpos, 1 found newpos
incontour     as integer'is 1 when currentpos is in the contour
currentpos    as vector 'its the current position of the crawler
newpos        as vector 'new position for search shape / of the contour / current position when stop

firstpos      as vector 'contains the first discovered position of the contour, entrypoint in contour, check when contour is closed
end type

type ContourCrawler
private:
'positions of surrounding pixels
'screen coordinate system
'  7 0 1
'
'  6 x 2   x=current position
'
'  5 4 3
viewoffset(7) as vector'contains the position offsets of all 8 surrounding pixels
scolor        as uinteger'shape color
ccolor        as uinteger'contour color
bcolor        as uinteger'background color
cd            as crawldata
initpos       as vector
initdir       as integer
scrwidth      as integer
scrheight     as integer
public:
declare constructor
declare function crawl (currentpos as vector) as crawldata
declare sub InitCrawler(shapecolor as uinteger, contourcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
end type

constructor ContourCrawler
viewoffset(0).x=0
viewoffset(0).y=-1
viewoffset(1).x=1
viewoffset(1).y=-1
viewoffset(2).x=1
viewoffset(2).y=0
viewoffset(3).x=1
viewoffset(3).y=1
viewoffset(4).x=0
viewoffset(4).y=1
viewoffset(5).x=-1
viewoffset(5).y=1
viewoffset(6).x=-1
viewoffset(6).y=0
viewoffset(7).x=-1
viewoffset(7).y=-1
scolor=&H000000
ccolor=&H00AA00
bcolor=&HFFFFFF
initpos.x=0
initpos.y=0
initdir=0
cd.searchstate=0
cd.foundnew=0
cd.incontour=0
cd.newpos.x=0
cd.newpos.y=0
cd.newpos.x=-1
cd.newpos.y=-1
cd.firstpos.x=-1
cd.firstpos.y=-1
screeninfo scrwidth,scrheight
end constructor

function ContourCrawler.crawl(currentpos as vector) as crawldata
dim as uinteger currentcolor,tmpcolor
dim as vector tmppos
dim as integer found,search
cd.currentpos=currentpos
currentcolor=point(cd.currentpos.x,cd.currentpos.y) and &HFFFFFF

select case currentcolor
case bcolor
cd.searchstate=1'searching for first contact
cd.incontour=0'we're not in a shape
cd.newpos.x=cd.currentpos.x + viewoffset(initdir).x'set new search position
cd.newpos.y=cd.currentpos.y + viewoffset(initdir).y

case scolor
'next stuff happens only while first contact
if cd.searchstate=1 then
cd.foundnew=1'a contour point was found
cd.searchstate=2          'set to contoursearch mode
cd.firstpos=cd.currentpos 'save firstpos of contour
cd.incontour=1            'we're in a shape
end if

'search for a point outside of the shape
search=-1
do
search+=1
tmppos.x=cd.currentpos.x + viewoffset(search).x
tmppos.y=cd.currentpos.y + viewoffset(search).y
if (tmppos.x>=0) and (tmppos.x<scrwidth) and (tmppos.y>=0) and (tmppos.y<scrheight) then _
tmpcolor=(point(tmppos.x,tmppos.y) and &HFFFFFF)
loop until tmpcolor=bcolor

'search clockwise for a pixel inside of the shape
found=-1
do
search = (search+1) mod 8
tmppos.x=cd.currentpos.x + viewoffset(search).x
tmppos.y=cd.currentpos.y + viewoffset(search).y
if (tmppos.x>=0) and (tmppos.x<scrwidth) and (tmppos.y>=0) and (tmppos.y<scrheight) then _
tmpcolor=(point(tmppos.x,tmppos.y) and &HFFFFFF)
loop until (tmpcolor=scolor) or (tmpcolor=ccolor)

if (tmppos.x<>cd.firstpos.x) or (tmppos.y<>cd.firstpos.y) then
cd.newpos=tmppos
cd.searchstate=2'search contour
cd.foundnew=1'a contour point was found
cd.incontour=1'we're in a shape
else
cd.newpos=cd.currentpos
cd.searchstate=0'stop search
cd.incontour=1'we're in a shape
end if
end select
function=cd
end function

sub ContourCrawler.InitCrawler (shapecolor as uinteger, contourcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
scolor=shapecolor
ccolor=contourcolor
bcolor=backgroundcolor
initdir=direction
end sub

'******************************************************************************
'******************************************************************************
'******************************************************************************

screenres 800,600,32

dim as ContourCrawler crawl

dim as FB.Image ptr horse=imagecreate(640,480)
dim as uinteger scol,ccol,bcol
scol=&H000000'shape color
ccol=&HFF0000'contour color
bcol=&HFFFFFF'background color
dim as vector anypos
anypos.x=40
anypos.y=260

put(30,30),horse,PSET
crawl.InitCrawler scol,ccol,bcol,2'2 means search in right direction

dim as crawldata dat

do
dat=crawl.crawl(anypos)
if dat.incontour then
pset(anypos.x, anypos.y),ccol
locate (1,1)
print anypos.x,anypos.y
end if
anypos=dat.newpos
sleep 5
loop until dat.searchstate=0
beep

sleep
imagedestroy horse

Mutton
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: a very very basic contour finder :)

When testing an algorithm it is wise to try it on lots of random examples to see if there are any problems.

Code: Select all

screenres 800,600,32

dim as ContourCrawler crawl

dim as FB.Image ptr horse=imagecreate(640,480)
line horse,(0,0)-(639,479),rgb(255,255,255),bf
line horse,(143,83)-(293,231),rgb(0,0,0),bf
line horse,(294,232)-(455,370),rgb(0,0,0),bf
Posts: 130
Joined: May 28, 2009 20:07

### Re: a very very basic contour finder :)

hey, its in progress. there are some known problems, other problems will appear. Its an approach, nothing more :)
Last but not least, it depends on the requirements.

to your example: what is it? one or two closed shapes.

Mutton
Roland Chastain
Posts: 859
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: a very very basic contour finder :)

I like guys when you use french words: contour, silhouette...
Posts: 130
Joined: May 28, 2009 20:07

### Re: a very very basic contour finder :)

final

Code: Select all

#include "fbgfx.bi"

'some types
type vector
x as single
y as single
end type

type crawlmessage
searchstate   as integer'0=stop searching, 1=search for firstpos, 2= search newpos in contour
incontour     as integer'is 1 when currentpos is in the contour

firstpos      as vector 'first discovered position of the contour, reference for contour close check
prepos        as vector 'predecessor
currentpos    as vector 'current position of the crawler
newpos        as vector 'new found point in contour

end type

type ContourCrawler
private:
'positions of surrounding pixels
'clock wise
'  7 0 1
'  6 x 2  x=current position
'  5 4 3
'
'look up table for all 8 surrounding pixels
offset(7)  as vector'contains the position offsets of all 8 surrounding pixels clockwise

'short time color memory
colormem(7)   as uinteger'contains the colors of surrounding pixels

'colors
c_color       as uinteger'contour color
ch_color      as uinteger'contour color hightlighted
b_color       as uinteger'background color

'states
searchstate   as integer'0=stop searching, 1=search for firstpos, 2= search newpos in contour
incontour     as integer'is 1 when currentpos is in the contour

'directions
predir        as integer'direction of predecessor seen from current positition
newdir        as integer'direction of new found contour position seen from current positition
olddir        as integer'newdir of previous crawl "old newdir" ;)

'positions
firstpos      as vector 'first discovered position of the contour, reference for contour close check
preprepos     as vector 'pre-predecessor
prepos        as vector 'predecessor
currentpos    as vector 'current position of the crawler
newpos        as vector 'new found point in contour

'init stuff
initdir       as integer
scrwidth      as integer
scrheight     as integer
public:
declare constructor
declare function crawl (currentpos as vector) as crawlmessage
declare sub InitCrawler(contourcolor as uinteger, conturhighlightcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
end type

constructor ContourCrawler
offset(0).x=0
offset(0).y=-1
offset(1).x=1
offset(1).y=-1
offset(2).x=1
offset(2).y=0
offset(3).x=1
offset(3).y=1
offset(4).x=0
offset(4).y=1
offset(5).x=-1
offset(5).y=1
offset(6).x=-1
offset(6).y=0
offset(7).x=-1
offset(7).y=-1

c_color=&H000000
ch_color=&H00AA00
b_color=&HFFFFFF
initdir=0
searchstate=0
incontour=0
firstpos.x=-1
firstpos.y=-1
preprepos.x=-1
preprepos.y=-1
prepos.x=-1
prepos.y=-1
currentpos.x=-1
currentpos.y=-1
newpos.x=-1
newpos.y=-1
screeninfo scrwidth,scrheight
end constructor

function ContourCrawler.crawl(currentpos as vector) as crawlmessage
dim as integer found,counter,tmpdir,gapsize
dim as uinteger currentcolor,tmpcolor
dim as vector tmppos
dim as crawlmessage cm

currentpos=currentpos
currentcolor=point(currentpos.x,currentpos.y) and &HFFFFFF

select case currentcolor

case b_color  ' we're outside of a contour

searchstate=1'searching for first contact
incontour=0'we're not in a contour
newpos.x=currentpos.x + offset(initdir).x'set new search position
newpos.y=currentpos.y + offset(initdir).y

case c_color,ch_color' we're on a contour, its the first contact or we are in searching contour mode

'Step 0:
'next stuff happens only on first entry in a contour
if searchstate=1 then
incontour=1        'we're in a contour !!!!!!!
searchstate=2      'set to contour search mode
firstpos=currentpos'save firstpos of contour
end if

'Step 1:
'copy all colors of the surrounding pixels of current point in colormem
for i as integer=0 to 7
tmppos.x=currentpos.x + offset(i).x
tmppos.y=currentpos.y + offset(i).y
if (tmppos.x>=0) and (tmppos.x<scrwidth) and (tmppos.y>=0) and (tmppos.y<scrheight) then

'to prevent problems that can occure when pre-predecessor position is set in colormem we change it to background
'its no loss on information cause this position was detected before as contour point
if (tmppos.x=preprepos.x) and (tmppos.y=preprepos.y) then
colormem(i)=b_color
else
colormem(i)=(point(tmppos.x,tmppos.y) and &HFFFFFF)
end if

else
colormem(i)=b_color
end if
next i

'Step 2:
'direction of prepos seen from currentpos, start position for searching new contour point
predir=0
for i as integer=0 to 7
tmppos.x=currentpos.x + offset(i).x
tmppos.y=currentpos.y + offset(i).y
if (tmppos.x=prepos.x) and (tmppos.y=prepos.y) then predir=i
next i

'Step 3:
'search clockwise(!!!) for a point outside of contour
found=0
counter=0
gapsize=0
for i as integer=1 to 7
counter= (predir+i) mod 8
if i=1 then
if  colormem(counter)=b_color then found=1 else found=2
else
if  colormem(counter)<>b_color then found=2
end if

if found=1 then gapsize +=1
next i

'Step 4:
'optimize stuff ??

'Step 5:
'final new position
newdir=(predir + gapsize + 1) mod 8
tmppos.x=currentpos.x + offset(newdir).x
tmppos.y=currentpos.y + offset(newdir).y

if (tmppos.x<>firstpos.x) or (tmppos.y<>firstpos.y) then
newpos=tmppos
searchstate=2'search contour
incontour=1'we're in a shape
else
newpos=currentpos
searchstate=0'stop search
incontour=1'we're in a shape
end if

end select

preprepos=prepos
prepos=currentpos

'prepare message
cm.searchstate   =searchstate
cm.incontour     =incontour
cm.firstpos      =firstpos
cm.prepos        =prepos
cm.currentpos    =currentpos
cm.newpos        =newpos

'locate (1,1)
'print currentpos.x,currentpos.y,prepos.x,prepos.y,preprepos.x,preprepos.y
'print gapsize,predir,newdir
'sleep 10

function=cm
end function

sub ContourCrawler.InitCrawler (contourcolor as uinteger, conturhighlightcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
c_color=contourcolor
ch_color=conturhighlightcolor
b_color=backgroundcolor
initdir=direction
end sub

'******************************************************************************
'******************************************************************************
'******************************************************************************

screenres 800,600,32

dim as ContourCrawler crawl

dim as FB.Image ptr horse=imagecreate(640,480)

line horse,(0,0)-(639,479),rgb(255,255,255),bf
line horse,(143,83)-(293,231),rgb(0,0,0),bf
line horse,(294,232)-(455,370),rgb(0,0,0),bf

dim as uinteger scol,ccol,bcol
scol=&H000000'shape color
ccol=&HFF0000'contour color highlighted
bcol=&HFFFFFF'background color
dim as vector anypos
anypos.x=35
anypos.y=260

put(30,30),horse,PSET
crawl.InitCrawler scol,ccol,bcol,2'2 means start search to right
dim as crawlmessage msg

do
msg=crawl.crawl(anypos)
if msg.incontour then
pset(anypos.x, anypos.y),ccol
end if
anypos=msg.newpos
loop until msg.searchstate=0

imagedestroy horse

'paint (250,120),ccol,ccol'food fill proof test
sleep

Mutton
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

### Re: a very very basic contour finder :)

Looks great!

But I obtain only two squares. When editing line 233 to bload the horse, I've also to comment the boxes. And that still wont really work. So how should be the expected image to get the contour from? What background color for example? All of that seems to influe, true?
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: a very very basic contour finder :)

Muttonhead wrote:... to your example: what is it? one or two closed shapes.

It is one closed shape as you can see below.
It has to do with how many neighboring pixels you want to consider as being connected to the current pixel.
The code below assumes a background of black while searching for the first pixel in a blob of any color but black.
In other code the whole image can be made up of connected blobs of color and all blob outlines are extracted. In other words blobs within blobs as you would get with the shapes B or O as apposed to the shapes L or T. There are issues like one blob merging with another blob (fbHorse and its base) or one blob breaking into two blobs or even requiring two blobs like the character : and ; and so on..
These outlines could be used to determine what shape the blob is. Is it a square, a circle, a triangle or something complicated like a horse or less complicated like the outline of a character.
The particular purpose in my other post,
viewtopic.php?f=8&t=23705
was simply to enable someone with a silhouette like the horse to have its outline automatically turned into a list of coordinates in a set of data statements. I imagine doing it manually would be tiresome and time consuming. Reducing the actual number of coordinates I thought was also a good idea thus the data reduction challenge.

Code: Select all

'THIS ASSUMES A 480x480 image.
screenres 480,480,32

dim shared as any ptr image1,image2
image1 = imagecreate(480,480) 'blob image with black background
image2 = imagecreate(480,480) 'save image of blob's outline

dim shared as integer xp(10000)  'save contour coordinates
dim shared as integer yp(10000)
dim shared as integer count      'count number of coordinates

sub TraverseBlob(x as integer, y as integer,image2 as any ptr,c as uinteger,image as any ptr)

dim as integer ox,oy,sx,sy,direction,cc

direction = 0
ox = x
oy = y
sx = x
sy = y
cc = point(x,y,image)  'color to draw outline
xp(count)=x
yp(count)=y
count = count + 1

do

select case as const direction

'EAST
case 0
if point(x+1,y-1,image) = c then
direction = 3 'north
else
if point(x+1,y,image) <> c then
direction = 1 'south
end if
end if
x = x + 1

'SOUTH
case 1
if point(x,y+1,image) = c then
direction = 0 'east
else
if point(x-1,y+1,image) <> c then
direction = 2 'west
end if
end if
y = y + 1

'WEST
case 2
if point(x-2,y,image) = c then
direction = 1 'south
else
if point(x-2,y-1,image) <> c then
direction = 3 'north
end if
end if
x = x - 1

'NORTH
case 3
if point(x-1,y-2,image) = c then
direction = 2 'west
else
if point(x,y-2,image) <> c then
direction = 0 'east
end if
end if
y = y - 1
end select

pset image2,(x,y),rgb(255,255,255)  'draw outline

xp(count)=x
yp(count)=y
count = count + 1

ox = x
oy = y

loop until sx = x and sy = y

end sub

line image1,(0,0)-(479,479),rgb(0,0,0),bf
line image1,(70,70)-(200,200),rgb(255,0,0),bf
line image1,(201,201)-(300,300),rgb(255,0,0),bf
line image1,(100,80)-(300,80),rgb(255,0,0)
line image1,(40,301)-(199,388),rgb(255,0,0),bf
put (0,0),image1
locate 2,2
print "tap space bar to continue ..."
sleep

dim as integer blobFound = 0
'scans image array to find blob
for j as integer = 1 to 478
for i as integer = 1 to 478
if blobFound = 0 then
if point(i,j,image1) <> rgb(0,0,0) then
blobFound = 1
'traverseBlob (x,y,destination,colorOfBlob,source)
traverseBlob(i,j,image2,point(i,j,image1),image1)
cls
put (0,0), image2 'show outline
end if
end if
next i
next j

print "number of points =";count
if count<>0 then
for i as integer = 1 to count-1
line (xp(i-1),yp(i-1))-(xp(i),yp(i)),rgb(255,255,0)
next i
end if

sleep
Posts: 130
Joined: May 28, 2009 20:07

### Re: a very very basic contour finder :)

you need more than 4 connected pixels:

Code: Select all

#include "fbgfx.bi"

'some types
type vector
x as single
y as single
end type

type crawlmessage
searchstate   as integer'0=stop searching, 1=search for firstpos, 2= search newpos in contour
incontour     as integer'is 1 when currentpos is in the contour

firstpos      as vector 'first discovered position of the contour, reference for contour close check
prepos        as vector 'predecessor
currentpos    as vector 'current position of the crawler
newpos        as vector 'new found point in contour

end type

type ContourCrawler
private:
'positions of surrounding pixels
'clock wise
'    0
'  3 x 1  x=current position
'    2
'
'look up table for all 8 surrounding pixels
offset(3)  as vector'contains the position offsets of all 8 surrounding pixels clockwise

'short time color memory
colormem(3)   as uinteger'contains the colors of surrounding pixels

'colors
c_color       as uinteger'contour color
ch_color      as uinteger'contour color hightlighted
b_color       as uinteger'background color

'states
searchstate   as integer'0=stop searching, 1=search for firstpos, 2= search newpos in contour
incontour     as integer'is 1 when currentpos is in the contour

'directions
predir        as integer'direction of predecessor seen from current positition
newdir        as integer'direction of new found contour position seen from current positition
olddir        as integer'newdir of previous crawl "old newdir" ;)

'positions
firstpos      as vector 'first discovered position of the contour, reference for contour close check
preprepos     as vector 'pre-predecessor
prepos        as vector 'predecessor
currentpos    as vector 'current position of the crawler
newpos        as vector 'new found point in contour

'init stuff
initdir       as integer
scrwidth      as integer
scrheight     as integer
public:
declare constructor
declare function crawl (currentpos as vector) as crawlmessage
declare sub InitCrawler(contourcolor as uinteger, conturhighlightcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
end type

constructor ContourCrawler
offset(0).x=0
offset(0).y=-1
offset(1).x=1
offset(1).y=0
offset(2).x=0
offset(2).y=1
offset(3).x=-1
offset(3).y=0

c_color=&H000000
ch_color=&H00AA00
b_color=&HFFFFFF
initdir=0
searchstate=0
incontour=0
firstpos.x=-1
firstpos.y=-1
preprepos.x=-1
preprepos.y=-1
prepos.x=-1
prepos.y=-1
currentpos.x=-1
currentpos.y=-1
newpos.x=-1
newpos.y=-1
screeninfo scrwidth,scrheight
end constructor

function ContourCrawler.crawl(currentpos as vector) as crawlmessage
dim as integer found,counter,tmpdir,gapsize
dim as uinteger currentcolor,tmpcolor
dim as vector tmppos
dim as crawlmessage cm

currentpos=currentpos
currentcolor=point(currentpos.x,currentpos.y) and &HFFFFFF

select case currentcolor

case b_color  ' we're outside of a contour

searchstate=1'searching for first contact
incontour=0'we're not in a contour
newpos.x=currentpos.x + offset(initdir).x'set new search position
newpos.y=currentpos.y + offset(initdir).y

case c_color,ch_color' we're on a contour, its the first contact or we are in searching contour mode

'Step 0:
'next stuff happens only on first entry in a contour
if searchstate=1 then
incontour=1        'we're in a contour !!!!!!!
searchstate=2      'set to contour search mode
firstpos=currentpos'save firstpos of contour
end if

'Step 1:
'copy all colors of the surrounding pixels of current point in colormem
for i as integer=0 to 3
tmppos.x=currentpos.x + offset(i).x
tmppos.y=currentpos.y + offset(i).y
if (tmppos.x>=0) and (tmppos.x<scrwidth) and (tmppos.y>=0) and (tmppos.y<scrheight) then

'to prevent problems that can occure when pre-predecessor position is set in colormem we change it to background
'its no loss on information cause this position was detected before as contour point
if (tmppos.x=preprepos.x) and (tmppos.y=preprepos.y) then
colormem(i)=b_color
else
colormem(i)=(point(tmppos.x,tmppos.y) and &HFFFFFF)
end if

else
colormem(i)=b_color
end if
next i

'Step 2:
'direction of prepos seen from currentpos, start position for searching new contour point
predir=0
for i as integer=0 to 3
tmppos.x=currentpos.x + offset(i).x
tmppos.y=currentpos.y + offset(i).y
if (tmppos.x=prepos.x) and (tmppos.y=prepos.y) then predir=i
next i

'Step 3:
'search clockwise(!!!) for a point outside of contour
found=0
counter=0
gapsize=0
for i as integer=1 to 3
counter= (predir+i) mod 4
if i=1 then
if  colormem(counter)=b_color then found=1 else found=2
else
if  colormem(counter)<>b_color then found=2
end if

if found=1 then gapsize +=1
next i

'Step 4:
'optimize stuff ??

'Step 5:
'final new position
newdir=(predir + gapsize + 1) mod 4
tmppos.x=currentpos.x + offset(newdir).x
tmppos.y=currentpos.y + offset(newdir).y

if (tmppos.x<>firstpos.x) or (tmppos.y<>firstpos.y) then
newpos=tmppos
searchstate=2'search contour
incontour=1'we're in a shape
else
newpos=currentpos
searchstate=0'stop search
incontour=1'we're in a shape
end if

end select

preprepos=prepos
prepos=currentpos

'prepare message
cm.searchstate   =searchstate
cm.incontour     =incontour
cm.firstpos      =firstpos
cm.prepos        =prepos
cm.currentpos    =currentpos
cm.newpos        =newpos

'locate (1,1)
'print currentpos.x,currentpos.y,prepos.x,prepos.y,preprepos.x,preprepos.y
'print gapsize,predir,newdir
'sleep

function=cm
end function

sub ContourCrawler.InitCrawler (contourcolor as uinteger, conturhighlightcolor as uinteger, backgroundcolor as uinteger, direction as integer=2)
c_color=contourcolor
ch_color=conturhighlightcolor
b_color=backgroundcolor
initdir=direction
end sub

'******************************************************************************
'******************************************************************************
'******************************************************************************

screenres 800,600,32

dim as ContourCrawler crawl

dim as FB.Image ptr horse=imagecreate(640,480)

line horse,(0,0)-(639,479),rgb(255,255,255),bf
line horse,(143,83)-(293,231),rgb(0,0,0),bf
line horse,(294,232)-(455,370),rgb(0,0,0),bf

dim as uinteger scol,ccol,bcol
scol=&H000000'shape color
ccol=&HFF0000'contour color highlighted
bcol=&HFFFFFF'background color
dim as vector anypos
anypos.x=35
anypos.y=260

put(30,30),horse,PSET
crawl.InitCrawler scol,ccol,bcol,1'1 means start search to right
dim as crawlmessage msg

do
msg=crawl.crawl(anypos)
if msg.incontour then
pset(anypos.x, anypos.y),ccol
end if
anypos=msg.newpos
loop until msg.searchstate=0

imagedestroy horse
beep
sleep

nearly the same code, with four connected pixels: it dont detect the second square.

but your right, to describe a form in this way, its a lot in information

https://en.wikipedia.org/wiki/Marching_squares
sorry if this hint is old, didnt follow the whole stuff

Mutton
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: a very very basic contour finder :)

Muttonhead wrote:you need more than 4 connected pixels: ... nearly the same code, with four connected pixels: it don't detect the second square.

If you want all the blobs outlined, connected or not, you need to search the whole image, there are silhouettes that are composed of disconnected blobs and blobs within blobs.

With regards to a computer recognition system I was interested in, when two corners touch like this you may not want to detect them as ONE shape.
Do you see two discs or one "shape" when you run the example below?
The fbHorse is recognized as a horse because you break the blob into blob components like parts of the legs, the head, tail and so on all with constrained spatial relationships.

Code: Select all

screenres 640,480,32

circle (100,100),50,rgb(255,255,255),,,,f
circle (100,199),50,rgb(255,255,255),,,,f

sleep
grindstone
Posts: 726
Joined: May 05, 2015 5:35
Location: Germany

### Re: a very very basic contour finder :)

I took the best (I hope) of all the snippets that have been posted to this subject (especially the outline creation by "blob shifting" I find simply ingenious) and merged them to a contour scanner that can handle shapes with multiple outlines:

Code: Select all

Dim As UInteger w,h,x,y,count
Dim As String shapedata

ScreenRes 640,480,32

Dim As Any Ptr horse,temp,t2
horse = ImageCreate(640,480)
temp  = ImageCreate(640,480)
t2  = ImageCreate(640,480,RGBA(0,0,0,255))
Put (0,0),horse,PSet            'place on display
Put (1,0),horse,Xor             'xor x shifted version onto display
Put temp,(0,1),horse,Xor    'xor y shifted version onto temp
Put temp,(0,0),t2,Or         'reset alpha channel
Put (0,0),temp,Or               'or shifted versions together onto display

BSave ExePath + "\horseOutline.bmp",0

ImageInfo temp,w,h 'get image dimensions
Color RGB(255,255,255)

Cls
Put (0,0),temp,PSet 'draw outline image on screen
Locate 3,40
Print "TRAVERSING"
'create outline data file
Open ExePath + "\oTdata.txt" For Output As #1
Do
'scan for line starting point from the top to the bottom
' and from the left to the right
For y = 2 To h-1
For x = 2 To w-1 'scan line
If POINT (x,y,temp) <> RGBA(0,0,0,255) Then
Exit For,For 'line found
EndIf
Next
Next
If (x = w) And (y = h) Then 'no line found => end scanning
Exit Do
EndIf
Print #1,x 'line starting point
Print #1,y
Do 'traverse line
PSet (x,y),RGB(255,0,0) 'set pixel on screen for control
PSet temp,(x,y),RGBA(0,0,0,255) 'delete scanned pixel
If POINT (x+1,y,temp) <> RGBA(0,0,0,255) Then 'right
x += 1
shapedata += Chr(50)
ElseIf POINT (x-1,y,temp) <> RGBA(0,0,0,255) Then 'left
x -= 1
shapedata += Chr(51)
ElseIf POINT (x,y+1,temp) <> RGBA(0,0,0,255) Then 'up
y += 1
shapedata += Chr(48)
ElseIf POINT (x,y-1,temp) <> RGBA(0,0,0,255) Then 'down
y -= 1
shapedata += Chr(49)
ElseIf (Point (x+1,y+1,temp) <> RGBA(0,0,0,255)) Then 'right/up
x += 1
y += 1
shapedata += Chr(55)
ElseIf (Point (x-1,y+1,temp) <> RGBA(0,0,0,255)) Then 'left/up
x -= 1
y += 1
shapedata += Chr(54)
ElseIf (Point (x+1,y-1,temp) <> RGBA(0,0,0,255)) Then 'left/down
x += 1
y -= 1
shapedata += Chr(53)
ElseIf (Point (x-1,y-1,temp) <> RGBA(0,0,0,255)) Then 'right/down
x -= 1
y -= 1
shapedata += Chr(52)
Else 'line ended
Print #1, shapedata
shapedata = ""
Exit Do 'search for next line
EndIf
Sleep 1
Loop
Loop
Close
Locate 3,40
Print "          "

ImageDestroy horse
ImageDestroy temp

'draw image outline from the saved file
Locate 3,40
Print "DRAWING FROM FILE"
Open ExePath + "\oTdata.txt" For Input As #1
Do
Input #1, x, y 'starting point
PSet(x,y),RGB(0,255,0)

Input #1, shapedata
If Len(shapedata) = 0 Then 'single point
Continue Do
EndIf
For count = 0 To Len(shapedata) - 1
Select Case shapedata[count] - 48
Case 0 'down
y += 1
Case 1 'up
y -= 1
Case 2 'right
x += 1
Case 3 'left
x -= 1
Case 4 'left/up
x -= 1
y -= 1
Case 5 'right/up
x += 1
y -= 1
Case 6 'left/down
x -= 1
y += 1
Case 7 'right/down
x += 1
y += 1
End Select
PSet(x,y),RGB(0,255,0)
Locate 31,40
Print "^"
Locate 30,30
Print Mid(shapedata,count-10,20)
Sleep 100
Next
Loop Until Eof(1)
Close

Sleep

horse2.bmp (You see the gap in the bottom line has been closed)

Regards
grindstone
Last edited by grindstone on Jul 19, 2015 10:18, edited 1 time in total.
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: a very very basic contour finder :)

grindstone,
For some reason your program displays the outline and then freezes with a red line horizontal line at top of display and the output TRAVERSING but nothing seems to be happening.

I haven't had time to figure out your code yet but I guess you scan for lines instead of blobs and then trace them with another color which would then act as a flag that it has already been traced when the scan hits it again.

Yes I thought I was ingenious when I thought to use shifted bitmaps :)
Try it with any color image and you will get colored outlines.
.