PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Linien-, Kreis- und Füllkreis Algorithmus

https://www.purebasic.fr/german/viewtopic.php?t=7831

Seite 1 von 1

Linien-, Kreis- und Füllkreis Algorithmus

Verfasst: 10.04.2006 21:47
von Ja!
Hab hier mal ein paar sehr nützliche und vielseitig einsetzbare
Algorythmen aus der Kategorie Lineare Interpolation übersetzt..
Ein kleines Beispiel was man mit dem Linienalgorythmus machen kann (ausser Linien zeichnen natürlich), habe ich noch dazugemacht.


Vielleicht kann ja mal jemand etwas damit anfangen. :)


Danke nochmal an Hades für die Hilfe beim Füllkreis ;)

Code: Alles auswählen

;
;########################### Lineare Interpolation ########################
;
;--------------------------- Der Linienalgorythmus ------------------------
;
;
;
;´06 Udo Kessler


InitSprite()
InitMouse()
InitKeyboard()

OpenWindow(0,0,0,640,480,#PB_Window_WindowCentered,"Linien-Algorythmus  -ESC zum beenden-")
OpenWindowedScreen(WindowID(),0,0,640,480,0,0,0)


Procedure Linie(x1.l,y1.l,x2.l,y2.l)

a.l
dx.l
dy.l
tmp.l
addval.l=1

If Abs(x2-x1) > Abs(y2-y1) ;winkel kleiner 45°..
  
  If x2 < x1 ;Achsen spiegeln?
   tmp=x1 : x1=x2 : x2=tmp
   tmp=y1 : y1=y2 : y2=tmp
  EndIf

  If y2 < y1
    y2=2*y1-y2
    addval=-1
  EndIf
  
  dy=2*(y2-y1)
  a=x2-x1
  dx=a+a
  
  StartDrawing(ScreenOutput())
    FrontColor(200,200,200)
    While x1 <= x2  
      Plot(x1,y1) 
      x1+1
      a=a-dy
      If a<=0
        a+dx
        y1+addval
      EndIf
    Wend
  StopDrawing()

  
Else ; winkel größer 45°
  If y1>y2 ;Achsen spiegeln?
    tmp=x1 : x1=x2 : x2=tmp
    tmp=y1 : y1=y2 : y2=tmp
  EndIf
  
  If x2<x1
    x2=2*x1-x2
    addval=-1
  EndIf
  
  dy=2*(x2-x1)
  a=y2-y1
  dx=a+a

  StartDrawing(ScreenOutput()) 
    FrontColor(200,200,200)
    While y1<=y2
      Plot(x1,y1)
      y1+1
      a-dy
      If a <= 0
        a+dx
        x1+addval
      EndIf
    Wend
  StopDrawing()

EndIf

EndProcedure



;#### Main Loop ##############
Repeat
ExamineKeyboard()
WindowEvent()

Linie(400,300,Random(639),Random(479))


FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Code: Alles auswählen

;
;########################### Lineare Interpolation ########################
;
;--------------------------- Der Kreisalgorythmus ------------------------
;
;
;
;´06 Udo Kessler


InitSprite()
InitMouse()
InitKeyboard()

OpenWindow(0,0,0,640,480,#PB_Window_WindowCentered,"Kreis-Algorythmus  -ESC zum beenden-")
OpenWindowedScreen(WindowID(),0,0,640,480,0,0,0)


Procedure kreis(xm.l, ym.l, radius.l)
zaehler.l = radius
y.l = radius
x.l = 0

StartDrawing(ScreenOutput())
 While y>=x
   
   If zaehler < 0
     y-1
     zaehler+y+y
   EndIf
   
  FrontColor(200,200,200)
  
  Plot(xm+x,ym-y)
  Plot(xm-x,ym-y)
  Plot(xm+x,ym+y)
  Plot(xm-x,ym+y)
  Plot(xm+y,ym-x)
  Plot(xm-y,ym-x)
  Plot(xm+y,ym+x)
  Plot(xm-y,ym+x)
  
  zaehler-(x+x+1)
  x+1
  
 Wend
StopDrawing()

EndProcedure



;######## -MainLoop- ##############
Repeat
ClearScreen(0,0,0)
ExamineKeyboard()
WindowEvent()

kreis(120,120,100)


FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Code: Alles auswählen

;
;########################### Lineare Interpolation ########################
;
;-------------------------- Der Füllkreisalgorythmus ------------------------
;
;
;
;´06 Udo Kessler


InitSprite()
InitMouse()
InitKeyboard()

OpenWindow(0,0,0,640,480,#PB_Window_WindowCentered,"FüllKreis-Algorythmus  -ESC zum beenden-")
OpenWindowedScreen(WindowID(),0,0,640,480,0,0,0)


Procedure fuellkreis(xm.l, ym.l, radius.l)
zaehler.l = radius
y.l = radius
x.l = 0

StartDrawing(ScreenOutput())
 FrontColor(200,200,200)
 While y >= x
  
  If zaehler < 0
      LineXY(xm-x,ym-y,xm+x,ym-y)
      LineXY(xm-x,ym+y,xm+x,ym+y)
      y-1
      zaehler+y+y
    EndIf
   
    LineXY(xm-y,ym-x,xm+y,ym-x)   
    LineXY(xm-y,ym+x,xm+y,ym+x)   
   
    zaehler-(x+x+1) 

    x+1
  
 Wend
StopDrawing()

EndProcedure



;######## -MainLoop- ##############
Repeat
ClearScreen(0,0,0)
ExamineKeyboard()
WindowEvent()

fuellkreis(200,200,150)


FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)



Hier noch ein Beispiel für den Linienalgo:

Code: Alles auswählen

InitSprite()
InitMouse()
InitKeyboard()


Global spiegel.l


#screen_width = 640
#screen_height = 480


Structure xy
 x.l
 y.l
EndStructure

start.xy
ziel.xy

NewList pfad.xy()


start\x = #screen_width/2
start\y = #screen_height/2



Procedure pathfinder(x1.l,y1.l,x2.l,y2.l)

a.l
dx.l
dy.l
tmp.l
addval.l=1

If Abs(x2-x1) > Abs(y2-y1) ;winkel kleiner 45°

  If x2 < x1 ;spiegeln?
   tmp=x1 : x1=x2 : x2=tmp
   tmp=y1 : y1=y2 : y2=tmp
   spiegel=1
  Else
   spiegel=0
  EndIf
 
  If y2 < y1
    y2=2*y1-y2
    addval=-1
  EndIf
 
  dy=2*(y2-y1)
  a=x2-x1
  dx=a+a
  
  While x1 <= x2  
    AddElement(pfad())
    pfad()\x=x1 : pfad()\y=y1 
    x1+1
    a=a-dy
    If a<=0
      a+dx
      y1+addval
    EndIf
  Wend

  
Else ;winkel größer 45°
spiegel=2
  If y1 > y2 ;spiegeln?
    tmp=x1 : x1=x2 : x2=tmp
    tmp=y1 : y1=y2 : y2=tmp
   spiegel=1
  Else
   spiegel=0
  EndIf
  
  If x2<x1
    x2=2*x1-x2
    addval=-1
  EndIf
  
  dy=2*(x2-x1)
  a=y2-y1
  dx=a+a
  
  While y1<=y2
    AddElement(pfad())
    pfad()\x=x1 : pfad()\y=y1
    y1+1
    a-dy
    If a <= 0
      a+dx
      x1+addval
    EndIf
  Wend

EndIf

EndProcedure



OpenWindow(0,0,0,#screen_width,#screen_height,#PB_Window_WindowCentered,"Pathfinder  Steuerung: Maus u linke M.taste  -ESC zum beenden-")
OpenWindowedScreen(WindowID(),0,0,#screen_width,#screen_height,0,0,0)


Repeat;#######################################################################
ClearScreen(0,0,0)
ExamineKeyboard()
ExamineMouse()


If MouseButton(1)
  ziel\x=MouseX() : ziel\y=MouseY()
  ClearList(pfad())
  pathfinder(start\x,start\y,ziel\x,ziel\y)
  If spiegel :   Else
    ResetList(pfad())
    NextElement(pfad())  
  EndIf
EndIf



 If CountList(pfad()) > 0
  start\x = pfad()\x
  start\y = pfad()\y
  DeleteElement(pfad(), 1)
 EndIf


StartDrawing(ScreenOutput()) : DrawingMode(1)
  FrontColor(90,90,200)
  Locate(10,10) : DrawText("Pfad: "+Str(CountList(pfad())))

  Line(MouseX()-5,MouseY(),11,0)
  Line(MouseX(),MouseY()-5,0,11)
  
  Circle(start\x,start\y,5)
  FrontColor(200,200,200) : DrawingMode(4)
  Circle(ziel\x,ziel\y,5)
   
  If ListIndex(pfad()) > -1
    *pointer = @pfad()
    ForEach pfad() : Plot(pfad()\x,pfad()\y) : Next
    ChangeCurrentElement(pfad(), *pointer)
  EndIf
StopDrawing()


FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)

Verfasst: 11.04.2006 12:18
von tranquil
Danke für den Source, kann sicher der eine oder andere noch was von lernen.

So nebenher als Tipp, Strukturen wie

Structure xy
x.l
y.l
EndStructure

musst net mehr extra erstellen. Hier hätte es die .POINT structure getan die PB gleich in seinen residents mitbringt. :D

Grüße
Mike

Verfasst: 11.04.2006 16:18
von Ja!
Gut zu wissen @ tranquil
Danke

Verfasst: 20.04.2006 15:16
von PureLust
Hi, ...

wirklich eine sehr interessante Umsetzung eines Kreisalgorythmus !!!

Nur Deinen Füllkreisalgorythmus solltest Du nochmals nachbessern, der bugged wenn mx und my nicht identisch sind.

Greetz, PureLust.

Verfasst: 20.04.2006 15:40
von Karl
Empfehle die Bezeichnung Algorithmus im Fenstertitel.

Verfasst: 20.04.2006 16:32
von Hades
PureLust hat geschrieben: Nur Deinen Füllkreisalgorythmus solltest Du nochmals nachbessern, der bugged wenn mx und my nicht identisch sind.
:oops: Das hab ich wohl verbockt. :oops:

Bitte ersetzen:

Code: Alles auswählen

    If zaehler < 0 
      LineXY(xm-x,ym-y,xm+x,ym-y) 
      LineXY(xm-x,ym+y,xm+x,ym+y) 
      y-1 
      zaehler+y+y 
    EndIf 
    
    LineXY(xm-y,ym-x,xm+y,ym-x)    ; die hier 
    LineXY(xm-y,ym+x,xm+y,ym+x)    ; waren falsch
    
    zaehler-(x+x+1)

Verfasst: 22.04.2006 09:41
von Ja!
Hades hat geschrieben: :oops: Das hab ich wohl verbockt. :oops:

Und oben habe ich Dir noch gedankt!! ;)

Habe es damals gar nicht mehr durchgeschaut, war nur froh, daß
es endlich funktioniert.
Hatte in den Tagen so viele Algorithmen durchgenommen, daß
ich vor lauter x und y nicht mehr wusste, wer ich bin :D
PureLust hat geschrieben: wirklich eine sehr interessante Umsetzung eines Kreisalgorythmus !!!
Die Algorithmen stammen noch aus einer Zeit, als es auf jeden Prozessortakt ankam, deshalb sind sie äusserst schnell, wenn nicht sogar die schnellsten.
Der Linienalgorythmus ist sogar noch etwas schneller (ich glaube 1 oder 2 Takte pro Loop) als der viel gelobte Bresenham-Algorythmus.
Dies gilt natürlich nur, wenn man die Algos mit ASM auskleidet.


Was micht wundert ist, daß wohl die meisten hier diese Algos
ziemlich aussergewöhnlich finden. Ich kenne das gar nicht anderst, zumindest nicht, wenn sie schnell sein sollen..

Verfasst: 22.04.2006 09:47
von Ja!
Karl hat geschrieben:Empfehle die Bezeichnung Algorithmus im Fenstertitel.
Was ist am momentanen Fenstertitel denn nicht ok?

Verfasst: 22.04.2006 10:28
von Kiffi
> Was ist am momentanen Fenstertitel denn nicht ok?

Algorithmus <> Algorythmus

Grüße ... Kiffi

P.S.: Bitte in Zukunft Doppelposts vermeiden. Man kann mit dem Edit-Button
seine eigenen Posts verändern.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de