Commit a2213fb3 by kollo

### version 1.12-2

parent 067c4362
 ' WSHOW.bas is a program which calculates and draws 3 dimentional Objects ' with linear algebra (c) Markus Hoffmann 1993 ' ' Original version GFA-Basic on ATARI ST ' Ported to X11-Basic ' DIM pxU(4),pyU(4) meldung\$="WSHOW (c) Markus Hoffmann 1989 - 2001" maxfl=20000 ... ... @@ -61,11 +68,11 @@ lichtr=50000 lichtg=65535 lichtb=65535 ' weiss=get_color(65535,65535,65535) schwarz=get_color(0,0,0) grau=get_color(32000,32000,32000) gelb=get_color(65535,65535,32000) blau=get_color(32000,32000,65535) weiss=get_color(65535,65535,65535) schwarz=get_color(0,0,0) grau=get_color(32000,32000,32000) gelb=get_color(65535,65535,32000) blau=get_color(32000,32000,65535) dim film\$(73) while exist("bild"+str\$(bildcount,3,3,1)+".xpm") ... ... @@ -104,8 +111,8 @@ do sty=sin(stwink) bbx=-cos(stwink) ! Beobachterblickrichtung bby=-sin(stwink) zwink=SGN(bby)*SGN(bbx)*ATN(ABS(bbx/bby))+PI*ABS(bby<0) xwink=-SGN(bbz)*ATN(ABS(bbz/SQR(bbz^2+bby^2))) zwink=SGN(bby)*SGN(bbx)*ATN(ABS(bbx/bby))+PI*ABS(bby<0) xwink=-SGN(bbz)*ATN(ABS(bbz/SQR(bbz^2+bby^2))) @sort @plot ... ... @@ -167,8 +174,8 @@ procedure calc @addfl(x,y,z,x+sx,y,zz,x+sx,y+sy,zzzz,x,y+sy,zzz) NEXT x NEXT y gprint anzfl;" Flchen. in ";ctimer-t;" Sekunden." vsync gprint anzfl;" Flchen. in ";ctimer-t;" Sekunden." vsync kug: local r,spsp,st,phi,theta,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4 ... ... @@ -218,8 +225,8 @@ procedure sort adr=varptr(welt(0)) ad=8*13 t=ctimer welt2()=welt() adr2=varptr(welt2(0)) welt2()=welt() adr2=varptr(welt2(0)) FOR i=0 TO anzfl-1 j=index(i) bmove adr2+ad*j,adr+ad*i,ad ... ... @@ -262,40 +269,38 @@ procedure plot color grau pbox 0,0,640,400 color weiss pxU(0)=@kx(x1,y2,z1/2) pyU(0)=@ky(x1,y2,z1/2) pxU(1)=@kx(x2,y2,z1/2) pyU(1)=@ky(x2,y2,z1/2) pxU(2)=@kx(x2,y2,z2/2) pyU(2)=@ky(x2,y2,z2/2) pxU(3)=@kx(x1,y2,z2/2) pyU(3)=@ky(x1,y2,z2/2) POLYFILL 4,pxU(),pyU() color schwarz POLYLINE 4,pxU(),pyU() pxU(0)=@kx(x1,y2,z1/2) pyU(0)=@ky(x1,y2,z1/2) pxU(1)=@kx(x1,y2,z2/2) pyU(1)=@ky(x1,y2,z2/2) pxU(2)=@kx(x1,y1,z2/2) pyU(2)=@ky(x1,y1,z2/2) pxU(3)=@kx(x1,y1,z1/2) pyU(3)=@ky(x1,y1,z1/2) color weiss POLYFILL 4,pxU(),pyU() color blau for i=z1/2 to z2/2 step (z2-z1)/12 LINE @kx(x1,y1,i),@ky(x1,y1,i),@kx(x1,y2,i),@ky(x1,y2,i) LINE @kx(x1,y2,i),@ky(x1,y2,i),@kx(x2,y2,i),@ky(x2,y2,i) next i color gelb text 20,20,"3D - Flaechengrafik mit X11-Basic (c) Markus Hoffmann" color schwarz LINE @kx(x1,y1,0),@ky(x1,y1,0),@kx(x1,y2,0),@ky(x1,y2,0) LINE @kx(x1,y2,0),@ky(x1,y2,0),@kx(x2,y2,0),@ky(x2,y2,0) POLYline 4,pxU(),pyU() pxU(0)=@kx(x1,y2,z1/2) pyU(0)=@ky(x1,y2,z1/2) pxU(1)=@kx(x2,y2,z1/2) pyU(1)=@ky(x2,y2,z1/2) pxU(2)=@kx(x2,y2,z2/2) pyU(2)=@ky(x2,y2,z2/2) pxU(3)=@kx(x1,y2,z2/2) pyU(3)=@ky(x1,y2,z2/2) POLYFILL 4,pxU(),pyU() color schwarz POLYLINE 4,pxU(),pyU() pxU(0)=@kx(x1,y2,z1/2) pyU(0)=@ky(x1,y2,z1/2) pxU(1)=@kx(x1,y2,z2/2) pyU(1)=@ky(x1,y2,z2/2) pxU(2)=@kx(x1,y1,z2/2) pyU(2)=@ky(x1,y1,z2/2) pxU(3)=@kx(x1,y1,z1/2) pyU(3)=@ky(x1,y1,z1/2) color weiss POLYFILL 4,pxU(),pyU() color blau for i=z1/2 to z2/2 step (z2-z1)/12 LINE @kx(x1,y1,i),@ky(x1,y1,i),@kx(x1,y2,i),@ky(x1,y2,i) LINE @kx(x1,y2,i),@ky(x1,y2,i),@kx(x2,y2,i),@ky(x2,y2,i) next i color gelb text 20,20,"3D - Flaechengrafik mit X11-Basic (c) Markus Hoffmann" color schwarz LINE @kx(x1,y1,0),@ky(x1,y1,0),@kx(x1,y2,0),@ky(x1,y2,0) LINE @kx(x1,y2,0),@ky(x1,y2,0),@kx(x2,y2,0),@ky(x2,y2,0) POLYLINE 4,pxU(),pyU() FOR i=0 to anzfl-1 ' ... ... @@ -329,24 +334,21 @@ FOR i=0 to anzfl-1 pyU(2)=@ky(welt(6+13*i),welt(7+13*i),welt(8+13*i)) pxU(3)=@kx(welt(9+13*i),welt(10+13*i),welt(11+13*i)) pyU(3)=@ky(welt(9+13*i),welt(10+13*i),welt(11+13*i)) POLYFILL 4,pxU(),pyU() POLYFILL 4,pxU(),pyU() if timer-ptimer>1 vsync @progress(anzfl,i) ptimer=timer endif endif NEXT i @progress(anzfl,i) vsync print "Plotted in ";round(timer-plottime);" sec." vsync @progress(anzfl,i) ptimer=timer endif endif NEXT i @progress(anzfl,i) vsync print "Plotted in ";round(timer-plottime);" sec." return ' ' ' function f(x,y) return 0.8*EXP(-2*(x^2+y^2))*COS((x^2+y^2)*10) return 0.8*EXP(-2*(x^2+y^2))*COS((x^2+y^2)*10) endfunc ' Koordinatentransformationen mit Perspektive: FUNCTION kx(x,y,z) ... ...
 Index of /examples/3D-graphics

Index of /examples/3D-graphics

Size  Description

Parent Directory 11-Sep-2003 18:17 - 3Dshow.bas 9k(Screenshot)

Apache/1.3.26 Server at x11-basic.sourceforge.net Port 80
 ' Beispiele, wie man mit Grafik-Objekten umgeht. ' Wer das AES vom ATARI ST kennt, dem kommt es bekannt vor... ' Example program how to use the GUI objects. All who are familiar with the ' GEM AES definitions of ATARI ST will find it similar. ' (c) Markus hoffmann 2002 strings\$="Bitte whlen Sie aus:"+chr\$(0) strings\$="Please select from given choices:"+chr\$(0) btext1\$="OK"+chr\$(0) btext2\$="CANCEL"+chr\$(0) x=100 ... ... @@ -12,10 +12,10 @@ h=200 sel=9 s\$="" for i=0 to sel-1 s\$=s\$+str\$(i+1)+chr\$(0) s\$=s\$+str\$(i+1)+chr\$(0) next i name\$="Ichbins"+string\$(30,chr\$(0)) name\$="Itsme"+string\$(30,chr\$(0)) buf\$=space\$(20)+chr\$(0) ted\$=mkl\$(varptr(name\$))+mkl\$(varptr(buf\$))+mkl\$(varptr(buf\$)) ted\$=ted\$+mki\$(3)+mki\$(0)+mki\$(0)+mki\$(0x100)+mki\$(0)+mki\$(1)+mki\$(len(name\$)-1)+mki\$(len(buf\$)-1) ... ... @@ -37,8 +37,8 @@ ob\$=ob\$+mki\$(5+sel)+mki\$(5)+mki\$(5+sel-1)+mki\$(20)+mki\$(0)+mki\$(32) ob\$=ob\$+mkl\$(-1)+mki\$(50)+mki\$(50)+mki\$(200)+mki\$(50) for i=0 to sel-2 ob\$=ob\$+mki\$(5+i+1)+mki\$(-1)+mki\$(-1)+mki\$(26)+mki\$(1 or 16)+mki\$(0) ob\$=ob\$+mkl\$(varptr(s\$)+2*i)+mki\$(10+i*20)+mki\$(16)+mki\$(16)+mki\$(16) ob\$=ob\$+mki\$(5+i+1)+mki\$(-1)+mki\$(-1)+mki\$(26)+mki\$(1 or 16)+mki\$(0) ob\$=ob\$+mkl\$(varptr(s\$)+2*i)+mki\$(10+i*20)+mki\$(16)+mki\$(16)+mki\$(16) next i ob\$=ob\$+mki\$(4)+mki\$(-1)+mki\$(-1)+mki\$(26)+mki\$(1 or 16)+mki\$(0) ob\$=ob\$+mkl\$(varptr(s\$)+2*(sel-1))+mki\$(10+(sel-1)*20)+mki\$(16)+mki\$(16)+mki\$(16) ... ... @@ -51,9 +51,14 @@ ob\$=ob\$+mkl\$(varptr(ted\$))+mki\$(10)+mki\$(110)+mki\$(16*10)+mki\$(16) ~form_dial(1,0,0,0,0,x,y,w,h) ~objc_draw(varptr(ob\$),0,-1,0,0) vsync print "Move the mouse and this tells you the OBJ-#:" print "click the mouse to do the form." while mousek=0 print objc_find(varptr(ob\$),mousex,mousey) pause 0.1 if mousex<>omx or mousey<>omy mouse omx,omy print objc_find(varptr(ob\$),mousex,mousey) endif pause 0.1 wend ~form_dial(2,0,0,0,0,x,y,w,h) ~form_dial(3,0,0,0,0,x,y,w,h) ... ... @@ -69,11 +74,11 @@ if ret=2 ! OK for i=0 to sel-1 if dpeek(varptr(ob\$)+(5+i)*24+10)=1 gedr=i print "Sie hatten nr.";gedr+1;" gewaehlt." print "You selected nr.";gedr+1;"." endif next i if gedr=-1 ~form_alert(1,"[3][Sie haben nix gewhlt !][OH]") ~form_alert(1,"[3][You have not selected anything !][OH]") dpoke varptr(ob\$)+(ret)*24+10,0 goto nochmal endif ... ... @@ -82,5 +87,5 @@ endif ~form_dial(2,0,0,0,0,x,y,w,h) ~form_dial(3,0,0,0,0,x,y,w,h) vsync print "Ihre Texteingabe war: ",name\$ end print "Your text input was: ",name\$ quit
 color get_color(65535,0,0) pbox 0,0,640,400 ' Test der Rsrc-Funktionen ' Es koennen ATARI ST *.RSC-Files verwendet werden... ' v.1.11 color get_color(65535,65535,0) gprint "You can use ATARI ST *.RSC-files..." gprint "Test of the rsrc-funktions..." ' v.1.11 (c) Markus Hoffmann color get_color(0,65535,0) for i=0 to 30 circle 320,200,i*5 next i text 10,10,"Mit der rechten Maustaste geht es weiter." fileselect "RSC-Laden","./rsc/*.rsc","",f\$ gprint "use the right mouse button to skip this dialog." fileselect "load RSC...","./rsc/*.rsc","",f\$ rsrc_load f\$ count=0 adr=rsrc_gaddr(15,count) ... ... @@ -31,6 +31,7 @@ while adr<>-1 ~form_center(adr,x,y,w,h) ~form_dial(0,x,y,w,h,x,y,w,h) ~form_dial(1,x,y,w,h,x,y,w,h) ~objc_draw(adr,0,-1,0,0) print form_do(adr) ~form_dial(2,x,y,w,h,x,y,w,h) ~form_dial(3,x,y,w,h,x,y,w,h) ... ...
 ... ... @@ -6,8 +6,9 @@ dim a(18000),b(18000) arrayfill a(),0 arrayfill b(),0 clearw gprint "shows ATARI ST monochrome pictures (32000 Bytes)" fileselect "Datei auswaehlen:","pictures/*.pic","f1.pic",f\$ fileselect "Select picture file ...","pictures/*.pic","f1.pic",f\$ if exist(f\$) open "I",#1,f\$ clr x,y,count ... ... @@ -41,12 +42,12 @@ endif quit procedure showit for t=1 to 15 pbox 0,0,640,400 color get_color(65535,65535,10000) scope b(),a(),1,t/10,200-200*t/10,t/10,320-320*t/10 color get_color(65535,0,65535) scope a(),b(),1,t/10,,t/10 vsync color get_color(0,0,10000) pbox 0,0,640,400 next t return
 gm=0 i=1 while len(param\$(i)) i0=val(param\$(i)) inc i wend if i0=0 i0=tineget("GLOBALS[HECUR]") gm=1 endif alpha=5/30 t=0 dt=1/60/60 ~@hochrechnung() if gm weiss=get_color(65535,65535,65535) grau=get_color(65535/1.2,65535/1.2,65535/1.2) schwarz=get_color(0,0,0) rot=get_color(65535,0,0) gelb=get_color(20000,65535,20000) groesse=0.7 bw=700 bh=200 COLOR schwarz sizew ,bw,bh pause 1 PBOX 0,0,bw,bh color rot deftext ,0.05,0.05 ltext 10,100,"Run-Ende:" do i0=tineget("GLOBALS[HECUR]") a=@hochrechnung() @display(unixtime\$(timer+3600*a)) pause 3 loop endif quit function hochrechnung() tau=@tau(i0) i=i0 t=0 do di=-i/tau*dt add i,di tau=@tau(i) add t,dt ' print t;" ";i;" ";tau if i<13 print "13 mA erreicht in ";str\$(t,3,3);" Stunden, also um ";unixtime\$(timer+t*3600) return t endif exit if t>10 loop endfunction function i(t) return i0*exp(-t/tau) endfunction function tau(i) return 16-alpha*i endfunction procedure display(d\$) COLOR schwarz PBOX 0,0,bw,bh color rot DEFLINE ,2,2 deftext ,0.05,0.07 ltext 50,2,"Run-Ende:" DEFLINE ,25*groesse,2 DEFTEXT 1,groesse,2*groesse color gelb 'for i=0 to 360 step 10 LTEXT bw/2+cos(i/180*pi)*10-LTEXTLEN(d\$)/2,30+sin(i/180*pi)*10,d\$ 'next i color weiss LTEXT bw/2-LTEXTLEN(d\$)/2,30,d\$ VSYNC return