home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / plot / 3dbas03.arc / 3DPLOT.BAS < prev   
Encoding:
BASIC Source File  |  1989-08-01  |  4.6 KB  |  96 lines
  1. 1 KEY OFF:CLS:GOTO 9916
  2. 2 REM      Lines 10 through 9915 are reserved for defining z=f(x,y).
  3. 3 REM
  4. 10 REM     This function plots a circular wave in three dimensions.
  5. 20 REM Try plotting -1 <= x <= 1 and -1 <= y <= 1 with 30 divisions
  6. 30 REM along each axis, a rotation of 30 degrees, and a tilt of 20
  7. 40 REM degrees.
  8. 50 T1=X*X+Y*Y
  9. 60 T2=COS(7!*SQR(T1))
  10. 70 Z=2*T2*T2/(1!+30!*T1)
  11. 80 RETURN
  12. 9916 C2%=639:C3%=199:PRINT "                             Three Dimensional Plot"
  13. 9917 PRINT:PRINT:PRINT:PRINT "Smallest value for x";:INPUT E4
  14. 9918 PRINT "Largest value for x";:INPUT E3:PRINT "Smallest value for y";
  15. 9919 INPUT F3:PRINT "Largest value for y";:INPUT F2
  16. 9920 PRINT "Number of divisions for x";:INPUT C4%:IF C4%>1 THEN 9922
  17. 9921 PRINT "? there must be at least 2 divisions":GOTO 9920
  18. 9922 PRINT "Number of divisions for y";:INPUT C6%:IF C6%>1 THEN 9924
  19. 9923 PRINT "? there must be at least 2 divisions":GOTO 9922
  20. 9924 DIM E5(C4%*C6%),F6(C4%,C6%),G2(C4%,C6%),E0%(C4%*C6%),F0%(C4%*C6%),A5%(4)
  21. 9925 DIM A9%(4)
  22. 9926 PRINT "Rotation about the z-axis (degrees)";:INPUT D1
  23. 9927 PRINT "Tilt about the resulting y-axis (degrees)";:INPUT D9
  24. 9928 PRINT "After the plot is displayed, press a key to continue."
  25. 9929 PRINT "Evaluating function...":C9=ATN(1!)/45!:C8=D9*C9:B5=COS(C8)
  26. 9930 D3=SIN(C8):C8=D1*C9:B4=COS(C8):D2=SIN(C8):X=E4:Y=F3:GOSUB 10:E8=E4*B4+F3*D2
  27. 9931 F8=-E4*D2+F3*B4:G4=-E8*D3+Z*B5:F7=F8:G3=G4:E6=E8*B5+Z*D3:B6=C4%
  28. 9932 B6=(E3-E4)/B6:B7=C6%:B7=(F2-F3)/B7:X=E4:C5%=0:FOR E1%=1 TO C4%:Y=F3
  29. 9933 FOR F1%=1 TO C6%:GOSUB 10:C5%=C5%+1:E0%(C5%)=E1%:F0%(C5%)=F1%:E8=X*B4+Y*D2
  30. 9934 F6(E1%,F1%)=-X*D2+Y*B4:E5(C5%)=E8*B5+Z*D3:G2(E1%,F1%)=-E8*D3+Z*B5
  31. 9935 IF E5(C5%)>E6 THEN E6=E5(C5%)
  32. 9936 IF F6(E1%,F1%)<F8 THEN F8=F6(E1%,F1%)
  33. 9937 IF F6(E1%,F1%)>F7 THEN F7=F6(E1%,F1%)
  34. 9938 IF G2(E1%,F1%)<G4 THEN G4=G2(E1%,F1%)
  35. 9939 IF G2(E1%,F1%)>G3 THEN G3=G2(E1%,F1%)
  36. 9940 Y=Y+B7:NEXT F1%:X=X+B6:NEXT E1%:PRINT "Adjusting perspective..."
  37. 9941 IF F7-F8>G3-G4 THEN 9944
  38. 9942 IF G3=G4 THEN 9949
  39. 9943 E2=2!*(G3-G4)+E6:GOTO 9945
  40. 9944 E2=2!*(F7-F8)+E6
  41. 9945 E9=(F7+F8)/2!:F9=(G3+G4)/2!:C5%=0:FOR E1%=1 TO C4%:Y=F3:FOR F1%=1 TO C6%
  42. 9946 C5%=C5%+1:X=E5(C5%):Y=F6(E1%,F1%):Z=G2(E1%,F1%):B6=X-E2:B7=Y-E9:B8=Z-F9
  43. 9947 E5(C5%)=SQR(B6*B6+B7*B7+B8*B8):F6(E1%,F1%)=E9+(Y-E9)*(E2-E6)/(E2-X)
  44. 9948 G2(E1%,F1%)=F9+(Z-F9)*(E2-E6)/(E2-X):NEXT F1%:NEXT E1%
  45. 9949 PRINT "Sorting points...":D4%=C5%\2:D4%=D4%+1:D5%=C5%:D6=E5(1):D7%=E0%(1)
  46. 9950 D8%=F0%(1)
  47. 9951 IF D5%<=1 THEN 9964
  48. 9952 IF D4%<=1 THEN 9954
  49. 9953 D4%=D4%-1:D6=E5(D4%):D7%=E0%(D4%):D8%=F0%(D4%):GOTO 9956
  50. 9954 D6=E5(D5%):D7%=E0%(D5%):D8%=F0%(D5%):E5(D5%)=E5(1):E0%(D5%)=E0%(1)
  51. 9955 F0%(D5%)=F0%(1):D5%=D5%-1
  52. 9956 IF D5%<=1 THEN 9964
  53. 9957 C1%=D4%
  54. 9958 C0%=C1%:C1%=2*C1%:IF C1%>D5% THEN 9963
  55. 9959 IF C1%=D5% THEN 9961
  56. 9960 IF E5(C1%)>E5(C1%+1) THEN C1%=C1%+1
  57. 9961 IF D6<=E5(C1%) THEN 9963
  58. 9962 E5(C0%)=E5(C1%):E0%(C0%)=E0%(C1%):F0%(C0%)=F0%(C1%):GOTO 9958
  59. 9963 E5(C0%)=D6:E0%(C0%)=D7%:F0%(C0%)=D8%:GOTO 9951
  60. 9964 E5(1)=D6:E0%(1)=D7%:F0%(1)=D8%:SCREEN 2:A0=1!/(4!*(200!/640!)/3!):F5=C2%
  61. 9965 G1=C3%:IF A0*G1*(F7-F8)<=F5*(G3-G4) THEN 9967
  62. 9966 C7=F5/(A0*(F7-F8)):F4=0!:G0=-(G1-C7*(G3-G4))/2!:GOTO 9970
  63. 9967 IF A0*G1*(F7-F8)>=F5*(G3-G4) THEN 9969
  64. 9968 C7=G1/(G3-G4):F4=(F5-A0*C7*(F7-F8))/2!:G0=0!:GOTO 9970
  65. 9969 C7=1!:F4=F5/2!:G0=-G1/2!
  66. 9970 FOR E7%=1 TO C5%:E1%=E0%(E7%):IF E1%=C4% THEN 9992
  67. 9971 F1%=F0%(E7%):IF F1%=C6% THEN 9992
  68. 9972 A5%(1)=FIX(F4+C7*A0*(F6(E1%,F1%)-F8)):A9%(1)=FIX(G0+G1-C7*(G2(E1%,F1%)-G4))
  69. 9973 A5%(2)=FIX(F4+C7*A0*(F6(E1%+1,F1%)-F8))
  70. 9974 A9%(2)=FIX(G0+G1-C7*(G2(E1%+1,F1%)-G4))
  71. 9975 A5%(3)=FIX(F4+C7*A0*(F6(E1%+1,F1%+1)-F8))
  72. 9976 A9%(3)=FIX(G0+G1-C7*(G2(E1%+1,F1%+1)-G4))
  73. 9977 A5%(4)=FIX(F4+C7*A0*(F6(E1%,F1%+1)-F8))
  74. 9978 A9%(4)=FIX(G0+G1-C7*(G2(E1%,F1%+1)-G4)):B1%=A9%(1):B0%=B1%:FOR A3%=2 TO 4
  75. 9979 IF A9%(A3%)<B1% THEN B1%=A9%(A3%)
  76. 9980 IF A9%(A3%)>B0% THEN B0%=A9%(A3%)
  77. 9981 NEXT A3%:FOR B3%=B1% TO B0%:B9%=0:A4%=2:FOR A3%=1 TO 4
  78. 9982 IF A9%(A3%)>=B3% THEN 9987
  79. 9983 IF B3%>A9%(A4%) THEN 9988
  80. 9984 A2=A9%(A4%)-A9%(A3%):A1=A5%(A4%)-A5%(A3%):B2=B3%-A9%(A3%):A6=A5%(A3%)
  81. 9985 A7%=FIX(A1*B2/A2+A6):IF B9%=0 THEN A8%=A7% ELSE LINE (A7%,B3%)-(A8%,B3%),0
  82. 9986 B9%=1-B9%:GOTO 9988
  83. 9987 IF B3%>A9%(A4%) THEN 9984
  84. 9988 A4%=A4%+1:IF A4%>4 THEN A4%=1
  85. 9989 NEXT A3%:NEXT B3%:A8%=A7%:A4%=2:FOR A3%=1 TO 4
  86. 9990 LINE (A5%(A3%),A9%(A3%))-(A5%(A4%),A9%(A4%)):A4%=A4%+1:IF A4%>4 THEN A4%=1
  87. 9991 NEXT A3%
  88. 9992 NEXT E7%
  89. 9993 R$=INKEY$:IF LEN(R$)=0 THEN 9993
  90. 9994 SCREEN 0:WIDTH 80
  91. 9995 PRINT "                             Three Dimensional Plot":PRINT:PRINT
  92. 9996 PRINT:PRINT "Again (y or n)? ";
  93. 9997 R$=INKEY$:IF LEN(R$)=0 THEN 9997
  94. 9998 PRINT:IF ((R$="Y") OR (R$="y")) THEN 9926
  95. 9999 END
  96.