home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / algebra.bas < prev    next >
BASIC Source File  |  1988-05-22  |  5KB  |  136 lines
  1. 10    '***  ALGEBRA AND GEOMETRY PROGRAM
  2. 20    '** for the IBM PC...requires 32K and Color/Graphics
  3. 30    ON ERROR GOTO 1150
  4. 40    CLR
  5. 70    REM
  6. 80    SCREEN 1,2,0:WIDTH 80:SCNCLR : PRINT "ALGEBRA Graphics Program"
  7. 90    PRINT "    Steve VanArsdale"
  8. 100   PRINT "Mt.Prospect, Illinois  312-259-7224"
  9. 110   PRINT
  10. 120   PRINT "SELECT algebra function:"
  11. 130   PRINT "A ... for the SINE of X"
  12. 140   PRINT "B ... for the COSINE of X"
  13. 150   PRINT "C ... for the TANGENT of X"
  14. 160   PRINT "D ... for the SECANT of X"
  15. 170   PRINT "E ... for the COTANGENT of X"
  16. 180   PRINT "F ... for the COSECANT of X"
  17. 190   PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
  18. 200   PRINT "H ... for the SQUARE ROOT of X"
  19. 210   PRINT " > ";:GETKEY CHOICE$
  20. 220   IF CHOICE$ <>"A" AND CHOICE$ <> "a" THEN 230
  21. 225   DEF FNFCTN(X)=SIN(X):FCTN$="SIN(X)":GOTO 310
  22. 230   '  IF CHOICE$ <>"B" OR CHOICE$ <> "b"  THEN 240
  23. 235   '  DEF FNFCTN(X)=COS(X):FCTN$="COSINE(X)":GOTO 310
  24. 240   '  IF CHOICE$ <>"C" OR CHOICE$ <> "c" THEN 250
  25. 245   '  DEF FNFCTN(X)=TAN(X):FCTN$="TANGENT(X)":GOTO 310
  26. 250   '  IF CHOICE$ <>"D" OR CHOICE$ <> "d" THEN 260
  27. 255   '  DEF FNFCTN(X)=1/COS(X):FCTN$="SECANT(X)":GOTO 310
  28. 260   '  IF CHOICE$ <>"E" OR CHOICE$ <> "e" THEN 270
  29. 265   '  DEF FNFCTN(X)=1/TAN(X):FCTN$="COTANGENT(X)":GOTO 310
  30. 270   '  IF CHOICE$ <>"F" OR CHOICE$ <> "f" THEN 280
  31. 275   '  DEF FNFCTN(X)=1/SIN(X):FCTN$="COSECANT(X)":GOTO 310
  32. 280   '  IF CHOICE$ <>"G" OR CHOICE$ <> "g" THEN 290
  33. 285   '  DEF FNFCTN(X)=LOG(X+SQR(X*X+1)):FCTN$="INVERSE HYPERBOLIC SINE(X)":GOTO 310
  34. 290   '  IF CHOICE$ <>"H" OR CHOICE$ <>"h" THEN 300
  35. 295   '  DEF FNFCTN(X)=SQR(ABS(X)):FCTN$="SQ.RT(X)":GOTO 310
  36. 300   GOTO 70
  37. 310   PRINT "DEPTH OF ";FCTN$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
  38. 320   IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 310
  39. 330   SCNCLR:SCREEN 0,2,0 :WIDTH 40
  40. 340   '****   GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
  41. 350   SCNCLR
  42. 360   'SCREEN 1,0:COLOR 0,1
  43. 370   C=100:R=100
  44. 380   '** AXIS DRAWING ROUTINE
  45. 390   GOSUB 1180
  46. 400   '** PLOTTING PARAMETERS DISPLAY
  47. 410   PRINT AT(1,17); "GRAPH of:"
  48. 420   PRINT AT (1,18); FCTN$
  49. 430   PRINT AT (1,20); "  X     Y"
  50. 440   '** PLOTTING ROUTINE
  51. 450   X=0:Y=0:XX=-1:YY=FNFCTN(XX):DRAW (100,100)
  52. 460   FOR X = -1 TO 7 STEP .1
  53. 470   PRINT AT (1,21);:PRINT USING "##.##";X
  54. 480   REM
  55. 490   Y = FNFCTN(X)
  56. 500   YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMIT < 0 THEN GOTO 570
  57. 510   ON ERROR GOTO 1270
  58. 520   PRINT AT (7,21);:PRINT USING "##.##";Y
  59. 530   DRAW (20*X+100,100-30*Y),2
  60. 540   IF DEPTH <> 0 THEN DRAW (20*X+101,99-30*Y TO 20*X+100+DEPTH,100-30*Y-DEPTH),1
  61. 550   DRAW (20*XX+100,100-30*YY TO 20*X+100,100-30*Y),2
  62. 560   IF DEPTH <> 0 THEN DRAW (20*XX+100+DEPTH,100-30*YY-DEPTH TO 20*X+100+DEPTH,100-30*Y-DEPTH),2
  63. 570   XX=X:YY=Y
  64. 580   NEXT X
  65. 590   GOSUB 1180
  66. 600   PRINT AT (1,23); "ENTER  X  TO EXIT";:VALUE$=INPUT$(1)
  67. 610   IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 70 ELSE SCNCLR
  68. 620   '****  SPECIAL EXIT DISPLAY ****
  69. 630   '** AXIS DRAWING SUBROUTINE
  70. 640   GOSUB 1180
  71. 650   '** PLANE GRID DRAWING ROUTINE
  72. 660   FOR X = 10 TO R-10 STEP 10
  73. 670   DRAW (C+X,R-X TO 105+C+X,R-X),1
  74. 680   DRAW (C+X,R-X TO C+X,0),1
  75. 690   DRAW (C,R-X TO 195-X,5),1
  76. 700   DRAW (C+X,R TO 195+X,5),1
  77. 710   NEXT X
  78. 720   PRINT AT (22,1); " Z axis"
  79. 730   '** HOOP ROUTINE
  80. 740   CIRCLE (160,90),50,1
  81. 750   'FOR I = 1 TO 20 STEP
  82. 760   'CIRCLE STEP (1,-1),50,1
  83. 770   'NEXT I
  84. 780   'CIRCLE (160,90),50,1
  85. 790   '** ELLIPTICAL TUBE ROUTINE
  86. 800   'CIRCLE (155,90),25,1
  87. 810   'FOR I = 1 TO 35
  88. 820   'CIRCLE STEP (1,1),25,1
  89. 830   'NEXT I
  90. 840   'CIRCLE STEP (1,1),25,1
  91. 850   CIRCLE (155,90),25,.5
  92. 860   'FOR I = 1 TO 20
  93. 870   'CIRCLE STEP (1,-1),24,1,,,.5
  94. 880   'NEXT I
  95. 890   CIRCLE (155,90),25,.5
  96. 900   '***  CONE ROUTINE
  97. 910   CIRCLE (45,55),38,3
  98. 920   'FOR I = 1 TO 38
  99. 930   'CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
  100. 940   'NEXT I
  101. 950   CIRCLE (45,55),38,1
  102. 960   '**  GLOBE ROUTINE
  103. 970   CIRCLE (245,170),1,2
  104. 980   'FOR I = 1 TO 10 STEP 1
  105. 990   'CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
  106. 1000  'NEXT I
  107. 1010  'FOR I = 10 TO 0 STEP -1
  108. 1020  'CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
  109. 1030  'NEXT I
  110. 1040  DRAW  (TO 245,170),3
  111. 1050  '** PYRAMID ROUTINE
  112. 1060  'DRAW "BM10,150;C1;E30;F30;L60"
  113. 1070  'DRAW "BM+30,-28;D13"
  114. 1080  DRAW (40,135 TO 11,149),1
  115. 1090  DRAW (40,135 TO 69,149),1
  116. 1100  '** CUBE ROUTINE
  117. 1110  'DRAW "BM265,85;C3;U30;R30;D30;L30"
  118. 1120  'DRAW "BM+20,-20;C3;U30;R30;D30;L30"
  119. 1130  'DRAW "C3;G20;BM+30,0;E20;BM+0,-30;G20;BM-30,0;E20"
  120. 1140  PRINT AT (1,25); "BYE.";
  121. 1150  '**** TERMINATION LOGIC
  122. 1160  SCNCLR: PRINT "ALGEBRA Program Terminated."
  123. 1170  END
  124. 1180  '****  AXIS DRAWING SUBROUTINE ****
  125. 1190  '****  AXIS DRAWING SUBROUTINE ****
  126. 1200  DRAW (C,0 TO C,199),6
  127. 1210  DRAW (90,110 TO 200,0),6
  128. 1220  DRAW (0,R TO 319,R),6
  129. 1230  PRINT AT (1,13); "X axis"
  130. 1240  PRINT AT (10,2); "Y axis"
  131. 1250  PRINT AT (22,1); " Z axis"
  132. 1260  RETURN
  133. 1270  '****  CALCULATION ERROR HANDLER
  134. 1280  RESUME 390
  135. 1290  SCNCLR : PRINT "ALGEBRA Graphics Program"
  136.