PureBoard

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

Wellen wollen sich nicht so recht wellen

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

Seite 1 von 1

Wellen wollen sich nicht so recht wellen

Verfasst: 02.06.2005 19:21
von benpicco
Ich hab mal auf gutglück ein wellenprogramm geschrieben, aber warum wellt es nur realistiscge wellen wen es so wenige Teilchen gibt?
Irgendwie bin ich nicht so wirklich zufriedenn damit...

Code: Alles auswählen

;seltsamerweise sind die wellen realistischer, je niedriger die Details...
InitSprite()
InitKeyboard()
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #detail
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #start
  #aend
  #wellenlaenge
  #gleich
  #frame
EndEnumeration
Global detail.w
Global wasserspiegel.w
Global laenge.w
Global aend.w
Global x.w
Global warte.w
Global frame.b
frame=80
aend=20
laenge=40
wasserspiegel=200
detail=1000
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 290, 184, 600, 300,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "Welleneinstellungen")
    If CreateGadgetList(WindowID())
      TrackBarGadget(#detail, 110, 230, 390, 30, 41, 2000)
      TrackBarGadget(#aend, 110, 190, 390, 30, 0, 200)
      TrackBarGadget(#wellenlaenge, 110, 150, 390, 30, 0, 300)
      TrackBarGadget(#frame, 110, 110, 390, 30, 1, 127)
      TextGadget(#Text_0, 10, 230, 100, 20, "Wasserdetails:"+Str(detail))
      TextGadget(#Text_1, 10, 190, 100, 20, "Änderung:"+Str(aend))
      TextGadget(#Text_2, 10, 150, 100, 20, "Wellenlänge:"+Str(laenge))
      TextGadget(#Text_3, 10, 110, 110, 20, "Max FPS:" + Str(frame))
      ButtonGadget(#start, 500, 220, 80, 40, "Start")
      CheckBoxGadget(#gleich,10,70,180,20,"Wellenlänge=Änderung")
    EndIf
  EndIf
EndProcedure
Open_Window_0()
SetGadgetState(#detail,1000)
SetGadgetState(#aend,20)
SetGadgetState(#wellenlaenge,40)
SetGadgetState(#frame,frame)
1:
Repeat
  
  Event = WaitWindowEvent()
  
  If Event = #PB_EventGadget
    
    
       
    GadgetID = EventGadgetID()
    
    If GadgetID = #detail
      detail=GetGadgetState(#detail)
      SetGadgetText(#Text_0, "Wasserdetails:"+Str(detail))
    ElseIf GadgetID = #aend
      aend=GetGadgetState(#aend)
      SetGadgetText(#Text_1, "Änderung:"+Str(aend))
      If GetGadgetState(#gleich)=1
        laenge=GetGadgetState(#wellenlaenge)
        SetGadgetText(#Text_2, "Wellenlänge:"+Str(laenge))
        SetGadgetState(#wellenlaenge,aend)
      EndIf
    ElseIf GadgetID = #wellenlaenge
      laenge=GetGadgetState(#wellenlaenge)
      SetGadgetText(#Text_2, "Wellenlänge:"+Str(laenge))
      If GetGadgetState(#gleich)=1
        aend=GetGadgetState(#aend)
        SetGadgetText(#Text_1, "Änderung:"+Str(aend))
        SetGadgetState(#aend,laenge)
      EndIf
    ElseIf GadgetID =#frame
      frame=GetGadgetState(#frame)
      SetGadgetText(#Text_3,"Max FPS:"+Str(frame))  
    ElseIf GadgetID = #start
    aend=GetGadgetState(#aend)
    laenge=GetGadgetState(#wellenlaenge)
    detail=GetGadgetState(#detail)

      Goto start
      
    EndIf
    
  EndIf
  
Until Event = #PB_EventCloseWindow
End
start:
Dim TeilchenX(detail+1)
Dim TeilchenY(detail+1)
TeilchenY(detail+1)=wasserspiegel+10
TeilchenY(0)=wasserspiegel-10
For x=0 To detail+1
  TeilchenX(x)=Int(x*(1024/detail))
  TeilchenY(x)=wasserspiegel
Next
TeilchenX(1)=0

OpenScreen(1024,768,32,"wasser")

SetFrameRate(frame)
Repeat
ClearScreen(10,10,150)

If warte=0
  TeilchenY(detail-40)=wasserspiegel-aend
  TeilchenY(detail-20)=wasserspiegel+aend
  warte=laenge
EndIf
warte=warte-1
StartDrawing(ScreenOutput())
For x=1 To detail
  ;TeilchenY(x-1)=TeilchenY(x-1)+1
  Plot(TeilchenX(x),TeilchenY(x),RGB(0,0,255))
  If TeilchenY(x)>TeilchenY(x+1) Or TeilchenY(x)>TeilchenY(x-1); Ein Komma vor der Or ändert die wellenform
    TeilchenY(x)=TeilchenY(x)-1
  ElseIf TeilchenY(x)<TeilchenY(x+1) Or TeilchenY(x)<TeilchenY(x-1);dito
    TeilchenY(x)=TeilchenY(x)+1
  EndIf
  ;If TeilchenY(x) < Wasserspiegel ;Sieht nur bei niedrigen Details gut aus
   ; TeilchenY(x) = TeilchenY(x)+0.5
  ;ElseIf TeilchenY(x) > Wasserspiegel
  ;  TeilchenY(x) = TeilchenY(x)-0.4
  ;EndIf
  LineXY(TeilchenX(x), TeilchenY(x),TeilchenX(x+1), TeilchenY(x+1),RGB(0,0,255))
Next
DrawingMode(1)
FrontColor(0,0,0)
Locate(10,10)
DrawText("Warte:"+Str(warte))
StopDrawing()
FlipBuffers()
ExamineKeyboard()
Until KeyboardReleased(#pb_key_escape)
CloseScreen()
warte=0
Goto 1:

Verfasst: 02.06.2005 19:51
von Hroudtwolf
So gehts !

Code: Alles auswählen

;seltsamerweise sind die wellen realistischer, je niedriger die Details...
InitSprite()
InitKeyboard()
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #detail
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #start
  #aend
  #wellenlaenge
  #gleich
  #frame
EndEnumeration
Global detail.w
Global wasserspiegel.w
Global laenge.w
Global aend.w
Global x.w
Global warte.w
Global frame.b
frame=80
aend=20
laenge=40
wasserspiegel=200
detail=1000
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 290, 184, 600, 300,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "Welleneinstellungen")
    If CreateGadgetList(WindowID())
      TrackBarGadget(#detail, 110, 230, 390, 30, 41, 2000)
      TrackBarGadget(#aend, 110, 190, 390, 30, 0, 200)
      TrackBarGadget(#wellenlaenge, 110, 150, 390, 30, 0, 300)
      TrackBarGadget(#frame, 110, 110, 390, 30, 1, 127)
      TextGadget(#Text_0, 10, 230, 100, 20, "Wasserdetails:"+Str(detail))
      TextGadget(#Text_1, 10, 190, 100, 20, "Änderung:"+Str(aend))
      TextGadget(#Text_2, 10, 150, 100, 20, "Wellenlänge:"+Str(laenge))
      TextGadget(#Text_3, 10, 110, 110, 20, "Max FPS:" + Str(frame))
      ButtonGadget(#start, 500, 220, 80, 40, "Start")
      CheckBoxGadget(#gleich,10,70,180,20,"Wellenlänge=Änderung")
    EndIf
  EndIf
EndProcedure
Open_Window_0()
SetGadgetState(#detail,1000)
SetGadgetState(#aend,20)
SetGadgetState(#wellenlaenge,40)
SetGadgetState(#frame,frame)
1:
Repeat
 
  Event = WaitWindowEvent()
 
  If Event = #PB_EventGadget
   
   
       
    GadgetID = EventGadgetID()
   
    If GadgetID = #detail
      detail=GetGadgetState(#detail)
      SetGadgetText(#Text_0, "Wasserdetails:"+Str(detail))
    ElseIf GadgetID = #aend
      aend=GetGadgetState(#aend)
      SetGadgetText(#Text_1, "Änderung:"+Str(aend))
      If GetGadgetState(#gleich)=1
        laenge=GetGadgetState(#wellenlaenge)
        SetGadgetText(#Text_2, "Wellenlänge:"+Str(laenge))
        SetGadgetState(#wellenlaenge,aend)
      EndIf
    ElseIf GadgetID = #wellenlaenge
      laenge=GetGadgetState(#wellenlaenge)
      SetGadgetText(#Text_2, "Wellenlänge:"+Str(laenge))
      If GetGadgetState(#gleich)=1
        aend=GetGadgetState(#aend)
        SetGadgetText(#Text_1, "Änderung:"+Str(aend))
        SetGadgetState(#aend,laenge)
      EndIf
    ElseIf GadgetID =#frame
      frame=GetGadgetState(#frame)
      SetGadgetText(#Text_3,"Max FPS:"+Str(frame)) 
    ElseIf GadgetID = #start
    aend=GetGadgetState(#aend)
    laenge=GetGadgetState(#wellenlaenge)
    detail=GetGadgetState(#detail)

      Goto start
     
    EndIf
   
  EndIf
 
Until Event = #PB_EventCloseWindow
End
start:
Dim TeilchenX(detail+1)
Dim TeilchenY(detail+1)
TeilchenY(detail+1)=wasserspiegel+10
TeilchenY(0)=wasserspiegel-10
For x=0 To detail+1
  TeilchenX(x)=Int(x*(1024/detail))
  TeilchenY(x)=wasserspiegel
Next
TeilchenX(1)=0

OpenScreen(1024,768,32,"wasser")

SetFrameRate(frame)
Repeat
ClearScreen(10,10,150)

If warte=0
  TeilchenY(detail-40)=wasserspiegel-aend
  TeilchenY(detail-20)=wasserspiegel+aend
  warte=laenge
EndIf
warte=warte-1
StartDrawing(ScreenOutput())
For x=1 To detail
  ;TeilchenY(x-1)=TeilchenY(x-1)+1


;-------------------------------------------------------------------------
; geänderter Bereich
  If TeilchenX(x)>0 And TeilchenX(x)<1023 And TeilchenY(x)>0 And TeilchenY(x)<767
   Plot(TeilchenX(x),TeilchenY(x),RGB(0,0,255))
  EndIf 
;-------------------------------------------------------------------------


  If TeilchenY(x)>TeilchenY(x+1) Or TeilchenY(x)>TeilchenY(x-1); Ein Komma vor der Or ändert die wellenform
    TeilchenY(x)=TeilchenY(x)-1
  ElseIf TeilchenY(x)<TeilchenY(x+1) Or TeilchenY(x)<TeilchenY(x-1);dito
    TeilchenY(x)=TeilchenY(x)+1
  EndIf
  ;If TeilchenY(x) < Wasserspiegel ;Sieht nur bei niedrigen Details gut aus
   ; TeilchenY(x) = TeilchenY(x)+0.5
  ;ElseIf TeilchenY(x) > Wasserspiegel
  ;  TeilchenY(x) = TeilchenY(x)-0.4
  ;EndIf
  LineXY(TeilchenX(x), TeilchenY(x),TeilchenX(x+1), TeilchenY(x+1),RGB(0,0,255))
Next
DrawingMode(1)
FrontColor(0,0,0)
Locate(10,10)
DrawText("Warte:"+Str(warte))
StopDrawing()
FlipBuffers()
ExamineKeyboard()
Until KeyboardReleased(#pb_key_escape)
CloseScreen()
warte=0
Goto 1:

Verfasst: 02.06.2005 23:30
von NicTheQuick
Was soll das darstellen?

Verfasst: 02.06.2005 23:39
von Deeem2031
Steht doch in der Überschrift: Wellen.
Aber Hroudtwolfs Ergebnis sieht irgendwie nicht richtig aus..

Verfasst: 03.06.2005 00:31
von Hroudtwolf
Ich hab nur die Fehlerquelle beseitigt.

Für das Prinzip ist der Autor verantwortlich.

Verfasst: 03.06.2005 13:37
von benpicco

Code: Alles auswählen

;------------------------------------------------------------------------- 
; geänderter Bereich 
  If TeilchenX(x)>0 And TeilchenX(x)<1023 And TeilchenY(x)>0 And TeilchenY(x)<767 
   Plot(TeilchenX(x),TeilchenY(x),RGB(0,0,255)) 
  EndIf 
;-------------------------------------------------------------------------
Ich seh da keinen Unterschied, die if bedingung trifft doch immer zu.
Ich hab mehr die Wellenform gemeint, es gibt doch keine Fehler, das aussehen ist nur nicht realistisch.[/list]

Verfasst: 03.06.2005 13:50
von DarkDragon
benpicco hat geschrieben:

Code: Alles auswählen

;------------------------------------------------------------------------- 
; geänderter Bereich 
  If TeilchenX(x)>0 And TeilchenX(x)<1023 And TeilchenY(x)>0 And TeilchenY(x)<767 
   Plot(TeilchenX(x),TeilchenY(x),RGB(0,0,255)) 
  EndIf 
;-------------------------------------------------------------------------
Ich seh da keinen Unterschied, die if bedingung trifft doch immer zu.
Ich hab mehr die Wellenform gemeint, es gibt doch keine Fehler, das aussehen ist nur nicht realistisch.[/list]
Nein nicht immer, schau mal in den Debugger Error: "Plot outside of drawing area"

Verfasst: 03.06.2005 14:36
von Hroudtwolf
Zur Belehrung:

Erst Debugger benutzen, dann Code posten.
Das gleiche gilt für das Veröffentlichen von Programmen.

Verfasst: 03.06.2005 20:01
von benpicco
Da ich die demo benutze ist der debugger immer an, aber ich habe die maximale Änderung aus 200 festgelegt, da kann kein Plot aus dem bild raus!
Eigentlich wollte ich wissen, wie man die Wellen realistische gestalten kann, es liegt ja daran, das man alle plots gleichzeiti abfragen muss, naja, ich hab mir schon überlegt, wie ich´s jetzt mach, aber danke trotzdem, sonst hätte ich mich villeicht irgendwann mal gewundert warum es zu Fehlern bei Plots auserhalb des Bildschirms kommt :wink:

Verfasst: 03.06.2005 20:07
von Hroudtwolf
Schau mal was der liebe Rob da Feines in der Vergangeheit gemacht hat.
Ich glaube das sollte dir bei deinem Problem ein wenig weiterhelfen.

Code: Alles auswählen

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=2515&highlight=
; Author: Rob
; Date: 09. October 2003

; Bezier-Kurven Funktion:
; Im Beispiel: Mit der Maus die Punkte bewegen, mit der linken Maustaste den aktiven Punkt ändern. 

cw = RGB(255,255,255) 
cr = RGB(255,0,0) 

Procedure bezier(x1,y1,x2,y2,x3,y3,x4,y4,color) 
  oldx=x1 
  oldy=y1 
  cx.f=3*(x2-x1) 
  bx.f=3*(x3-x2)-cx 
  ax.f=x4-x1-cx-bx 
  cy.f=3*(y2-y1) 
  by.f=3*(y3-y2)-cy 
  ay.f=y4-y1-cy-by 
  While i.f < 1 
    i+0.05 
    x=((ax*i+bx)*i+cx)*i+x1 
    y=((ay*i+by)*i+cy)*i+y1 
    If i>0: LineXY(oldx,oldy,x,y,color) : EndIf 
    oldx=x 
    oldy=y 
  Wend 
EndProcedure 

InitSprite() 
InitKeyboard() 
InitMouse() 

OpenScreen(640,480,16,"Bezier") 

x1=0 : y1=0 
x2=640 : y2=0 
x3=0 : y3=480 
x4=640 : y4=480 

key = 1 

Repeat 
  ExamineKeyboard() 
  ExamineMouse() 
  
  ; Punkt wechseln 
  If MouseButton(1) And mousepush=0 ; Punkte rotieren: 1-4 
    key = (key % 4) + 1 
    If key=1 : MouseLocate(x1,y1) : EndIf 
    If key=2 : MouseLocate(x2,y2) : EndIf 
    If key=3 : MouseLocate(x3,y3) : EndIf 
    If key=4 : MouseLocate(x4,y4) : EndIf 
  EndIf 
  mousepush=MouseButton(1) 

  StartDrawing(ScreenOutput()) 
  DrawingMode(4) 
  ; Punkte zeichnen 
  If key=1 : x1=MouseX() : y1=MouseY() : Circle(x1,y1,5,cr) : Else : Circle(x1,y1,5,cw) : EndIf 
  If key=2 : x2=MouseX() : y2=MouseY() : Circle(x2,y2,5,cr) : Else : Circle(x2,y2,5,cw) : EndIf 
  If key=3 : x3=MouseX() : y3=MouseY() : Circle(x3,y3,5,cr) : Else : Circle(x3,y3,5,cw) : EndIf 
  If key=4 : x4=MouseX() : y4=MouseY() : Circle(x4,y4,5,cr) : Else : Circle(x4,y4,5,cw) : EndIf 
  
  ; Bezierkurve zeichnen 
  bezier(x1,y1,x2,y2,x3,y3,x4,y4,cw) 

  StopDrawing() 
    
  FlipBuffers() 
  ClearScreen(0,0,0) 
Until KeyboardPushed(1)
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de