Algorithmen Teil VII: Das andere Müllspiel!

Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

  • Abt. Mit Fernglas am Aussichtspunkt
    ========================
    Wie weit kann man auf der Erde von einem Punkt in Höhe h Meter (über Horizontal-Level) bis zur Kimmlinie - also wo Himmel und Meer bzw. Boden sich treffen - eigentlich sehen? Das nachfolgene Winzprogramm sagt es uns. Achtung: Eingabe in Metern, Ausdabe in km!

    Quellcode

    1. WindowTitle "Horizont-Entfernung"
    2. declare d!,r!,h!:font 2
    3. r!=6371 ' Durchschnittlicher Erdradius [km]
    4. lop:
    5. Cls
    6. print "\n Sichtlinie zum Horizont [km] berechnen:"
    7. print " =======================================\n"
    8. print "\n Augenhöhe über Horizonthöhe [m]: ";
    9. input h!:h!=h!/1000
    10. d!=sqrt(2*r!*h!+sqr(h!))
    11. print "\n Horizontentfernung: ";format$("###0.###",d!);" km"
    12. waitinput
    13. goto "lop"
    Alles anzeigen
    :santa: Gruss

    P.S.: Auch die Frage, wie weit UKW-Wellen (Ausbreitung entlang Sichtlinie) reichen, lässt sich damit klären: Sendeantennenhöhe über Horizont liefert Strecke a, Empfangsantennenhöhe Strecke b,
    die überbrückbare Distanz ist dann a + b [km]. Auch die Frage, wann die Mastspitze eines Segelbotes am Horizont auftaucht, ist so zu klären.
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. Kreis zeichnen durch zwei Umfangspunkte und Kreistangente in P1 zu Maus
    ====================================================
    Beim Bau möglichst kompakter Getriebe taucht manchmal das angesprochene Problem auf. Bei uns hier ist es zumindest eine nette geometrische Spielerei.
    :santa: Weihnachtsgruss!

    Quellcode

    1. Windowtitle "Kreis, definiert durch zwei Punkte und eine Tangente"
    2. '(CL) Copyleft P.Specht@gmx.at, Keine wie auch immer geartete Gewähr!
    3. 'xm=-(sin(a)*sqr(y2)-2*sin(a)*y1*y2-2*cos(a)*x1*y2+sin(a)*sqr(y1)+2*cos(a)*x1*y1\
    4. '+sin(a)*sqr(x2)-sin(a)*sqr(x1))/(2*(cos(a)*y2-cos(a)*y1-sin(a)*x2+sin(a)*x1))
    5. 'ym=1/tan(a)*(x1-xm)+y1 : r=sqrt(sqr(x1-xm)+sqr(y1-ym))
    6. Windowstyle 24:window (%maxx-680)/2,0-680,%maxy-40
    7. declare xm!,a!,sa!,y2!,y1!,x1!,ca!,x2!,ym!,xh!,yh!,dx!,dy!,ta!,r!
    8. declare mausx&,mausy&:UseFont "Arial",15,9,1,0,0
    9. Textcolor rgb(0,0,0),-1:usebrush 0,rgb(255,255,255)
    10. x1!=150:y1!=150 'P1
    11. a!=-10/180*pi() 'absoluter Tangentenwinkel
    12. x2!=400:y2!=300 'P2
    13. xh!=(x1!+x2!)/2:yh!=(y1!+y2!)/2
    14. lup:
    15. xm!=-(sin(a!)*sqr(y2!)-2*sin(a!)*y1!*y2!-2*cos(a!)*x1!*y2!+sin(a!)*sqr(y1!)+2*cos(a!)*x1!*y1!\
    16. +sin(a!)*sqr(x2!)-sin(a!)*sqr(x1!))/(2*(cos(a!)*y2!-cos(a!)*y1!-sin(a!)*x2!+sin(a!)*x1!))
    17. case a!<>0:ym!=cos(a!)/sin(a!)*(x1!-xm!)+y1!
    18. r!=sqrt(sqr(x1!-xm!)+sqr(y1!-ym!))
    19. cls
    20. print "Kreis, definiert durch zwei Punkte und eine Tangente"
    21. usepen 0,3,rgb(255,0,0)
    22. ellipse xm!+r!,ym!+r! - xm!-r!,ym!-r!
    23. usepen 0,11,255:line x1!,y1!-x1!+1,y1!:line x2!,y2!-x2!+1,y2!:line xm!,ym! - xm!+1,ym!
    24. usepen 0,8,0:line xh!,yh! - xh!+1,yh!
    25. usepen 1,1,0:line x1!,y1! - x2!,y2!
    26. usepen 1,1,rgb(0,0,255):line xh!,yh! - xm!,ym!:line x1!,y1! - xm!,ym!
    27. usepen 2,1,rgb(0,0,255):line mausx&,mausy&-x1!,y1!
    28. drawtext x1!,y1!-22,"P1":drawtext x2!,y2!-22,"P2"
    29. drawtext xh!,yh!-22,"H":drawtext xm!,ym!-22,"M"
    30. waitinput 333:mausx&=%mousex:mausy&=%mousey:a!=0
    31. case mausx&-x1!:a!=arctan((mausy&-y1!)/(mausx&-x1!))
    32. goto "lup"
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. Schnelle Extremwertsuche in Floatingpoint-Arrays: "FindEdge reloaded"
    ================================================
    Assembler allein ist per se nicht immer das Allheilmittel, wenn es um Geschwindigkeit geht. Bei Simulationen, in denen große Matrizen eine Rolle spielen, kommt es eher auf gescheiten Einsatz guter Algorithmen und der jeweils verfügbaren Mittel unter Beachtung von Hardware- und Sytemeigenschaften an.
    So konnte die erforderliche Durchlaufzeit für ein Array von 40 Mio. Floatingpoint-Werten mit dem nachfolgenden Teil auf ein Zwanzigstel :!: gegenüber Versionen mit Stackverwendung gesenkt werden.

    Gruss
    P.S.: Weitere Beschleunigung erscheint z.B. durch SIMD-Befehle auf der XMM-Einheit sowie durch Parallelisierung auf mehrere Kerne möglich. Mal sehen ...

    Quellcode

    1. $MAKE CLEQ
    2. ' "Frabbing's FindEdge" reloaded: Minimal/Maximalwertsuche in großen FLoatingpoint-Arrays
    3. ' Ursprünglicher Quelltext von Frank Abbing (D), mit Änderungen durch Michael Wodrich (D)
    4. ' An aktuelle xpia/Profan/Jwasm-Version angepasst 2014-01-01 durch P. Specht (A).
    5. ' Democode, ohne jedwede Gewähr! Allfällige Rechte liegen bei den jeweiligen Inhabern.
    6. Window 0,0-%maxx,%maxy:font 0:set("decimals",18):declare c$,anzahl&,x&,y&,z&,text$,tim&,eax&
    7. cls $dcdcdc
    8. print "\n\n Sucht die höchste und die niedrigste Zahl aus einem Array mit Fließkommazahlen."
    9. Print "\n Anzahl gewünschte Fließkommazahlen im Array = _________"
    10. anzahl&=10 :frag:
    11. locate %csrlin-1,48:input c$:case c$>"":anzahl&=val(c$):casenot between(anzahl&,1,40000000):goto "frag"
    12. dec anzahl&:Declare Tabelle_1![anzahl&],Tabelle_2![2]
    13. Randomize 'Zufällige Fließkommazahlen generieren:
    14. Print "\n Erzeuge ";format$("###,###,###",Anzahl&+1);" Float-Zufallszahlen. ";
    15. tim&=&gettickcount
    16. 'Tabelle_1![]=(rnd(4294967295)*10^-8+rnd(1000000000)*10^-17)*10^(rnd(612)-306)
    17. Tabelle_1![]=(rnd(4294967295)*10^-8/9)*10^(rnd(612)-306)
    18. 'oder Rnd(100000)/1.09-50000
    19. sound 300,45
    20. Print " Testarray erstellt in ";format$("##,###,###,##0",int(&gettickcount-tim&));" ms."
    21. Print "\n Start Min- & Maxwertsuche ...\n"
    22. '4 Assemblerfunktions-Parameter: Adresse von Tabelle mit Floats, Adresse von Zieltabelle, Anzahl Floats, 0
    23. tim&=&gettickcount
    24. AsmStart FindEdge
    25. Parameters addr(Tabelle_1![0]),addr(Tabelle_2![0]), anzahl&, 0
    26. jmp weiter
    27. flo1 dq 0
    28. flo2 dq 0
    29. weiter:
    30. ;
    31. ; höchste Zahl ermitteln
    32. ;
    33. mov edx,para1
    34. mov ecx,para3
    35. lea ebx,flo1
    36. mov eax,[edx]
    37. mov [ebx],eax
    38. mov eax,[edx+4]
    39. mov [ebx+4],eax
    40. schleifei:
    41. lea ebx,flo2
    42. mov eax,[edx]
    43. mov [ebx],eax
    44. mov eax,[edx+4]
    45. mov [ebx+4],eax
    46. push ecx
    47. push edx
    48. fld flo2
    49. fcomp flo1
    50. fnstsw ax
    51. shr ah,1
    52. jc is_less
    53. is_more:
    54. pop edx
    55. pop ecx
    56. lea ebx,flo1
    57. mov eax,[edx]
    58. mov [ebx],eax
    59. mov eax,[edx+4]
    60. mov [ebx+4],eax
    61. jmp is_ready
    62. is_less:
    63. pop edx
    64. pop ecx
    65. is_ready:
    66. add edx,8
    67. sub ecx,1
    68. jne schleifei
    69. mov edx,para2
    70. lea ebx,flo1
    71. mov eax,[ebx]
    72. mov [edx],eax
    73. mov eax,[ebx+4]
    74. mov [edx+4],eax
    75. ;
    76. ; niedrigste Zahl ermitteln
    77. ;
    78. mov edx,para1
    79. mov ecx,para3
    80. lea ebx,flo1
    81. mov eax,[edx]
    82. mov [ebx],eax
    83. mov eax,[edx+4]
    84. mov [ebx+4],eax
    85. ;
    86. xschleifei:
    87. ;
    88. lea ebx,flo2
    89. mov eax,[edx]
    90. mov [ebx],eax
    91. mov eax,[edx+4]
    92. mov [ebx+4],eax
    93. push ecx
    94. push edx
    95. fld flo2
    96. fcomp flo1
    97. fnstsw ax
    98. shr ah,1
    99. jc xis_less
    100. xis_more:
    101. pop edx
    102. pop ecx
    103. jmp xis_ready
    104. xis_less:
    105. pop edx
    106. pop ecx
    107. lea ebx,flo1
    108. mov eax,[edx]
    109. mov [ebx],eax
    110. mov eax,[edx+4]
    111. mov [ebx+4],eax
    112. xis_ready:
    113. add edx,8
    114. sub ecx,1
    115. jne xschleifei
    116. ;
    117. mov edx,para2
    118. lea ebx,flo1
    119. mov eax,[ebx]
    120. mov [edx+8],eax
    121. mov eax,[ebx+4]
    122. mov [edx+12],eax
    123. mov eax,1
    124. AsmEnd (eax&)
    125. tim&=&gettickcount-tim&
    126. sound 600,45
    127. Whileloop 0,if((anzahl&+1)<25,anzahl&,24)
    128. Print " ";if((&Loop+1)<10," ","");int(&Loop+1);".";tab(11);lower$(format$("%g",Tabelle_1![&loop]))
    129. EndWhile
    130. case (anzahl&+1)>25: print " ...... usw. ...... "
    131. Print
    132. Print " Höchste Zahl aus dem Array =",lower$(format$("%g",Tabelle_2![0]))
    133. Print " Niedrigste Zahl aus den Array =",lower$(format$("%g",Tabelle_2![1]))
    134. Print " Laufzeit: ";format$("##,###,###,##0.0",tim&);" ms ";
    135. Print "\n\n Taste für Beenden! "
    136. WaitKey
    137. End
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Ergänzende Links zu Assembler-Tutorials und zugehörigen Programmierhilfen
    ================================================
    Specht's Zusammenstellung Adressierungsarten für Intel- und AMD-Prozessoren
    Specht's Praxistest zu den Adressierungsarten
    Downloadseite für ICZELIONs WinApi-Helper.chm.
    Allgemeine Einführung Assembler (pdf) Uni Marburg
    (Achtung: Befehl Quelle, Ziel ist gegenüber MASM verkehrte Arbeitsrichtung!)
    Grundgerüst für MASM-kompatible Assembler wie z.B. JWasm
    Assembler-Crashkurs Uni Magdeburg
    IT- und Assembler-Grundkurs für Schüler RWTH Aachen (pdf)
    Etwas älter: Win32 Assembly Coding Tutorial (deutsch)
    Assembly Language Tutorial auf Friendsspace.com (Engl.)

    und für Microprozessor-affine Hardware-Bastler:
    -----------------------------------------------------
    ATMEL- und AVR Assembler für Anfänger Uni Cottbus (pdf)
    AVR-Programmiertechniken - eine Einführung
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von p. specht ()

  • Abt. Unterlagen und Links zur FPU-Programmierung - reloaded
    =======================================
    Die Floating Point Unit (FPU), ursprünglich als externer Hardwarebaustein '8087' bis '80387' realisiert, war und ist der "Wissenschaftliche Taschenrechner" der Intel-Prozessoren 8086 bis 80386 (CPU). Ab 80486 wurde der gesamte IC in die CPU integriert, die Handhabung entspricht allerdings bis heute der umständlichen Art, in der asynchron 'angestrickte' Bausteine nun einmal programmiert werden mußten. Zumindest die Abfrage des FPU-Statuswords 'über 5 Ecken' wurde in den CPUs 80586 'Pentium', 80686 'Celeron, ...','Core '(80786 'Core 2 Quad) und später (Core 7i, ...) vereinfacht.

    Die Architektur der FPU als '8-schüssiger Revolver für 10-Byte-Patronen' mit den Kammern ST(0) bis ST(7) diente damals der Beschleunigung von Umschaltvorgängen. Schließlich geht es viel viel schneller, eine Kammeradresse (3 bit) rauf- und runter zu zählen, als jeweils 10 Byte umständlich in eine Art "Akkumulatorregister" zu schauflen, dort zu behandeln und das Ergebnis wieder mühsam zurück zu schreiben. Nachteil: Damit ist aber ein Umdenken in Stack-Operationen erforerlich.

    Kenntnisse in Stackbehandlung und "Umgekehrter Polnischer Notation" können da recht hilfreich sein: Es heisst dann eben nicht 'A = B + C', sondern die Zeitachse bleibt konsequent nach rechts gerichtet: 'A B + C = ', bzw. im Einzelnen:

    Quellcode

    1. FInit = Umschalten der FPU aus der Zweitverwendung als MM-64bit-Registereinheit und
    2. Leeren der 8 FPU-Kammern von allfälligen 'Patronen' aus vorherigen Operationen:
    3. ; [( )]( )( )( )( )( )( )( ):|(A, Stackerror)( )( )...
    4. Befehl: ; Im Revolver: (= 'nach Befehlsausführung am FPU-Hardwarestack')
    5. Lade A ; [(A)]( )( )( )( )( )( )( ):|(A, Stackerror)( )( )...
    6. Lade B ; [(B)](A)( )( )( )( )( )( ):|(B, Stackerror)(A)( )...
    7. Addiere!; [(S)]( )( )( )( )( )( )(B, Stackerror):|(B+A) ( )...
    8. Speichere nach Speicherstelle Summe mit Pop (Trommel 1 x links drehen):
    9. [( )]( )( )( )( )( )(B, Stackerror)( ):|( )...


    Hardware der FPU
    ---------------------
    Umfassend beschrieben in: Intel Architecture Software Developer's Manual Vol 1: Basic Architecture

    Unterlagen zur syntaktisch richtigen FPU-Programmierung
    -----------------------------------------------------------------

    SIMPLY FPU 1.4
    by Raymond Filiatreault
    Copyright 2003, Latest revision August 2009
    Umfassende Darstellung und Nachschlagewerk (Engl.)

    Online (Hopepage von Raymond):
    ray.masmcode.com/tutorial/index.html

    Online-Version (falls oben nicht zugreifbar)

    Download im Hilfe-Format .CHM, compiled by Sonic (Mirror-Server leider nur von Zeit zu Zeit gültig!)

    Raymond hat auch eine FPU-Library geschrieben, die auf dieser Internetseite ausführlich dargestellt wird...



    Gruss

    P.S.: Spätestens seit der Core Generation sind (bei 32bit-Windows) weitere FloatingPoint-Befehle ('SSE 4') auch in den 128 Byte breiten acht XMM-Registern verfügbar, allerdings nur mit 8 Byte Präzision.
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 8 mal editiert, zuletzt von p. specht ()

  • Abt. Quadrantenrichtige Winkelermittlung ohne Abstürze auf mind. 10 Stellen genau
    =====================================================
    Hatten wir zwar schon mal, aber nicht so kompakt als proc. Reloaded aus aktuellem Anlaß.
    Gruss

    Quellcode

    1. WindowTitle "Quadrantenrichtige Winkelermittlung ohne 'Division durch Null & dgl.'-Fehler"
    2. AppendMenuBar 1,"(D)Demoware 2014-01 by P. Specht, Wien"
    3. ' *** Demo ohne jedwede Gewähr ***"
    4. CLS:font 2:set("decimals",5)
    5. declare winkel!
    6. var x1!=310:var y1!=3300
    7. var x2!=200:var y2!=350
    8. winkel!=to_Polar(x2!-x1!,y2!-y1!)
    9. Print "\n Die Aufgabe: Winkel von P1 zu P2 ermitteln"
    10. print "\n P1( ";x1!;" ";y1!;" ), P2( ";x2!;" ";y2!;" )\n"
    11. Print " Winkel = ";winkel!;" [rad] bzw. ";winkel!*180/pi();" Grad.\n"
    12. Print " Distanz= ";Sqrt(sqr(x2!-x1!)+sqr(y2!-y1!));" Einheiten.\n"
    13. print
    14. print "\n Start Selbsttest zur Prüfung des Winkelmaßes auf "
    15. print " mind. 10 Stellen Genauigkeit in 1000stel-Grad-Schritten läuft ...\n\n ";
    16. var r!=200:var alpha!=0:set("decimals",17)
    17. whileloop 360000-1:alpha!=pi()*&Loop/180000
    18. print &Loop
    19. x1!=r!*cos(alpha!)
    20. y1!=r!*sin(alpha!)
    21. if abs(to_Polar(x1!,y1!)*180000/pi()-&Loop)>10^-10
    22. print "\n Abs. Fehler bei ";int(&Loop)/1000;"°",to_Polar(x1!,y1!)*180000/pi()-&Loop
    23. sound 2000,200
    24. else
    25. locate %csrlin-1,2
    26. endif
    27. endwhile
    28. Waitinput
    29. Waitinput
    30. end
    31. proc to_Polar :parameters x!,y! '= Karthesische x2-x1,y2-y1 Differenzen mit x1,y1=Bezugspunkt
    32. var pi!=3.14159265358979323846:var laenge!=sqrt(sqr(x!)+sqr(y!)):var prec&=lg(abs(laenge!))
    33. if Nearly(x!,0,15-prec&) and Nearly(0,y!,15-prec&):winkel!=0
    34. elseif (x!>0) and Nearly(0,y!,15-prec&):winkel!=0
    35. elseif (x!>0) and (y!>0) and Nearly(x!,y!,14-prec&):winkel!=pi!*0.25
    36. elseif (y!>0) and Nearly(x!,0,15-prec&):winkel!=pi!*0.5
    37. elseif (x!<0) and (y!>0) and Nearly(-x!,y!,14-prec&):winkel!=pi!*0.75
    38. elseif (x!<0) and Nearly(0,y!,15-prec&):winkel!=pi!
    39. elseif (x!<0) and (y!<0) and Nearly(-x!,-y!,14-prec&):winkel!=pi!*1.25
    40. elseif (y!<0) and Nearly(x!,0,15-prec&):winkel!=pi!*1.5
    41. elseif (x!>0) and (y!<0) and Nearly(x!,-y!,14-prec&):winkel!=pi!*1.75
    42. elseif (x!>0) and (y!>0) and (x!>y!):winkel!=arctan(y!/x!)
    43. elseif (x!>0) and (y!>0) and (x!<y!):winkel!=pi!/2-arctan(x!/y!)
    44. elseif (x!<0) and (y!>0) and (-x!<y!):winkel!=pi!/2+arctan(-x!/y!)
    45. elseif (x!<0) and (y!>0) and (-x!>y!):winkel!=pi!-arctan(y!/-x!)
    46. elseif (x!<0) and (y!<0) and (-x!>-y!):winkel!=pi!+arctan(-y!/-x!)
    47. elseif (x!<0) and (y!<0) and (-x!<-y!):winkel!=pi!*1.5-arctan(-x!/-y!)
    48. elseif (x!>0) and (y!<0) and ( x!<-y!):winkel!=pi!*1.5+arctan(x!/-y!)
    49. elseif (x!>0) and (y!<0) and (x!>-y!):winkel!=2*pi!-arctan(-y!/x!)
    50. endif
    51. return winkel!
    52. endproc
    Alles anzeigen

    P.S.: Wer´s mit Quadranten- bzw. Oktantenangabe braucht: Die gab's in der ursprünglichen Veröffentlichung...
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

  • Abt. Winkel von Punkt_1 nach Punkt_2 nun deutlich schneller
    ======================================
    Kaskadieren von Variablenvergleichen mittels IFELSE, auf den häufigsten Fall optimiert, mit ehestemöglichem Rücksprung - das scheint's zu bringen. Schneller ginge es nur mit Assembler ;-)
    Gruss

    Quellcode

    1. WindowTitle "ArcTan4( dx, dy ): Rasche Winkelermittlung 0..2*Pi() auf 10 Stellen genau"
    2. AppendMenuBar 1,"(D) Demoware 2014-01 by P. Specht, Wien"
    3. ' *** Demo, ohne jedwede Gewähr ***"
    4. CLS
    5. font 2
    6. set("decimals",5)
    7. declare winkel!,w!
    8. var x1!=0:var y1!=0 ' P1
    9. var x2!=0.00001:var y2!=0.00001 ' P2
    10. winkel!=to_Polar(x2!-x1!,y2!-y1!)
    11. Print "\n Aufgabe: Winkel von P1 zu P2 ermitteln"
    12. print "\n P1( ";x1!;" , ";y1!;" ) - P2( ";x2!;" , ";y2!;" )\n"
    13. set("decimals",11)
    14. Print " Winkel = ";winkel!;" [rad] bzw. ";winkel!*180/pi();"° [Grad]\n"
    15. Print " Distanz= ";Sqrt(sqr(x2!-x1!)+sqr(y2!-y1!));" Einheiten.\n"
    16. print
    17. print "\n Start des etwa 20minütigen Selbsttests zur Prüfung des Winkelmaßes \n"
    18. print " 0..2*Pi() auf 10 Stellen Genauigkeit, in 10.000stel Grad-Schritten: \n\n ";
    19. var r!=200:var alpha!=0:set("decimals",17)
    20. whileloop 0,3600000-1:alpha!=pi()*&Loop/1800000
    21. print &Loop
    22. x1!=r!*cos(alpha!)
    23. y1!=r!*sin(alpha!)
    24. if abs(to_Polar(x1!,y1!)*1800000/pi()-&Loop)>5.85*10^-10
    25. print "\n Absolut-Fehler bei ";int(&Loop)/10000;"°",to_Polar(x1!,y1!)*1800000/pi()-&Loop
    26. sound 2000,50
    27. else
    28. locate %csrlin-1,2
    29. endif
    30. endwhile
    31. Waitinput
    32. Waitinput
    33. end
    34. proc to_Polar
    35. parameters x!,y!
    36. var pi!=3.1415926535897932
    37. if (x!=0)
    38. if (y!>0)
    39. w!=pi!*0.5:return w!
    40. elseif (y!<0)
    41. w!=pi!*1.5:return w!
    42. else 'if (y!=0)
    43. w!=0:return w!
    44. endif
    45. elseif (x!>0)
    46. if (y!=0)
    47. w!=0:return w!
    48. elseif (y!>0)
    49. if (x!>y!)
    50. w!=arctan(y!/x!):return w!
    51. else 'if (x!<y!)
    52. w!=pi!/2-arctan(x!/y!):return w!
    53. endif
    54. else 'if (y!<0)
    55. if (x!<-y!)
    56. w!=pi!*1.5+arctan(x!/-y!):return w!
    57. else 'if (x!>-y!)
    58. w!=2*pi!-arctan(-y!/x!):return w!
    59. endif
    60. endif
    61. else 'if (x!<0)
    62. if (y!>0)
    63. if (x!>-y!)
    64. w!=pi!/2+arctan(-x!/y!):return w!
    65. else 'if (x!<-y!)
    66. w!=pi!-arctan(y!/-x!):return w!
    67. endif
    68. elseif (y!<0)
    69. if (x!<y!)
    70. w!=pi!+arctan(-y!/-x!):return w!
    71. else 'if (x!>y!)
    72. w!=pi!*1.5-arctan(-x!/-y!):return w!
    73. endif
    74. else 'if y!=0
    75. w!=pi!:return w!
    76. endif
    77. endif
    78. ' Notfall-Ausgang bei Rundungslogik-Fehler
    79. print "\n Error in proc to_Polar: Hätte nie bis hierher kommen dürfen!"
    80. print " dx = ";x!;", dy = ";y! :Sound 800,400:waitinput :waitinput
    81. return w!
    82. endproc
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

  • Abt. Spielerei mit Polarkoordinaten - ArcTan4(dx,dy) Funktion
    ======================================
    Hier mal was in kompakter Schreibweise. Müllkippentauglich halt ;-)
    Gruss

    Quellcode

    1. window 0,0-%maxx,%maxy:var xx&=width(%hwnd)\2:var yy&=height(%hwnd)\2:cls $cdcdcd:randomize
    2. windowtitle "Polarkoordinaten":repeat :waitinput 100:line xx&,yy&-%mousex,%mousey
    3. drawtext xx&,yy&+3,str$(sqrt(sqr(%mousex-xx&)+sqr(yy&-%mousey)))+"@"+\
    4. str$(57.295779513082321*ArcTan4(%mousex-xx&,yy&-%mousey))+"° "
    5. until %key=27:end
    6. proc ArcTan4 :parameters x!,y!:var pi!=3.1415926535897932:var w!=0 '(CL)2014-01 P.Specht§gmx.at
    7. if x!=0:if y!>0:w!=pi!*0.5:elseif y!<0:w!=pi!*1.5:else :w!=0:endif :return w!:elseif x!>0
    8. if y!=0:w!=0:return w!:elseif y!>0:if x!>y!:w!=arctan(y!/x!):else :w!=pi!/2-arctan(x!/y!):endif
    9. return w!:else :if x!<-y!:w!=pi!*1.5+arctan(x!/-y!):else :w!=2*pi!-arctan(-y!/x!):endif :return w!
    10. endif :else :if y!>0:if x!>-y!:w!=pi!/2+arctan(-x!/y!):return w!:else :w!=pi!-arctan(y!/-x!)
    11. return w!:endif :elseif y!<0:if x!<y!:w!=pi!+arctan(-y!/-x!):else :w!=pi!*1.5-arctan(-x!/-y!)
    12. endif :return w!:else :w!=pi!:return w!:endif :endif :Print " ArcTan4 ERROR":waitinput:waitinput
    13. endproc
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • So... Gibt's von mir doch auch mal wieder was für diesen Thread. Lang ist's her. ;-)

    Ich habe mir gestern ein kleines Framerate-Monitoring-Programm für DirectX-Spiele geschrieben, welches die Shared-Memory-Schnittstelle von "RivaTuner Statistics Server" (auch bekannt als "MSI Afterburner On-Screen Display Server") nutzt, und damit ein kleines Overlay ins Spiel zaubert. Das Programm berechnet die durchschnittliche Framerate, die Schwankung der Framerate, die Langzeit-Schwankung der Framerate, die durchschnittliche Schwankung der Framerate und die Minimale/Maximale Framerate. Dazu kann man die Messwerte in eine Datei aufzeichnen, um sie dann z.B. mit Gnuplot oder so graphisch darzustellen.

    EDIT: Irgendwie knödelt mir die neue Forensoftware den ganzen Code in eine Zeile, entfernt also alle Zeilenumbrüche. Seltsam. Deshalb muss ich hier wohl leider einen werbeverseuchten Hoster nutzen...: file-upload.net/download-8490948/OSD_test.xprf.html

    Falls es jemand gebrauchen kann... Viel Spaß damit. Den Code zum Anzeigen von Overlays sollte man da auch recht leicht rausfischen können, sodass man auch andere Sachen als Overlay in Spielen anzeigen kann.


    Gruß
    Jonathan
    WICHTIG: Bitte diesen Virencheck durchführen: paules-pc-forum.de/forum/pc-si…infiziert.html#post902873

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von Jonathan ()

  • Danke!! Super Sache, wird sofort getestet!

    Inzwischen hier ein Abfallprodukt der 'Raumfahrt' ;-) zum selber-basteln:

    Quellcode

    1. WindowTitle "Kometenschoner zum selber basteln"
    2. '(CL)CopyLeft 2014-01 by P.Specht, Wien
    3. Windowstyle 24:Window 0,0-%maxx,%maxy-40:randomize
    4. Font 2:var xx&=width(%hwnd)\2:var yy&=height(%hwnd)\2
    5. var grad!=0.0174532925199432958:var rad!=57.2957795130823209
    6. declare G!,m1!,v2!,x2!,y2!,w2!,a2!,rr!,alpha!,a2x!,a2y!,v2x!,v2y!,n&,m&: Nochmal:
    7. whileloop 9 '<< anpassen!
    8. select &Loop
    9. caseof 1:G!=10^-17 : m1!=10^20 : v2!= 1 :x2!=100: y2!=0 :w2!=90*grad!
    10. caseof 2:G!=10^-17 : m1!=10^20 : v2!= 2.1 :x2!=100: y2!=0 :w2!=-90*grad!
    11. caseof 3:G!=10^-17 : m1!=10^20 : v2!= 2.2 :x2!=100: y2!=0 :w2!= 98*grad!
    12. caseof 4:G!=5*10^-18:m1!=10^20 : v2!= 2 :x2!=100: y2!=0 :w2!=-90*grad!
    13. caseof 5:G!=10^-15 : m1!=10^30 : v2!= 2.19:x2!=100: y2!=0 :w2!=90*grad!
    14. caseof 6:G!=5*10^-18 :m1!=10^30 : v2!=2.19:x2!=200:y2!=0 :w2!=90*grad!
    15. '=========================================================================
    16. ' Raum für eigene experimentelle Parameter:
    17. ' Gravitation : Sonnenmasse : Kometengeschw. : Start-Ort x,y : Abschusswinkel
    18. caseof 7:G!=5*10^-18 :m1!=10^30 : v2!= 2.19:x2!=200:y2!=0 :w2!=-90*grad!
    19. caseof 8:G!=5*10^-18:m1!=10^20 : v2!= 1 :x2!=100: y2!=0 :w2!=-91*grad!
    20. otherwise :G!=2*10^-17 :m1!=10^20: v2!= 2.17:x2!=200:y2!=0:w2!=2*grad!
    21. '=========================================================================
    22. endselect
    23. cls rgb(rnd(170),rnd(170),rnd(170))
    24. locate 1,1:print &Loop;:usepen 0,1,0:line 20,yy& - 2*xx&-20,yy&:line xx&,20-xx&,2*yy&-20
    25. usepen 1,22,rgb(255,255,0):line xx&,(yy&)-xx&+1,yy&:m&=8^8
    26. whileloop 12000
    27. usepen 0,12,rnd(m&)
    28. line xx&+x2!,(yy&-y2!) - xx&+1+x2!,yy&-y2!
    29. alpha!=ArcTan4(x2!,y2!)
    30. rr!=sqr(x2!)+sqr(y2!):case rr!<10000:rr!=10000
    31. a2!= -G!*m1!/rr!
    32. v2x!=v2!*cos(w2!)+a2!*cos(alpha!)/2
    33. v2y!=v2!*sin(w2!)+a2!*sin(alpha!)/2
    34. w2!=ArcTan4(v2x!,v2y!)
    35. x2!=x2!+v2x!
    36. y2!=y2!+v2y!
    37. v2!=sqrt(sqr(v2x!)+sqr(v2y!))
    38. endwhile
    39. endwhile :goto "Nochmal"
    40. proc ArcTan4 :parameters x!,y!
    41. var pi!=3.1415926535897932:var w!=0 '(CL)2014-01 P.Specht§gmx.at
    42. if x!=0:if y!>0:w!=pi!*0.5:elseif y!<0:w!=pi!*1.5:else :w!=0:endif :return w!:elseif x!>0
    43. if y!=0:w!=0:return w!:elseif y!>0:if x!>y!:w!=arctan(y!/x!):else :w!=pi!/2-arctan(x!/y!):endif
    44. return w!:else :if x!<-y!:w!=pi!*1.5+arctan(x!/-y!):else :w!=2*pi!-arctan(-y!/x!):endif :return w!
    45. endif :else :if y!>0:if x!>-y!:w!=pi!/2+arctan(-x!/y!):return w!:else :w!=pi!-arctan(y!/-x!)
    46. return w!:endif :elseif y!<0:if x!<y!:w!=pi!+arctan(-y!/-x!):else :w!=pi!*1.5-arctan(-x!/-y!)
    47. endif :return w!:else :w!=pi!:return w!:endif :endif :Print " ArcTan4 ERROR":waitinput:waitinput
    48. endproc
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von p. specht ()

  • Abt. Variablenaverträglichkeiten erforschen in XProfan
    =================================
    Hier erste Ergebnisse für Xprofan 2.1a:

    x! ist nicht x![], eine Kombination ist möglich.
    x% ist nicht x%[], eine Kombination ist möglich.
    x& ist nicht x&[], eine Kombination ist möglich.
    x$ ist nicht x$[], Kombination ist möglich.
    Declare x![10] und Declare x![] sind die selbe Variable, schließen einander aus, dennoch von unterschiedlichem Typ.
    Declare x%[11] und Declare x%[] sind die selbe Variable, schließen einander aus.
    Declare x&[12] und Declare x&[] sind die selbe Variable, schließen einander aus.
    Declare x$[13] und Declare x$[] sind die selbe Variable, schließen einander aus.
    Konstanten:
    !x nimmt einen String (die restliche Zeile) und wandelt ihn (per implizitem Val() ) in eine Float-Zahl um.
    !x[] wird nicht als Array erkannt, aber auch nicht als !x. Scheint nicht mehr abrufbar zu sein.
    Das gilt auch für %x[], &x[] und $x[].
    !x(n): n wird als Parameterzahl einer Funktion !x() interpretiert, die Parameter werden eingefordert. Der Aufruf dieser Funktion ist nur mit Tricks möglich.

    Wer's selbst testen will, oder um die neuen Defintionsarten OHNE Suffix erweitern, hier das Experimentierbrett.
    Gruss

    Quellcode

    1. WindowTitle "Variablenverträglichkeitsforschung XProfan"
    2. Windowstyle 24:Window 0,0-%maxx,%maxy:font 2:print "Ausgabe = Zeilennummer\n"
    3. def !x 3.0e-2
    4. 'def !x[] 4.4
    5. 'def !x[2] 5.5
    6. def %x 6
    7. def %x[2] 7
    8. def %x(3) 8
    9. def &x 9
    10. def &x[] 10
    11. def &x[2] 11
    12. def &x(3) 12
    13. def $x "13"
    14. def $x[] "14"
    15. def $x[2] "15"
    16. def $x(what$) "16"
    17. def $x(Völlig egal hauptsache Klammer zu) "17"
    18. '
    19. '
    20. declare x!:x!=20
    21. declare x![]:x![2]=21
    22. 'declare x![2]:x![3]=22
    23. declare x%:x%=23
    24. declare x%[2]:x%[2]=24
    25. 'declare x%[]:x%[5]=25
    26. declare x&:x&=26
    27. declare x&[2]:x&[2]=27
    28. 'declare x&[]:x&[4]=28
    29. declare x$:x$="29"
    30. declare x$[2]:x$[2]="30"
    31. 'declare x$[]:x$[7]="31"
    32. declare x#:dim x#,2:char x#,0="32"
    33. '
    34. print " def !x 3.0 liefert: ";!x
    35. 'print " def !x[] 4.4 liefert: ";!x[]
    36. 'print " def !x[2] 5.5 liefert: ";!x[2]
    37. print " def %x 6 liefert: ";%x
    38. 'print " def %x[2] 7 liefert: ";%x[2]
    39. 'print " def %x(3) 8 liefert: ";%x(3)
    40. print " def &x 9 liefert: ";&x
    41. 'print " def &x[] 10 liefert: ";&x[]
    42. 'print " def &x[2] 11 liefert: ";&x[2]
    43. 'print " def &x(0) 12 liefert: ";&x()
    44. print " def $x "+chr$(34)+"13"+chr$(34)+" liefert: ";$x
    45. 'print " def $x[] "+chr$(34)+"14"+chr$(34)+" liefert: ";$x[]
    46. 'print " def $x[2] "+chr$(34)+"15"+chr$(34)+" liefert: ";$x[2]
    47. ''print " def $x(what$) "+ chr$(34)+"16"+chr$(34)+ " liefert: ";$x()
    48. 'print " def $x (Völlig egal) "+chr$(34)+"17"+chr$(34)+" liefert: ";$x("Völlig egal")
    49. '
    50. print " declare x!:x!=20 liefert: ";x!
    51. 'print " declare x![2]:x![2]=21 liefert: ";x![2]
    52. 'print " declare x![]:x![3]=22 liefert: ";x![3]
    53. print " declare x%:x%=23 liefert: ";x%
    54. print " declare x%[2]:x%[2]=24 liefert: ";x%[2]
    55. 'print " 'declare x%[]:x%[5]=25 liefert: ";!x%[5]
    56. print " declare x&:x&=26 liefert: ";x&
    57. print " declare x&[2]:x&[2]=27 liefert: ";x&[2]
    58. 'print " declare x&[]:x&[4]=28 liefert: ";x&[4]
    59. print " declare x$:x$="+chr$(34)+"29"+chr$(34)+" liefert: ";x$
    60. print " declare x$[2]:x$[2]="+chr$(34)+"30"+chr$(34)+" liefert: ";x$[2]
    61. 'print " declare x$[]:x$[7]="+chr$(34)+"31"+chr$(34)+" liefert: ";x$[7]
    62. print " declare x#:dim x#,2:char x#,0="+chr$(34)+"32"+chr$(34)+" liefert: ";char$(x#,0,2)
    63. dispose x#
    64. waitinput
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. 3D-Weltraummüll, begrenzt als Bildschirmschoner tauglich
    =======================================
    Da wird nix Gescheites mehr draus. Zum Rumexperimentieren vielleicht... *Kipp & Tret*
    Gruss

    Brainfuck-Quellcode

    1. WindowTitle "Räumliche Inkrementelle Mehrkörper-Orbitsimulation nach Newton"
    2. '(CL) CopyLeft 2014-01 by P.Specht, Wien. Keine Gewähr, für Garnichts!
    3. WindowStyle 24:Window 0,0-%maxx,%maxy:cls 0:font 2
    4. var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2
    5. set("decimals",15):set("numwidth",30)
    6. 'print 2*xh&,2*yh&:waitinput 2000 'Bildschirmauflösung
    7. var fm$=mkstr$("0",16):fm$=" "+fm$+"."+fm$+";-"+fm$+"."+fm$+"; "+fm$+"."+fm$
    8. declare m&,n&,i&,j&,k&,G!,rr!,urrr!
    9. G!=6.67384*10^-11 'Universelle Gravitationskonstante [m³/(kg*s²)]=[N m²/kg²]
    10. ' Zur Beschleunigung Sonne schwerer und Einschussgeschwindigkeiten erhöht!
    11. n&=12 ' Max.Anz. Körper (unten im Detail definiert)
    12. dec n&:declare ax![n&],ay![n&],az![n&] 'Errechnete Beschleunigungskomponenten
    13. declare x_neu![n&],y_neu![n&],z_neu![n&] 'schrittpuffer als Zwischenspeicher
    14. declare vx_neu![n&],vy_neu![n&],vz_neu![n&] 'schrittpuffer als Zwischenspeicher
    15. 'Daten: Name, Masse, Durchmesser, Farbe&Helligkeit, Orts- und Geschwindigkeitskomponenten:
    16. declare m$[n&],m![n&],dm![n&],farbe&[n&], x![n&],y![n&],z![n&], vx![n&],vy![n&],vz![n&]
    17. Goto "Daten_holen": weiter_hier:
    18. n&=7 ' Beschränke das Sytem vorläufig auf n Körper ausser der Sonne (Testphase)
    19. var Nr&=-n& ' = zeige Daten des Planeten Nr&; - = off
    20. REPEAT
    21. inc m&
    22. whileloop 0,n&:i&=&Loop ' Unter Nutzung der Unabhängigkeit der Koordinaten: Für jeden Körper...
    23. ax![i&]=0:ay![i&]=0:az![i&]=0
    24. whileloop 0,n&:j&=&Loop ' summiere alle Beschleunigungsvektoren auf, die durch die Massen
    25. case j&=i&:continue ' aller ANDEREN Körper verursacht sind:
    26. rr!=sqr(x![j&]-x![i&])+sqr(y![j&]-y![i&])+sqr(z![j&]-z![i&]) ' = Quadrat der Distanz
    27. if rr! > 1000000000 ' bzw. r(i)+r(j) = Kollision, im else-Zweig zu behandeln
    28. urrr!=1/(rr!*sqrt(rr!)) ' Kehrwert der dritten Potenz der Körperdistanzen [m]
    29. '(1 Potenz mehr als Gravitationsgesetz, um Richtungsvektor-Multiplikation zu kompensieren)
    30. else
    31. 'Hier: Division durch 0 - Vermeidung durch Ansatz einer rechnerischen Mindestdistanz
    32. urrr!=0 ' keine v-Änderung
    33. endif
    34. ax![i&]=ax![i&]+( m![j&]*(x![j&]-x![i&]) )*urrr!*G!
    35. ay![i&]=ay![i&]+( m![j&]*(y![j&]-y![i&]) )*urrr!*G!
    36. az![i&]=az![i&]+( m![j&]*(z![j&]-z![i&]) )*urrr!*G!
    37. endwhile
    38. ' Einfluß der Beschleunigung auf die Geschwindigkeit: a/2 *t^2 , mit t = 1 sek bleibt a/2
    39. vx_neu![i&]=vx![i&]+ax![i&]*0.5 ' Puffer um vorzeitigen Einfluss zu verhindern
    40. vy_neu![i&]=vy![i&]+ay![i&]*0.5
    41. vz_neu![i&]=vz![i&]+az![i&]*0.5
    42. ' Auswirkung der neuen mittleren Geschwindigkeiten auf die Ortsveränderung:
    43. x_neu![i&]=x![i&]+vx_neu![i&] ' s = s0 + Durchschnittl._V_unter_Beschleunigung * {t=1 sek}
    44. y_neu![i&]=y![i&]+vy_neu![i&] ' Puffer um vorzeitigen Einfluss zu verhindern
    45. z_neu![i&]=z![i&]+vz_neu![i&]
    46. endwhile
    47. Stelle_Situation_dar
    48. whileloop 0,n&:i&=&Loop ' Alle Planeten: Umgreifen für den nächsten Iterationsschritt:
    49. x![i&]=x_neu![i&]
    50. y![i&]=y_neu![i&]
    51. z![i&]=z_neu![i&]
    52. vx![i&]=vx_neu![i&]
    53. vy![i&]=vy_neu![i&]
    54. vz![i&]=vz_neu![i&]
    55. endwhile
    56. UNTIL &loop
    57. END
    58. Proc Stelle_Situation_dar
    59. declare r!,xx!,yy!
    60. whileloop 0,n&
    61. i&=&Loop
    62. r!=(1+dm![i&]*0.5)/(2500000+z_neu![i&])
    63. case i&=0:r!=7 'Zonnenradius sonst viel zu groß
    64. xx!=(x_neu![i&])/(z_neu![i&]+579100000)
    65. yy!=(y_neu![i&])/(z_neu![i&]+579100000)
    66. usebrush 1,farbe&[i&]:usepen 0,1,farbe&[i&]*rnd(2)*(i& mod 11)
    67. ellipse xh&+xx!-r!,(yh&-yy!-r!) - xh&+xx!+r!+1,yh&-yy!+r!+1
    68. endwhile
    69. case nr&<0:return ' -1 = keine Daten anzeigen
    70. locate 1,1
    71. print " a =",format$(fm$,ax![nr&]),format$(fm$,ay![nr&]),format$(fm$,az![nr&])
    72. print " v =",format$(fm$,vx_neu![nr&]),format$(fm$,vy_neu![nr&]),format$(fm$,vz_neu![nr&])
    73. print "xyz:",format$(fm$,x_neu![nr&]),format$(fm$,y_neu![nr&]),format$(fm$,z_neu![nr&])
    74. print " ";m$[nr&]," ... Step",format$("000000",m&)',format$(" 0000;-0000",xh&+xx!),format$(" 000;-000",yh&-yy!)
    75. endproc
    76. '{ Daten des Zolar-Systems, provisorisch bis Zmars eingegeben
    77. Daten_holen:
    78. ' Ort und Geschwindigkeiten (z.B. am 1.1.2000 00:00 Uhr UTZ(=GMT) )
    79. i&=0 ' Katalognummer 0..n&-1, 0 = Zentralgestirn
    80. m$[i&]="Zonne"
    81. m![i&]=val("1.989e38") ' val("1.989e30") 'Masse in kg
    82. farbe&[i&]=rgb(255,230,100) 'Farbe * Helligkeit
    83. dm![i&]=val("1391000000") ' Durchmesser in m
    84. x![i&]=val("0")
    85. y![n&]=val("0")
    86. z![n&]=val("0")
    87. vx![i&]=val("0 m/s")
    88. vy![i&]=val("0 m/s")
    89. vz![i&]=val("0 m/s")
    90. i&=1
    91. m$[i&]="Zmerkur"
    92. dm![i&]=val("12104000") ' Durchmesser in m
    93. m![i&]=val("4.867e24") ' Masse in kg
    94. farbe&[i&]=rgb(200,200,255)
    95. x![i&]=val("-108200000000")
    96. y![n&]=val("0")
    97. z![n&]=val("0")
    98. vx![i&]=val("0 m/s")
    99. vy![i&]=val("-100000000 m/s") 'val("0 m/s")
    100. vz![i&]=val("1100 m/s")
    101. i&=2'OK
    102. m$[i&]="Zvenus"
    103. dm![i&]=val("12104000") ' Durchmesser in m
    104. m![i&] =val("4.867e24") ' Masse in kg
    105. farbe&[i&]=rgb(200,200,0)
    106. x![i&]=val("108200000000")
    107. y![n&]=val("0")
    108. z![n&]=val("0")
    109. vx![i&]=val("0 m/s")
    110. vy![i&]=val("100000000 m/s")'val("0 m/s")'val("0 m/s")
    111. vz![i&]=val("5500 m/s")
    112. i&=3' Mit Überraschung, so OK!
    113. m$[i&]="Zerde"
    114. m![i&]=val("5.972e24") 'Masse in kg
    115. dm![i&]=val("12742000") ' Durchmesser in m
    116. farbe&[i&]=rgb(150,200,255)
    117. x![i&]=val("149600000000")
    118. y![n&]=val(" ")
    119. z![n&]=val(" ")
    120. vx![i&]=val("0 m/s")
    121. vy![i&]=val("183300000 m/s")
    122. vz![i&]=val("6000 m/s")
    123. '}
    124. '{ Ausserhalb Erdbahn
    125. i&=4
    126. m$[i&]="Zmars" ' Doppelüberraschung!!
    127. m![i&]=val("639e21") 'Masse
    128. dm![i&]=val("6779000") ' Durchmesser in m
    129. farbe&[i&]=rgb(200,200,0)
    130. x![i&]=val("227900000000")
    131. y![n&]=val("0")
    132. z![n&]=val("0")
    133. vx![i&]=val("0 m/s")
    134. vy![i&]=val("-183300000 m/s")
    135. vz![i&]=val("2000 m/s")
    136. i&=5
    137. m$[i&]="Zupiter"
    138. m![i&]=val("1.898e27") 'Masse
    139. dm![i&]=2*val("69911000") ' Durchmesser in m
    140. farbe&[i&]=rgb(200,150,80)
    141. x![i&]=val("278500000000") ' val("778500000000")'real
    142. y![n&]=val(" ")
    143. z![n&]=val(" ")
    144. vx![i&]=val("0 m/s")
    145. vy![i&]=val("-28330000 m/s")
    146. vz![i&]=val("0 m/s")
    147. ' }
    148. ' {----------------------------Experimente ab hier (n& erhöhen!) -----------------------
    149. i&=6
    150. m$[i&]="Zaturn"
    151. m![i&]=val("568.3e24") 'Masse
    152. dm![i&]=val("58232000") '*2 Durchmesser in m
    153. farbe&[i&]=rgb(243,0,200)
    154. x![i&]=0 ' val("1433000000000")'real
    155. y![n&]=val("1333000000000")
    156. z![n&]=val("29999")
    157. vx![i&]=val("0 m/s")
    158. vy![i&]=val("-18330000 m/s")
    159. vz![i&]=val("1555 m/s")
    160. i&=7
    161. m$[i&]="Zuranus"
    162. m![i&]=val("568.3e24") 'Masse
    163. dm![i&]=val("8232000") ' Durchmesser in m
    164. farbe&[i&]=rgb(189,200,0)
    165. x![i&]=val(" ")
    166. y![n&]=val(" ")
    167. z![n&]=val(" ")
    168. vx![i&]=val("0 m/s")
    169. vy![i&]=val("-8330000 m/s")
    170. vz![i&]=val("-8330000 m/s")
    171. i&=8
    172. m$[i&]="Zneptun"
    173. m![i&]=val("1.98934") ' val("1.989e30") 'Masse in kg
    174. farbe&[i&]=rgb(255,230,100) 'Farbe * Helligkeit
    175. dm![i&]=val("13910000") ' Durchmesser in m
    176. x![i&]=val(" ")
    177. y![n&]=val("-13330000000")
    178. z![n&]=val(" ")
    179. vx![i&]=val("100000 m/s")
    180. vy![i&]=val("0 m/s")
    181. vz![i&]=val("0 m/s")
    182. Goto "weiter_hier"
    183. '}
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Hmmm... bei mir kein Problem diesbezüglich. Ich dachte eigentlich, RGH hätte das längst in Ordnung gebracht und den FloatingPoint-Bereich von 10^(+\-53) wieder zurück-erweitert auf Profan11's 10^(+\-306)? Oder betraf das damals nur FreeProfan32 ? Bitte checken: Update auf X2.1 von HIER, oder du könntest den FreeProfan32 oder Profan64-Compiler von HIER verwenden - z.B. gleich mit einer Bit-Versionsrichtigen IDE wie dem XProf-Pad64 von T.S.-Soft.
    Gruss
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • So... Zum Testen einer anderen XProfan-Version bezüglich Gleitkommagedöns bin ich leider noch nicht gekommen, dafür hab ich aber ein nettes Stück Code für euch ;-)

    Quellcode

    1. Declare callbackCDECLtoSTDCALL#, cbcode$
    2. cbcode$ = "55 89 E5 83 EC 28 C7 45 F4 55 55 55 55 8B 45 08 89 04 24 8B 45 F4 FF D0 83 EC 04 C9 C3 90 90 90 "
    3. Dim callbackCDECLtoSTDCALL#, @Len(cbcode$) / 3 + 1
    4. WhileLoop 1, @Len(cbcode$) - 2, 3
    5. Byte callbackCDECLtoSTDCALL#, (&loop - 1) / 3 = @Val("$" + @Mid$(cbcode$, &loop, 2))
    6. EndWhile
    7. WhileLoop 0, @SizeOf(callbackCDECLtoSTDCALL#) - 1 - 3
    8. If @Long(callbackCDECLtoSTDCALL#, &loop) = $55555555
    9. Long callbackCDECLtoSTDCALL#, &loop = @ProcAddr("XProfan_callback_func", 1)
    10. EndIf
    11. EndWhile
    12. 'Beispiel
    13. @External("CDECL-DLL.dll", "FunktionDieEinCallbackInCDECLHat", callbackCDECLtoSTDCALL#)
    Alles anzeigen


    Konvertiert einen CDECL-Call in einen STDCALL-Call, damit man auch DLLs, die CDECL verwenden, XProfan-Callback-Funktionen geben kann. Der Assembler-Code macht das momentan aber nur für Calls mit bloß einem Argument.


    Gruß
    Jonathan
    WICHTIG: Bitte diesen Virencheck durchführen: paules-pc-forum.de/forum/pc-si…infiziert.html#post902873
  • :thumbsup: Super :!:

    Frage ("Ein Narr kann mehr fragen als 10 Weise beantworten..."): Gibt es eine Möglichkeit, das verwendete Übergabeverfahren solcher Zusatz-DLL irgendwie automatisch zu erkennen? Gibt's eine Art Marker, ähnlich wie in Windows-Programmen die Anfangszeichen "MZ" nach Mark Zbikowski?

    Aus einer ähnlichen Anfragebeantwortung werde ich jedenfalls nicht schlau: stackoverflow.com/questions/41…tion-of-a-third-party-dll
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht ()

  • p. specht schrieb:

    :thumbsup: Super :!:

    Frage ("Ein Narr kann mehr fragen als 10 Weise beantworten..."): Gibt es eine Möglichkeit, das verwendete Übergabeverfahren solcher Zusatz-DLL irgendwie automatisch zu erkennen? Gibt's eine Art Marker, ähnlich wie in Windows-Programmen die Anfangszeichen "MZ" nach Mark Zbikowski?

    Aus einer ähnlichen Anfragebeantwortung werde ich jedenfalls nicht schlau: stackoverflow.com/questions/41…tion-of-a-third-party-dll
    Leider nicht wirklich - der Unterschied zwischen CDECL und STDCALL ist z.B. nur, dass bei CDECL der Aufrufer den Stack hinterher saubermacht, und bei STDCALL die aufgerufene Funktion selbst das tut. Wenn du eine Möglichkeit findest, zu erkennen, ob der Stack bereits sauber ist, oder nicht, kann man das natürlich auch automatisch machen.


    Gruß
    Jonathan
    WICHTIG: Bitte diesen Virencheck durchführen: paules-pc-forum.de/forum/pc-si…infiziert.html#post902873
  • Abt. Explizites Euler-Verfahren am Beispiel Meteoreinschlag
    =====================================
    Bei vielen physikalischen Vorgängen mit nichtlinearen Einzel-Zusammenhängen können selbst bei bekannten Anfangsbedingungen keine geschlossenen Formeln zur Ergebnisberechnung herangezogen werden. Also muss man den Systemzustand für einen bestimmten Zeitpunkt schrittweise errechnen. Der große schweizerische Mathematiker Leonhard Euler stellte dazu schon um 1745 herum fest, daß dazu eine Lineare Näherung genügt, solange die einzelnen Rechenschritte nur klein genug sind. Hier eine entsprechende Anwendung, bei der man mit den Einzelwerten rumexperimentieren kann, um z.B. zu erkennen, warum Sternschnuppen meist in 15-20 km Höhe leuchten...
    Gruss

    Quellcode

    1. WindowTitle "Explizites Euler-Verfahren, um einen typischen Kleinmeteor-Absturz zu simulieren"
    2. ' Details siehe http://de.wikipedia.org/wiki/Methode_der_kleinen_Schritte
    3. ' Beispiel nach XProfan 11.2a übertragen (CL) CopyLeft 2014-01 by P.Specht, Wien
    4. Window 0,0-%maxx,%maxy-40:Font 2:set("decimals",5):set("numwidth",18)
    5. declare n&,a_gravi!, rho!, F_Luft!, a_gesamt!, v_neu!, v_alt!, h_neu!, h_alt!
    6. var Masse! = 0.04 ' kg Typische Eisenmeteor-Masse wäre nur ca. 4 Gramm!
    7. var A! = 0.33 ' cm² Querschnittsfläche des Meteors
    8. var v! = 25 ' km/s Geschwindigkeit am Startpunkt (Anfangsbedingung, ca. 15 km/s)
    9. var h! = 120 ' km Anfangshöhe über Grund
    10. var rho_Boden! = 1.2041 ' kg/m³ =0,0012041 g/cm³ Luftdichte bei 20 °C auf Meeresniveau
    11. var Cw!=1.18 ' 0.18 - 1.18 ' Cw = 2*Fw/(rho*A*v^2) Luftwiderstandsbeiwert cw, geschätzt
    12. var dt!=0.1 ' s = Sec-Zeitschritt der Simulation
    13. Ueberschrift
    14. Repeat
    15. inc n& ' Segment-Nr.
    16. a_gravi! = 9.80665 * sqr( 6370/(6370 + h!) ) ' Abnahme der Gravitation mit der Höhe
    17. rho!=rho_Boden!*exp(-h!/8.4) ' Luftdichte in x km Höhe
    18. F_Luft! = rho!*Cw!*A!*sqr(v!)/2 ' Gegenwind-Kraft
    19. a_gesamt! = a_gravi! - F_Luft! / Masse! ' Gesamtbeschleunigung
    20. v_neu! = v! + a_gesamt! * dt! ' Segment-Durchschnittsgeschwindigkeit
    21. h_neu! = h! - v_neu! * dt! ' Seehöhe
    22. Print h_neu!,n&,,v_neu!,a_gravi!,rho!,F_Luft!,a_gesamt!
    23. casenot (%csrlin+2) mod 4:print
    24. case %csrlin>46 : warte
    25. v!=v_neu!
    26. h!=h_neu!
    27. Until h! < -0.5
    28. Waitinput
    29. End
    30. proc warte
    31. waitinput
    32. cls
    33. Ueberschrift
    34. endproc
    35. proc Ueberschrift
    36. print " Seeöhe [km] Bahnsegment Geschwindigkeit [km/s],";
    37. print " Gravitation, Luftdichte, Bremskraft, Verzögerung\n"
    38. endproc
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3