home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Basic / 3DGRAFII.ZIP / 3DGRAFII.BAS
Encoding:
BASIC Source File  |  1992-12-12  |  8.1 KB  |  217 lines
  1. '       3-D GRAPH II  Version 1.0a By Kevin Patterson
  2. '       Filename 3DGRAFII.BAS (.ZIP)  in QuickBasic Format
  3.   
  4. '       3-D Graph II is a QuickBasic (QBASIC compatible) graphing program
  5. '       used to generate 3-dimensional graphs or funtion plots.  All of
  6. '       the standard mathematical functions are available as well as a few
  7. '       additional funtions for ease of use.
  8.  
  9. '       Since the mathematical function is generated by an interpreter, and
  10. '       the function is changed by altering the program code itself, I do
  11. '       not recommend running this program in a compiled state.  This pro-
  12. '       gram was intended to be run under QBASIC or the QuickBasic inter-
  13. '       preter.
  14.  
  15. '       A graph is generated by a mathematical formula that produces a
  16. '       variable, Y, that is base on the X coordinate and/or the Z coor-
  17. '       dinate as well as calculations using trigonometric functions.
  18.  
  19. '       To start the program immediatly, press <Shift>-<F5>.  The program
  20. '       will generate a 3-D graph based on the following DEFAULT formula:
  21.  
  22. '                            Y = SIN(X) - COS(Z)
  23.   
  24. '       Ignore the following program line.  It is needed for initialization.
  25.  
  26. DEFSNG A, D-F, H-P, S-Z: DEFINT B-C, G, Q-R: CLS : SCREEN 0, 0, 0: LOCATE 1, 1, 0: COLOR 7, 0: CLS : PI = 3.141593
  27.  
  28. '       The following definition can be changed to create a graph of a
  29. '       different function.  The n and m represent numbers or other function
  30. '       combinations.  The available operators and constants are:
  31.  
  32. '          n + m    n - m    n * m    n / m    n ^ m    n \ m   n MOD m
  33. '          ABS(n)   ATN(n)  CINT(n)   COS(n)   EXP(n)   INT(n)   LOG(n)
  34. '          SGN(n)   SIN(n)   SQR(n)   TAN(n)  n AND m   n OR m   NOT n
  35. '          n XOR m   (  )      PI       X        Z
  36.  
  37. '       The function used to produce the graph can consist of any combination
  38. '       of the above operators.  Any illegal calculations will be reported
  39. '       by the program.  (For example, taking the square root of a negative
  40. '       number.)
  41.  
  42. '       To change the function to be graphed, replace the formula after the
  43. '       equals sign with your own algebraic function based on X and/or Z:
  44.  
  45. DEF FNY (X, Z) = SIN(X) - COS(Z)
  46.                               
  47. '       The following lines allow you to change the graph's outer limits:
  48.  
  49. XMIN = -PI       'This is the left edge (minimum X coordinate) of the graph.
  50. XMAX = PI        'This is the right edge (maximum X coordinate) of the graph.
  51. YMIN = -PI       'This is the bottom (maximum Y coordinate) of the graph.
  52. YMAX = PI        'This is the top (minimum Y coordinate) of the graph.
  53. ZMIN = -PI       'This is the front (maximum Z coordinate) of the graph.
  54. ZMAX = PI        'This is the back (minimum Z coordinate) of the graph.
  55.  
  56. '       The following constant adjusts the quality of the graphical output:
  57.  
  58. FREQ = 20        'This value tells the program how defined the graph will
  59.                  'be.  The higher the value, the more defined the graph,
  60.                  'but the more time it will take to produce the graph.
  61.  
  62. '       The following lines change video defaults:
  63.  
  64. CI = 1           'Set this constant to 1 for color, 0 for black & white.
  65. CLIP = 1         'Set this constant to 1 to 'clip' any lines that extend
  66.                  'beyond the top or bottom of the graph.  Set to 0 to allow
  67.                  'lines to extend to edge of screen.
  68.  
  69. QMODE = 6        'Set this constant to one of the following video modes:
  70.  
  71. '                       6 - 640x480x16          3 - 640x480x2
  72. '                       5 - 320x200x256         2 - 720x348x2
  73. '                       4 - 320X200x4           1 - 640x200x2
  74.                
  75. '       The best video mode will be downward selected automatically.
  76.  
  77. '       The following line enables or disables error checking.  With error-
  78. '       checking enabled, the program will report errors and give you the
  79. '       option to continue immediately.  With error checking disabled, the
  80. '       program will pass the error to QuickBASIC or QBASIC.
  81.  
  82. ERCHK = 1       'Set to 1 to enable, 0 to disable.
  83.  
  84. '       To contact the author for additional high-quality programs, write:
  85.  
  86. '       Kevin H. Patterson
  87. '       Rt. 2 Box 194
  88. '       Blytheville, AR  72315
  89.  
  90. '       In case of technical difficulty, you may call (501) 763-2470 after
  91. '       4:00 pm weekdays for support.  (Ask for Kevin)
  92.  
  93. '       Although this is a shareware program, I do not ask for registration
  94. '       unless you feel this program is worthy of comment.  Suggested
  95. '       donation $5.00.
  96. '
  97. '                   /////PROGRAM CODE STARTS HERE/////
  98.  
  99. DIM LZX(FREQ), LZY(FREQ)
  100.  
  101. DEF FNADJX (X, Z) = Z * .5 + X
  102. DEF FNADJY (Y, Z) = Z * .5 + Y
  103.  
  104. ON ERROR GOTO SCRFIX
  105.  
  106. IF QMODE = 3 THEN GOTO S640480002: CI = 0
  107. IF QMODE = 2 THEN GOTO S720348002: CI = 0
  108. IF QMODE = 1 THEN GOTO S640200002: CI = 0
  109. IF CI = 0 THEN GOTO NOCLR
  110. IF QMODE = 6 THEN GOTO S640480016
  111. IF QMODE = 5 THEN GOTO S320200256
  112. IF QMODE = 4 THEN GOTO S320200004
  113. PRINT "ERROR: VIDEO MODE UNKNOWN"
  114. PRINT "Sorry, the default video mode must be between 1 and 6 inclusive."
  115. GOTO EXT
  116.  
  117. YESCLR:
  118.  
  119. S640480016:
  120. QMODE = 6: CMIN = 1: CMAX = 15: SCREEN 12
  121. PALETTE 15, 31 + 256 * 31 + 65536 * 31
  122. PRINT "15 Color Simulation:  640x480x16"
  123. PRINT "Generating color array..."
  124. GOTO GRAPH
  125.  
  126. S320200256:
  127. QMODE = 5: CMIN = 1: CMAX = 192: SCREEN 13
  128. PALETTE 255, 31 + 256 * 31 + 65536 * 31: COLOR 255
  129. PRINT "192 Color Simulation:  320x200x256"
  130. PRINT "Generating color array..."
  131. F = 2: C = 0: R = 63: G = 0: B = 0
  132. FOR G = 1 TO 63 STEP F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  133. G = G - F
  134. FOR R = 62 TO 0 STEP -F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  135. R = R + F
  136. FOR B = 1 TO 63 STEP F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  137. B = B - F
  138. FOR G = 62 TO 0 STEP -F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  139. G = G + F
  140. FOR R = 1 TO 63 STEP F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  141. R = R - F
  142. FOR B = 62 TO 0 STEP -F: C = C + 1: PALETTE C, R + G * 256 + B * 65536: NEXT
  143. B = B + F
  144. GOTO GRAPH
  145.  
  146. S320200004:
  147. QMODE = 4: CMIN = 1: CMAX = 3: SCREEN 1
  148. PRINT "3 Color Simulation:  320x200x4"
  149. PRINT "Using preset color array."
  150. GOTO GRAPH
  151.  
  152. NOCLR:
  153.  
  154. S640480002:
  155. CMIN = 1: CMAX = 1: QMODE = 3: SCREEN 11
  156. PRINT "1 Color Simulation:  640x480x2"
  157. PRINT "Using predefined color array."
  158. GOTO GRAPH
  159.  
  160. S720348002:
  161. CMIN = 1: CMAX = 1: QMODE = 2: SCREEN 3
  162. PRINT "1 Color Simulation:  720x348x2"
  163. PRINT "Using preset color array."
  164. GOTO GRAPH
  165.  
  166. S640200002:
  167. CMIN = 1: CMAX = 1: QMODE = 1: SCREEN 2
  168. PRINT "2 Color Simulation:  640x200x2"
  169. PRINT "Using preset color array."
  170. GOTO GRAPH
  171.  
  172. S080025016:
  173. CMIN = 1: CMAX = 15: QMODE = 0: SCREEN 0
  174. PRINT "ERROR: NO GRAPHICS ADAPTOR"
  175. PRINT "Sorry, you need a graphics adaptor to run this program."
  176. GOTO EXT
  177.  
  178. SCRFIX:
  179. IF QMODE = 6 THEN RESUME S320200256
  180. IF QMODE = 5 THEN RESUME S320200004
  181. IF QMODE = 4 THEN RESUME S640480002
  182. IF QMODE = 3 THEN RESUME S720348002
  183. IF QMODE = 2 THEN RESUME S640200002
  184. RESUME S080025016
  185.  
  186. GRAPH:
  187. IF ERCHK = 1 THEN ON ERROR GOTO PROGERROR
  188. IF ERCHK = 0 THEN ON ERROR GOTO 0
  189. CLS
  190. XSMIN = XMIN - .25 * (XMAX - XMIN): YSMIN = YMIN - .25 * (YMAX - YMIN)
  191. XSMAX = XMAX + .25 * (XMAX - XMIN): YSMAX = YMAX + .25 * (YMAX - YMIN)
  192. WINDOW (XSMIN, YSMIN)-(XSMAX, YSMAX)
  193.  
  194. FOR Z = ZMAX TO ZMIN STEP -((ZMAX - ZMIN) / FREQ): Q = 0: FOR X = XMIN TO XMAX STEP (XMAX - XMIN) / FREQ: Q = Q + 1: LX = LZX(Q): LY = LZY(Q): LZX(Q) = FNADJX(X, Z): YTEMP = FNY(X, Z)
  195. IF YTEMP < YMIN AND CLIP = 1 THEN YTEMP = YMIN ELSE IF YTEMP > YMAX AND CLIP = 1 THEN YTEMP = YMAX
  196. LZY(Q) = FNADJY(YTEMP, Z)
  197. IF Q = 1 THEN LZX(Q - 1) = LZX(Q): LZY(Q - 1) = LZY(Q)
  198. IF CI <> 1 THEN C = 1: GOTO NOCLR2
  199. C = ABS(INT((YTEMP - YMIN) / (YMAX - YMIN) * (CMAX - CMIN)) MOD (CMAX - CMIN + 1)) + CMIN
  200. NOCLR2:
  201. LINE (LZX(Q - 1), LZY(Q - 1))-(LZX(Q), LZY(Q)), C: IF Z = ZMAX THEN GOTO SKIP1
  202. LINE (LX, LY)-(LZX(Q), LZY(Q)), C
  203. SKIP1:
  204. NEXT X: NEXT Z
  205.  
  206. EXT:
  207. END
  208.  
  209. PROGERROR:
  210. LOCATE 1, 1
  211. PRINT "A program error has occured.  Please check your default settings."
  212. PRINT
  213. PRINT "Do you want to continue? (Y/N) ";
  214. LINE INPUT A$: IF A$ = "N" THEN RESUME EXT
  215. RESUME NEXT
  216.  
  217.