Füllen

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

 

Steffen

Betreff: Füllen

 BeitragSo, Dez 14, 2003 12:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab mich gewundert, dass es im engl. Codearchiv keine rekursive Füllfunktion gibt, weil es eigentlich schneller sein sollte, als jeden Punkt in einem Type zu speichern. Aber einen Nachteil gibt es: Bei größeren Flächen gibt´s ein 'stack overflow'. Wenn es noch schneller geht, dann lasst mich bitte nicht dumm sterben.

Code: [AUSKLAPPEN]
Graphics 640, 480, 32, 2
rgbalt% = 0
rgbneu% = 255*$10000 + 100*$100 + 50
Color 255, 255, 255
Oval 0, 0, 200, 200, 0
WaitKey()
LockBuffer FrontBuffer()
fuellen_rekursiv(100, 100, FrontBuffer(), 640, 480, rgbalt%, rgbneu%)
UnlockBuffer FrontBuffer()
Flip
WaitKey()
End


Function fuellen_rekursiv(x%, y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)   
   ;x%, y% -> Koordinaten des Pixels
   ;buffer% -> Identität des Buffers, in dem gearbeitet wird
   ;breite%, hoehe% -> Größe des Buffers
   ;rgbalt% -> RGB-Wert der Farbe, die geändert werden soll
   ;rgbneu% -> RGB-Wert der Farbe, die das Pixel annehmen soll
   ;      => rgb = r*$10000 + g*$100 + b
   If (ReadPixelFast(x%, y%, buffer%)And $FFFFFF)=rgbalt% Then
      WritePixelFast(x%, y%, rgbneu%, buffer%)
      If (x% + 1)<breite% Then fuellen_rekursiv((x% + 1), y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (x% - 1)>=0 Then fuellen_rekursiv((x% - 1), y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (y% + 1)<hoehe% Then fuellen_rekursiv(x%, (y% + 1), buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (y% - 1)>=0 Then fuellen_rekursiv(x%, (y% - 1), buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
   EndIf
End Function


Edit: Wahrscheinlich geht es mit dem Hack und ASM noch schneller.
 

Xyanta

 BeitragSo, Dez 21, 2003 21:12
Antworten mit Zitat
Benutzer-Profile anzeigen
Jetzt nochmal auf Deutsch. Bei deinem Geschwafel versteht man doch überhaupt nichts. Versuch mal sachlich zu sein. Vielleicht kann ich dir helfen!!!

War nicht bös gemeint( Rolling Eyes )

Valio

 BeitragSo, Dez 21, 2003 21:19
Antworten mit Zitat
Benutzer-Profile anzeigen
Also eigentlich ist das Deutsch...wenn du nix von dem verstehst, was er sagt (in Verbindung des Sourcecodes noch), wirst du ihm wohl auch kaum helfen können...

EDIT: Damit du nicht meckerst. Das konkrete Problem ist eine Fläche mit einer Farbe auszufüllen, ähnlich wie die Funktion in Windows Paint.
Programming today is a race between software engineers striving to build better and bigger idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far, the Universe is winning. - Rick Cook
Gegen TCPA || Stoppt RFID || Tux user #361946 || User posted image
 

Alu-Folie

Gast

BeitragMo, Dez 22, 2003 0:06
Antworten mit Zitat
Ist nett. Es hat doch im alten Forum jemand an einem kleinen Paint gearbeitet. Naja, auch egal...

@Xyanta: Wenn du keine Ahnung hast, von dem was du sagst dann:

Wenn man keine Ahnung hat - Einfach mal die Fresse halten

Ich vermisses Divis Avatar

DC

Sieger des B2D Retro Wettbewerb / Aug 04

BeitragMo, Dez 22, 2003 11:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Hmm nunja.. schön.. aber bringt einem wegen dem besagten overflow nichts, wenn man nicht ausschließen kann, das die Flächen die man füllen will zu groß für die Function sind. Und kleinere Flächen sind auch mit Füllfunktionen die Types verwenden schnell gefüllt.. also imho nicht so unheimlich sinvoll Wink
Core i5 4670K | 4 x 3,40 GHZ | 16 GB Ram | GeForce GTX 960 | HTC Vive | Win 10 Pro
www.UnrealSoftware.de | www.StrandedOnline.de | www.CS2D.com |
www.CarnageContest.com | www.Stranded3.com

Travis

 BeitragMo, Dez 22, 2003 12:23
Antworten mit Zitat
Benutzer-Profile anzeigen
Nicht übel. Das hat mich auf die Idee gebracht, auch mal eine Funktion zu entwickeln, die gefüllte Kreise zeichnet. Ist natürlich mit Steffen's Werk nicht zu vergleichen, dafür aber vielleicht einfacher nachvollziehbar und sau schnell!

Code: [AUSKLAPPEN]

; Kreisfunktion

Graphics 640, 480, 16, 2
AppTitle "Kreisfunktion"

Print "Press any key to start"
WaitKey

Start = MilliSecs()
 Kreis(320,240,100,1,255,0,0) ; Kreis(X, Y, Radius, Füllung, r,g,b)
Zeit = MilliSecs() - Start

Color 255,255,255
Print "Benötigte Zeit: " + Zeit + "ms"

WaitKey
End


Function Kreis(PosX, PosY, Radius, Fill, r, g, b)

 LockBuffer FrontBuffer() 
  If Fill = 0
   For grad# = 0 To 360 Step .05
    x = ((Sin (grad#) * radius) + PosX)
    y = ((Cos (grad#) * radius) + PosY)
    WritePixelFast x, y, a*$1000000 + r*$10000 + g*$100 + b
   Next
  EndIf

  If Fill = 1 Then
   For rad = radius To 0 Step -1
    For grad# = 0 To 360 Step .3
     x = ((Sin (grad#) * rad) + PosX)
     y = ((Cos (grad#) * rad) + PosY)   
     WritePixelFast x, y, a*$1000000 + r*$10000 + g*$100 + b
    Next
   Next
  EndIf
 UnlockBuffer FrontBuffer()

End Function
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.
 

HOT-BIT

Gast

BeitragDo, Jan 15, 2004 0:39
Antworten mit Zitat
Hmmm...

Einfacher wäre aber, wenn du einfach Oval nimmst, denn dann würdest statt der 20 ms nur 1 ms brauchen !

Toni

Travis

 BeitragDo, Jan 15, 2004 14:39
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja sicher, aber wo bleibt denn da die Herausforderung? Very Happy Außerdem habe ich es damit mal geschafft unter ganz bestimmten Bedingungen einen unausgefüllten Kreis schneller zu malen als mit Oval.
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.
 

HOT-BIT (alter Account)

Gast

BeitragDo, Jan 15, 2004 15:59
Antworten mit Zitat
Hallo !

Naja, die Herausforderung.....

Vielleicht ist das eine ?

Hier wird ein Kreis in rot gezeichnet.
Dieser soll mit blau gefüllt werden.

Dies ist eine rekursive Routine.
Sollte aber bis 300*300 Pixel ohne Probleme funktionieren !
Nicht so wie das erste Prog oben.

Diese Routine ist schneller, als die mit den Types.

Mit BB2d könnte es sein, daß die Farbwerte nur 3 Byte haben.
Also da bei AlteFarbe und NeueFarbe die ersten 2 "FF" weglassen.
Da gibt es ja keinen Alpha-Wert.


Code: [AUSKLAPPEN]

;
;
; FloodFill-Routine by HOT-BIT, Knafl Anton
;
;
Graphics 800,600,32
SeedRnd MilliSecs()

Global x1,y1,NeueFarbe,AlteFarbe
Global xstart,xend,ystart,yend

xstart=100
xend=400
ystart=100
yend=400

NeueFarbe=$ff0000ff
AlteFarbe=$ffff0000

While Not KeyHit(1)

  Cls
  Color 255,0,0
  Oval 100,100,Rand(100,300),Rand(100,300),1
  Color 255,255,0
  Rect 200,90,Rand(10,60),Rand(100,400)
  h#=MilliSecs()
   LockBuffer FrontBuffer()
     Flood_Fill_Now 150,150,AlteFarbe,NeueFarbe
   UnlockBuffer FrontBuffer()
  Text 100,500,MilliSecs()-h+" ms"
  Delay 1000

Wend

WaitKey
End


Function Flood_Fill_Now (Xpos,Ypos,AlteFarbe,NeueFarbe)
     LeftX=Xpos
     RightX=Xpos
     WritePixel Xpos,Ypos,NeueFarbe
     While (LeftX>xstart)
       rgb=ReadPixel(LeftX-1,Ypos)
       If rgb=AlteFarbe LeftX=LeftX-1 WritePixel LeftX,Ypos,NeueFarbe Else Exit
     Wend

     While (RightX<xend)
        rgb=ReadPixel(RightX+1,Ypos) 
        If rgb=AlteFarbe RightX=RightX+1 WritePixel RightX,Ypos,NeueFarbe Else Exit
     Wend

    If Ypos>ystart Then
        For i=LeftX To RightX
          rgb=ReadPixel(i,Ypos-1)
          If rgb=AlteFarbe Flood_Fill_Now i,Ypos-1,AlteFarbe,NeueFarbe
        Next
    End If

    If Ypos<yend Then
        For i=LeftX To RightX
          rgb=ReadPixel(i,Ypos+1)
          If rgb=AlteFarbe Flood_Fill_Now i, Ypos+1,AlteFarbe,NeueFarbe
        Next
    End If
End Function

Mr.Keks

 BeitragDo, Jan 15, 2004 20:12
Antworten mit Zitat
Benutzer-Profile anzeigen
die kreisfunktion ist bei mir so ca. 10mal schneller... dabei benutze ich ein noch simplereres verfahren Smile
Code: [AUSKLAPPEN]

Function Kreis(PosX, PosY, Radius, Fill, r, g, b)
 
 col = a*$1000000 + r*$10000 + g*$100 + b
 LockBuffer
  If Fill = 0
   For grad# = 0 To 360 Step .05
    x = ((Sin (grad#) * radius) + PosX)
    y = ((Cos (grad#) * radius) + PosY)
    WritePixelFast x, y, col
   Next
  Else
   xs = posx-radius
   ys = posy-radius
   x = xs
   For x = xs To posx
      lin = 0
      t2 = (posx-x)*(posx-x)
      For y = ys To posy
         Lin = lin +1
         If Sqr(t2+(posy-y)*(posy-y)) <= radius
            WritePixelFast x, y, col
            WritePixelFast posx*2-x, y, col
            t1 = radius*2+ys-lin
            WritePixelFast x,t1, col
            WritePixelFast posx*2-x,t1, col
         EndIf
      Next   
   Next
   EndIf
 UnlockBuffer

End Function
MrKeks.net
 

tasky

 BeitragDo, Jan 15, 2004 21:04
Antworten mit Zitat
Benutzer-Profile anzeigen
Stichwort: Bresenham

Code: [AUSKLAPPEN]

Function cirlce(x, y, rad, r, g, b)
   Local col = (r Shl 16) Or (g Shl 8) Or b
   Local xi
   Local yi = rad
   Local e = 3 - (rad Shl 1)
   Local ye = (y - 1) * 4

   LockBuffer
   While xi <= yi
      WritePixelFast x + xi, y + yi, col
      WritePixelFast x - xi, y + yi, col
      WritePixelFast x + xi, y - yi, col
      WritePixelFast x - xi, y - yi, col
      WritePixelFast x + yi, y + xi, col
      WritePixelFast x - yi, y + xi, col
      WritePixelFast x + yi, y - xi, col
      WritePixelFast x - yi, y - xi, col
      
      xi = xi + 1
      If e < 0
         e = e + 2 + (xi Shl 2)
      Else
         e = e + 2 + (xi Shl 2) - ((yi - 1) Shl 2)
         yi = yi - 1
      End If
   Wend
   UnlockBuffer
End Function

Function fillcircle(x, y, rad, r, g, b)
   Local col = (r Shl 16) Or (g Shl 8) Or b
   Local xi
   Local yi = rad
   Local e = 3 - (rad Shl 1)
   Local ye = (y - 1) * 4

   While xi <= yi
      Rect x - xi, y + yi, xi Shl 1, 1
      Rect x - xi, y - yi, xi Shl 1, 1
      Rect x - yi, y + xi, yi Shl 1, 1
      Rect x - yi, y - xi, yi Shl 1, 1

      xi = xi + 1
      If e < 0
         e = e + 2 + (xi Shl 2)
      Else
         e = e + 2 + (xi Shl 2) - ((yi - 1) Shl 2)
         yi = yi - 1
      End If
    Wend
End Function
BlitzBasic 1.85 - BlitzPlus 1.37 - VC++ 6 - Delphi 7 - Haskell - FASM

Mr.Keks

 BeitragDo, Jan 15, 2004 21:13
Antworten mit Zitat
Benutzer-Profile anzeigen
kenne bresenham, finde es bei mir aber simpler. abgesehen davon ist dein code hier noch wesentlich langsamer ^^
MrKeks.net
 

tasky

 BeitragDo, Jan 15, 2004 22:55
Antworten mit Zitat
Benutzer-Profile anzeigen
Wie wärs mal mit gescheitem Testen.

Alleine schon, dass der Bresenhamalgo nur Additionen und Bitshiftings (= sehr schnell) besitzt, läst deinen Algo (SIN, COS, SQR = langsam, da Reihenentwicklung notwendig) alt aussehen. Ausserdem hat dein Algo einen Aufwand (in dem Schleifenteil) von n = radius ^ 2 (für fill = 1) und n = 360 / 0.05 = 7200 (für fill <> 1), wobei der Bresenham n <= radius hat.

Fazit:
- weniger Schleifendurchgänge
- keine Multiplikationen
- keine Floating-Point-Operationen bzw. Reihenentwicklung notwendig (die sind in SIN, COS und SQR enthalten)

Probiers doch mal mit der Kreisfunktion f(x) = Sqr(r ^ 2 - x ^ 2) Very Happy
BlitzBasic 1.85 - BlitzPlus 1.37 - VC++ 6 - Delphi 7 - Haskell - FASM

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group