Commit 3f0ea8b4 by kollo

### version 1.19

parent 7b02fc54
This diff is collapsed.
 ' Calculates Surfaces of two hollow Balls and saves it into a file ' It then can be displayed with 3Dshow.bas ' (c) Markus Hoffmann 1990 PRINT "MAKE-WORLD (c) Markus Hoffmann" meldung$="Surfaces of two hollow Balls"+chr$(0) maxworld%=10000 mf%=maxworld%*13*8 world%=MALLOC(mf%) maxworld%=mf%/13/8 PRINT PRINT "Maxworld:"'maxworld% ' ' x_1=-1 x_2=1 y_1=-1 y_2=1 z_1=-0.1 z_2=1 ' sx=0.05 sy=0.05 sz=0.1 ' CLR anzworld% PRINT "Berechne Welt:" PRINT "Koordinatenkreuz..." ' @add4fl(0,x_1,y_2,z_1/2,x_2,y_2,z_1/2,x_2,y_2,z_2/2,x_1,y_2,z_2/2) ' @add4fl(0,x_1,y_2,z_1/2,x_1,y_2,z_2/2,x_1,y_1,z_2/2,x_1,y_1,z_1/2) PRINT "WWFkt." ' Auenkugel: Transparent r=0.5 spsp=PI/15 st=PI/15 FOR phi=0 TO 2*PI STEP spsp FOR theta=0.05 TO PI STEP st PRINT chr$(13);"Flchen:"'anzworld%; flush @polar1(r,theta,phi) @polar2(r,theta+st,phi) @polar3(r,theta+st,phi+spsp) @polar4(r,theta,phi+spsp) @add4fl(0,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4) NEXT theta NEXT phi ' Innenkukel: Solid r=0.3 spsp=PI/10 st=PI/10 print FOR phi=0 TO 2*PI STEP spsp FOR theta=0.05 TO PI STEP st PRINT chr$(13);"Flchen:"'anzworld%; @polar1(r,theta,phi) @polar2(r,theta+st,phi) @polar3(r,theta+st,phi+spsp) @polar4(r,theta,phi+spsp) @add4fl(16,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4) NEXT theta NEXT phi print ' PRINT "Welt: ";anzworld%;" Elemente..." @saveworld @ende ' PROCEDURE polar1(r,th,ph) x1=r*COS(ph)*SIN(th) y1=r*SIN(ph)*SIN(th) z1=r*COS(th) RETURN PROCEDURE polar2(r,th,ph) x2=r*COS(ph)*SIN(th) y2=r*SIN(ph)*SIN(th) z2=r*COS(th) RETURN PROCEDURE polar3(r,th,ph) x3=r*COS(ph)*SIN(th) y3=r*SIN(ph)*SIN(th) z3=r*COS(th) RETURN PROCEDURE polar4(r,th,ph) x4=r*COS(ph)*SIN(th) y4=r*SIN(ph)*SIN(th) z4=r*COS(th) RETURN ' PROCEDURE add4fl(nu,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4) IF anzworld%
Atari-ST/e24.bas 0 → 100644
 dim width(128) f$="grotlt.e24" f$="normande.e24" f$="/work/CDs/ATARI-ST_v_2/st/d/chsets/grotlt.p24" open "I",#1,f$ d=10 clearw seek #1,0 header$=input$(#1,140) for i=0 to 128-1 width(i)=CVI(reverse$(input$(#1,4))) next i memdump varptr(header$),140 data$=input$(#1,lof(#1)-140-512) wx=0 for c=1 to 63 @disp(wx,100,c) next c wx=0 for c=64 to 127 @disp(wx,200,c) next c keyevent quit procedure disp(x,y,c) local o,w,h,d o=width(c) h=(width(c+1)-o)/2 d=peek(varptr(data$)+o) w=peek(varptr(data$)+o+1) w=peek(varptr(data$)+o+2) text x,y+50,str$(w) print peek(varptr(data$)+o+1),peek(varptr(data$)+o+3),w print "char ";c;" offs=";d add y,d add o,4 sub h,2 for j=0 to h-1 a=peek(varptr(data$)+o+j*2)*256+(peek(varptr(data$)+o+1+j*2) and 255) for i=0 to 15 if btst(a,i) plot x+15-i,y endif next i inc y next j vsync add wx,w return  ' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann scale=2 text$="This example demonstrates the use of the old Atari-ST fonts!"+chr$(14)+chr$(15)+" We used " color get_color(65535,65535,0) COLOR GET_COLOR(65535,65535,0) fileselect "FONT-Laden","./*.fnt","",f$if len(f$) if exist(f$) open "I",#1,f$ text$=text$+f$f$=input$(#1,4096) close #1 for i=0 to 256 text$=text$+chr$(i) next i endif @text(text$) endif endif pause 10 quit procedure text(t$) local i for i=0 to len(t$)-1 char=peek(varptr(t$)+i) and 255 @char(x,y,char) vsync pause 0.1 add x,8*scale if x>=640 x=0 add y,16*scale endif next i return procedure char(x,y,c) local i,j for i=0 to 15 for j=0 to 7 if btst(peek(varptr(f$)+c+i*256),7-j)=0 pbox x+j*scale,y+i*scale,x+j*scale+scale,y+i*scale+scale-1 endif next j next i return FILESELECT "FONT-Laden","./*.fnt","",f$ IF LEN(f$) IF EXIST(f$) OPEN "I",#1,f$text$=text$+f$ f$=INPUT$(#1,4096) CLOSE #1 FOR i=0 TO 256 text$=text$+CHR$(i) NEXT i ENDIF @text(text$) ENDIF PAUSE 10 QUIT PROCEDURE text(t$) LOCAL i FOR i=0 TO LEN(t$)-1 char=PEEK(VARPTR(t$)+i) AND 255 @char(x,y,char) VSYNC PAUSE 0.1 ADD x,8*scale IF x>=640 x=0 ADD y,16*scale ENDIF NEXT i RETURN PROCEDURE char(x,y,c) LOCAL i,j FOR i=0 TO 15 FOR j=0 TO 7 IF BTST(PEEK(VARPTR(f$)+c+i*256),7-j)=0 PBOX x+j*scale,y+i*scale,x+j*scale+scale-1,y+i*scale+scale-1 ENDIF NEXT j NEXT i RETURN
 f$="ST-fonts/spat-a.fnt" OPEN "I",#1,f$ text$=text$+f$f$=INPUT$(#1,4096) CLOSE #1 scalex=31 scaley=22 a=ASC("s") DO CLEARW @char(0,0,a) COLOR GET_COLOR(65535,0,0) FOR i=0 TO 10 LINE 10+0,50+i*20,10+10*20,50+i*20 NEXT i FOR i=0 TO 10 LINE 10+i*20,50+0,10+i*20,50+200 NEXT i DEFTEXT ,2,2 DEFLINE ,3 LTEXT 10,50,CHR$(a) DEFLINE ,1 TEXT 300,200,STR$(a) VSYNC KEYEVENT INC a LOOP PAUSE 10 QUIT PROCEDURE char(x,y,c) LOCAL i,j color get_color(65535,65535,0) FOR i=0 TO 15 FOR j=0 TO 7 IF BTST(PEEK(VARPTR(f$)+c+i*256),7-j)=0 PBOX x+j*scalex,y+i*scaley,x+j*scalex+scalex-1,y+i*scaley+scaley-1 ENDIF NEXT j NEXT i RETURN
Atari-ST/p24.bas 0 → 100644
 ' Das fileformat: ' Byte 0 bis 7: "eset0001" (fuer e24 files) und "ps240001" beio P24 files ' Byte 8 bis 11: Long: Anzahl der Zeichen (normalerweise 128) ' byte 12 bis 139: ?? ' Byte 140: long[anzchar] offsets dim width(128) f$="grotlt.e24" f$="normande.e24" f$="/work/CDs/ATARI-ST_v_2/st/d/chsets/amber.p24" open "I",#1,f$ d=10 clearw seek #1,0 header$=input$(#1,140) for i=0 to 128-1 width(i)=CVI(reverse$(input$(#1,4))) next i memdump varptr(header$),140 data$=input$(#1,lof(#1)-140-512) wx=0 for c=1 to 63 @disp(wx,100,c) next c wx=0 for c=64 to 127 @disp(wx,200,c) next c keyevent quit procedure disp(x,y,c) local o,w,h,d o=width(c) h=(width(c+1)-o)/4 d=peek(varptr(data$)+o) w=peek(varptr(data$)+o+1) ' w=peek(varptr(data$)+o+2) text x,y+50,str$(w) print peek(varptr(data$)+o+1),peek(varptr(data$)+o+3),w, print "char ";c;" offs=";d add y,d add o,4 sub h,1 for j=0 to h-1 a=(peek(varptr(data$)+o+j*4) and 255)*256*256*256+(peek(varptr(data$)+o+1+j*4) and 255)*256*256+(peek(varptr(data$)+o+2+j*4) and 255)*256+(peek(varptr(data$)+o+3+j*4) and 255) ' a=(peek(varptr(data$)+o+0+j*4) and 255)*256+(peek(varptr(data$)+o+1+j*4) and 255) for i=0 to 32 if btst(a,i) plot x+15-i,y endif next i inc y next j vsync add wx,w return  ... ... @@ -10,7 +10,16 @@ for i=0 to 30 circle 320,200,i*5 next i gprint "use the right mouse button to skip this dialog." i=0 while len(param$(i)) inc i wend f$=param$(i-1) print i,f$if not exist(f$) or upper$(right$(f$,4))<>".RSC" fileselect "load RSC...","./rsc/*.rsc","",f$ endif rsrc_load f$count=0 adr=rsrc_gaddr(15,count) ... ...  Summary: Example basic program sourcefiles for X11-Basic Vendor: Markus Hoffmann Name: X11Basic-examples Version: 1.15 Version: 1.19 Release: 1 Copyright: GPL Group: Development/Languages ... ... @@ -11,7 +11,11 @@ Packager: Markus Hoffmann %description Thease are example programs for X11-Basic. Thease are example programs for X11-Basic. Most of them can be easily run from a text console, e.g. on UNIX/Linux systems. Not all of them are useful on other platforms like WINDOWS or Android. Have fun. ... ... File added  ' ' smartpen.bas (c) Markus Hoffmann 2011 ' ' demonstrated how one can use the data, which comes from a livescrive Smartpen ' Export a page as pdf. Then this program can read it. ' needs debian package: pstoedit ' bw=930 bh=1080 top=850 sizew ,bw,bh vsync pause 0.1 clearw vsync ' Fileneame to read : in$="Smartpen-Demo.pdf" if not exist(in$) in$=param$(2) endif tmp$="/tmp/a.svg" system "pstoedit "+in$+" "+tmp$ fluent=0 scale=1.5 open "I",#1,tmp$entry: bbcount=0 while not eof(#1) lineinput #1,t$ if glob(t$,"* TomTom/TTsky.bas 0 → 100644 This diff is collapsed.  ' Zu Spektrum der Wissenschaft ' There is a scaling law on the first digit of random numbers ' SIZEW ,11*10,400 DIM zl(10) CLEAR FOR I=0 TO 9 TEXT i*10,10,STR$(i) NEXT i DO INC c% z%=RANDOM(RANDOM(10000)) ziff%=VAL(LEFT$(STR$(z%))) INC zl(ziff%) ' print zl(ziff%) COLOR 0 LINE ziff%*10,400,ziff%*10,16 COLOR get_color(65535,0,0) LINE ziff%*10,zl(ziff%)/c%*600+16,ziff%*10,16 TEXT 50,380,STR$(c%) VSYNC PAUSE 0.01 LOOP QUIT This diff is collapsed.  print "\documentclass[12pt,a4paper,dvips,openany,final]{scrartcl}" print "\begin{document} " print "\subsection*{dB Tabelle}" print "\begin{tabular}{|r|cc|}" print "\hline" print "{\bf dB} & {\bf Amplitude} & {\bf Leistung}\\" print "\hline" db=-90 do print str$(db,5,5);" & ";str$(10^(db/20),6,3);" & ";str$(10^(db/10),6,3);" \\" add db,10 exit if db>60 loop print "\hline" print "\end{tabular}" print "\begin{tabular}{|r|cc|}" print "\hline" print "{\bf dB} & {\bf Amplitude} & {\bf Leistung}\\" print "\hline" db=-10 do print str$(db,5,5);" & ";str$(10^(db/20),6,3);" & ";str$(10^(db/10),6,3);" \\" add db,1 exit if db>10 loop print "\hline" print "\end{tabular}" print "\end{document}" quit  ... ... @@ -61,13 +61,18 @@ PROCEDURE init lila=get_color(65530,0,65530) blau=get_color(10000,10000,65530) gruen=get_color(0,30000,0) bx=0 by=16 by=0 bw=640 bh=384 bh=400 get_geometry 1,bx,by,bw,bh add by,16 sub bh,bx color weiss pbox bx,by,bx+bw,by+bh color schwarz color schwarz,weiss RESTORE menudata FOR i=0 TO 80 read t$ ... ... @@ -83,7 +88,14 @@ PROCEDURE init RESTORE px_data READ pkoxv,pkoxb,pkox_v,pkox_b,pkorwx,pkorwx_ RESTORE py_data READ pkoyv,pkoyb,pkoy_v,pkoy_b,pkorwy,pkorwy_ goto aaa aaa: READ pkoyv READ pkoyb READ pkoy_v READ pkoy_b READ pkorwy READ pkorwy_ RETURN procedure n ~form_alert(1,"[3][Funktion nicht implementiert !][ OH ]") ... ... @@ -325,7 +337,7 @@ PROCEDURE pkoordinate(tx$,ty$) TEXT @px(0)-8*LEN(ty$)-8,@py(pkod)+8,ty$ RETURN PROCEDURE m(k) print k ' print k on k gosub info on k-10 gosub load.dgl,save.dgl,n,load,save,clear,n,delete,n,ende on k-22 gosub vfeldxn,vfeldxp,n,vfeldyn,@vfeldyp,n,ox,oy,rennenx,renneny ... ... @@ -385,12 +397,12 @@ PROCEDURE ende RETURN PROCEDURE info ~form_alert(1,"[0][DIFFGLEI.BAS |(c) Markus Hoffmann][ OK ]") ~form_alert(1,"[0][DIFFGLEI.BAS |Spiel mit Differentialgleichungen.|(c) Markus Hoffmann][ OK ]") RETURN PROCEDURE koordin LOCAL xU,yU,wU,hU,fdoretU,b$' ~@rsrc_gaddr(0,koordin__U,dialogadr%) ~rsrc_gaddr(0,koordin__U,dialogadr%) ~FORM_CENTER(dialogadr%,xU,yU,wU,hU) ' ~FORM_DIAL(0,0,0,10,20,xU,yU,wU,hU) ~FORM_DIAL(1,0,0,10,20,xU,yU,wU,hU) ... ... @@ -429,7 +441,7 @@ RETURN PROCEDURE koordin2 LOCAL xU,yU,wU,hU,fdoretU,b$ ' ~@rsrc_gaddr(0,koordin2__U,dialogadr%) ~rsrc_gaddr(0,koordin2__U,dialogadr%) ~FORM_CENTER(dialogadr%,xU,yU,wU,hU) ' ~FORM_DIAL(0,0,0,10,20,xU,yU,wU,hU) ~FORM_DIAL(1,0,0,10,20,xU,yU,wU,hU) ... ...
 ' ' Finanzierung.bas (c) Markus Hoffmann 2007-2010 ' ' berechnet bei gegebenem Zinssatz und gewuenschter ' monatlicher Zahlung (Tilgunk+Zinsen) und optional jaerhlichen ' Extratilgungen die Kreditlaufzeit in Abhaengigekeit von der ' Kreditsumme. ' ' Effektiver Jahreszinssatz f"uer den Kredit zinssatz=5.4/100 ' Monatliche Rueckzahlung belastung=1100 ' Extra-Tilgung am Jahresende extratilgung=00 tmp$="/tmp/f"+str$(timer)+".dat" tmp2$="/tmp/f"+str$(timer)+".gnu" open "O",#1,tmp$print #1,"# Kreditsumme Laufzeit/Jahren" for j=1000 to 500000 step 1000 t=@laufzeit(j) print #1,j;" ";t/12 print j;" EURO --> ";int(t/12);" Jahre"; if (t mod 12) print " und ";(t mod 12);" Monate." else print "." endif exit if t=0 next j close #1 open "O",#1,tmp2$ print #1,"set grid" print #1,"set xlabel 'Kreditsumme'" print #1,"set ylabel 'Laufzeit / Jahre'" print #1,"plot [][:30] "+chr$(34)+tmp$+chr$(34)+" u 1:2 w st t 'mon. Belastung: "+str$(belastung)+"+"+str$(extratilgung)+"'" print #1,"pause -1" close #1 system "gnuplot "+tmp2$ system "rm -f "+tmp$system "rm -f "+tmp2$ quit function laufzeit(gesamt) local i i=0 do zins=gesamt*zinssatz/12 exit if 12*zins>12*belastung+extratilgung ' print i,int(i/12),gesamt,zins,(belastung-zins) sub gesamt,(belastung-zins) inc i exit if gesamt<1000 if (i mod 12)=0 sub gesamt,extratilgung endif loop return i endfunction