Commit f150bcef by kollo

2002-09-09

parents
Dies sind einige Beispielprogramme mit teils
groesserem Umfang fuer X11-Basic.
Sie sollen als Anleitung und Anregung fuer eigene
Programme diehnen.
Viel Spass damit.
Markus Hoffmann
<TITLE>Directory listing of examples/calculation</TITLE>
<H1>Directory listing of examples/calculation</H1>
<PRE>
<A HREF="..">Up to higher level directory</A><BR>
<A HREF="sieve.bas"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> sieve.bas</A> 363 bytes Tue Sep 4 00:56:31 2001
<A HREF="sortdemo.bas"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> sortdemo.bas</A> 27 Kb Sun Oct 7 23:51:04 2001
<A HREF="sqr.bas"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> sqr.bas</A> 314 bytes Thu Apr 1 09:26:48 1999
</PRE>
rem "sieve.bas" , a prime number sieve benchmark
t=timer
tc=ctimer
s=40000
dim f(s+1)
arrayfill f(),1
clr c
for i=2 to s
if f(i)
if 2*i<s
for k=2*i to s step i
clr f(k)
next k
flush
endif
print i,
inc c
endif
next i
print
print c;" primes found in ";
t=timer-t
tc=ctimer-tc
print t;" seconds (";tc;" s CPU )"
quit
echo off
print "Dieses Programm rechnet die Quadratwurzel einer Zahl"
input "Zahl=",z
r124=1
105:
r123=r124
r124=(r123^2+z)/(2*r123)
if abs(r124-r123)-0.00001>0
print r124
goto 105
endif
print "Das Ergebnis des Algoritmus:"'r124
print "Zum Vergleich: sqr(";z;")=";sqr(z)
print "Abweichung:"'abs(sqr(z)-r124)
end
Diese Beispiel-Scripten lassen sich als *.cgi Programme von einem
Webserver (z.B. apache) aus aufrufen. Bei mir befinden sie sich z.B.
im Ordner /usr/local/httpd/cgi-bin/.
Auf meiner Homepage http://cips02.physik.uni-bonn.de/~hoffmann/
können die Scripte live erlebt und ausprobiert
werden.
viel Spass damit
M. Hoffmann 01'2001
#!/bin/xbasic
echo off
'
' brabbel.cgi von Markus Hoffmann (Jan 2001)
'
host$=""
print "Content-type: text/html"
print
t$=env$("REQUEST_URI")
wort_sep t$,"?",1,a$,t$
iq=4
ut=0
wort_sep t$,"&",1,a$,t$
while len(a$)
wort_sep a$,"=",1,b$,a$
if b$="url"
url$=a$
else if b$="IQ"
iq=min(15,max(val(a$),1))
else if b$="button"
if a$="URL+Testen"
ut=1
endif
else
print "Unbekannte Option: "+b$+" : "+a$+"<p>"
endif
wort_sep t$,"&",1,a$,t$
wend
t$=url$
@ersetzen
tmpfile$="/tmp/brabbeltmp"+str$(stimer)
url$=t$
if len(url$)=0
url$="http://cips01.physik.uni-bonn.de/~hoffmann/texte/party.html"
endif
if left$(url$,5)="http:"
wort_sep url$,"//",1,uhost$,url$
endif
wort_sep url$,"/",1,uhost$,url$
url$="/"+url$
print "<HTML> <HEAD> <TITLE>Markus Hoffmann's Webgebrabbel</TITLE></HEAD>"
print "<BODY bgcolor="#ffffff" link=2200aa vlink=008800><center>"
print "<H1> Webgebrabbel</H1><HR>"
print "Geben Sie die Web-Seite ein, &uuml;ber die gebrabbelt werden soll. Der Intelligenzquotient bestimmt, "
print "wie sinnig der Ausgabetext sein soll: 1=unsinnig -- 10=Orginaltext. Werte 3,4,5 sind sinnvoll."
print "<form name=querybox action="+host$+"/cgi-bin/brabbel.cgi method=get>"
print "<font size=2 color=000000>"
print "URL=<input type=text name=url value="+chr$(34)+"http://"+uhost$+url$+chr$(34)+" size=60><br>"
print "Intelligenzquotient=<input type=text name=IQ value="+chr$(34)+str$(iq)+chr$(34)+" size=2>"
r$=env$("REMOTE_ADDR")
h$=env$("REMOTE_HOST")
open "A",#1,"/tmp/WEBBrabbel.log"
print #1,date$+" "+time$+" "+r$+" "+h$+" ";
print #1,"UT="+str$(ut)+" IQ="+str$(iq)+" ";
print #1,chr$(34)+"http://"+uhost$+url$+chr$(34)
close #1
print "<input name=button value="+chr$(34)+"Losbrabbeln"+chr$(34)+" type="+chr$(34)+"submit"+chr$(34)+">"
print "<input name=button value="+chr$(34)+"URL Testen"+chr$(34)+" type="+chr$(34)+"submit"+chr$(34)+">"
print "</font>"
print "</form><p></center><HR><font size=2 color=ff0000>"
flush
s$="wget -O "+tmpfile$+".brab "+chr$(34)+uhost$+url$+chr$(34)+" ; "
s$=s$+"html2text -nobs "+tmpfile$+".brab > "+tmpfile$+" ; "
s$=s$+"rm -f "+tmpfile$+".brab"
system s$
if ut=0
open "I",#1,tmpfile$
l=lof(#1)
t$=space$(l+1)
close #1
bload tmpfile$,varptr(t$),l
u$=trim$(t$)
read a$,b$
while a$<>""
u$=@ersetze$(u$,a$,b$)
read a$,b$
wend
bsave tmpfile$,varptr(u$),len(u$)
s$="/usr/local/bin/brabbel -intelligenz "+str$(iq)+" -laenge "+str$(min(l,5000))+" -input "+tmpfile$
else
s$="echo '</font><font size=2 color=1000ff><pre>' ; cat "+tmpfile$
endif
s$=s$+" ; "+"rm -f "+tmpfile$
system s$
print "</font></pre><hr><font size=1>*** Webgebrabbel Version: 1.00 (c) Markus Hoffmann "
print " *** letzte Bearbeitung 5.1.2001 </font><hr>"
print "<I>Kommentare oder Anregungen zu dieser WWW-Seite bitte "
print "<A HREF=mailto:hoffmann@physik.uni-bonn.de>hierhin</A>.</I><P>"
print "<FONT FACE="+chr$(34)+"ARIAL,HELVETICA"+chr$(34)+" SIZE=1>"
print "Erzeugt am "+time$+" "+date$
print "</FONT></BODY></HTML>"
quit
data "~","-"
data "!!","!","??","?","==","=","--","-","**","*"
data "",""
procedure ersetzen
local y$,a$,b$,i
for i=20 to 255
y$="%"+right$(upper$(hex$(i)),2)
wort_sep t$,y$,1,a$,b$
while a$<>t$
t$=a$+chr$(i)+b$
wort_sep t$,y$,1,a$,b$
wend
next i
return
function ersetze$(era$,erb$,erc$)
local tta$,ttb$
wort_sep era$,erb$,0,tta$,ttb$
while len(ttb$)
era$=trim$(tta$+erc$+ttb$)
wort_sep era$,erb$,0,tta$,ttb$
wend
return era$
endfunction
#!/bin/xbasic
' Formtomail.cgi (c) Markus Hoffmann 2001
' Das Programm verschickt Emails mit dem Inhalt des Formulars
' Die Prozedur formtomail.cgi bewirkt, dass die ins Formular
' eingegebenen Parameter mit ihren Werten per Mail an die Adresse
' geschickt werden, die in dem Input-Feld mit dem Namen "Mailto" unter
' "Value" angegeben ist. Die beiden Input-Felder "Mailto" und "Subject"
' muessen genau in der unten spezifizierten Form angegeben werden
' (Gross-/Kleinschreibung bei "Mailto" und "Subject" beachten). Das
' Input-Feld "Subject" ist dafuer da, dass der Benutzer bei mehreren
' verschiedenen Formularen eine Zuordnung vornehmen kann (da es nicht
' moeglich ist, den Text des Formulars mitzuschicken, sondern nur die
' Parameter). Diese beiden Felder haben das Attribut "hidden", damit der
' Benutzer, der das Formular ausfuellt, sie nicht veraendern kann. >
print "Content-type: text/html"+chr$(13)
print ""+chr$(13)
flush
dim value$(200)
t$=""
print "<html><head></head><body>"
print "Vielen Dank f&uuml;r das Ausf&uuml;llen des Formulars.<p>"
print "Es wird so schnell wie m&ouml;glich bearbeitet...<p>"
print "<pre>"
r$=env$("REMOTE_ADDR")
h$=env$("REMOTE_HOST")
refer$=env$("HTTP_REFERER")
length=val(env$("CONTENT_LENGTH"))
if length
for i=0 to length-1
t$=t$+chr$(inp(-2))
next i
orig$=t$
count=0
wort_sep t$,"&",1,a$,t$
while len(t$)
value$(count)=a$
inc count
print a$
wort_sep t$,"&",1,a$,t$
wend
value$(count)=a$
inc count
print a$
endif
if count
for i=0 to count-1
wort_sep value$(i),"=",1,a$,b$
if a$="Mailto"
mailto$=b$
endif
if a$="Subject"
subject$=b$
endif
next i
mailto$=@ersetze$(mailto$,"%40","@")
flush
if upper$(right$(mailto$,3))=".DE"
s$="mail -s "+chr$(34)+"[Form-to-Mail]: "+subject$+chr$(34)+" "+mailto$+" << EOF"+chr$(13)
for i=0 to count-1
s$=s$+value$(i)+chr$(10)
next i
s$=S$+chr$(10)+"EOF"+chr$(10)
system s$
status$="sent to "+mailto$
else
status$="unsent ("+mailto$+")"
endif
endif
print "</pre>"
print "</body></html>"
flush
open "A",#1,"/tmp/WEBformtomail.log"
print #1,date$+" "+time$+" "+r$+" "+h$+" ";
print #1,"B="+chr$(34)+refer$+chr$(34)+" ";
print #1,"C="+chr$(34)+orig$+chr$(34)+" Status="+status$
close #1
quit
function ersetze$(era$,erb$,erc$)
local tta$,ttb$
wort_sep era$,erb$,0,tta$,ttb$
while len(ttb$)
era$=trim$(tta$+erc$+ttb$)
wort_sep era$,erb$,0,tta$,ttb$
wend
return era$
endfunction
<TITLE>Directory listing of examples/cgi</TITLE>
<H1>Directory listing of examples/cgi</H1>
<PRE>
<A HREF="..">Up to higher level directory</A><BR>
<A HREF="README"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> README</A> 331 bytes Thu Aug 23 21:02:00 2001
<A HREF="brabbel.cgi"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> brabbel.cgi</A> 3 Kb Thu Aug 23 20:58:05 2001
<A HREF="formtomail.cgi"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> formtomai...</A> 2 Kb Thu Aug 23 20:58:05 2001
<A HREF="mandel.cgi"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> mandel.cgi</A> 2 Kb Thu Aug 23 20:58:05 2001
<A HREF="mandelgif.cgi"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> mandelgif...</A> 893 bytes Thu Aug 23 20:58:05 2001
<A HREF="mandelposter.cgi"><IMG ALIGN=absbottom BORDER=0 SRC="internal-gopher-unknown"> mandelpos...</A> 1 Kb Thu Aug 23 20:58:05 2001
</PRE>
#!/bin/xbasic
echo off
host$=""
'
' mandel.cgi (c) Markus Hoffmann 1999 V. 1.01
' darf mit dem Paket X11-Basic weitergegeben werden
'
print "Content-type: text/html"
print
t$=env$("REQUEST_URI")
wort_sep t$,"?",1,a$,t$
wort_sep t$,"?",1,t$,u$
if len(t$)<2
x1=-2
y1=-2
x2=2
y2=2
else
wort_sep t$,"&",1,a$,t$
while len(a$)
wort_sep a$,"=",1,a$,b$
if a$="x1"
x1=val(b$)
else if a$="x2"
x2=val(b$)
else if a$="y1"
y1=val(b$)
else if a$="y2"
y2=val(b$)
endif
wort_sep t$,"&",1,a$,t$
wend
endif
if len(u$)
wort_sep u$,",",1,x$,y$
nx=val(x$)/256*(x2-x1)+x1
ny=(256-val(y$))/256*(y2-y1)+y1
u=abs(x2-x1)
x1=nx-u/4
x2=nx+u/4
u=abs(y2-y1)
y1=ny-u/4
y2=ny+u/4
endif
if x1=-2
r$=env$("REMOTE_ADDR")
h$=env$("REMOTE_HOST")
open "A",#1,"/tmp/WEBMANDEL.log"
print #1,date$+" "+time$+" "+r$+" "+h$
close #1
endif
gifname$="mandelgif.cgi?x1="+str$(x1)+"&x2="+str$(x2)+"&y1="+str$(y1)+"&y2="+str$(y2)
print "<HTML> <HEAD> <TITLE>Markus Hoffmann's Mandelbrodmenge</TITLE></HEAD>"
print "<BODY bgcolor="#ffffff" link=2200aa vlink=008800><center>"
print "<H1> Die Mandelbrodmenge interaktiv</H1><HR>"
print "Klicken Sie in das Bild, um einen Bereich zu vergr&ouml;&szlig;ern. Alternativ k&ouml;nnen Sie die Koordinaten auch eingeben."
print "<form name=querybox action="+host$+"/cgi-bin/mandel.cgi method=get>"
print "<a href="+host$+"/cgi-bin/mandel.cgi?x1="+str$(x1)+"&x2="+str$(x2)+"&y1="+str$(y1)+"&y2="+str$(y2)+"><img src=/cgi-bin/"+gifname$+" ismap align=left></a>"
print "X1=<input type=text name=x1 value="+str$(x1)+" size=16><br>"
print "X2=<input type=text name=x2 value="+str$(x2)+" size=16><br>"
print "y1=<input type=text name=y1 value="+str$(y1)+" size=16><br>"
print "Y2=<input type=text name=y2 value="+str$(y2)+" size=16><br>"
print "<input value="+chr$(34)+"Koordinaten Berechnen"+chr$(34)+" type="+chr$(34)+"submit"+chr$(34)+">"
print "<a href="+host$+"/cgi-bin/mandel.cgi?> Zur&uuml;ck zum Start </a><p>"
print "<a href="+host$+"/cgi-bin/mandelposter.cgi?x1="+str$(x1)+"&x2="+str$(x2)+"&y1="+str$(y1)+"&y2="+str$(y2)+"> Ausschnitt als 800x800 Poster </a>"
print "<input type=hidden name=format value=2>"
print "</form><p></center><HR><br>"
print "<I>Kommentare oder Anregungen zu dieser WWW-Seite bitte "
print "<A HREF=mailto:hoffmann@physik.uni-bonn.de>hierhin</A>.</I><P>"
print "<FONT FACE="+chr$(34)+"ARIAL,HELVETICA"+chr$(34)+" SIZE=1>"
print "Erzeugt am "+time$+" "+date$
print "</FONT></BODY></HTML>"
quit
#!/bin/xbasic
echo off
'
' mandelgif.cgi (c) Markus Hoffmann 1999 V. 1.01
' darf mit dem Paket X11-Basic weitergegeben werden
'
t$=env$("REQUEST_URI")
wort_sep t$,"?",1,a$,t$
if len(t$)<2
x1=-2
y1=-2
x2=2
y2=2
else
wort_sep t$,"&",1,a$,t$
while len(a$)
wort_sep a$,"=",1,a$,b$
if a$="x1"
x1=val(b$)
else if a$="x2"
x2=val(b$)
else if a$="y1"
y1=val(b$)
else if a$="y2"
y2=val(b$)
endif
wort_sep t$,"&",1,a$,t$
wend
endif
' print "/usr/local/bin/mandelraw "+str$(x1)+" "+str$(x2)+" "+str$(y1)+" "+str$(y2)+" | raw2gif -p /home/hoffmann/bin/colormap -s 256 256 > /tmp/testm.gif"
system "echo 'Content-type: image/png';echo ; /usr/local/bin/mandelraw "+str$(x1)+" "+str$(x2)+" "+str$(y1)+" "+str$(y2)+" | raw2gif -p /usr/local/httpd/cgi-bin/colormap -s 256 256 | /usr/X11R6/bin/giftopnm | /usr/X11R6/bin/pnmtopng -inter"
quit
#!/bin/xbasic
echo off
'
' mandelposter.cgi (c) Markus Hoffmann 1999 V. 1.01
' darf mit dem Paket X11-Basic weitergegeben werden
'
t$=env$("REQUEST_URI")
wort_sep t$,"?",1,a$,t$
if len(t$)<2
x1=-2
y1=-2
x2=2
y2=2
else
wort_sep t$,"&",1,a$,t$
while len(a$)
wort_sep a$,"=",1,a$,b$
if a$="x1"
x1=val(b$)
else if a$="x2"
x2=val(b$)
else if a$="y1"
y1=val(b$)
else if a$="y2"
y2=val(b$)
endif
wort_sep t$,"&",1,a$,t$
wend
endif
r$=env$("REMOTE_ADDR")
h$=env$("REMOTE_HOST")
open "A",#1,"/tmp/WEBMANDEL.log"
print #1,date$+" "+time$+" "+r$+" "+h$+" Poster: "+str$(x1)+" "+str$(x2)+" "+str$(y1)+" "+str$(y2)
close #1
' print "/usr/local/bin/mandelraw "+str$(x1)+" "+str$(x2)+" "+str$(y1)+" "+str$(y2)+" | raw2gif -p /home/hoffmann/bin/colormap -s 256 256 > /tmp/testm.gif"
system "echo 'Content-type: image/png';echo ; /usr/local/bin/mandelraw800 "+str$(x1)+" "+str$(x2)+" "+str$(y1)+" "+str$(y2)+" | raw2gif -p /usr/local/httpd/cgi-bin/colormap -s 800 800 | /usr/X11R6/bin/giftopnm | /usr/X11R6/bin/pnmtopng -inter"
quit
Diese Beispielprogramme sind Anwendingen der Modifikation csxbasic fuer das
ELSA-Kontrollsystem (Physikalisches Institut, Uni-Bonn) und laufen nicht in
der normalen X11-Basic-Version. Sie koennen aber als Beispiel und Anregung
diehnen.
M.H. 08'2001
' Macht aus ASCII-Dateien ein Menu im *.mdf-Format
' Markus Hoffmann 1999 V.1.00
'
echo off
i=0
chrw=9
chrh=16
yoffs=120
xoffs=10
maxw=0
dim a$(200)
fileselect "ASCII-Datei auswaehlen:","./*.txt","",in$
if exist(in$)
wort_sep in$,".txt",1,out$,a$
out$=out$+".mdf"
print "******"+out$
open "I",#1,in$
while not eof(#1)
t$=lineinput$(#1)
print t$
if len(t$)>maxw
maxw=len(t$)
endif
a$(i)=t$
inc i
wend
close #1
open "O",#2,out$
print #2,"!"
print #2,"! ascii2mdf 1.1 - "+date$+" - Do not edit here !"
print #2,"!"
print #2,"MenuValidation: VALID=1"
print #2,"MenuVersion: VERSION=0 SV=1 SR=1 DATE=925124825 ORIGFNAME=ascii2mdf.mdf"
print #2,"MenuProperty: XP=0 YP=0 WIDTH="+str$(chrw*maxw+2*xoffs)+" HEIGHT="+str$(chrh*i+yoffs)+" WBGC=[26214,26214,26214] FGC=[65535,65535,65535] BGC=[39321,32896,32896] LFONT=*-Helvetica-Medium-r-*-12-*-*-*-*-*-*-*"
for u=0 to i-1
print #2,"MenuString: XP="+str$(chrw+xoffs)+" YP="+str$(chrh*u+yoffs)+" WIDTH=0 HEIGHT=13 FGC=[65535,65535,65535] BGC=[52428,52428,52428] FONT=*-Courier-Bold-r-*-14-*-*-*-*-*-*-* TEXT="+chr$(34)+a$(u)+chr$(34)
next u
close #2
endif
quit
' Markus Hoffmann 23.04.2000
' Programm fuer die Online-Energiemessung mit den Touschek-Zaehlern
' V.1.00 noch Testbetrieb
echo off
kleistung=100
kamplitude=sqrt((kleistung+5.672)/791.4)-0.05504
periode=1200
scanbereich=0.01
umlauf=(csget("ELS_HF_MASTER.FREQ_DC")-36e5)/274/100
qz=csget("ELS_MAGNETE_OPTIK.QZ_AC")
energie=csget("ELS_MAGNETE_DIPOL.ENERGIE_AC")*1000
print "Energie="+str$(energie)+" MeV"
print "Qz="+str$(qz)+""
gammaa=energie/440.6485620
print "Gamma a="+str$(gammaa)+""
sema=0
frequenz=abs(gammaa-int(gammaa+1))*umlauf
gfreq=abs(qz-int(qz+1))*umlauf
print "Arbeitspunktresonanz="+str$(gfreq)+" kHz"
' fabs(gamma_a-(double)((int)(gamma_a+1)))*umlauf;
energiemin=energie*(1-scanbereich)
energiemax=energie*(1+scanbereich)
energiemin=2501
energiemax=2507
frequenzmin=@etofreq(energiemin)
frequenzmax=@etofreq(energiemax)
print "Energie-Suchbereich: "+str$(energiemin)+" MeV bis "+str$(energiemax)+" MeV."
print "Frequenz bei Sollenergie ="+str$(frequenz)+" kHz"
print "Rampe zwischen "+str$(frequenzmin)+" kHz und "+str$(frequenzmax)+" kHz."
print "Periode: "+str$(periode)+" Min"
print "Kickerleistung: P="+str$(kleistung)+" W"
csset "ELS_MAGNETE_SHAKER.AMPLITUDE_AC",0
csset "ELS_MAGNETE_SHAKER.FREQUENZ_AC",frequenz
csset "ELS_MAGNETE_SHAKER.AMPLITUDE_AC",kamplitude
csset "ELS_MAGNETE_SHAKER.FREQUENZ_AC",frequenzmin
print ccserr
if ccserr
print "Kann Shaker nicht erreichen..."
stop
endif
' Farbdefinitionen
'weiss=GET_COLOR(65535,65535,65535)
'schwarz=GET_COLOR(0,0,0)
'rot=get_color(65535,0,0)
'orange=get_color(65535,65535/2,0)
'blau=get_color(0,0,65535/4)
'gelb=get_color(65535,65535,0)
'grau=get_color(65535/2,65535/2,65535/2)
'hellgrau=get_color(65535/3*2,65535/3*2,65535/3*2)
experiment$=csget$("SUP_GLOBAL_MESSAGE.EXPERIMENT_SC")
open "A",#1,"brandau.log"
print #1,"# Ausgabe von counter.bas vom "+date$
print #1,"# Experiment: "+experiment$
print #1,"# Energie: "+str$(csget("ELS_MAGNETE_DIPOL.ENERGIE_AM"))+" GeV"
print #1,"# Datum Uhrzeit Zeit[s] Strom[mA] Lebensdauer[min] Druck[mbar] Kickfrequenz Brandau Dipolfeld[T] "
' tbase=timer
tbase=0
cssetcallback "SUP_SISCOUNTER.FREQ5_AD",interrupt
print "(";
do
pause 1
pause 0.1
' Jetzt neue Frequenz setzen
en=(energiemax-energiemin)/periode*((timer-tbase) MOD periode)+energiemin
freq=@etofreq(en)
print "Frequenz: "+str$(freq,5,5)+" kHz. Sollenergie: "+str$(en,6,6)+" MeV."
sema=1
csset "ELS_MAGNETE_SHAKER.FREQUENZ_AC",freq
sema=0
frequenz=freq
loop
quit
function etofreq(energie2)
local gammaa
gammaa=energie2/440.6485620
return abs(gammaa-int(gammaa+1))*umlauf
endfunc
procedure interrupt
if sema=0
strom=csget("ELS_DIAG_TOROID.STROM_AM")
leben=csget("ELS_DIAG_TOROID.LEBEN_AM")/60
nmr=csget("ELS_DIAG_NMR.FELD_AM")
druck=csget("ELS_VAKUUM_SYS.IGPMEAN_AD")
print #1,date$+" "+time$+" "+str$(timer-tbase);
print #1," "+str$(strom)+" "+str$(leben)+" "+str$(druck)+" "+str$(frequenz);
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ5_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ6_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ6_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ11_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ12_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ14_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ15_AD"))+" ";
print #1," "+str$(csget("SUP_SISCOUNTER.FREQ16_AD"))+" "+str$(nmr)
flush #1
print ".";
else
print "<->";
endif
flush
return
t$="libsimlib.so"
if not exist(t$)
' quit
endif
print t$
link #1,t$
exec sym_adr(#1,"SimLibStartUp")
flush
kd=-0.593
kf=0.632
exec sym_adr(#1,"SimPutQdd"),D:kd
exec sym_adr(#1,"SimPutQdf"),D:kf
exec sym_adr(#1,"SimPutParticleMomentum"),D:1.6e9
' Orbit-Datei einlesen und fit mit virtuellen Korrektoren
' Als Fehlerquellen. Dies simuliert den Orbit und man erhaelt auch
' Zwischenwerte
o$="/home/hoffmann/physik/depol/orbits/orbit_unkorrigiert.dat"
DIM bpmspos(100),bpmread(100),bpmerror(100)
clr nummon
DIM korrspos(100),result(100)
clr numkorr
arrayfill result(),4711
open "I",#2,o$
while not eof(#2)
lineinput #2, t$
t$=trim$(t$)
wort_sep t$," ",1,a$,b$
wort_sep b$," ",1,b$,c$
bpmspos(nummon)=val(a$)
bpmread(nummon)=val(b$)
bpmerror(nummon)=0.000001
inc nummon
wend
close #2
numkorr=20
rc=exec(sym_adr(#1,"SimLibLinear"))
if rc
for i=0 to 20
korrspos(i)=i*5
next i
rc2=exec(sym_adr(#1,"SimLibMICADO"),nummon,numkorr,numkorr,L:varptr(bpmspos(0)),L:varptr(korrspos(0)),L:varptr(bpmread(0)),L:varptr(bpmerror(0)),0,L:varptr(result(0)),D:1/1e4)
for i=0 to 20
print korrspos(i),result(i)
next i
endif
if rc
clr e0,qx,qz,e1
exec sym_adr(#1,"SimGetXTune"),L:varptr(qx)
exec sym_adr(#1,"SimGetZTune"),L:varptr(qz)
exec sym_adr(#1,"SimGetXNaturalEmittance"),L:varptr(e0)
exec sym_adr(#1,"SimGetZNaturalEmittance"),L:varptr(e1)
print "Qx=";qx,"Qz=";qz,"Emmix=";e0,"Emmiz=";e1
a$=space$(2*(11*8+1+4))
data$=space$(79)
print "s [m]","Alphax","Betax"
for g=0 to 50 step 0.1
' print orbit
exec sym_adr(#1,"SimLibTwissParam"),L:2,D:g,L:varptr(a$)
' for i=0 to 100
' print hex$(peek(varptr(a$)+i) and 255,2,2);
' next i
' print
alpha=cvd(a$)
beta=cvd(mid$(a$,8+1,8))
gamma=cvd(mid$(a$,2*8+1,8))
my=cvd(mid$(a$,3*8+1,8))
mysign=cvl(mid$(a$,4*8+1,4))
disp=cvd(mid$(a$,5*8+1+4,8))
ddisp=cvd(mid$(a$,6*8+1+4,8))
orbit=cvd(mid$(a$,7*8+1+4,8))
dorbit=cvd(mid$(a$,8*8+1+4,8))
intdisp=cvd(mid$(a$,9*8+1+4,8))
dintdisp=cvd(mid$(a$,10*8+1+4,8))
poke varptr(data$)+3*beta,asc("*")
poke varptr(data$)+orbit*3000+40,asc("%")
' print g,(g mod 1),(g mod 1)-1
if (g mod 1)<0.0001 or abs((g mod 1)-1)<0.01
print g,data$
data$=space$(79)
endif
next g
endif
unlink #1
quit
' Wobbel.bas fuer die 120 kV Quelle
' Markus Hoffmann im Nov. 1998
' goto wobbel2
i=0
echo off
parameter$="EXT_MAGNETE_QD1.STROM_AC"
sollwert=50
amplitude=45
do