10REM 3D Function Plotting Program 20REM by Piotr Sliwinski (1990) 30REM modified by M.Bobrowski (1991) 40: 50MODE4:T$="3D FUNCTIONS"+CHR$10+CHR$ 10+CHR$8+CHR$8+"by Piotr Sliwinski (1990 )":PRINTTAB(0,4)T$''''"Assembling. Pleas e wait. ";:PROCfkeys 60DIM ta(24,24),V%(24,24):Z%=30:di%=2 6 70PROCass:PROCass2:X%=-250:Y%=400 80PRINTTAB(0,10)SPC24;CHR$7TAB(0,20)" Important: after plotting the graph"''"y ou may always press SPACE for the"''"Edi ting Menu."'''"Now press any key to cont inue. ";:REPEAT UNTIL GET 90ON ERROR PROCerr 100MODE4:PRINTTAB(0,4)T$''''"Press f0- f3 for a demonstration"''SPC6"(f0-f9 for Master users)"''"or enter formula in te rms of X and Y"''"as a valid BASIC expre ssion." 110REPEAT:INPUTTAB(0,20)SPC120TAB(0,20 )"Function f(X,Y)="f$:UNTILf$>"" AND INS TR(f$,"X")>0 AND INSTR(f$,"Y")>0 120tested=FALSE:VDU28,0,31,39,24 130REPEAT 140CLS:IF tested PROCinfo ELSE PROCche ck 150PRINT'"1.Draft 2.Plot graph 3.Chang e X,Y range"'"4.Change zoom 5.Change fun ction 6.Exit" 160PROCon:INPUT"Enter option :"opt% 170IF opt%=1 AND tested PROCdraft 180IF opt%=2 AND tested PROCgraph 190IF opt%=3 PROCcheck:tested=TRUE 200IF opt%=4 AND tested PROCzoom 210IF opt%=5 UNTIL TRUE:GOTO 100 220UNTIL opt%=6 230MODE7:END 240: 250DEFPROCass:DIMQ%1200:wr=!&20E AND&F FFF 260DIM oy% di%,oy`1% di%,oy2% di%,oy2` 1% di% 270FOR A%=0 TO di%:A%?oy%=0:A%?oy`1%=0 :A%?oy2%=0:A%?oy2`1%=0:NEXT 280x=&70:y=&74:z=&78:mult=&7C 290cand=&7E:res=&80:p%=&84 300chaz=&B48B:shaz=&B57E 310xp=&85:yp=&87:zp=&89:oyp=&8B:oyp1=& 8D:oyp2=&8F:ox=&91:oz=&95 320po=&99:o%=&9B 330dend=res:divs=cand:rem=mult 340FORW%=0TO2STEP2:P%=Q%:[OPTW% 350.dix OPT FNlxy(chaz):OPT FNsxy(mult ) 360OPT FNv(z,cand) 370JSRmpl:OPT FNadc(x,res+2,res+2):RTS 380.diy OPT FNlxy(shaz):OPT FNsxy(mult ) 390OPT FNv(z,cand) 400JSRmpl:OPT FNadc(y,res+2,res+2):RTS 410.mpl LDX#16:LDA#0:STAres+2:STAres+3 420.mplo LSRmult+1:RORmult:BCCskip 430OPT FNadc(cand,res+2,res+2) 440.skip LSRres+3:RORres+2:RORres+1 450RORres:DEX:BNEmplo:RTS 460.plot LDA#25:JSRwr:LDA#69 470.vdus JSRwr:JSRdix:LDAres+2:JSRwr:L DAres+3:JSRwr 480JSRdiy:LDAres+2:JSRwr:LDAres+3:JMPw r 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:LD A#0:JSRwr:JSRsurf:LDAgcol:JSRwr:OPT FNm( ox,x,oyp1,y):OPT FNv(oz,z):JSRmove 540OPT FNm(xp,x,oyp,y):JSRmove 550OPT FNm(yp,y,zp,z):JSRtri 560OPT FNm(ox,x,oyp2,y):JSRmove 570OPT FNm(oyp1,y,oz,z):JSRtri 580LDA#18:JSRwr:LDA#0:JSRwr:LDAgcol:EO R#1:JSRwr 590OPT FNm(xp,x,oyp,y):JSRdraw 600OPT FNm(yp,y,zp,z):JSRdraw 610OPT FNm(ox,x,oyp2,y):JSRdraw 620OPT 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 670OPT FNv(&601,po):LDY#0:LDA(po),Y 680STAxp:INY:LDA(po),Y:STAxp+1 690OPT FNv(&604,po):LDY#0:LDA(po),Y 700STAyp:INY:LDA(po),Y:STAyp+1 710OPT FNv(&607,po):LDY#0:LDA(po),Y 720STAzp:INY:LDA(po),Y:STAzp+1:RTS 730.rec%JSRget% 740LDXp%:LDAoy%,X:STAoyp1:LDAoy`1%,X 750STAoyp1+1:LDAoy2%,X:STAoyp2:LDAoy2` 1%,X:STAoyp2+1:INCp%:INX 760LDAoy%,X:STAoyp:LDAoy`1%,X:STAoyp+1 770JSRsqr%:LDXp%:LDAyp:STAoy2%,X:LDAyp +1:STAoy2`1%,X:OPT FNv(xp,ox):RTS 780.mov% LDX#di%:.lo LDAoy2%,X:STAoy%, X 790LDAoy2`1%,X:STAoy`1%,X:DEX:BPLlo 800LDA#0:STAoy2%:STAoy2`1%:.rts RTS 810.xdiv EQUW0:.ydiv EQUW0:.xdiv1 EQUW 0:.ydiv1 EQUW0:.xdiv2 EQUW0:.ydiv2 EQUW0 820.alen1 EQUW0:.alen2 EQUW0:.blen1 EQ UW0:.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) 860JSRdiy:OPT FNv(res+2,ydiv1) 870OPT FNm(oyp2,y,zp,z):JSRdix:OPT FNv (res+2,xdiv) 880JSRdiy:OPT FNv(res+2,ydiv) 890OPT FNm(xp,x,yp,y):JSRdix:OPT FNv(r es+2,xdiv2) 900JSRdiy:OPT FNv(res+2,ydiv2) 910OPT FNsbc(xdiv1,xdiv,alen1) 920OPT FNsbc(ydiv1,ydiv,alen2) 930OPT FNsbc(xdiv2,xdiv,blen1) 940OPT FNsbc(ydiv2,ydiv,blen2) 950OPT FNm(alen2,dend+2,alen1,divs) 960JSRdivis:OPT FNv2(dend,aw) 970OPT FNm(blen2,dend+2,blen1,divs) 980JSRdivis:OPT FNv2(dend,bw) 990OPT FNsbc2(bw,aw,aw) 1000LDAaw+3:BMIone:LDA#0:STAgcol 1010RTS:.one LDA#1:STAgcol:RTS 1020.divis LDY#0:BITdend+3:BPLchdiv:JSR negdiv:LDY#2 1030.chdiv BITdivs+1:BPLdiv:SEC:LDA#0:S BCdivs:STAdivs:LDA#0:SBCdivs+1:STAdivs+1 :INY 1040.div STYsign:LDX#32:LDA#0:STArem:ST Arem+1 1050.divl2 ASLdend:ROLdend+1:ROLdend+2: ROLdend+3:ROLrem:ROLrem+1:BCSwill`go2 1060SEC:LDArem:SBCdivs:TAY:LDArem+1:SBC divs+1:BCCwont`go2 1070.will`go2 STArem+1:STYrem:INCdend 1080.wont`go2 DEX:BNEdivl2:LSRsign:BCCc hrem:JSRnegdiv 1090.chrem LSRsign:BCCrtu:JSRnegdiv:SEC :LDA#0:SBCrem:STArem:LDA#0:SBCrem+1:STAr em+1:.rtu RTS 1100.negdiv SEC:LDA#0:SBCdend:STAdend:L DA#0:SBCdend+1:STAdend+1:LDA#0:SBCdend+2 :STAdend+2:LDA#0:SBCdend+3:STAdend+3:RTS 1110.sign EQUB0 1120]:NEXT:ENDPROC 1130DEFFNlxy(n%):[OPTW%:LDX#n%MOD256:LD Y#n%DIV256:]:=W% 1140DEFFNsxy(a%):[OPTW%:STXa%:STYa%+1:] :=W% 1150DEFFNaxy(a%):[OPTW%:LDXa%:LDYa%+1:] :=W% 1160DEFFNv(a%,b%):[OPT FNaxy(a%):OPT FN sxy(b%):]=W% 1170DEFFNv2(a%,b%):[OPT FNv(a%,b%):OPT FNv(a%+2,b%+2):]:=W% 1180DEFFNm(a%,b%,c%,d%):[OPT FNv(a%,b%) :OPT FNv(c%,d%):]:=W% 1190DEFFNsbc(a%,b%,c%):[OPTW%:LDAa%:SEC :SBCb%:STAc%:LDAa%+1:SBCb%+1:STAc%+1:]:= W% 1200DEFFNsbc2(a%,b%,c%):[OPT FNsbc(a%,b %,c%):LDAa%+2:SBCb%+2:STAc%+2:LDAa%+3:SB Cb%+3:STAc%+3:]:=W% 1210DEFFNadc(a%,b%,c%):[OPTW%:LDAa%:CLC :ADCb%:STAc%:LDAa%+1:ADCb%+1:STAc%+1:]:= W% 1220DEFPROCass2 1230ptr=&60:DIM bgr 30 1240FORpass=0TO2STEP2:P%=bgr:[OPTpass 1250LDA#&58:STA ptr+1:LDA#0:STA ptr:LDY #0 1260.loop:LDA#&55:STA(ptr),Y:INY:LDA#&A A:STA(ptr),Y:INY:BNE loop 1270INC ptr+1:LDA ptr+1:BPL loop 1280RTS 1290]:NEXT:ENDPROC 1300: 1310DEFPROCcheck 1320IF tested CLS:PROCinfo 1330PRINT'"Enter X and Y range:" 1340REPEAT:INPUT"x min ="x1:INPUT"x max ="x2:INPUT"y min ="y1:INPUT"y max ="y2: UNTIL x1<x2 AND y1<y2 AND FNq("OK") 1350CLS:PRINT:PROCwa 1360dix=x2-x1:diy=y2-y1 1370stx=dix/25:sty=diy/25 1380max=0:min=0 1390Y=y2 1400FORD%=24TO0STEP-1:X=x1:FORE%=0TO24 1410w=EVALf$:IFw>max max=w 1420IFw<min min=w 1430ta(D%,E%)=w:X=X+stx:NEXT:Y=Y-sty:PR INTTAB(h,v);D%;" ";:SOUND1,-7,200,1:NEXT :PRINT 1440CLS:PRINT'"Max.value:";max''"Min.va lue:";min 1450IF ABS(max)>ABS(min) maz=ABS(max):E LSE maz=ABS(min) 1460PRINT'"Max.abs.val.:";maz 1470IFmaz=0 Z=0:GOTO1490 1480Z=360/maz 1490PRINT'"Zoom:";Z; 1500PROCchz:tested=TRUE:CLS:PROCinfo:EN DPROC 1510DEFPROCdraft:VDU26,12,28,0,31,39,24 :GCOL0,1 1520PROCoff:?p%=0:!ox=0:!oz=600 1530FORD%=24TO0STEP-1:M%=Y%+D%*Z%:PROCp lot(X%,V%(D%,0),M%):FORE%=1TO24:PROCdraw (X%+E%*Z%,V%(D%,E%),M%):NEXT, 1540PROCon:PRINTTAB(1,6)"Press SPACE";: *FX21 1550REPEATUNTILGET=32:CLS:ENDPROC 1560DEFPROCgraph:VDU26,12:CALL bgr 1570VDU28,0,31,39,24:!oz=25*Z%+Y% 1580FORD%=24TO0STEP-1:?p%=0:!ox=X%:PROC plot(X%,V%(D%,0),Y%+D%*Z%):M%=Y%+D%*Z% 1590FORE%=0TO24:IFE%=0ORD%=24 ?o%=1:ELS E?o%=0 1600PROCfill(X%+E%*Z%,V%(D%,E%),M%):NEX T:!oz=M%:CALL mov%:NEXT 1610IF LENf$<37 PRINTTAB(1,6); ELSEPRIN TTAB(0,6);SPC80;TAB(0,6); 1620PRINT"Z=";f$;:VDU7:REPEATUNTILGET=3 2:ENDPROC 1630DEFFNq(a$):PRINTa$;" ? (Y/N) ";:REP EATa$=GET$:UNTILINSTR("YyNn",a$):PRINTa$ :=(a$="Y"OR a$="y") 1640DEFPROCzoom:CLS:PRINT'"Old zoom val ue:";Z 1650INPUT'"Enter new zoom value:"Z 1660PROCchz:ENDPROC 1670DEFPROCchz:PROCwa:FORD%=24TO0STEP-1 :FORE%=0TO24:V%(D%,E%)=ta(D%,E%)*Z:NEXT: PRINTTAB(h,v);D%;" ";:SOUND1,-7,200,1:NE XT:PRINT:ENDPROC 1680DEFPROCwa:PRINT'"Calculating. Pleas e wait ... ";:h=POS:v=VPOS:ENDPROC 1690DEFPROCoff:VDU23,1,0;0;0;0;0;:ENDPR OC 1700DEFPROCon:VDU23,1,1;0;0;0;0;:ENDPRO C 1710DEFPROCinfo:PRINT"f(X,Y)=";f$''"X < ";x1;",";x2;">";TAB(20)"Y <";y1;",";y2;" >":ENDPROC 1720DEFPROCfill(x%,y%,z%):CALL rec%,x%, y%,z%:ENDPROC 1730DEFPROCplot(x%,y%,z%):CALL pl%,x%,y %,z%:ENDPROC 1740DEFPROCdraw(x%,y%,z%):CALL dr%,x%,y %,z%:ENDPROC 1750DEFPROCfkeys: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|M 180|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 1800IF 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|M 9|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|M 2|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 1870ENDPROC 1880DEFPROCerr:SOUND1,-10,10,10 1890IF ERR=17 AND INKEY-1 VDU26,12,10:E ND ELSE IF ERR=17 ENDPROC 1900CLS:IF ERR=26:PRINT"Invalid express ion for function!" ELSE REPORT:PRINT''"T ry to change range!" 1910PRINT'"Press any key to continue .. .";:REPEATUNTILGET:ENDPROC