1000 '3d plots
1010 KEY OFF
1020 DIM MIN(320),MAX(320)
1030 SWIDE=320:SHIGH=200
1040 GOSUB 1890:SCREEN 0
1050 GOSUB 2190
1060 SCREEN 1:WIDTH 40:CLS
1070 WIDTH 40
1080 COLOR 1,3
1090 PRINT TAB(15);"3-D GRAPHICS":PRINT
1100 INPUT "Color 1-16";CO$
1110 IF CO$="" THEN CO=1 ELSE CO=VAL(CO$)
1120 IF CO<0 OR CO>16 THEN 1100
1130 COLOR CO,1
1140 INPUT "P)rogram or D)isk";A$
1150 IF A$="D" OR A$="d" THEN 1840
1160 IF A$="" THEN 1500
1170 IF A$<> "P" AND A$ <> "p" THEN 1140
1180 INPUT "3/4 display (Y or N)";TQ$
1190 IF TQ$="y" OR TQ$="Y" THEN TQ=1 ELSE IF TQ$="N" OR TQ$="n" OR TQ$="" THEN TQ=0 ELSE 1180
1200 INPUT "How many X slices";SX: IF SX>1 AND SX<=SWIDE THEN SX=2/SX ELSE IF SX=0 THEN 1500 ELSE 1200
1210 INPUT "How many Z slices";SZ: IF SZ>1 AND SZ<= SWIDE THEN SZ=2/SZ ELSE IF SZ=0 THEN 1500 ELSE 1200
1220 CLS:SCREEN 1,0
1230 FOR N=0 TO SWIDE:MAX(N)=SHIGH:MIN(N)=0:NEXT
1240 LX =0: LY = 0
1250 BE=.3:CE=.5
1260 XX=COS(BE):XY=0:XZ=SIN(BE)
1270 YX=SIN(BE)*SIN(CE):YY=COS(CE):YZ=-SIN(CE)*COS(BE)
1280 ZF=1:ZR=-1
1290 FOR Z=ZF TO ZR STEP -SZ
1300 X2=0
1310 XW=SQR(1-Z*Z)
1320 IF TQ=1 THEN LL=O ELSE LL=-XW
1330 X=LL:GOSUB 1760
1340 XO=LX:YO=LY:XE=X1:YE=Y1:LX=X1:LY=Y1
1350 GOSUB 1570
1360 X=XW:GOSUB 1760
1370 XO=RX:YO=RY:XE=X1:YE=Y1:RX=X1:RY=Y1
1380 GOSUB 1570
1390 IF ABS(Z)<(ZF+ZR+.001)/2 AND TQ=1 THEN TQ=0:LL=-XW:X=LL:GOSUB 1760:LX=X1:LY=Y1
1400 FOR X=LL TO XW+SX/2 STEP SX
1410 IF X>0 AND XXW-SX THEN X=XW
1440 GOSUB 1760
1450 XE=X1:YE=Y1:XO=X2:YO=Y2:X2=X1:Y2=Y1
1460 GOSUB 1570
1470 NEXT X
1480 NEXT Z
1490 'done with drawing
1500 KEY ON
1510 IF INKEY$="S" THEN GOSUB 2330
1520 IF INKEY$="E" THEN STOP
1530 IF INKEY$="D" THEN KEY OFF:GOSUB 1970
1540 IF INKEY$="N" THEN GOTO 1030
1550 IF INKEY$="L" THEN GOSUB 2260
1560 GOTO 1500
1570 IF XO=0 OR XE=0 THEN 1740
1580 IF XE=XO THEN XE=XE+.5:XO=XO-.5
1590 M=(YE-YO)/(XE-XO)
1600 C=YE-M*XE
1610 XB=XO: YB=INT(M*XO+C+.5):XA=XB:YA=YB
1620 FOR XA=XO TO XE STEP SGN(XE-XO)
1630 YA=INT(M*XA+C+.5)
1640 H=0
1650 IF XA<0 OR XA>SWIDE THEN RETURN 'had a NEXT statement here
1660 IF YA<=MAX(XA) THEN MAX(XA)=YA:H=1
1670 IF YA>=MIN(XA) THEN MIN(XA)=YA:H=1
1680 IF YA<0 OR YA>SHIGH THEN H=0
1690 IF H=0 THEN XB=0
1700 IF XB*H<>0 THEN LINE (XB,YB)-(XA,YA)
1710 IF H<>0 THEN XB=XA:YB=YA
1720 NEXT
1730 XA=0:XB=0:YA=0:YB=O
1740 RETURN
1750 'FUNCTION TO BE PLOTTED
1760 XR=5:XS=126:YS=58
1770 D=SQR(X*X+Z*Z)*XR
1780 Y=COS(D)+COS(3*D)/2
1790 X1=X*XX+Y*XY+Z*XZ
1800 Y1=X*YX+Y*YY+Z*YZ
1810 Y1=INT(SHIGH/2-Y1*YS)
1820 X1=INT(SWIDE/2+X1*XS)
1830 RETURN
1840 GOSUB 2260
1850 IF B$="D" OR B$="d" THEN GOSUB 1970:GOTO 1140
1860 GOTO 1500
1870 'This is a program to demonstrate three dimensional plotting of functions
1880 'by Gerald Fitzpatrick, Plano, Texas
1890 'switch to color
1900 DEF SEG=0
1910 POKE &H410, (PEEK(&H410) AND &HCF) OR &H10
1920 SCREEN 1,0,0,0
1930 SCREEN 0
1940 WIDTH 40
1950 RETURN
1960 RETURN
1970 'dump to printer
1980 DIM Z%(20)
1990 LPRINT CHR$(&H1B);"f"; 'set forward line feed
2000 LPRINT CHR$(&H1F);CHR$(1); 'move to top of next page
2010 LPRINT CHR$(&H1B);"r"; 'set reverse line feed
2020 FOR J=1 TO 6:LPRINT:NEXT J 'skip some spaces
2030 LPRINT CHR$(27);"T";"16"; 'set spacing to 16/244 inch
2040 LPRINT CHR$(27);"L015"; 'set left margin
2050 WIDTH "LPT1:",255 'set width
2060 FOR C%= 0 TO 316 STEP 4
2070 LPRINT CHR$(27);CHR$(&H53);"0400"; '400 bytes on the way
2080 FOR R%=0 TO 199
2090 GET (C%+3,R%)-(C%,R%),Z%
2100 X$=CHR$(Z%(2))
2110 LPRINT X$;X$;
2120 NEXT R%
2130 LPRINT
2140 NEXT C%
2150 LPRINT CHR$(27);"A"; 'set spacing to 1/8 inch
2160 LPRINT CHR$(&H1B);"f"; 'forward direction
2170 LPRINT CHR$(&H1F);CHR$(1); 'top of next page
2180 RETURN 'if called as subroutine
2190 'set function keys
2200 KEY 1,"L)OAD"
2210 KEY 2,"S)AVE"
2220 KEY 3,"P)RINT"
2230 KEY 4,"N)EW"
2240 KEY 5,"E)ND"
2250 RETURN
2260 'load in file
2270 KEY OFF
2280 LOCATE 25,1
2290 INPUT "Name of file to load";A$
2300 DEF SEG=&HB800
2310 BLOAD A$,0
2320 RETURN
2330 'save
2340 KEY OFF
2350 LOCATE 25,1
2360 INPUT "Name of file to save";A$
2370 DEF SEG = &HB800
2380 BSAVE A$,0,&H4000
2390 KEY ON
2400 RETURN
2410 'dump
2420 KEY OFF
2430 LOCATE 25,1
2440 GOSUB 1890
2450 KEY ON
2460 RETURN
2470 'color
2480 'color
2490 KEY OFF
2500 LOCATE 25,1
2510 INPUT "New colors a,b";AA%,BB%
2520 COLOR AA%,BB%
2530 RETURN
2540 STOP
2550 'end
2560 'switch to mono
2570 DEF SEG=0
2580 POKE &H410, (PEEK(&H410) OR  &H30)
2590 SCREEN 1,0,0,0
2600 SCREEN 0
2610 WIDTH 40
2620 WIDTH 80
2630 LOCATE ,,1,12,13