Abstürze lassen mich aufhorchen
Zeile 24: Doppeltes Komma rausnehmen und schon läufts
Gruß Volkmar
Abstürze lassen mich aufhorchen
Zeile 24: Doppeltes Komma rausnehmen und schon läufts
Gruß Volkmar
Alter Fehler aus GWBASIC-Zeiten: Bitte ersetzt die Zeile:
: Print h_neu!,n&,,v_neu!,a_gravi!,rho!,F_Luft!,a_gesamt!
durch
: Print h_neu!,n&;".",v_neu!,a_gravi!,rho!,F_Luft!,a_gesamt!
dann klappts auch mit dem Nachbarn ...äh...Compiler.
Gruss
Ja, so klappt's. Wäre aber nett, wenn sich Interpreter und Compiler mal einig werden, was sie mögen und was nicht.
Gruß Volkmar
Abt. Anstiegsfunktion von Ellipsen in beliebiger Lage
=================================
Weil wir hier schon lange nichts über Ellipsen hatten, aber ein Kollege unbedingt zwischen Satellitenorbits navigieren will, wurden dazu die nachstehenden ersten Vorarbeiten geleistet. Man beachte den großen Geschwindigkeitsunterschied zwischen der Darstellung in Karthesischen Koordinaten und in Polarkoordinaten (was leider auch die Verwendbarkeit als Bildschirmschoner torpediert).
Gruss
P.S.: Fernziel ist die Bestimmung energiearmer Homan-Übergangsbahnen zwischen Orbits, z.B. von Erde zu Mars. Wer also mit Privatrakete auf den Roten Planeten auswandern will, muß noch etwas Geduld haben
WindowTitle "ELLI" '(CL)CopyLeft 2014-02 by P.Specht
WindowStyle 24:Window 0,0-%maxx,%maxy-39:Var xh&=width(%hwnd)\2:Var yh&=height(%hwnd)\2
Font 2:Randomize:var f!=-1*pi()/180:var ff!=180/pi()
declare x!,y!,xx!,yy!,u&,v!,a!,b!,w!,xm!,ym!,step&
usepen 0,1,0:Line 0,yh&-2*xh&,yh&:Line xh&,0-xh&,2*yh&
proc Ellips :parameters xm!,ym!,a!,b!,w!,d&,c&
'Zeichne Ellipse in allg. Lage (xm,ym,a,b,w°) in Polarkoordinaten P(x,y)
usepen 0,d&,c&
whileloop 0,360,6
v!= -0.017453292519943296*&Loop
x!=a!*cos(v!):y!=b!*sin(v!)
xx!= x!*cos(w!)+y!*sin(w!)
yy!= -x!*sin(w!)+y!*cos(w!)
if v!=0:moveto xh&+xm!+xx!,yh&-ym!-yy!
else :lineto xh&+xm!+xx!,yh&-ym!-yy!
endif
endwhile
endproc
proc Ellip :parameters xm!,ym!,a!,b!,w!,d&,c&
'Zeichne Ellipse in allg. karthes. Lage (verwendet Elli_y(x))
'-xh&,xh&
declare y1!,y2!
whileloop xm!-a!,xm!+a!:x!=&Loop
y1!=Elli(xm!,ym!,a!,b!,w!,x!,0)
y2!=Elli(xm!,ym!,a!,b!,w!,x!,1)
usepen 0,d&,c&:Line xh&+x!,(yh&-y1!) - xh&+x!+1,yh&-y1!
usepen 0,d&,c&:Line xh&+x!,(yh&-y2!) - xh&+x!+1,yh&-y2!
endwhile
endproc
proc Elli :parameters xm!,ym!,a!,b!,w!,x!,ob&
w!=-w! 'Karthes. Ellipsenpunkte y(x) in allg. Lage
var aa!=sqr(a!):var bb!=sqr(b!)
var sw!=sin(w!):var cw!=cos(w!)
var ssw!=sqr(sw!):var ccw!=sqr(cw!)
var nenn!=bb!*ssw!+aa!*ccw!
var f1!=sqr(ssw!+ccw!)
var wurz!=nenn!-f1!*sqr(xm!-x!)
if (nenn!<>0) and (wurz!>0)
var f2!=(bb!-aa!)*cw!*sw!
var f3!=a!*b!*sqrt(wurz!)
var f4!=f2!*(xm!-x!)
if ob&
return ym!+(f4!-f3!)/nenn! 'Obere Hälfte
else
return ym!+(f4!+f3!)/nenn! 'Untere Hälfte
endif
else
y1!=yh&+2:y2!=y1!
endif
endproc
proc EllipsSlope :parameters xm!,ym!,a!,b!,w!,d&,c&
'Zeichne Ellipsentangenten in allg. karthes. Lage (verwendet Ellislope_y(x))
'-xh&,xh&
declare y1!,y2!
whileloop xm!-a!,xm!+a!:x!=&Loop
y1!=b!/5*ElliSlope(xm!,ym!,a!,b!,w!,x!,0)
y2!=b!/5*ElliSlope(xm!,ym!,a!,b!,w!,x!,1)
usepen 0,d&,c&:Line xh&+x!,(yh&-y1!) - xh&+x!+1,yh&-y1!
usepen 0,d&,255+0*c&:Line xh&+x!,(yh&-y2!) - xh&+x!+1,yh&-y2!
endwhile
endproc
proc ElliSlope :parameters xm!,ym!,a!,b!,w!,x!,ob&
var aa!=sqr(a!):var bb!=sqr(b!)
var sw!=sin(w!):var cw!=cos(w!)
var ssw!=sqr(sw!):var ccw!=sqr(cw!)
var f1!= sqr(ssw!+ccw!)
var nenn!=bb!*ssw!+aa!*ccw!
var wurz!= nenn!-f1!*sqr(xm!-x!)
var f2!=(bb!-aa!)*cw!*sw!
if (nenn!<>0) and (wurz!>0)
if ob&
return (-1*(a!*b!*2*f1!*(xm!-x!))/(2*sqrt(wurz!))-f2!)/nenn!
else
return ( (a!*b!*2*f1!*(xm!-x!))/(2*sqrt(wurz!))-f2!)/nenn!
endif
else
return yh&+2
endif
endproc
'xm!= 0:ym!= 0:a!=375:b!= 25:w!=10*f!:Ellips(xm!,ym!,a!,b!,w!,3,rgb(255,0,0)):waitinput 1000
'xm!= 0:ym!= 0:a!=375:b!= 25:w!=10*f!: Ellip(xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
'xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!:Ellips(xm!,ym!,a!,b!,w!,2,rgb(0,200,0))
'xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!: Ellip(xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!
''Karthes. Ellipse drehen
'whileloop 0,1790,180:w!=&Loop*f!*0.1
' Ellip(xm!,ym!,a!,b!,w!,1,rgb(255,0,0))
'Endwhile
step&=30
' EllipsenTangente drehen
whileloop 0,1799,step&:w!=&Loop*f!*0.1
'EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
casenot (&Loop/step&+0) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,255))
casenot (&Loop/step&+1) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,200,0))
casenot (&Loop/step&+2) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(255,0,0))
casenot (&Loop/step&+3) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(200,200,0))
casenot (&Loop/step&+4) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(200,0,200))
casenot (&Loop/step&+5) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,200,200))
casenot (&Loop/step&+6) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
Endwhile
Print "Anstiegsfunktion einer rotierenden Ellipse"
Print "Tastendruck zeigt zugehörige Ellipse"
waitinput
'end
step&=30
'Polarkoordinaten-Ellipse
whileloop 0,1799,step&:w!=&Loop*f!*0.1
casenot (&Loop/step&+0) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,170,255))
casenot (&Loop/step&+1) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,200,170))
casenot (&Loop/step&+2) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(255,170,170))
casenot (&Loop/step&+3) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(200,200,170))
casenot (&Loop/step&+4) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(200,170,200))
casenot (&Loop/step&+5) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,200,200))
casenot (&Loop/step&+6) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,170,170))
Endwhile
usepen 0,1,0:Line 0,yh&-2*xh&,yh&:Line xh&,0-xh&,2*yh&
waitinput
end
Alles anzeigen
Abt. IE-Sicherheit durch interne Nabelbeschau
=============================
Wer glaubt, sich wie in Win98 (1 IE Cache) oder WinXP (4 oder 8 IE-Caches) einfach mal die diversen Datencaches des jeweils aktuellen Internet Explorers ansehen zu können, der wird bei Vista von neuen, versteckten Speicherorten überrascht, die aber mittels REGEDIT und dem Schlüssel HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Cache noch relativ leicht zu finden sind. (Die unsaubere Trennung zwischen Explorer und Internet Explorer war Gegenstand einer Strafe der EU für M$ in Höhe von ausgerechnet 561 Millionen Euro, zufällig beim damaligen Kurs genau 750 Mio $, die sich in den Produktpreisen merkwürdigerweise nicht zeigte. Zugehörige Verschwörungstheorie: Offenbar wurde M$ da einiges aus US-Budgets ersetzt, was die Vermutung nährt, dass M$ hier lediglich Vehikel einer Zahlung Nordamerikas an die EU war - etwa für Flugpassagierdaten?)
Win7 überrascht dann mit der Tatsache, daß Microsoft dem IE-Cache einen Wachhund namens "WinInetCacheServer" verpasst hat, der u.a. offenbar Phishing verhindern soll, aber auch im Verstecken von Dateien und dem Unlöschbarmachen gewisser Cookies sehr gut zu sein scheint. Die zu diesem Server gehörigen Clients "Wininet Cache task object" mit verlinkendem Eintrag AppID REG_SZ {3eb3c...} scheinen sogar die Möglichkeit zu eröffnen, im Cache AKTIVE TASKS zu starten, die der von MS zugesagten Umgebungsvirtualisierung relativ leicht entkommen können. Die Phantasie von Experten, die um die nationale Sicherheit der USA besorgt sind, die damit aber auch den Interessen anderer, nicht wohlgesonnener Kräfte (( - wie wichtig doch Beistriche sind )) Scheunentor-große Eintrittspforten eröffnen scheint tatsächlich grenzenlos zu sein...
Mein Eindruck ist folgender: Solange der IE etwas Längeres ladet, hat man Zeit zur Ermittlung der aktuellen versteckten Cache-Verzeichnisnamen (die sich aber mit jedem IE-Start leeren oder sogar ändern (- gilt zumindest für IE11 mit Update 1 unter Win7-64): Mit der Umgebungsvariablen %LOCALAPPDATA%=%USERPROFILE%\AppData\Local gilt folgendes nach Start von CMD.exe als Admin: Man gelangt mit folgenden Kommandozeileneingabe an einen Ort, der einem normalerweise auch im Modus "Zeige Systemdateien an" nicht angezeigt wird:
>CD %LOCALAPPDATA%\Microsoft\Windows\Temporary Internet Files\Low\Content.IE5
Die Anzeige der versteckten Verzeichnisnamen klappt dann (meist) mit
>dir *. /s /w /AH
... und schon kann man sogar Unterverzeichnisse namens ACTIVE_TASKS und dergleichen finden.
Auch die aus Vorversionen gültigen "Geheimpfade" existieren noch aus Kompatibilitätsgründen, manche scheinen aber tatsächlich leer zu sein. Also: Viel Spaß noch beim Surfen im Unterbewusstsein eures Computers.
Gruss
P.S.: Wenn ich bedenke, was da noch alles an doppelt-versteckten Verzeichnissen existieren könnte, deren Pfade wir alle NICHT kennen .
PPS: Wer glaubt, Chrome oder Firefox seien sicherer: Gott erhalte ihm seinen Glauben!
Versuche zur Datumsarithmetik (Abt. Sackgassenprojekte)
====================================
Wenn man mal den Grundaufbau eines Programms versaut hat (z.B. weil man die Zeit vor der Kalenderreform von 1582 auch noch reinquetschen wollte), helfen auch keine Klimmzüge zur Reparatur mehr. Nur ein kompletter Neubau mit einer logisch durchdachteren Modul-Struktur würde da noch helfen. Hier das verbockte Machwerk als abschreckendes Beispiel.
Sorry!
P.S.: In gewissen Grenzen funktioniert das Zeug, die Procs sind aber leider völlig überfrachtet.
Windowtitle "Wochentag eines Datums, Tag im Jahr, Unix-DayNbr, Tage zwischen Datumsangaben"
'Early Alpha mit garantiert vielen Bugs. Keine wie auch immer geartete Gewähr!
windowstyle 24:window 0,0-%maxx,%maxy-40 :var xx&=width(%hwnd):font 2
var yy&=height(%hwnd):declare yr&,mt&,dy&,ly&,doy&,uxdy&,dt1$,dt2$
'{ Diverse datumsbezogene Procs
proc dt2yrmtdy :parameters dt$
case dt$<="15821004":Print " Tagesname julianisch! "
'Setzt Jahres-, Monats- und Tageszahl
'Zerlege Datumsstring im Datenbankformat JJJJMMTT in die einzelnen Zahlen yr,mt,dy
yr&=val(mid$(dt$,1,4)):mt&=val(mid$(dt$,5,2)):dy&=val(mid$(dt$,7,2))
case (yr&=1582) and (mt&=10) and (dy&>4) and (dy&<15):Print "\n *** Achtung: Von Papst Gregor gestrichenes Datum! *** ";
endproc
proc isLeapYear :parameters yr&
' Stellt fest ob Schaltjahr (1) oder nicht (0)
casenot yr& mod 400:return 1:casenot yr& mod 100:return 0:
casenot yr& mod 4:return 1:return 0
endproc
proc doy :parameters yr&,mt&,dy&
' Welche Tagesnummer im Jahr hat der dy.te Tag im mt.Monat des Jahres yr&
' im zuückliegend erweiterten Gregorianischen Kalender
if (mt&<1) or (mt&>12):Print " Month-Error ":return int(-1):endif
if (dy&<1) or (dy&>31):Print " Day-Error ":return int(-1):endif
var ly&=isleapyear(yr&)
if (mt&=2) and (dy&>(28+ly&)):Print " Leap-Error ":return int(-1):endif
var base&=dy&:case mt&>=3:base&=base&+ly&
case (yr&=1582) and (mt&=10) and (dy&>14):Print " ***Wg.Kalenderreform doy 10 zuviel!***"
select mt&:caseof 12:return int(334+base&):caseof 11:return int(304+base&)
caseof 10:return int(273+base&):caseof 9:return int(243+base&)
caseof 8:return int(212+base&):caseof 7:return int(181+base&)
caseof 6:return int(151+base&):caseof 5:return int(120+base&)
caseof 4:return int(90+base&):caseof 3:return int(59+base&)
caseof 2:return int(31+base&):caseof 1:return base&
endselect
print " Undefined doy Error ":return int(-1)
endproc
proc yrdoy2mt :parameters yr&,doy&
' In welchem Monat liegt der doy.te Tag des Jahres yr&
' (yr 4stellig nötig wg. Schaltjahresfesstellung)
Select doy&
caseof >(365+ly&):return int(-1)
caseof >(334+ly&):return int(12):caseof >(304+ly&):return int(11)
caseof >(273+ly&):return int(10):caseof >(243+ly&):return int(9)
caseof >(212+ly&):return int(8):caseof >(181+ly&):return int(7)
caseof >(151+ly&):return int(6):caseof >(120+ly&):return int(5)
caseof >(90+ly&):return int(4):caseof >(59+ly&):return int(3)
caseof >31:return int(2):caseof >0:return int(1)
endselect
return int(-1)
endproc
proc yrdoy2dy :parameters yr&,doy&
Select doy&
caseof >(365+ly&):return int(-1)
caseof >(334+ly&):return int(doy&-334-ly&)
caseof >(304+ly&):return int(doy&-304-ly&)
caseof >(273+ly&):return int(doy&-273-ly&)
caseof >(243+ly&):return int(doy&-243-ly&)
caseof >(212+ly&):return int(doy&-212-ly&)
caseof >(181+ly&):return int(doy&-181-ly&)
caseof >(151+ly&):return int(doy&-151-ly&)
caseof >(120+ly&):return int(doy&-120-ly&)
caseof >(90+ly&):return int(doy&-90-ly&)
caseof >(59+ly&):return int(doy&-59-ly&)
caseof >31:return int(doy&-31)
caseof >0:return int(doy&)
endselect
return int(-1)
endproc
proc maxdom :parameters yr&,mt&,dy&
case (mt&<1) or (mt&>12):return int(-1):case (dy&<1) or (dy&>31):return int(-1)
var ly&=isleapyear(yr&):case (mt&=2) and (dy&>(28+ly&)):return int(-1)
select mt&
caseof 12:return int(31):caseof 11:return int(30):caseof 10:return int(31)
caseof 9:return int(30):caseof 8:return int(31):caseof 7:return int(31)
caseof 6:return int(30):caseof 5:return int(31):caseof 4:return int(30)
caseof 3:return int(31):caseof 2:return int(28+ly&):caseof 1:return int(31)
endselect :return int(-1)
endproc
proc yr2dybase :parameters yr&
return int((yr&-1970)*365+int((yr&-1968)*0.2425))
endproc
proc uxdy :parameters yr&,mt&,dy&
return int(yr2dybase(yr&)+doy(yr&,mt&,dy&)-1)
endproc
proc dtsapart :parameters dt1$,dt2$
dt2yrmtdy(dt2$)
var ux2&=uxdy(yr&,mt&,dy&)
dt2yrmtdy(dt1$)
var ux1&=uxdy(yr&,mt&,dy&)
return int(ux2&-ux1&)
endproc
proc dynam$ :parameters uxdy&
var ux&=uxdy&
case ux&<0:ux&=ux&+2147483645
select (ux&+if(uxdy&>-141427,4,0)) mod 7
caseof 0:return "Sonntag":caseof 1:return "Montag":caseof 2:return "Dienstag"
caseof 3:return "Mittwoch":caseof 4:return "Donnerstag":caseof 5:return "Freitag"
caseof 6:return "Samstag":otherwise :return "LongDayname Error"
endselect
endproc
proc Monam$ :parameters mt&
select mt& :caseof 1:return "Jänner":caseof 2:return "Februar":caseof 3:return "März"
caseof 4:return "April":caseof 5:return "Mai":caseof 6:return "Juni"
caseof 7:return "Juli":caseof 8:return "August":caseof 9:return "September"
caseof 10:return "Oktober":caseof 11:return "November":caseof 12:return "Dezember"
otherwise :return "MonNam Error"
endselect
endproc
'}
var dt$=date$(3)
' dt$="19700301" 'Testdatum (immer 8 Zeichen bzw. auskommentieren für "heute")
' dt$="15821004" 'Do, ucdy& >= -141437
' dt$="15821015" 'Fr, ucdy& <= -141426 Kalenderreform: 10 ausgesparte Tage
dt$="15821016"
dt2yrmtdy(dt$):locate 3,1:uxdy&=uxdy(yr&,mt&,dy&):print " "+dynam$(uxdy&);",";
print " ";format$("00",dy&);".";format$("00",mt&);".";yr&,if(isleapyear(yr&),"*","")
doy&=doy(yr&,mt&,dy&):if doy&=-1:waitinput :end :else :print " ";doy&;". Tag im Jahr, ":endif
print " UnixDayNbr:",uxdy&;". abgelaufener Tag bzgl. 19700101"
'print " Vorjahres-Schalttage seit 19700101 gab es:",int((yr&-1968)*0.2425)
print "\n Rückrechnung aus Unix-Tagesnummer:"
mt&=yrdoy2mt(yr&,doy&):dy&=yrdoy2dy(yr&,doy&)
print " ";dynam$(uxdy&);", ";dy&;".",Monam$(mt&),yr&,if(isleapyear(yr&),"*"," ")
print "\n----------------------------------------------"
waitinput 10000:case %key=27:end
Print " Tage zwischen Anfangs- und Enddatum " : nochmal:
print "----------------------------------------------"
print " Anfangsdatum [JJJJMMTT oder * für heute]: ";:input dt1$
case (dt1$="*") or (dt1$="heute") or (dt1$="today"):dt1$=date$(3)
print " End-Datum [JJJJMMTT oder * für heute]: ";:input dt2$
case (dt2$="*") or (dt2$="heute") or (dt2$="today"):dt2$=date$(3)
print "\n Wochentage von ";dt1$;" bis einschließlich ";dt2$;" : ";int(dtsapart(dt1$,dt2$)+1);" Tage "
waitinput 18000:case %key=27:end
goto "nochmal"
Alles anzeigen
Kenne ich, solche Projekte die sich anders entwickeln, als gedacht.
Abt. Im Weltraum gehen die Uhren anders
===========================
... nämlich gleichmäßiger - z.B. weil es dort keine auf die Erde rückwirkenden Ebbe-und-Flut-Bewegungen gibt, und fast kein Gravitationsfeld. Die Bewegung der Himmelskörper folgt dieser Raumzeit, der Mond z.B. richtet sich nicht nach irdischen Schaltsekunden. Aus diesem Grund kommt es bereits über 50 Jahre zu erheblichem Korrekturbedarf gegenüber Erdzeit. Genau deshalb gibt es die sog. Zeitkorrektur Delta-T, die aus mittelalterlichen Aufzeichnungen bis hin zu hypergenauen modernen Messungen derzeit zwischen 2000 v.Chr. (= Astronomisches Jahr -1999) bis 3000 n.Chr. bekannt ist. Währen man dazu früher Tabellenbücher wälzen mußte, geht das heutzutage flotter.
Gruss an alle Sterngucker!
P.S.: Wenn in der Zeitung die Minute des Mond- und Sonnenauf- und -untergangs steht, muss das ja jemand berechnen. Das Progi räumt nur die erste kleine Schwierigkeit dazu aus dem Weg...
Windowtitle "Korrektur Raumzeit - Erdzeit auf +/-4 sek genau zwischen -1999 v.Chr. und +3000 n.Chr"
'(D) Demoware (XProfan 11.2a) 2014-02 by P. Specht, Wien. Mit Sorgfalt, aber ohne jede Gewähr!
' Ausgangspunkt siehe http://de.wikipedia.org/wiki/Delta_T
Declare Jahr$,y!,c$
var sw&=1 'Korrektur c wegen der vor 1955 nicht so genau bekannten Tidenhubverzögerung des Mondes
Cls:font 2:set("decimals",5):Jahr$=date$(3)
print "------------------------------------------------------------------------"
rept:
Print " Astronom.Jahr (Gregor./vor 1583: Julian: 1=1 n.Chr.,0=-1 v.Chr): ";
input c$:case c$>"":jahr$=c$:y!=val(Jahr$)
Print " Monatsnummer in diesem Jahr (1..12): ";:input c$
y!=y!+(val(c$)-0.5)/12 ' Zehnteljahre, kalibriert auf Monatsmitte
print " Gestirn erscheint ( -:später, +:früher) um ";
print format$("+########0.##;-########0.##; 0 ",Delta_T(y!));" sec"
print "-------------------------------------------------------------------------"
waitinput :case %key=27:end
goto "rept"
proc Delta_T :parameters y!,sw&
declare T!,u!
if y! >3000:print "\n *** Out-Of-Range Overflow Error *** ":beep:return 0
elseif y!<-1999:Print "\n *** Out-Of-Range Underflow Error ***":beep:return 0
elseif (y!>=-1999) and (y!<-500): u! = (y!-1820)/100: T! = -20+32*sqr(u!):return T!
elseif (y!>=-500) and (y!<500): u!=y!/100
T! = 10583.6 - 1014.41 * u! + 33.78311 * sqr(u!) - 5.952053 * sqr(u!)*u! - 0.1798452 \
* sqr(sqr(u!)) + 0.022174192 * sqr(sqr(u!))*u! + 0.0090316521 * sqr(sqr(u!))*sqr(u!)
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=500) and (y!<1600): u! = (y!-1000)/100
T! = 1574.2 - 556.01 * u! + 71.23472 * sqr(u!) + 0.319781 * sqr(u!)*u! - 0.8503463 \
* sqr(sqr(u!)) - 0.005050998 * sqr(sqr(u!))*u! + 0.0083572073 * sqr(sqr(u!))*sqr(u!)
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1600) and (y!<1700): u! = y! - 1600
T! = 120 - 0.9808 * u! - 0.01532 * sqr(u!) + sqr(u!)*u! / 7129
return T!- 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1700) and (y!<1800): u! = y! - 1700
T! = 8.83 + 0.1603 * u! - 0.0059285 * sqr(u!) + 0.00013336 * sqr(u!)*u! - sqr(sqr(u!))/1174000
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1800) and (y!<1860): u! = y! - 1800
T! = 13.72 - 0.332447 * u! + 0.0068612 * sqr(u!) + 0.0041116 * sqr(u!)*u! - \
0.00037436 * sqr(sqr(u!)) + 0.0000121272 * sqr(sqr(u!))*u! - 0.0000001699 * \
sqr(sqr(u!))*sqr(u!) + 0.000000000875 * sqr(sqr(u!))*sqr(u!)*u!
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1860) and (y!<1900): u! = y! - 1860
T! = 7.62 + 0.5737 * u! - 0.251754 * sqr(u!) + 0.01680668 * sqr(u!)*u! - \
0.0004473624 * sqr(sqr(u!)) + sqr(sqr(u!))*u! / 233174
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1900) and (y!<1920): u! = y! - 1900
T! = -2.79 + 1.494119 * u! - 0.0598939 * sqr(u!) + 0.0061966 * \
sqr(u!)*u! - 0.000197 * sqr(sqr(u!))
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1920) and (y!<1941): u! = y! - 1920
T! = 21.20 + 0.84493*u! - 0.076100 * sqr(u!) + 0.0020936 * sqr(u!)*u!
return T! - 0.000012932*sqr(y!-1955)*sw&
elseif (y!>=1941) and (y!<1961): u! = y! - 1950
T! = 29.07 + 0.407*u! - sqr(u!)/233 + sqr(u!)*u! / 2547
return T! - 0.000012932*sqr(y!-1955)*(y!<1955)*sw&
elseif (y!>=1961) and (y!<1986): u! = y! - 1975
T! = 45.45 + 1.067*u! - sqr(u!)/260 - sqr(u!)*u! / 718 : return T!
elseif (y!>=1986) and (y!<2005): u! = y! - 2000
T! = 63.86 + 0.3345 * u! - 0.060374 * sqr(u!) + 0.0017275 * sqr(u!)*u! + \
0.000651814 * sqr(sqr(u!)) + 0.00002373599 * sqr(sqr(u!))*u! : return T!
elseif (y!>=2005) and (y!<2050): u!=y!-2000:T!=62.92+0.32217*u!+0.005589*sqr(u!):return T!
' This expression is derived from estimated values of T in the years 2010 and 2050.
' The value for 2010 (66.9 seconds) is based on a linearly extrapolation from 2005
' using 0.39 seconds/year (average from 1995 to 2005). The value for 2050 (93 seconds)
' is linearly extrapolated from 2010 using 0.66 seconds/year (average rate from 1901 to 2000).
elseif (y!>=2050) and (y!< 2150)
T! = -20 + 32 * sqr((y!-1820)/100) - 0.5628 * (2150 - y!):return T!
' The last term is introduced to eliminate the discontinuity at 2050.
elseif (y!>=2150) and (y!<=3000):u! = (y!-1820)/100:T! = -20 + 32 * sqr(u!):return T!
else :print "\n *** Unexpected Error *** " :beep:return 0
endif
endproc
'{ Kurzbeschreibung
' Als Delta T (dT) wird in der Astronomie die Differenz der Terrestrischen Dynamischen Zeit (TDT,
' auch TT genannt) und der Universal Time (UT, formals GMT -Greenwich Mean Time) bezeichnet,
' also die Differenz zu einer Zeitskala, die die Bewegung und Gravitationsfelder im Sonnensystem
' kompensiert und jener, die durch die tatsächliche Erdrotation bestimmt ist.
'
' Additive Korrektur 'Delta' T = TDT - UT = ErdrotatationsPhasenversatz - GMT,
' betrug Anfang 2007 eine Minute und 5.15 Sekunden = 65.15 s
' Definitionsgleichung: T = 32.184 s + (TAI - UTC) - (UT1 - UTC)
'
' Die 32,1840 Sekunden sind die konstante Differenz zwischen TDT und der Internat. Atomzeit (TAI).
' Die Differenz zwischen TAI und der Koordinierten Weltzeit (UTC) entspricht der Anzahl der bisher
' bei UTC eingefügten Schaltsekunden (seit dem 1. Juli 2012 und bis zur nächsten Schaltsekunde: 35).
' Der Beitrag des letzten Teilterms beträgt weniger als eine Sekunde, es handelt sich um die
' Differenz zwischen der Polschwankungen berücksichtigenden Variante der Universal Time (UT1)
' und UTC, die auch dUT1 genannt wird (Verantwortlich: IERS)
'
' Der aktuelle Wert für dT kann aus den vom International Earth Rotation and Reference
' Systems Service (IERS) bereitgestellten Daten ermittelt werden. Zu Beginn des 21. Jahrhunderts
' betrug dT ungefähr 64 Sekunden, am Ende dieses Jahrhunderts wird der Zeitunterschied
' auf etwa 204 Sekunden angewachsen sein.... Historische Werte für dT lassen sich
' ungefähr bestimmen, indem überlieferte Beobachtungen mit heutigen Berechnungsergebnissen
' verglichen werden. Weiterhin gibt es verschiedene aus diesen Daten abgeleitete Polynome
' zur näherungsweisen Berechnung. Solche Polynome gibt es auch zur Prognose zukünftiger Werte.
' ...
' Auf folgender NASA-"Eclipse" Seite fand ich diese Polynome:
' Q: http://eclipse.gsfc.nasa.gov/SEcat5/deltatpoly.html (Zugriff 03.02.2014)
' Eclipse Web Site by Fred Espenak, GSFC Planetary Systems Laboratory der NASA
' Polynomial Expressions for Delta T; abgeleitet aus: 'Five Millennium Canon of Solar
' Eclipses [Espenak and Meeus]' sowie: 'Morrison, L. and Stephenson, F.R.,
' 'Historical Values of the Earth's Clock Error T and the Calculation of Eclipses',
' J. Hist. Astron., Vol.35 Part 3, Aug. 2004, No.120, pp 327-336 (2004)
'
' All values of T based on Morrison and Stephenson [2004] assume a value for the
' Moon's secular acceleration of -26 arcsec / cy^2. [Ursache ist die Verzögerung des Mondes
' durch den nacheilenden Tidenhub des Meeres und in geringerem Maße der Landmassen. Es existieren
' da aber bereits genauere Daten, was per Korrektursummand c führt:]However,the ELP-2000/82 lunar
' ephemeris employed in the Canon (=Tabelle) uses a slightly different value of -25.858 arcsec/cy^2.
' Thus, a small correction "c" must be added to the values derived from the polynomial
' expressions for T before they can be used in the Canon:
'
' c = -0.000012932 * sqr(y-1955) '*** Korrektur wird mit sw&=1 zugeschaltet, siehe unten! ***
' Since the values of T! for the interval 1955 to 2005 were derived independent of any
' lunar ephemeris, no correction is needed for this period.
'}
Alles anzeigen
Abt. GrabFromURL
============
Vor Jahren gab es mal ein nützliches kleines DOS-Tool namens GrabURL.exe , das aber in der 64-bit-Welt von heute nicht mehr funktioniert . Anbei ein funktionell ähnliches Teil zum rohen Downloaden einzelner Files von Internetseiten auf den eigenen Desktop.
Gruss
P.S.: DRINGENDER HINWEIS: So geladene Dateien anschließend IMMER :idea: SOFORT auf Viren / Malware prüfen
Windowtitle "GrabFromURL":declare stat&,u$,url$,path$,fnam$
'NO WARRANTIES WHATSOEVER! IT'S YOUR OWN RISK!
Windowstyle 24:cls:font 2:url$="http://www.yepi.us/swf/Pee-Man---The-Game.swf"
path$=getenv$("USERPROFILE")+"//desktop//":fnam$=path$+"PeeMan.swf.txt"
print "FROM URL incl.'http' part: ";:input u$:case u$>"":url$=u$
print "TO Filename on Desktop: ";:input u$:case u$>"":fnam$=path$+u$
ifnot dirExists(path$):print "\nERROR: Directory not found!":waitinput 60000:end:endif
if fileexists(fnam$):print "\nERROR: File already exists!":beep:waitinput 60000:end:endif
stat&=@DownLoadFile(url$,fnam$)
if stat&>0:CLS:else :print "Sorry, no DL possible!":beep:waitinput 60000:end :endif
while %loading:locate 1,1:stat&=&BytesRead:print stat&;" bytes read...";:waitinput 250:endwhile
stat&=&BytesRead:if stat&=-1:locate 1,1:print "Error after trying DL!"
else :cls:locate 1,1:print stat&;" byte downloaded in total.\n":endif
print "File ";fnam$;" ready.\n\nAlways check for viruses!!!":beep:waitinput 10000:end
Alles anzeigen
Abt. Fliehkraftberechnung ohne Massendynamik
==============================
Zum Unterschied von Energie- bzw. Drehimpuls-Simulationen führt die bloße Darstellung des jeweils schon eingependelten Endzustandes von Fliehkraftreglern (wie er in Physiklehrbüchern als Winkel aus Gravitation und nach aussen wirkender Fliehkraft dargelegt wird) nicht zu realistisch wirkenden Resultaten, wie der nachfolgende Müllcode beweist... Das mit den Pendeln müssen wir also noch besser hinkriegen!
Gruss
WindowTitle "Fliehkraft"
'(CL) CopyLeft 2014-02 by P. Specht; Keine wie auch immer geartete Haftung!
WindowStyle 24:Randomize:Font 2:Window 0,0-%maxx,%maxy-40
cls rgb(200+rnd(56),200+rnd(56),200+rnd(56))
var xx&=width(%hwnd):var yy&=height(%hwnd)
line 0,yy&\2 - xx&,yy&\2:usepen 0,3,rgb(0,0,0):line xx&\2,0 - xx&\2,yy&
declare masse!,F_flieh!,F_grav!,alpha!,omega!,r!,x!,y!,freq!,scale!
scale!=5000
r!= 0.1'm Radius
masse!= 0.1'kg
freq!= 0 'U/s Drehzahl
whileloop 700,10000-700,100:if &Loop<5000:freq!=&Loop/2000:else : freq!=(10000-&Loop)/2000:endif
omega!=2*pi()*freq!
F_flieh!=masse!*r!*sqr(omega!)
F_grav! =masse!*9.80665 'kg.m/s² = N
if abs(F_flieh!)<10^-10:alpha!=pi()/2
else :alpha!=arctan(F_grav!/F_flieh!)
endif
locate 1,1:print freq!;" U/s "
usepen 0,3,255:line xx&\2,7 - xx&\2+scale!*r!*cos(pi()-alpha!), scale!*r!*sin(pi()-alpha!)
usepen 0,3,0:usebrush 1,rgb(rnd(256),255,255)
ellipse (xx&\2+25-scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)-25) - \
(xx&\2-25-scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)+25)
usepen 0,3,255:line xx&\2,7 - xx&\2-scale!*r!*cos(pi()-alpha!), scale!*r!*sin(pi()-alpha!)
usepen 0,3,0:usebrush 1,rgb(255,rnd(256),255)
ellipse (xx&\2+25+scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)-25) - \
(xx&\2-25+scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)+25)
waitinput 100
endwhile
waitinput
Alles anzeigen
Abt. Rechenpräzision von XProfan
=====================
Oft reicht die Double-precision-Arithmetik von XProfan für heikle iterative Simulationen (Wirksamkeit von Pharmaka etc.) nur dann, wenn der verwendete Algorithmus sehr geschickt programmiert ist und der Programmierer auch eine günstige Rechen-Reihenfolge wählt. Am Beispiel "Schwerpunkt" (z.B. eines Makromoleküls) kann das demonstriert werden, etwa beim Nachvollziehen der Vorgänge beim thermischen Cracken langkettiger Fette und Öle, wo es auf die präzise Berechnung der Teil-Schwerpunkte ((zur späteren Ermittlung der "Bruchspannungen" = Überwindung der Van der Waals-Kräfte)) ankommt. Nachstehend ein sehr einfach gehaltenes, "zu Fuß" programmiertes Testbeispiel dazu. In der Praxis wäre natürlich eine Automatisierung solcher Prüffolgen erforderlich!
Gruss
WindowTitle "Gesamtschwerpunkt-Ermittlung durch schrittweise Aggregatbildung"
' (CL) Copyleft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
WindowStyle 24:randomize:Window 0,0-%maxx,%maxy-40
Cls rgb(200+rnd(56),200+rnd(56),200+rnd(56)):Font 2:set("decimals",18)
declare m1!,x1!,y1!,z1!,m2!,x2!,y2!,z2!,m3!,x3!,y3!,z3!,m4!,x4!,y4!,z4!
declare m12!,x12!,y12!,z12!,m123!,x123!,y123!,z123!
declare m1234!,x1234!,y1234!,z1234!
print "\n Schwerpunkt eines Systems aus 4 gegeneinander fixierten Massen wird berechnet."
print "\n Aufgabe 'Schwerpunkt-Formel überprüfen': Gibt es Unterschiede im Ergebnis \n"
print " (bzgl. Präzision etc.) bei unterschiedlicher Zusammenfassungsreihenfolge? \n\n\n"
'--- Masse, x-, y-, z-Koordinate -------------------------------------------------------
m1!=val("11") :x1!=val("-10.5") : y1!=val(" 5") :z1!=val("1")
m2!=val("1 ") :x2!=val(" 10.5") : y2!=val("-5") :z2!=val("3")
m3!=val("-9") :x3!=val(" 1.5") : y3!=val(" 5") :z3!=val("7")
m4!=val("14") :x4!=val(" -1.5") : y4!=val("-2") :z4!=val("11")
'----------------------------------------------------------------------------------------
' Precision Tests:
'----------------------------------------------------------------------------------------
print:print tab(30);" Masse ";tab(52);" X ";tab(74);" Y ";tab(100);" Z ":print
m12!=m1!+m2!
x12!=(m1!*x1!+m2!*x2!)/(m1!+m2!)
y12!=(m1!*y1!+m2!*y2!)/(m1!+m2!)
z12!=(m1!*z1!+m2!*z2!)/(m1!+m2!)
m123!=m1!+m2!+m3!
x123!=(m12!*x12!+m3!*x3!)/(m12!+m3!)
y123!=(m12!*y12!+m3!*y3!)/(m12!+m3!)
z123!=(m12!*z12!+m3!*z3!)/(m12!+m3!)
m1234!=m1!+m2!+m3!+m4!
x1234!=(m123!*x123!+m4!*x4!)/(m123!+m4!)
y1234!=(m123!*y123!+m4!*y4!)/(m123!+m4!)
z1234!=(m123!*z123!+m4!*z4!)/(m123!+m4!)
print " Weg ((1+2)+3)+4: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
m12!=m4!+m2!
x12!=(m4!*x4!+m2!*x2!)/(m4!+m2!)
y12!=(m4!*y4!+m2!*y2!)/(m4!+m2!)
z12!=(m4!*z4!+m2!*z2!)/(m4!+m2!)
m123!=m4!+m2!+m3!
x123!=(m12!*x12!+m3!*x3!)/(m12!+m3!)
y123!=(m12!*y12!+m3!*y3!)/(m12!+m3!)
z123!=(m12!*z12!+m3!*z3!)/(m12!+m3!)
m1234!=m1!+m2!+m3!+m4!
x1234!=(m123!*x123!+m1!*x1!)/(m123!+m1!)
y1234!=(m123!*y123!+m1!*y1!)/(m123!+m1!)
z1234!=(m123!*z123!+m1!*z1!)/(m123!+m1!)
print " Weg ((4+2)+3)+1: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
m12!=m1!+m3!
x12!=(m1!*x1!+m3!*x3!)/(m1!+m3!)
y12!=(m1!*y1!+m3!*y3!)/(m1!+m3!)
z12!=(m1!*z1!+m3!*z3!)/(m1!+m3!)
m123!=m1!+m2!+m3!
x123!=(m12!*x12!+m2!*x2!)/(m12!+m2!)
y123!=(m12!*y12!+m2!*y2!)/(m12!+m2!)
z123!=(m12!*z12!+m2!*z2!)/(m12!+m2!)
m1234!=m1!+m2!+m3!+m4!
x1234!=(m123!*x123!+m4!*x4!)/(m123!+m4!)
y1234!=(m123!*y123!+m4!*y4!)/(m123!+m4!)
z1234!=(m123!*z123!+m4!*z4!)/(m123!+m4!)
print " Weg ((1+3)+2)+4: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
m12!=m4!+m3!
x12!=(m4!*x4!+m3!*x3!)/(m4!+m3!)
y12!=(m4!*y4!+m3!*y3!)/(m4!+m3!)
z12!=(m4!*z4!+m3!*z3!)/(m4!+m3!)
m123!=m4!+m3!+m2!
x123!=(m12!*x12!+m2!*x2!)/(m12!+m2!)
y123!=(m12!*y12!+m2!*y2!)/(m12!+m2!)
z123!=(m12!*z12!+m2!*z2!)/(m12!+m2!)
m1234!=m4!+m3!+m2!+m1!
x1234!=(m123!*x123!+m1!*x1!)/(m123!+m1!)
y1234!=(m123!*y123!+m1!*y1!)/(m123!+m1!)
z1234!=(m123!*z123!+m1!*z1!)/(m123!+m1!)
print " Weg ((4+3)+2)+1: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
print "\n\n Bitte weitere Tests durch Einprogrammieren stark abweichender Massen und Positionen durchführen! "
waitinput
Alles anzeigen
Hm, ich dachte das man so etwas nur bei
benötigt.
Für einfache Floatwerte mit Minuszeichen ist sowas nicht erforderlich. Ins Schleudern kommt XProfan nur bei dem negativen Exponenten.
Die Lösung Deines Problemes wäre aber nicht so einfach. Wenn man intern mit höherer Genauigkeit rechnet, dann bleibt es bei der Zuweisung hängen. Da wird dann wieder auf einfache (doppelte) Genauigkeit zurückgerechnet.
Um z.B. die Agner Fog Mathe-Routinen richtig ausreizen zu können braucht man dann auch die 80 oder 128-Byte Zielvariablen.
Aber da sieht man mal das man nicht erst in den Weltraum ausweichen muss um an die Grenzen der in fast allen Programmiersprachen verwendeten Mathe-Routinen zu stoßen.
Gruß
Michael Wodrich
Michael: Da dachtest du natürlich richtig! Ich hätte auch dazuschreiben sollen, daß ich mit der guten alten Version 11.2a programmiere, die den Wertebereich 10^-323 (Underflow, rechnet aber weiter) bzw. eigentlich 10^-306 bis 10^306 hat , - im Gegensatz zu einigen neueren Versionen mit Zahlenbereich 10^-53 bis 10^53 :8o: .
Der VAL()-Befehl ist nur dann erforderlich, wenn man die Grenzen der Präzision voll austesten will, z.B. bei zwei Werten in der Größenordnung 10^-15 die in der Formel multipliziert werden, um dann durch das Ergebnis zu dividieren. Da kommt es rasch zu starken Genauigkeitseinbussen, die bei hundert- bis tausendfacher Iteration fatal werden können.
Gruss
P.S.: Danke auch für den Hinweis auf das Math Pack von Prof. Agner Fog, werde ich mir gleich näher ansehen!
PPS: Klarstellung: Mit dem Schwerpunktsbeispiel oben galt es damals, Molekülbruchstellen zu finden - nur deshalb wurden auch 2-er und 3-er-Teilschwerpunkte ermittelt! Geht es lediglich um die 3D-Koordinaten des Gesamtschwerpunktes von N zueinander fest angeordneten Massenteilchen, dann gilt selbstverständlich die aus Film und Fernsehen bekannte Formel X_Schwerpkt = SUM(m[i]*X[i]) / SUM(m[i]) ... für i=1 bis N; gleiches dann jeweils auch für die Y- und Z-Koordinate. War aber eh klar, oder?
Abt. Bytefelder aus Dateien als hexadezimale XProfan-$Longvariablen ins Clipboard bringen
=========================================================
... aus gegebenem Anlaß. Gruss!
WindowTitle "File2Long into Clipboard"
'(CL)CopyLeft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
var DrivePathFilename$="TESTSELF.PRF"
declare i&,z$:Window 0,0-%maxx,%maxy-40
ifnot FileExists(DrivePathFilename$):print " *** File not found *** "
else :Assign #1,DrivePathFilename$:OpenRW #1:ClearClip
z$="var v$="+chr$(34)+chr$(34):print z$:putclip z$+"\n"
Repeat :print "v$=v$+"+chr$(34);:putclip "v$=v$+"+chr$(34)
whilenot eof(#1):inc i&:z$="$"+right$("00000000"+hex$(GetLong(#1)),8)
print z$;:putclip z$
if (i& MOD 8) and not(eof(#1)) :print ",";:putclip ","
else :print chr$(34):putclip chr$(34)+"\n":break
endif :endwhile
until eof(#1):Close #1:font 2:print "\n\n CLIPBOARD READY."
endif :WaitInput 60000:End
Alles anzeigen
Hm, da wird aber ein Rest verschluckt...
Sorry - stimmt nicht. Da landet bissl Müll am Ende. Ich hatte übersehen, das die Bytes ja anders herum gespeichert werden. Ist hiermit gut zu sehen...
' ##### VORSICHT: nur zum Ausloten benutzen... #############
WindowTitle "File2Long into Clipboard"
'(CL)CopyLeft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
var DrivePathFilename$ = "TESTSELF.PRF"
declare i&,z$ ,y$,L&
Window 0,0 - %maxx,%maxy-40
proc ch:parameters a%:return " "+if((a%>=32)and(a%<127),chr$(a%),"."):endproc
ifnot FileExists(DrivePathFilename$)
print " *** File not found *** "
else
Assign #1,DrivePathFilename$
OpenRW #1
ClearClip
z$ = "var v$=" + chr$(34) + chr$(34)
y$ = "var t$=" + chr$(34) + chr$(34)
print z$
putclip z$ + "\n"
putclip y$ + "\n"
Repeat
print "v$=v$+" + chr$(34);
putclip "v$=v$+" + chr$(34)
y$ = "t$=t$+" + chr$(34)
whilenot eof(#1)
inc i&
L& = GetLong(#1)
z$ = "$" + right$("00000000" + hex$(L&),8)
y$ = y$ + " " + ch(L& & $FF): L& = L& >> 8
y$ = y$ + ch(L& & $FF): L& = L& >> 8
y$ = y$ + ch(L& & $FF): L& = L& >> 8
y$ = y$ + ch(L& & $FF)
print z$;
putclip z$
if (i& MOD 8) and not(eof(#1))
print ",";
putclip ","
y$ = y$ + " "
else
print chr$(34)
putclip chr$(34) + "\n"
putclip y$ + chr$(34) + "\n"
break
endif
endwhile
until eof(#1)
Close #1
font 2
print "\n\n CLIPBOARD READY."
endif
WaitInput 60000
End
'****
Alles anzeigen
Genial einfach Dein Code und durch die Zwischenablage kann das Ergebnis gleich an die richtige Stelle gesetzt werden.
Gruß
Michael Wodrich
P.S.: Seit wann funktioniert eigentlich die Zahl hinter WaitInput. Ist nicht in der Hilfe erwähnt... 8O
Abt. Nebenläufige Parallel-Threads in XProfan-Versionen vor X2 bzw. Freeprofan32/XProfan64(beta)
==============================================================
lassen sich u.a. per xpse-Präcompiler realisieren. Die Beispiele in dessen Syntaxbeschreibung sind allerdings etwas dürftig. Deshalb hier ein etwas komplexeres Beispiel. Ab X2 gibt es dazu den Befehl pExec, mit dem sich z.B. ebenfalls multiple Timerschleifen realisieren lassen.
{$cleq}
cls:var n&=0:Print " Theads der Reihe nach beenden mit ESC-Taste!"
var thread&=thread.start(procaddr(meinThread),0,"")
var thread2&=thread.start(procaddr(meinZweiterThread),0,"")
main:
repeat
locate 10,10:print n&:inc n&;
waitinput 5:until %key=27
print "\n Habe Hauptschleife verlassen.":waitinput
thread.stop(thread&):while thread.is(thread&):endwhile:thread.close(thread&)
print " Habe Thread Nr. 1 beendet.":waitinput
thread.stop(thread2&):while thread.is(thread2&):endwhile:thread.close(thread2&)
print " Habe Thread Nr. 2 beendet."
print " Isch 'abe feddisch...":waitinput 3000
end
nproc meinThread :parameters thread&,dataLong&,dataString$
whilenot thread.message(thread&)==wm_close
settext(%hWnd,"Mein FensterTitel - ["+time$(0)+"."+substr$(time$(1),1,".")+"]")
sleep(1000):endwhile:return 0
endproc
nproc meinZweiterThread :parameters thread&,dataLong&,dataString$
whilenot thread.message(thread&)==wm_close
settext(%hWnd,"MEIN FENSTERTI - ("+time$(0)+"."+substr$(time$(1),1,".")+")")
sleep(900):endwhile:return 0
endproc
Alles anzeigen
pExec erzeugt keine Threads, sondern erzeugt einen weiteren Process! Das sind 2 sehr verschiedene Dinge.
Mehrere Threads eines Processes benutzen denselben Speicher, deshalb sind dort auch Maßnahmen wie
Ciritical Sections, Mutex und Semaphoren erforderlich, um undefinierte Zustände des Speichers entgegenzu-
wirken. Der von XPSE erzeugte Code ist nur sehr eingeschränkt Threadsafe.
Bei durch pExec erzeugten Processen gibt es keine solche Probleme, aber der Datenaustausch zwischen den
Processen ist natürlich stark beschränkt, dafür läuft das ganze aber wesentlich stabiler.
Danke für die Klarstellung, TSSoft! Genau das mit dem Speicher hatte ich bisher nie verstanden!
Gruss
P.S.: Meine Methode "Lernen durch Blödsinn schreiben und von kompetenter Stelle korrigiert werden" hat sich wieder einmal bewährt
Sie haben noch kein Benutzerkonto auf unserer Seite? Registrieren Sie sich kostenlos und nehmen Sie an unserer Community teil!