Fonte/ Codesnippets | | | | | 
Nico
Madysa | Simulation eines Sternensystems. Ist die Masse einer Sonne gleich Null, so wird ein Planeten-Sonnensystem betrachtet, andernfalls ein Doppelstern mit Planet. Der Sonnenradius darf nicht Null sein. Programmiert mit XPSE und nativen Funktionen.
KompilierenMarkierenSeparieren {$cleq}
{Gravi
nproc Gravi
parameters gamma!,x1!,y1!,m1!,x2!,y2!,m2!
var r2! = sqr(x1! - x2!) + sqr(y1! - y2!)
case nnull(r2!) : return 0
return gamma! * m1! * m2! / r2! 0.0000000000667428 * m1! * m2! / r2!
endproc
{nnull
nproc nnull
parameters x!
case (fabs(x!) < 0.000001) : return 1
return 0
endproc
{nnnull
nproc nnnul
parameters x!
case (fabs(x!) < 0.000001) : return 0
return 1
endproc
{fabs
nproc fabs
parameters x!
case (x! < 0.0) : return (-1.0) * x!
return x!
endproc
{fif
nproc fif
parameters bed&, fthen!, felse!
case bed& : return fthen!
return felse!
endproc
{arctan
nproc arctan
parameters atan!
return (atan! + 0.43157974 * atan!*sqr(atan!)) / (1.0 + 0.76443945 * sqr(atan!) + 0.05831938 * sqr(sqr(atan!)))
}endproc
{arccos
nproc arccos
parameters acos!
case acos! = 1 : return 0
case acos! = -1 : return Pi()
return (Pi() / 2) - arctan(acos! / Sqrt(1 - Sqr(acos!)))
}endproc
{GetAngle
nproc GetAngle
parameters dx!,dy!
case (dx! * dy!) < 0.0000001 : return 0
case dy! <= 0 : return arccos(dx! / Sqrt(Sqr(dx!) + Sqr(dy!)))
return 2 * Pi() - arccos(dx! / Sqrt(Sqr(dx!) + Sqr(dy!)))
}endproc
{UseBrush
nproc useBrush
parameters t&,c&
if t&=0
SelectObject(memDC,GetStockObject(NULL_BRUSH))
elseif t&=1
SetDCBrushColor(memDC,c&)
SelectObject(memDC,GetStockObject(DC_BRUSH))
endif
endproc
{usePen
nproc usePen
parameters t&,w&,c&
if t&=5
SelectObject(memDC,GetStockObject(NULL_PEN))
elseif t&=0
SetDCPenColor(memDC,c&)
SelectObject(memDC,GetStockObject(DC_PEN))
endif
endproc
{Mal_es
nproc Mal_Es
parameters x1!,y1!,x2!,y2!,x3!,y3!
Luusch
UseBrush(1,$FFFFFF)
UsePen(5,0,0)
Rectangle(&memDC,0,0,640,480)
Körper
UseBrush(1,$FF)
Ellipse(&memDC,int(x1!)-10,int(y1!)-10,int(x1!)+10,int(y1!)+10)
Ellipse(&memDC,int(x2!)-10,int(y2!)-10,int(x2!)+10,int(y2!)+10)
UseBrush(1,0)
Ellipse(&memDC,int(x3!)- 5,int(y3!)- 5,int(x3!)+ 5,int(y3!)+ 5)
BitBlt(%hDC,0,0,640,480,&memDC,0,0,SRCCOPY)
endproc
{main
nproc main
parameters mx!,my!,gamma!,r1!,r2!,m1!,m2!,m3!,v1!,v3!
declare F12!,F13!,F23!,r12!,r13!,r23!
var s1_x! = mx! + r1!
var s1_y! = my!
var s1_m! = m1!
var s1_vx! = 0.0
var s1_vy! = 0.0 - v1!
var s2_x! = mx! - r1!
var s2_y! = my!
var s2_m! = m2!
var s2_vx! = 0.0
var s2_vy! = v1!
var s3_x! = mx! + r2!
var s3_y! = my!
var s3_m! = m3!
var s3_vx! = 0.0
var s3_vy! = 0.0 - v3!
Mal_es(s1_x!,s1_y!,s2_x!,s2_y!,s3_x!,s3_y!)
Sleep(1000)
while 1
F12! = Gravi(gamma!,s1_x!,s1_y!,s1_m!,s2_x!,s2_y!,s2_m!)
F13! = Gravi(gamma!,s1_x!,s1_y!,s1_m!,s3_x!,s3_y!,s3_m!)
F23! = Gravi(gamma!,s2_x!,s2_y!,s2_m!,s3_x!,s3_y!,s3_m!)
r12! = sqrt(sqr(s2_x! - s1_x!) + sqr(s2_y! - s1_y!))
r13! = sqrt(sqr(s3_x! - s1_x!) + sqr(s3_y! - s1_y!))
r23! = sqrt(sqr(s3_x! - s2_x!) + sqr(s3_y! - s2_y!))
if nnnul(s1_m!)
s1_vx! = s1_vx! + F12! / s1_m! * (s2_x! - s1_x!) / r12! + F13! / s1_m! * (s3_x! - s1_x!) / r13!
s1_vy! = s1_vy! + F12! / s1_m! * (s2_y! - s1_y!) / r12! + F13! / s1_m! * (s3_y! - s1_y!) / r13!
endif
if nnnul(s2_m!)
s2_vx! = s2_vx! + F12! / s2_m! * (s1_x! - s2_x!) / r12! + F23! / s2_m! * (s3_x! - s2_x!) / r23!
s2_vy! = s2_vy! + F12! / s2_m! * (s1_y! - s2_y!) / r12! + F23! / s2_m! * (s3_y! - s2_y!) / r23!
endif
if nnnul(s3_m!)
s3_vx! = s3_vx! + F13! / s3_m! * (s1_x! - s3_x!) / r13! + F23! / s3_m! * (s2_x! - s3_x!) / r23!
s3_vy! = s3_vy! + F13! / s3_m! * (s1_y! - s3_y!) / r13! + F23! / s3_m! * (s2_y! - s3_y!) / r23!
endif
s1_x! = s1_x! + s1_vx!
s1_y! = s1_y! + s1_vy!
s2_x! = s2_x! + s2_vx!
s2_y! = s2_y! + s2_vy!
s3_x! = s3_x! + s3_vx!
s3_y! = s3_y! + s3_vy!
Mal_es(s1_x!,s1_y!,s2_x!,s2_y!,s3_x!,s3_y!)
Sleep(100)
case GetASyncKeyState(13) : break
wend
endproc
declare e%
WindowTitle "Animation mit OK starten"
cls
MCls 640,480,$FFFFFF
var h& = Create("Dialog",%hWnd,"Parameter",5,5,210,240)
Create("Text",h&,"Gravitationskonstante:",5, 5,100,20)
Create("Text",h&,"Radius der Sonnen:" ,5, 25,100,20)
Create("Text",h&,"Masse Sonne 1:" ,5, 45,100,20)
Create("Text",h&,"Masse Sonne 2:" ,5, 65,100,20)
Create("Text",h&,"Sonnen-Geschw.:" ,5, 85,100,20)
Create("Text",h&,"Radius des Planeten:" ,5,105,100,20)
Create("Text",h&,"Masse des Planeten:" ,5,125,100,20)
Create("Text",h&,"Geschw. des Planeten:" ,5,145,100,20)
var h1& = Create("Edit",h&,"0.667428",105, 5,100,20)
var h2& = Create("Edit",h&,"33" ,105, 25,100,20)
var h3& = Create("Edit",h&,"10000" ,105, 45,100,20)
var h4& = Create("Edit",h&,"0" ,105, 65,100,20)
var h5& = Create("Edit",h&,"0" ,105, 85,100,20)
var h6& = Create("Edit",h&,"100" ,105,105,100,20)
var h7& = Create("Edit",h&,"50" ,105,125,100,20)
var h8& = Create("Edit",h&,"11" ,105,145,100,20)
var b& = Create("Button",h&,"OK",5,170,100,20)
var a& = Create("Button",h&,"Abbruch",105,170,200,20)
repeat
WindowTitle "Animation mit OK starten"
e% = 0
repeat
waitinput
case Clicked(b&) : e% = 1
case Clicked(a&) : e% = -1
until e%
case e% < 0 : break
SetFocus(%hWnd)
WindowTitle "Animation mit ENTER abbrechen"
main(320,240,val(GetText$(h1&)) , val(GetText$(h2&)),val(GetText$(h6&)) , val(GetText$(h3&)),val(GetText$(h4&)),val(GetText$(h7&)) , val(GetText$(h5&)),val(GetText$(h8&)))
until e% < 0
end
|
 | | | | | | |
| | 
Thomas
Zielinski | Nach einem Klick auf OK mit den Voreinstellungen hat sich das Programm gnadenlos aufgehangen. Ein Stück der Animation war ja noch zu sehn. aber nach einer halben drehung der Kugel und ein Klick in das Einstellungsfenster wars vorbei.
Saluto Thomas |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | Hast du Enter gedrückt? Das potrebbe wohl an den NProcs liegen. Wenn ich ins Fenster klicke, kommt zwar auch "Keine Rückmeldung", aber bei Druck auf Enter reagierts meist doch wieder.
Es sei denn, dein PC rechnet mit ner anderen Physik als meiner.  |
| | | | | | |
| |
Thomas
Zielinski | | Ah Okay. Mit Enter gehts dann wieder. Trotzdem ist noch ein winziges Anzeigeproblem |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | Das ist beabsichtigt. Das Programm soll nicht schick sein, sondern ein Doppelsternsystem simulieren. Daher ist auch der Dialog so hingeklatscht.  |
| | | | | | |
| |  | "Keine Rückmeldung" wird angezeigt, z.B. wenn ein Prozess voll unter Last ist und die WProc auch keine Zeit zum Antworten hat. Eigentlich ist immer "Keine Rückmeldung" ausserhalb von Waitinput - grob gesehen. Ein Sleep ändert nichts an "Keine Rückmeldung" - hier bliebe z.B. ein eigener Thread oder noch eher eine TimerProc, sodass die XProfan-WProc auch mal Zeit zum "antworten" hat.
Die Meldung "Keine Rückmeldung" heisst also absolut nicht, dass etwas abgestürzt ist oder nicht funktioniert - eigentlich nur das grad hart am Arbeiten ist. 
cls mit sleep 100000 gibt auch "keine Rückmeldung" wenn man die wProc versucht zu befragen z.B. mit lauter Klicks aufs hWnd. ^^ |
| | | | | | |
| |
Nico
Madysa | | Gut, dann sehe ich mal, ob ich einen Thread daraus machen kann. |
| | | | | | |
| | | Ginge jetzt sehr einfach sogar per Thread.Start [...]  . ^^ |
| | | | | | |
|
Zum QuelltextTopic-Options | 11.753 Views |
ThemeninformationenDieses Thema hat 3 subscriber: |
(824)
Deutsch
English
Français
Español
Italia