10 REM 3D Function Plotting Program 20 REM by Piotr Sliwinski (1990) 30 REM modified by M.Bobrowski (1991) 40 : 50 MODE4:T$="3D FUNCTIONS"+CHR$10+CHR$10+CHR$8+CHR$8+"by Piotr Sliwinski (1990)":PRINTTAB(0,4)T$''''"Assembling. Please wait. ";:PROCfkeys 60 DIM ta(24,24),V%(24,24):Z%=30:di%=26 70 PROCass:PROCass2:X%=-250:Y%=400 80 PRINTTAB(0,10)SPC24;CHR$7TAB(0,20)"Important: after plotting the graph"''"you may always press SPACE for the"''"Editing Menu."'''"Now press any key to continue. ";:REPEAT UNTIL GET 90 ON ERROR PROCerr 100 MODE4:PRINTTAB(0,4)T$''''"Press f0-f3 for a demonstration"''SPC6"(f0-f9 for Master users)"''"or enter formula in terms of X and Y"''"as a valid BASIC expression." 110 REPEAT:INPUTTAB(0,20)SPC120TAB(0,20)"Function f(X,Y)="f$:UNTILf$>"" AND INSTR(f$,"X")>0 AND INSTR(f$,"Y")>0 120 tested=FALSE:VDU28,0,31,39,24 130 REPEAT 140 CLS:IF tested PROCinfo ELSE PROCcheck 150 PRINT'"1.Draft 2.Plot graph 3.Change X,Y range"'"4.Change zoom 5.Change function 6.Exit" 160 PROCon:INPUT"Enter option :"opt% 170 IF opt%=1 AND tested PROCdraft 180 IF opt%=2 AND tested PROCgraph 190 IF opt%=3 PROCcheck:tested=TRUE 200 IF opt%=4 AND tested PROCzoom 210 IF opt%=5 UNTIL TRUE:GOTO 100 220 UNTIL opt%=6 230 MODE7:END 240 : 250 DEFPROCass:DIMQ%1200:wr=!&20E AND&FFFF 260 DIM oy% di%,oy_1% di%,oy2% di%,oy2_1% di% 270 FOR A%=0 TO di%:A%?oy%=0:A%?oy_1%=0:A%?oy2%=0:A%?oy2_1%=0:NEXT 280 x=&70:y=&74:z=&78:mult=&7C 290 cand=&7E:res=&80:p%=&84 300 chaz=&B48B:shaz=&B57E 310 xp=&85:yp=&87:zp=&89:oyp=&8B:oyp1=&8D:oyp2=&8F:ox=&91:oz=&95 320 po=&99:o%=&9B 330 dend=res:divs=cand:rem=mult 340 FORW%=0TO2STEP2:P%=Q%:[OPTW% 350 .dix OPT FNlxy(chaz):OPT FNsxy(mult) 360 OPT FNv(z,cand) 370 JSRmpl:OPT FNadc(x,res+2,res+2):RTS 380 .diy OPT FNlxy(shaz):OPT FNsxy(mult) 390 OPT FNv(z,cand) 400 JSRmpl:OPT FNadc(y,res+2,res+2):RTS 410 .mpl LDX#16:LDA#0:STAres+2:STAres+3 420 .mplo LSRmult+1:RORmult:BCCskip 430 OPT FNadc(cand,res+2,res+2) 440 .skip LSRres+3:RORres+2:RORres+1 450 RORres:DEX:BNEmplo:RTS 460 .plot LDA#25:JSRwr:LDA#69 470 .vdus JSRwr:JSRdix:LDAres+2:JSRwr:LDAres+3:JSRwr 480 JSRdiy:LDAres+2:JSRwr:LDAres+3:JMPwr 490 .draw LDA#25:JSRwr:LDA#5:BNEvdus 500 .tri LDA#25:JSRwr:LDA#85:BNEvdus 510 .move LDA#25:JSRwr:LDA#4:BNEvdus 520 .emul RTS 530 .sqr% LDAo%:BNEemul:LDA#18:JSRwr:LDA#0:JSRwr:JSRsurf:LDAgcol:JSRwr:OPT FNm(ox,x,oyp1,y):OPT FNv(oz,z):JSRmove 540 OPT FNm(xp,x,oyp,y):JSRmove 550 OPT FNm(yp,y,zp,z):JSRtri 560 OPT FNm(ox,x,oyp2,y):JSRmove 570 OPT FNm(oyp1,y,oz,z):JSRtri 580 LDA#18:JSRwr:LDA#0:JSRwr:LDAgcol:EOR#1:JSRwr 590 OPT FNm(xp,x,oyp,y):JSRdraw 600 OPT FNm(yp,y,zp,z):JSRdraw 610 OPT FNm(ox,x,oyp2,y):JSRdraw 620 OPT FNm(oyp1,y,oz,z):JMPdraw 630 .pl%JSRget%:OPT FNm(xp,x,yp,y):OPT FNv(zp,z):JMPplot 640 .dr%JSRget%:OPT FNm(xp,x,yp,y):OPT FNv(zp,z):JMPdraw 650 .rts RTS 660 .get%LDA&600:CMP#3:BNErts 670 OPT FNv(&601,po):LDY#0:LDA(po),Y 680 STAxp:INY:LDA(po),Y:STAxp+1 690 OPT FNv(&604,po):LDY#0:LDA(po),Y 700 STAyp:INY:LDA(po),Y:STAyp+1 710 OPT FNv(&607,po):LDY#0:LDA(po),Y 720 STAzp:INY:LDA(po),Y:STAzp+1:RTS 730 .rec%JSRget% 740 LDXp%:LDAoy%,X:STAoyp1:LDAoy_1%,X 750 STAoyp1+1:LDAoy2%,X:STAoyp2:LDAoy2_1%,X:STAoyp2+1:INCp%:INX 760 LDAoy%,X:STAoyp:LDAoy_1%,X:STAoyp+1 770 JSRsqr%:LDXp%:LDAyp:STAoy2%,X:LDAyp+1:STAoy2_1%,X:OPT FNv(xp,ox):RTS 780 .mov% LDX#di%:.lo LDAoy2%,X:STAoy%,X 790 LDAoy2_1%,X:STAoy_1%,X:DEX:BPLlo 800 LDA#0:STAoy2%:STAoy2_1%:.rts RTS 810 .xdiv EQUW0:.ydiv EQUW0:.xdiv1 EQUW0:.ydiv1 EQUW0:.xdiv2 EQUW0:.ydiv2 EQUW0 820 .alen1 EQUW0:.alen2 EQUW0:.blen1 EQUW0:.blen2 EQUW0 830 .aw EQUD0:.bw EQUD0:.wyn EQUW0 840 .gcol EQUB0 850 .surf OPT FNm(ox,x,oyp1,y):OPT FNv(oz,z):JSRdix:OPT FNv(res+2,xdiv1) 860 JSRdiy:OPT FNv(res+2,ydiv1) 870 OPT FNm(oyp2,y,zp,z):JSRdix:OPT FNv(res+2,xdiv) 880 JSRdiy:OPT FNv(res+2,ydiv) 890 OPT FNm(xp,x,yp,y):JSRdix:OPT FNv(res+2,xdiv2) 900 JSRdiy:OPT FNv(res+2,ydiv2) 910 OPT FNsbc(xdiv1,xdiv,alen1) 920 OPT FNsbc(ydiv1,ydiv,alen2) 930 OPT FNsbc(xdiv2,xdiv,blen1) 940 OPT FNsbc(ydiv2,ydiv,blen2) 950 OPT FNm(alen2,dend+2,alen1,divs) 960 JSRdivis:OPT FNv2(dend,aw) 970 OPT FNm(blen2,dend+2,blen1,divs) 980 JSRdivis:OPT FNv2(dend,bw) 990 OPT FNsbc2(bw,aw,aw) 1000 LDAaw+3:BMIone:LDA#0:STAgcol 1010 RTS:.one LDA#1:STAgcol:RTS 1020 .divis LDY#0:BITdend+3:BPLchdiv:JSRnegdiv:LDY#2 1030 .chdiv BITdivs+1:BPLdiv:SEC:LDA#0:SBCdivs:STAdivs:LDA#0:SBCdivs+1:STAdivs+1:INY 1040 .div STYsign:LDX#32:LDA#0:STArem:STArem+1 1050 .divl2 ASLdend:ROLdend+1:ROLdend+2:ROLdend+3:ROLrem:ROLrem+1:BCSwill_go2 1060 SEC:LDArem:SBCdivs:TAY:LDArem+1:SBCdivs+1:BCCwont_go2 1070 .will_go2 STArem+1:STYrem:INCdend 1080 .wont_go2 DEX:BNEdivl2:LSRsign:BCCchrem:JSRnegdiv 1090 .chrem LSRsign:BCCrtu:JSRnegdiv:SEC:LDA#0:SBCrem:STArem:LDA#0:SBCrem+1:STArem+1:.rtu RTS 1100 .negdiv SEC:LDA#0:SBCdend:STAdend:LDA#0:SBCdend+1:STAdend+1:LDA#0:SBCdend+2:STAdend+2:LDA#0:SBCdend+3:STAdend+3:RTS 1110 .sign EQUB0 1120 ]:NEXT:ENDPROC 1130 DEFFNlxy(n%):[OPTW%:LDX#n%MOD256:LDY#n%DIV256:]:=W% 1140 DEFFNsxy(a%):[OPTW%:STXa%:STYa%+1:]:=W% 1150 DEFFNaxy(a%):[OPTW%:LDXa%:LDYa%+1:]:=W% 1160 DEFFNv(a%,b%):[OPT FNaxy(a%):OPT FNsxy(b%):]=W% 1170 DEFFNv2(a%,b%):[OPT FNv(a%,b%):OPT FNv(a%+2,b%+2):]:=W% 1180 DEFFNm(a%,b%,c%,d%):[OPT FNv(a%,b%):OPT FNv(c%,d%):]:=W% 1190 DEFFNsbc(a%,b%,c%):[OPTW%:LDAa%:SEC:SBCb%:STAc%:LDAa%+1:SBCb%+1:STAc%+1:]:=W% 1200 DEFFNsbc2(a%,b%,c%):[OPT FNsbc(a%,b%,c%):LDAa%+2:SBCb%+2:STAc%+2:LDAa%+3:SBCb%+3:STAc%+3:]:=W% 1210 DEFFNadc(a%,b%,c%):[OPTW%:LDAa%:CLC:ADCb%:STAc%:LDAa%+1:ADCb%+1:STAc%+1:]:=W% 1220 DEFPROCass2 1230 ptr=&60:DIM bgr 30 1240 FORpass=0TO2STEP2:P%=bgr:[OPTpass 1250 LDA#&58:STA ptr+1:LDA#0:STA ptr:LDY#0 1260 .loop:LDA#&55:STA(ptr),Y:INY:LDA#&AA:STA(ptr),Y:INY:BNE loop 1270 INC ptr+1:LDA ptr+1:BPL loop 1280 RTS 1290 ]:NEXT:ENDPROC 1300 : 1310 DEFPROCcheck 1320 IF tested CLS:PROCinfo 1330 PRINT'"Enter X and Y range:" 1340 REPEAT:INPUT"x min ="x1:INPUT"x max ="x2:INPUT"y min ="y1:INPUT"y max ="y2:UNTIL x1max max=w 1420 IFwABS(min) maz=ABS(max):ELSE maz=ABS(min) 1460 PRINT'"Max.abs.val.:";maz 1470 IFmaz=0 Z=0:GOTO1490 1480 Z=360/maz 1490 PRINT'"Zoom:";Z; 1500 PROCchz:tested=TRUE:CLS:PROCinfo:ENDPROC 1510 DEFPROCdraft:VDU26,12,28,0,31,39,24:GCOL0,1 1520 PROCoff:?p%=0:!ox=0:!oz=600 1530 FORD%=24TO0STEP-1:M%=Y%+D%*Z%:PROCplot(X%,V%(D%,0),M%):FORE%=1TO24:PROCdraw(X%+E%*Z%,V%(D%,E%),M%):NEXT, 1540 PROCon:PRINTTAB(1,6)"Press SPACE";:*FX21 1550 REPEATUNTILGET=32:CLS:ENDPROC 1560 DEFPROCgraph:VDU26,12:CALL bgr 1570 VDU28,0,31,39,24:!oz=25*Z%+Y% 1580 FORD%=24TO0STEP-1:?p%=0:!ox=X%:PROCplot(X%,V%(D%,0),Y%+D%*Z%):M%=Y%+D%*Z% 1590 FORE%=0TO24:IFE%=0ORD%=24 ?o%=1:ELSE?o%=0 1600 PROCfill(X%+E%*Z%,V%(D%,E%),M%):NEXT:!oz=M%:CALL mov%:NEXT 1610 IF LENf$<37 PRINTTAB(1,6); ELSEPRINTTAB(0,6);SPC80;TAB(0,6); 1620 PRINT"Z=";f$;:VDU7:REPEATUNTILGET=32:ENDPROC 1630 DEFFNq(a$):PRINTa$;" ? (Y/N) ";:REPEATa$=GET$:UNTILINSTR("YyNn",a$):PRINTa$:=(a$="Y"OR a$="y") 1640 DEFPROCzoom:CLS:PRINT'"Old zoom value:";Z 1650 INPUT'"Enter new zoom value:"Z 1660 PROCchz:ENDPROC 1670 DEFPROCchz:PROCwa:FORD%=24TO0STEP-1:FORE%=0TO24:V%(D%,E%)=ta(D%,E%)*Z:NEXT:PRINTTAB(h,v);D%;" ";:SOUND1,-7,200,1:NEXT:PRINT:ENDPROC 1680 DEFPROCwa:PRINT'"Calculating. Please wait ... ";:h=POS:v=VPOS:ENDPROC 1690 DEFPROCoff:VDU23,1,0;0;0;0;0;:ENDPROC 1700 DEFPROCon:VDU23,1,1;0;0;0;0;:ENDPROC 1710 DEFPROCinfo:PRINT"f(X,Y)=";f$''"X <";x1;",";x2;">";TAB(20)"Y <";y1;",";y2;">":ENDPROC 1720 DEFPROCfill(x%,y%,z%):CALL rec%,x%,y%,z%:ENDPROC 1730 DEFPROCplot(x%,y%,z%):CALL pl%,x%,y%,z%:ENDPROC 1740 DEFPROCdraw(x%,y%,z%):CALL dr%,x%,y%,z%:ENDPROC 1750 DEFPROCfkeys:master=(INKEY-256=253)OR(INKEY-256=245) 1760 *K.0 X*Y*(Y-X)*(1-X)*(1-Y)|M0|M1|M0|M1|MY|M2|M 1770 *K.1 COS(X*Y)|M-3|M3|M-3|M3|MY|M4|M180|M2|M 1780 *K.2 SIN(SQR(X*X+Y*Y))/SQR(X*X+Y*Y)|M-10|M10|M-10|M10|MY|M2|M 1790 *K.3 EXP(-SQR(X*X+Y*Y)*SQR(X*X+Y*Y))|M-3|M3|M-3|M3|MY|M2|M 1800 IF NOT master ENDPROC 1810 *K.4 COSX*COSY|M-3|M3|M-3|M3|MY|M4|M240|M2|M 1820 *K.5 COS(SQR(X*X+Y*Y))|M-9|M9|M-9|M9|MY|M4|M180|M2|M 1830 *K.6 X*Y*(X-Y)*(X+Y)/SQR(X*X+Y*Y)|M-6.5|M6.5|M-6.5|M6.5|MY|M4|M3|M2|M 1840 *K.7 X*SINX/Y-Y*COSY/X|M-2|M2|M-2|M2|MY|M2|M 1850 *K.8 ABS(0.5/(X*X+Y*Y-0.1))|M-.66|M.66|M-.66|M.66|MY|M2|M 1860 *K.9 EXP(-X*X-Y*Y)+0.75*EXP(-(Y+3)*(Y+3)-X*X)|M-3|M3|M-5.5|M2.5|MY|M2|M 1870 ENDPROC 1880 DEFPROCerr:SOUND1,-10,10,10 1890 IF ERR=17 AND INKEY-1 VDU26,12,10:END ELSE IF ERR=17 ENDPROC 1900 CLS:IF ERR=26:PRINT"Invalid expression for function!" ELSE REPORT:PRINT''"Try to change range!" 1910 PRINT'"Press any key to continue ...";:REPEATUNTILGET:ENDPROC