a very very basic contour finder :)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
grindstone
Posts: 737
Joined: May 05, 2015 5:35
Location: Germany

Re: a very very basic contour finder :)

Postby grindstone » Jul 19, 2015 10:15

BasicCoder2 wrote: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 can't confirm that. I've downloaded the posted code as well as the picture and it works here. The red line marks an outline the program is traversing. Maybe your hardware treats the alpha channel (which is also set to 0 at XORing) different than mine. I'll try to fix that.

EDIT: Done. I've replaced the posted code, the alpha channel is now set to &hFF. Please try again.
BasicCoder2
Posts: 3566
Joined: Jan 01, 2009 7:03
Location: Australia

Re: a very very basic contour finder :)

Postby BasicCoder2 » Jul 19, 2015 10:48

That seemed to fix it.
The traversing from file is too slow to watch!!
I changed the color with each hit instead of just using red to observe better what was happening.

Code: Select all

...
    dim as uinteger c
    c = rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    Do 'traverse line
        PSet (x,y),RGB(255,0,0) 'set pixel on screen for control
        pset (x,y),c
...
dodicat
Posts: 6557
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: a very very basic contour finder :)

Postby dodicat » Jul 19, 2015 13:51

Here is an ultra basic method using the original horse.bmp

Code: Select all

 



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

dim as integer _x,_y
dim shared as integer counter
getsize "horse.bmp",_x,_y

ScreenRes _x,_y,32
Dim As Any Ptr horse,temp,t2
horse = ImageCreate(_x,_y)
temp  = ImageCreate(_x,_y)
t2  = ImageCreate(_x,_y,RGB(0,0,0))
BLoad "horse.bmp",horse
BLoad "horse.bmp",temp


'line contour by basiccoder2's method

Put (0,0),horse,PSet           
Put (1,0),horse,Xor           
Put temp,(0,1),horse,Xor   
Put temp,(0,0),t2,Or         
Put (0,0),temp,Or             

Print "Press a key to start"
sleep
type point
    as integer x,y
end type

type Epoint extends point
    as point p(1 to 9)
    declare constructor
    declare constructor(c as point)
end type

dim shared as Epoint first

operator = (p1 as Epoint,p2 as Epoint) as integer
operator= abs((p1.p(9).x-p2.p(9).x)) <2 and abs(p1.p(9).y-p2.p(9).y) <2 and counter>5
end operator

constructor Epoint
end constructor

constructor Epoint(c as point)
p(9)=c
static as integer contact
dim as integer d
for d=1 to 4
p(1)=type<point>(p(9).x+d,p(9).y)
p(2)=type<point>(p(9).x+d,p(9).y-d)
p(3)=type<point>(p(9).x,p(9).y-d)
p(4)=type<point>(p(9).x-d,p(9).y-d)
p(5)=type<point>(p(9).x-d,p(9).y)
p(6)=type<point>(p(9).x-d,p(9).y+d)
p(7)=type<point>(p(9).x,p(9).y+d)
p(8)=type<point>(p(9).x+d,p(9).y+d)

for n as integer=1 to 8
    if point(p(n).x,p(n).y)=rgb(255,255,255) then
        pset(p(n).x,p(n).y),rgb(200,0,0)
        p(9)=p(n)
        if contact=0 then first.p(9)=p(9)
        contact=1
        counter+=1
        goto fin
    end if
next n

next d
if contact=0 then
    p(9).x+=1
    p(9).y+=1
pset (p(9).x,p(9).y),rgb(0,200,0)
end if

fin:
end constructor

dim as Epoint p
p.p(9).x=10
p.p(9).y=20
#define waitabit for x as integer=1 to 2000000:next
do
   
     p=type<Epoint>(p.p(9))
   
waitabit
loop until inkey=chr(27) or p=first
print "Points caught ";counter
sleep
imagedestroy horse
imagedestroy temp
imagedestroy t2


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

Re: a very very basic contour finder :)

Postby grindstone » Jul 19, 2015 23:27

BasicCoder2 wrote:The traversing from file is too slow to watch!!
I put a 'Sleep 100' - statement into the loop so the piece of data string that's actually processed can be watched. Just comment it (as well as the one in the traversing loop) to make the program work (a lot) faster.
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: a very very basic contour finder :)

Postby Quark » Nov 19, 2015 3:33

.
I don't know whether I am contributing anything to the natural flow of this thread, but here is a contour-maker for the FB horse, saved to disk as 'horse.bmp', which makes a thick-line contour (like a coloring book outline) and saves it as 'horse_contour_thick.bmp'.

--Quark

Code: Select all

'==============================================================================
'Contour_Line_Thick.bas - Quark - 2015.11.17
'Purpose: make thick contour line from solid graphic shape on white background
'Uses: horse.bmp  Saves: horse_contour_thick.bmp
'==============================================================================
CONST BLACK = RGB(&H00,&H00,&H00)
CONST WHITE = RGB(&HFF,&HFF,&HFF)
SCREENRES 640,480,32
DIM SHARED AS INTEGER w, h
SCREENINFO w,h
COLOR BLACK, WHITE
DIM horse AS ANY PTR = IMAGECREATE(640,480, WHITE, 32)
DIM contour AS ANY PTR = IMAGECREATE(640,480, WHITE, 32)
DIM AS STRING fname

WHILE LEN(INKEY) : WEND
BLOAD "horse.bmp",horse
PUT (0,0),horse,PSET 'show original
PRINT "Creating contour..."
SLEEP 2000

'SCAN 4 TIMES FOR THICK CONTOUR
FOR scan AS INTEGER = 1 TO 2
  IF scan = 2 THEN
    LINE horse, (0,0)-(639,479),WHITE,BF 'clear
    PUT horse,(0,0),contour,PSET
  END IF
  FOR i AS INTEGER = 0 TO h-1
    FOR j AS INTEGER = 1 TO w-1
      IF POINT(j,i,horse) <> POINT(j-1,i,horse) THEN
        IF scan = 1 THEN
          IF POINT(j,i,horse) = WHITE THEN
            PSET contour,(j-1,i),BLACK
          ELSE
            PSET contour,(j,i), BLACK
          END IF
        ELSE
          IF POINT(j,i,horse) = WHITE THEN PSET contour,(j-1,i),BLACK
          PSET contour,(j,i),BLACK
        END IF
      END IF
    NEXT
  NEXT
  SLEEP 100
  FOR j AS INTEGER = 0 TO w-1
    FOR i AS INTEGER = 1 TO h-1
      IF POINT(j,i,horse) <> POINT(j,i-1,horse) THEN
        IF scan = 1 THEN
          IF POINT(j,i,horse) = WHITE THEN
            PSET contour,(j,i-1),BLACK
          ELSE
            PSET contour,(j,i), BLACK
          END IF
        ELSE
          IF POINT(j,i,horse) = WHITE THEN PSET contour,(j,i-1),BLACK
          PSET contour,(j,i),BLACK
        END IF
      END IF
    NEXT
  NEXT
NEXT
'SAVE THICK CONTOUR IMAGE AND END
fname = "horse_contour_thick"
BSAVE fname, contour
PUT (0,0),contour, PSET 'show the contour
LOCATE 1,1
PRINT fname; " saved...any key"
SLEEP
END
'==============================================================================

.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 4 guests