nicht rekursive Flood-Fill Funktion

Übersicht

BlitzMax, BlitzMax NG

Codearchiv & Module

	klepto2 Betreff: nicht rekursive Flood-Fill Funktion	Sa, Okt 29, 2005 11:43 Antworten mit Zitat
Eine Routine, die ich von bb nach BMax portiert habe, nachdem ich von rekursiven Füll Routinen die Schnauze voll hatte. Ich hoffe sie nützt euch. Code: [AUSKLAPPEN] [EINKLAPPEN] 'Fill Routines ' Written By Paul Snart (Snarty) - Converted to BMax by klepto2 in Oct 2005 ' Oct 2001 ' RCol = RGB Color To Fill with ' Ax = X Start on Image To Fill ' Ay = Y Start on Image To Fill ' Image = Image To fill on Strict Type Point Global Point_List:TList Field x Field y Method New() If Point.Point_List = Null Then Point.Point_List = New TList Point.Point_List.Addlast(Self) End Method End Type Function FloodFill(RCol,ax,ay,Image:TPixmap) Local timeit=MilliSecs() Local BCol=Image.ReadPixel(ax,ay) Local ImW=Image.Width Local ImH=Image.Height If BCol<>RCol Local Hlt=-1 Local Hlb=-1 Local Hrt=-1 Local Hrb=-1 Local Entrys=1 Local FP:POINT = New Point Fp.x=ax Fp.y=ay Repeat FP:POINT=POINT(Point.Point_List.First()) Lx=Fp.x Rx=Fp.x+1 Local HitL=False Local HitR=False Hlt=-1 Hlb=-1 Hrt=-1 Hrb=-1 Repeat If Lx=>0 And HitL=False CColL=Image.ReadPixel(Lx,Fp.y) If CColL=BCol Image.WritePixel Lx,Fp.y,RCol If Fp.y>0 CColL=Image.ReadPixel(Lx,Fp.y-1) If CColL=BCol Hlt=Lx Else If Hlt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hlt Hlt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf EndIf If Fp.y<ImH-1 CColL=Image.ReadPixel(Lx,Fp.y+1) If CColL=BCol Hlb=Lx Else If Hlb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hlb Hlb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf EndIf Lx=Lx-1 Else HitL=True If Hlt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hlt Hlt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf If Hlb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hlb Hlb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf Else HitL=True If Hlt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hlt Hlt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf If Hlb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hlb Hlb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf If Rx<=ImW-1 And HitR=False CColR=Image.ReadPixel(Rx,Fp.y) If CColR=BCol Image.WritePixel Rx,Fp.y,RCol If Fp.y>0 CColR=Image.ReadPixel(Rx,Fp.y-1) If CColR=BCol Hrt=Rx Else If Hrt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hrt Hrt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf EndIf If Fp.y<ImH-1 CColR=Image.ReadPixel(Rx,Fp.y+1) If CColR=BCol Hrb=Rx Else If Hrb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hrb Hrb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf EndIf Rx=Rx+1 Else HitR=True If Hrt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hrt Hrt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf If Hrb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hrb Hrb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf Else HitR=True If Hrt<>-1 y=Fp.y-1 FP:POINT = New Point Fp.y=y Fp.x=Hrt Hrt=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf If Hrb<>-1 y=Fp.y+1 FP:POINT = New Point Fp.y=y Fp.x=Hrb Hrb=-1 FP:POINT = POINT(Point.Point_List.First()) Entrys=Entrys+1 EndIf EndIf Until (HitR=True And HitL=True) Or KeyHit(1) FP:POINT=POINT(Point.Point_List.First()) Point.Point_List.Remove(FP) Entrys=Entrys-1 Until Entrys=False Or KeyHit(1) EndIf mhit=False DebugLog (Float(MilliSecs()-TimeIt)/1000)+" seconds" End Function Graphics 800,600,0,-1 Local Test:TPixMAp = GrabPixmap(0,0,800,600) FLoodFill($FFff00ff,0,0,Test) DrawPixmap (Test,0,0) Flip WaitKey() Function DrawOutline(x1:Int, y1:Int, w1:Int, h1:Int,_b:Int = 1) DrawRect x1, y1, w1 - _B, _B DrawRect x1, y1, _B, h1 DrawRect x1 + w1 - _B, y1, _B, h1 DrawRect x1, y1 + h1, w1 , _B End Function
Matrix Screensaver Console Modul für BlitzMax KLPacker Modul für BlitzMax HomePage : http://www.brsoftware.de.vu

klepto2

Betreff: nicht rekursive Flood-Fill Funktion

Sa, Okt 29, 2005 11:43
Antworten mit Zitat

Eine Routine, die ich von bb nach BMax portiert habe, nachdem ich von rekursiven Füll Routinen die Schnauze voll hatte.

Ich hoffe sie nützt euch.

Code: [AUSKLAPPEN]

'Fill Routines
' Written By Paul Snart (Snarty) - Converted to BMax by klepto2 in Oct 2005
' Oct 2001

' RCol = RGB Color To Fill with
' Ax = X Start on Image To Fill
' Ay = Y Start on Image To Fill
' Image = Image To fill on

Strict

Type Point
Global Point_List:TList
Field x
Field y

Method New()
   If Point.Point_List = Null Then Point.Point_List = New TList
   Point.Point_List.Addlast(Self)
End Method

End Type

Function FloodFill(RCol,ax,ay,Image:TPixmap)

Local timeit=MilliSecs()

   Local BCol=Image.ReadPixel(ax,ay)
Local ImW=Image.Width
Local ImH=Image.Height

If BCol<>RCol

Local Hlt=-1
Local Hlb=-1
Local Hrt=-1
Local Hrb=-1
Local Entrys=1
Local FP:POINT = New Point
Fp.x=ax

Fp.y=ay
Repeat
FP:POINT=POINT(Point.Point_List.First())
Lx=Fp.x
Rx=Fp.x+1
Local HitL=False
   Local    HitR=False
Hlt=-1
      Hlb=-1
Hrt=-1
      Hrb=-1
Repeat
If Lx=>0 And HitL=False
CColL=Image.ReadPixel(Lx,Fp.y)
If CColL=BCol
Image.WritePixel Lx,Fp.y,RCol
If Fp.y>0
CColL=Image.ReadPixel(Lx,Fp.y-1)
If CColL=BCol
Hlt=Lx
Else
If Hlt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                           Fp.x=Hlt
Hlt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
EndIf
If Fp.y<ImH-1
CColL=Image.ReadPixel(Lx,Fp.y+1)
If CColL=BCol
Hlb=Lx
Else
If Hlb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
                           Fp.x=Hlb
Hlb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
EndIf
Lx=Lx-1
Else
HitL=True
If Hlt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                     Fp.x=Hlt
Hlt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
If Hlb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
                     Fp.x=Hlb
Hlb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
Else
HitL=True
If Hlt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                  Fp.x=Hlt
Hlt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
If Hlb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
                  Fp.x=Hlb
Hlb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
If Rx<=ImW-1 And HitR=False
CColR=Image.ReadPixel(Rx,Fp.y)
If CColR=BCol
Image.WritePixel Rx,Fp.y,RCol
If Fp.y>0
CColR=Image.ReadPixel(Rx,Fp.y-1)
If CColR=BCol
Hrt=Rx
Else
If Hrt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                           Fp.x=Hrt
Hrt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
EndIf
If Fp.y<ImH-1
CColR=Image.ReadPixel(Rx,Fp.y+1)
If CColR=BCol
Hrb=Rx
Else
If Hrb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
                           Fp.x=Hrb
Hrb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
EndIf
Rx=Rx+1
Else
HitR=True
If Hrt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                     Fp.x=Hrt
Hrt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
If Hrb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
                     Fp.x=Hrb
Hrb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
Else
HitR=True
If Hrt<>-1
y=Fp.y-1
FP:POINT = New Point
Fp.y=y
                     Fp.x=Hrt
Hrt=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
If Hrb<>-1
y=Fp.y+1
FP:POINT = New Point
Fp.y=y
               Fp.x=Hrb
Hrb=-1
FP:POINT = POINT(Point.Point_List.First())
Entrys=Entrys+1
EndIf
EndIf
Until (HitR=True And HitL=True) Or KeyHit(1)
FP:POINT=POINT(Point.Point_List.First())
Point.Point_List.Remove(FP)
Entrys=Entrys-1
Until Entrys=False Or KeyHit(1)
EndIf

mhit=False
DebugLog (Float(MilliSecs()-TimeIt)/1000)+" seconds"

End Function

Graphics 800,600,0,-1

Local Test:TPixMAp = GrabPixmap(0,0,800,600)

FLoodFill($FFff00ff,0,0,Test)

DrawPixmap (Test,0,0)

Flip

WaitKey()

Function DrawOutline(x1:Int, y1:Int, w1:Int, h1:Int,_b:Int = 1)
DrawRect x1, y1, w1 - _B, _B
DrawRect x1, y1, _B, h1
DrawRect x1 + w1 - _B, y1, _B, h1
DrawRect x1, y1 + h1, w1 , _B
End Function

Matrix Screensaver
Console Modul für BlitzMax
KLPacker Modul für BlitzMax

HomePage : http://www.brsoftware.de.vu