Kurvenlinie zeichnen - Wie?

[Dostej]

Hallo zusammen

Ich möchte ein Bild erstellen, das ungefähr so aussieht:



Die Wellenlinien sollte keinen knick haben, also mit anderen Worten die Bedingungen einer Funktion erfüllen (keine 2 y Punkte übereinander) (das bild hat ein paar Ecken in der Kurve, das sollte gerne gltt ineinander übergehen)
Die Anzahl der Peeks sollte ebenfalls einstellbar sein.

Hat jemand ne Idee, wie man das machen könnte?

Gibt es dazu ne bestimmt Formel oder einen Algo, der so was macht?

Thx schon mal

[STARGÅTE]

Wäre eine Überlagerung von Sin-Kurven zu einfach ?

Code: Alles auswählen

CreateImage(0, 512, 256)

Procedure.f Function(x)
 ProcedureReturn 50*Sin(x*0.03)+20*Cos(x*0.04)-30*Cos(x*0.05)+130
EndProcedure

StartDrawing(ImageOutput(0))
 DrawingMode(1)
 For x = 0 To 511
  LineXY(x, Function(x), x+1, Function(x+1))
 Next
StopDrawing()

OpenWindow(0, 0, 0, ImageWidth(0), ImageHeight(0), "Fenster", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
 ImageGadget(0,0,0,ImageWidth(0), ImageHeight(0), ImageID(0))

Repeat
 Event = WaitWindowEvent()
 Select Event
  Case #PB_Event_CloseWindow
   End
 EndSelect
ForEver

Es gibt dabei natürlich n art Berechnung, sodass du genau sagen kannst wie viele Peeks es geben soll,
dann gibts n Grund-Schwingung und mehrere nebenschwingungen die das ganze "chaos"-mäßig machen.

Oder du legst 4-10 Punkte fest, und interpolierst dann mit einer hoch-Gradigen Funktion, oder mehreren klein-Gradigen Funktionen.

[Kaeru Gaman]

du kannst auch mit einem "Lenkeinschlag"-wert arbeiten, also so eine art "steigung" für die kurve.
mit dieser steigung veränderst du den höhenwert, das ist was ganz anderes als wenn du den höhenwert direkt veränderst.

Code: Alles auswählen

    Procedure CreateLevel()
      ; *** Create Level ***
      Hi    = 7500
      Dir   = 0
      Turn  = 0
      count = 0
      While count < 10000
        Land(count) = 20 + Hi / 100
        Turn = (Random(25000)-Hi-5000)/666
        Dir + Turn
        If Dir >  100 : Dir =  100 : EndIf
        If Dir < -100 : Dir = -100 : EndIf
        Hi + Dir
        If Hi > 15000 : Hi = 15000 : EndIf
        If Hi <     0 : Hi =     0 : EndIf
        count + 1
      Wend
      Land(count) = 20 + Hi / 100
    EndProcedure

Dir ist die Direction, Turn ist die Veränderung der Direction, Hi ist der Höhenwert der von Direction verändert wird.
Turn erzeuge ich per Zufall, der verändert die Richtung, die die Höhe.
Direction ist auf das Intervall [-100|+100] festgelegt, das entspricht einer Steigung von 1 (45°), weil ich mit fixkomma1/100 arbeite.


angewendet habe ich diese Funktion in diesem Beispiel:
http://www.purebasic.fr/german/viewtopi ... 39#p136539

das ist leider noch für max. 4.31, also die Line-Funktion ist nicht umgestellt.

[Dostej]

Erst mal vielen Dank für die Hilfe

Die Funktion von Stargate zeichent genau das, was ich gesucht habe. Danke vielmals.

Die Funktion von Kaeru erscheint mir auch brauchbar, aber für das was ich brauche, etwas ungeeigneter. Trotzdem auch hier vielen Dank.

Bin mal gespannt was ich draus machen kann

[PureLust]

Hi Dostej,

als ich Dein Posting gelesen hatte, dachte ich eigentlich dass Du eine SPLINE-Funktion suchst.
Da es jedoch leider in PB keine solche Funktion gibt hab ich Dir dazu mal kurz was gemacht:

Code: Alles auswählen

; *****************************************************************
;  SPLINE-Demo = Zeichnet eine Spline-Kurve durch 4 Punkte
; *****************************************************************

#Aufloesung = 100.0

Procedure ParamTeil(*p1.Point, *p2.Point, fakt.f, *p.Point)
  *p\x = *p1\x + (fakt * (*p2\x - *p1\x))
  *p\y = *p1\y + (fakt * (*p2\y - *p1\y))
EndProcedure

Define x1.l, y1.l
Define.Point p1, p2, p3, p4, p12, p23, p34, p1223, p2334, p 
Width  = 640
Height = 400
p1\x = 10
p1\y = 360
p2\x = 200
p2\y = -10
p3\x = 400
p3\y = 480
p4\x = 600
p4\y = 20


InitSprite()
OpenWindow(0,0,0,Width,Height,"Spline")
OpenWindowedScreen(WindowID(0),0,0,Width,Height,0,0,0)
Repeat
	xold = p1\x
	yold = p1\y
	ClearScreen(0)
	For i = 1 To #Aufloesung
	  fa.f = i / #Aufloesung
	  ParamTeil(@p1, @p2, fa, @p12)
	  ParamTeil(@p2, @p3, fa, @p23)
	  ParamTeil(@p3, @p4, fa, @p34)
	  ParamTeil(@p12, @p23, fa, @p1223)
	  ParamTeil(@p23, @p34, fa, @p2334)
	  ParamTeil(@p1223, @p2334, fa, @p)
		If StartDrawing(ScreenOutput())
	 		LineXY(xold, yold, p\x, p\y,$ffff)
	  		xold = p\x
	  		yold = p\y
		  	StopDrawing()
		EndIf
	Next i
	p1\x + Random(6)-3
	p1\y + Random(6)-3
	p2\x + Random(6)-3
	p2\y + Random(6)-3
	p3\x + Random(6)-3
	p3\y + Random(6)-3
	p4\x + Random(6)-3
	p4\y + Random(6)-3
	Delay(1)
	FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE) 

Da Splines jedoch sehr komplex sind weiss ich nicht ob Du mit dem Code klar kommst und es selber schaffst ihn auf Deine Bedürfnisse an zu passen.
Aber vielleicht kriegst Du's ja doch hin und kannst was damit anfangen.

Wünsch Dir auf jeden Fall viel Erfolg.

Gruß, PL.

[Nachtrag:] Hab hier noch'n Beitrag mit Demo-Code bzgl. Splines gefunden.
Dabei ist die Spline-Funktion als Prozedur ausgeführt und dank flexibler Punktanzahl vielleicht besser für Deine Zwecke geeignet.
Also dann: FF, PL.

[PureLust]

Hi nochmal,

hab den ursprünglichen Code von Dennis noch mal ein wenig aufbereitet, so dass Du der Spline nun in Echtzeit neue Punkte hinzu fügen kannst und sie sofort neu gezeichnet wird:

Code: Alles auswählen

#SUBDIVS=40 
Structure Point2D 
x.w 
y.w 
EndStructure 

;---------Interpolating Splines----------- 

Procedure AbsLNG(a.l) 
  If a >> 31 
    a * -1 
  EndIf 
  ProcedureReturn a 
EndProcedure 


Procedure Mod(a, b) 
  Erg.l = a - a / b * b 
  If a >> 31 : Erg + AbsLNG(b) : EndIf 
  ProcedureReturn Erg 
EndProcedure 

Procedure.w InterpolateSpline (tTime.f,tpx1.f,tpy1.f,tpx2.f,tpy2.f,tpx3.f,tpy3.f,tpx4.f,tpy4.f) 
  
  Shared Final.Point2D 
  tTime2.f = tTime * tTime 
  tTime3.f = tTime2 * tTime 
  
  ;-------------------------------------------------- 
  tpOneX=  (-tpx1 + 3 * tpx2 - 3 * tpx3 + tpx4) * tTime3 
  tpOneY=  (-tpy1 + 3 * tpy2 - 3 * tpy3 + tpy4) * tTime3 
  
  ;-------------------------------------------------- 
  tpTwoX=  (2 * tpx1 - 5 * tpx2 + 4 * tpx3 - tpx4) * tTime2 
  tpTwoY=  (2 * tpy1 - 5 * tpy2 + 4 * tpy3 - tpy4) * tTime2 
  
  ;-------------------------------------------------- 
  tpThreeX=(-tpx1 + tpx3) * tTime 
  tpThreeY=(-tpy1 + tpy3) * tTime 
  
  ;-------------------------------------------------- 
  tpFourX= (2 * tpx2) 
  tpFourY= (2 * tpy2) 
  ;================================================== 
  
  Final\x=(tpOneX+tpTwoX+tpThreeX+tpFourX)/2 
  Final\y=(tpOneY+tpTwoY+tpThreeY+tpFourY)/2 
  
  ;-------------------------------------------------- 
    
EndProcedure 



InitSprite() 
InitKeyboard() 
InitMouse() 
ExamineDesktops()
If OpenScreen(DesktopWidth(0),DesktopHeight(0),16,"Cuttmull-Rom-Splines") 
    
   NewList PointList.Point2D() 
   CreateSprite(0,10,10) 
    
   StartDrawing(SpriteOutput(0)) 
    Circle(5,5,5,RGB(255,155,155)) 
   StopDrawing() 
    
    
   Repeat 
    ExamineKeyboard() 
    If ExamineMouse() 
      xm=MouseX() 
      ym=MouseY() 
      If MouseButton(1)<>0 
        AddElement(PointList()) 
        PointList()\x=xm 
        PointList()\y=ym 
      EndIf 
    EndIf 
    
   Repeat 
    ExamineMouse() 
   Until MouseButton(1)=0 
   FlipBuffers() 
   ClearScreen(RGB(0,0,0)) 
   StartDrawing(ScreenOutput()) 
    DrawingMode(1) 
    FrontColor(RGB(255,255,255)) 
   
   StopDrawing() 
   c=ListSize(PointList()) 
   FirstElement(PointList()) 
   For n=1 To c 
     StartDrawing(ScreenOutput()) 
     
      Circle(PointList()\x,PointList()\y,5,RGB(255,0,0)) 
     StopDrawing() 
     NextElement(PointList()) 
   Next 
    
   DisplaySprite(0,xm-5,ym-5) 
   Delay(1)
   If C>1 
   FirstElement(PointList()) 
   Dim p.Point2D(100) 
    
   For n=1 To C 
    
   p(n)\x=PointList()\x 
   p(n)\y=PointList()\y 
   NextElement(PointList()) 
   Next
   xold = -1000
   yold = -1000
   If StartDrawing(ScreenOutput()) 
	   For n=1 To C 
	    t0 = mod((n - 2 + C) , C + 1) 
	    t1 =  n 
	    t2 = Mod(n, C) + 1 
	    t3 = mod((n + 1),C) + 1 
	    
	    For m=1 To #SUBDIVS 
	      Time.f=(m-1.0)/#SUBDIVS 
	    InterpolateSpline(Time,p(t0)\x,p(t0)\y,p(t1)\x,p(t1)\y,p(t2)\x,p(t2)\y,p(t3)\x,p(t3)\y) 
	    If xold <> -1000 Or yold <> -1000
			LineXY(xold, yold, Final\x, Final\y, RGB(255,255,255)) 
	    EndIf
    	 xold = Final\x
    	 yold = Final\y
	    Next 
	   Next 
	   StopDrawing()
	EndIf
    
   ExamineKeyboard() 
   EndIf 
   Until KeyboardPushed(#PB_Key_Escape) 

EndIf

Hoffe Du kannst was damit anfangen und ihn für Deine Zwecke anpassen.

Gruß, Albert.

[Dostej]

Hm, also... erstmal ganz herzlichen Dank für die 2 Procs.

Die Funktion von Stargate ist vom Ergebnis her fast perfekt. Nur kriege ich es nicht hin, sie auf die Anzahl "gipfel" festzulegen, ohne das sie praktisch immer gleich aussieht.

Die Funktion mit den Mullroom-splines ist von daher besser (man kann einfacher die Höhe, die Anzahl der Gipfel und die Täler festlegen. soweit sehr praktisch. Nur das sie Kurve immer wieder geschlossen wird, das irritiert mich. Nebenbei muss ich sagen, kapier ich die Funktion nicht wirklich, das ich das ändern könnte.

Hm, Mist...

[STARGÅTE]

Sin und Cos sind nun mal Periodisch, damit du keine Periode mehr erkennen kannst, brauchst du unter umständen sehr viele Sind und Cos die eine andere Wellenlänge haben welche überlagert werden.

da sind die anderen Proceduren schon "zufälliger"

[PureLust]

Hi again, ...

Die Funktion mit den Mullroom-splines ist von daher besser (man kann einfacher die Höhe, die Anzahl der Gipfel und die Täler festlegen. soweit sehr praktisch. Nur das sie Kurve immer wieder geschlossen wird, das irritiert mich. Nebenbei muss ich sagen, kapier ich die Funktion nicht wirklich, das ich das ändern könnte.

Hab Dir die Routine nochmal ein wenig angepasst:
- Kurve wird nun nicht mehr geschlossen.
- Falls Du Dich mal verklickt hast oder Du mit dem Ergebnis mal nicht zufrieden bist, kannst Du nun immer den letzten Punkt mit "Backspace" löschen.
- Im Debug-Fenster werden Dir nun immer die aktuellen Werte Deiner Spline ausgegeben.

Wenn Du also nun eine Spline erstellt hast, die Dir gefällt, so brauchst Du Dir nun nur die Werte zu notieren und mit diesen dann später in Deinem eigenen Programm das p()-Array zu füllen um die gleiche Spline dann in Deinem Programm erzeugen zu können.
Um die Spline in Deinem eigenen Programm zu erstellen, benötigst Du von dem geposteten Code eigentlich nur die Struktur, die Prozeduren (also alles bis Zeile 51) sowie die Zeilen zwischen ;>>> und ;<<< (Zeile 122-139).
Zuvor wie gesagt noch das p()-Array erstellen (siehe Zeile 107) und mit den notierten Werten füllen (siehe oben).
Dann noch (bevor Du den Code aus Zeile 122-139 ausführt) in die Variable C die Anzahl der Punkte eintragen - das sollte schon alles sein (ohne Gewähr - da ungetestet).

Anbei mal der erweiterte Code auf den dann o.g. Änderungen sowie die genannten Zeilennummern zutreffen:

Code: Alles auswählen

#SUBDIVS=40 
Structure Point2D 
x.w 
y.w 
EndStructure 

;---------Interpolating Splines----------- 

Procedure AbsLNG(a.l) 
  If a >> 31 
    a * -1 
  EndIf 
  ProcedureReturn a 
EndProcedure 


Procedure Mod(a, b) 
  Erg.l = a - a / b * b 
  If a >> 31 : Erg + AbsLNG(b) : EndIf 
  ProcedureReturn Erg 
EndProcedure 

Procedure.w InterpolateSpline (tTime.f,tpx1.f,tpy1.f,tpx2.f,tpy2.f,tpx3.f,tpy3.f,tpx4.f,tpy4.f) 
  
  Shared Final.Point2D 
  tTime2.f = tTime * tTime 
  tTime3.f = tTime2 * tTime 
  
  ;-------------------------------------------------- 
  tpOneX=  (-tpx1 + 3 * tpx2 - 3 * tpx3 + tpx4) * tTime3 
  tpOneY=  (-tpy1 + 3 * tpy2 - 3 * tpy3 + tpy4) * tTime3 
  
  ;-------------------------------------------------- 
  tpTwoX=  (2 * tpx1 - 5 * tpx2 + 4 * tpx3 - tpx4) * tTime2 
  tpTwoY=  (2 * tpy1 - 5 * tpy2 + 4 * tpy3 - tpy4) * tTime2 
  
  ;-------------------------------------------------- 
  tpThreeX=(-tpx1 + tpx3) * tTime 
  tpThreeY=(-tpy1 + tpy3) * tTime 
  
  ;-------------------------------------------------- 
  tpFourX= (2 * tpx2) 
  tpFourY= (2 * tpy2) 
  ;================================================== 
  
  Final\x=(tpOneX+tpTwoX+tpThreeX+tpFourX)/2 
  Final\y=(tpOneY+tpTwoY+tpThreeY+tpFourY)/2 
  
  ;-------------------------------------------------- 
    
EndProcedure 



InitSprite() 
InitKeyboard() 
InitMouse() 
ExamineDesktops()
LastDebug = 2
OpenWindow(0,0,0,DesktopWidth(0),DesktopHeight(0),"Spline", #PB_Window_BorderLess)
If OpenWindowedScreen(WindowID(0),0,0,DesktopWidth(0),DesktopHeight(0),0,0,0) 
    
   NewList PointList.Point2D() 
   CreateSprite(0,10,10) 
    
   StartDrawing(SpriteOutput(0)) 
    Circle(5,5,5,RGB(255,155,155)) 
   StopDrawing() 
    
    
   Repeat 
    ExamineKeyboard() 
    If ExamineMouse() 
      xm=MouseX() 
      ym=MouseY() 
      If MouseButton(1)<>0 
        AddElement(PointList()) 
        PointList()\x=xm 
        PointList()\y=ym 
      EndIf 
    EndIf 
    
   Repeat 
    ExamineMouse() 
   Until MouseButton(1)=0 
   FlipBuffers() 
   ClearScreen(RGB(0,0,0)) 
   StartDrawing(ScreenOutput()) 
    DrawingMode(1) 
    FrontColor(RGB(255,255,255)) 
   
   StopDrawing() 
   c=ListSize(PointList()) 
   FirstElement(PointList()) 
   For n=1 To c 
     StartDrawing(ScreenOutput()) 
     
      Circle(PointList()\x,PointList()\y,5,RGB(255,0,0)) 
     StopDrawing() 
     NextElement(PointList()) 
   Next 
    
   DisplaySprite(0,xm-5,ym-5) 
   Delay(1)
   If C>1 
   FirstElement(PointList()) 
   Dim p.Point2D(100) 
   If c > LastDebug : Debug "" : Debug "Werte im p()-Array:" : EndIf
   For n=1 To C
   p(n)\x=PointList()\x 
   p(n)\y=PointList()\y
   If c > LastDebug
   	Debug "p("+Str(n)+")\x = "+Str(p(n)\x)+" ,  p("+Str(n)+")\y = "+Str(p(n)\y)
   EndIf
   NextElement(PointList()) 
   Next
  	LastDebug = c
   xold = -1000
   yold = -1000
   
	; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
   If StartDrawing(ScreenOutput()) 
      For n=1 To C-1
       t0 = mod((n - 2 + C) , C + 1) 
       t1 =  n 
       t2 = Mod(n, C) + 1 
       t3 = mod((n + 1),C) + 1 
       For m=1 To #SUBDIVS 
         Time.f=(m-1.0)/#SUBDIVS 
       InterpolateSpline(Time,p(t0)\x,p(t0)\y,p(t1)\x,p(t1)\y,p(t2)\x,p(t2)\y,p(t3)\x,p(t3)\y) 
       If xold <> -1000 Or yold <> -1000
         LineXY(xold, yold, Final\x, Final\y, RGB(255,255,255)) 
       EndIf
        xold = Final\x
        yold = Final\y
       Next 
      Next 
      StopDrawing()
   EndIf
	; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	    
   ExamineKeyboard() 
   EndIf
   If KeyboardPushed(#PB_Key_Back)
   	If c > 0
  		   LastElement(PointList())
			DeleteElement(PointList())
			LastDebug = -1
	   	Delay(200)
   	EndIf
   EndIf
   Until KeyboardPushed(#PB_Key_Escape) 

EndIf

Hoffe Du kannst damit was anfangen und kommst damit nun ein wenig weiter.

Gruß und viel Erfolg, PL.

[Dostej]

Cool.
Ganz herzlichen Dank. Perfekt. (Hätt ich vermutlich nie so hinbekommen)