home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 058.lha / 3D < prev    next >
Encoding:
Text File  |  1986-11-20  |  31.2 KB  |  1,540 lines
  1. '  *************  3DGrapher  **************
  2. '  *****  Copyright 1987 Randy Finch  *****
  3.  
  4. ' This program plots  Z = F(X,Y) with any axes rotation.
  5.  
  6. ' Axes drawn in following order: X, Y, Z
  7.  
  8.  
  9. '  **********  SET UP PROGRAM PARAMETERS  **********
  10.  
  11. CLEAR,30000
  12. CLEAR,75000&
  13.  
  14. WIDTH WINDOW(2)/8 - 2
  15. CLS : PRINT "Please wait ..."
  16.  
  17. curdir$ = "df1:"
  18. CHDIR curdir$
  19.  
  20. LIBRARY "graphics.library"
  21. DECLARE FUNCTION ReadPixel&() LIBRARY
  22. LIBRARY "dos.library"
  23. DECLARE FUNCTION Lock&() LIBRARY
  24. DECLARE FUNCTION Execute&() LIBRARY
  25.  
  26. success& = Execute&(SADD("cd "+curdir$+CHR$(0)),0,0)
  27.  
  28. ON BREAK GOSUB EndProg
  29. BREAK ON
  30.  
  31. checknum$ = "-.0123456789"
  32. checknumpos$ = ".0123456789"
  33.  
  34. true% = -1
  35. false% = 0
  36.  
  37. wrongequation% = false%  ' used when retrieving a graph
  38. picsave% = false%        ' flag for saving a graph
  39. picget% = false%         ' flag for retrieving a graph
  40. plottinggraph% = false%  ' flag - graph not currently plotting
  41.  
  42. size% = 20003
  43. DIM pic%(size%)   ' to GET screen
  44.  
  45. GOSUB SetUpMenu
  46. GOSUB SetUserParameters
  47. GOSUB SetUpScreen
  48. GOSUB SetColorPalette
  49. GOSUB SetEquationParameters
  50.  
  51. WIDTH 38
  52. LOCATE 12,7
  53. PRINT "PLEASE CHOOSE A MENU ITEM."
  54.  
  55. WaitForMenu: GOTO WaitForMenu
  56.  
  57.  
  58. ' *********************  MENU ROUTINES  ************************
  59.  
  60. Origin:
  61.  
  62. GOSUB SetEquationParameters  ' in case changes made
  63.  
  64. ' Project origin to projection plane along line to viewer
  65. xprojbase& = vp& * (xbase& - xcenter&) / (vp& + zplane&) + xcenter&
  66. yprojbase& = vp& * (ybase& - ycenter&) / (vp& + zplane&) + ycenter&
  67.  
  68. dummy = MOUSE(0)    ' Clear mouse settings
  69. WHILE MOUSE(0) = 0 OR MOUSE(0) = -1: WEND
  70. xclick& = MOUSE(3)
  71. yclick& = MOUSE(4)
  72.  
  73. IF xclick& < 1 AND yclick& < 1 THEN 
  74.   WINDOW 3, "Set Origin", (0,65)-(311,130),18,2
  75.   COLOR textpen%,0
  76.   PRINT
  77.   PRINT "Current projected origin"
  78.   PRINT "in screen coordinates:"
  79.   PRINT
  80.   PRINT "X-axis: "; xprojbase& ; TAB(20) ; "CHANGE TO:"
  81.   PRINT "Y-axis: "; yprojbase& ; TAB(20) ; "CHANGE TO:"
  82.  
  83.   CALL GetString(gs$, 5, 31, checknum$)
  84.   IF gs$ <> "" THEN
  85.     xclick& = VAL(gs$)
  86.   ELSE
  87.     xclick& = xprojbase&
  88.   END IF
  89.   CALL GetString(gs$, 6, 31, checknum$)
  90.   IF gs$ <> "" THEN
  91.     yclick& = VAL(gs$)
  92.   ELSE
  93.     yclick& = yprojbase&
  94.   END IF
  95.  
  96.   WINDOW CLOSE 3
  97. END IF
  98.   
  99. xmove& = xclick& - xprojbase&
  100. ymove& = yclick& - yprojbase&
  101. SCROLL (0,0)-(319,199), xmove&, ymove&
  102. xp& = xp& + xmove&
  103. yp& = yp& + ymove&
  104. xbase& = (vp& + zplane&) * (xclick& - xcenter&) / vp& + xcenter&
  105. ybase& = (vp& + zplane&) * (yclick& - ycenter&) / vp& + ycenter&
  106. pixelcolor% = POINT(xp&,yp&)    ' Only to move point cursor
  107.  
  108. MENU ON
  109.  
  110. RETURN
  111.  
  112.  
  113. Rotation:
  114.  
  115. WINDOW 3, "Set Axes Rotation", (0,65)-(311,130),18,2
  116. COLOR textpen%,0
  117. PRINT
  118. PRINT "Current rotations"
  119. PRINT "   in degrees"
  120. PRINT
  121. PRINT "Z-axis: "; thetadegrees ; TAB(20) ; "CHANGE TO:"
  122. PRINT "Y-axis: "; phidegrees ; TAB(20) ; "CHANGE TO:"
  123. PRINT "X-axis: "; deltadegrees ; TAB(20) ; "CHANGE TO:"
  124.  
  125. CALL GetString(gs$, 5, 31, checknum$)
  126. IF gs$ <> "" THEN thetadegrees = VAL(gs$)
  127. CALL GetString(gs$, 6, 31, checknum$)
  128. IF gs$ <> "" THEN phidegrees = VAL(gs$)
  129. CALL GetString(gs$, 7, 31, checknum$)
  130. IF gs$ <> "" THEN deltadegrees = VAL(gs$)
  131.  
  132. WINDOW CLOSE 3
  133. MENU ON
  134.  
  135. RETURN
  136.  
  137.  
  138. Scale:
  139.  
  140. WINDOW 3, "Set Scale", (0,65)-(311,130), 18, 2
  141. COLOR textpen%,0
  142. PRINT
  143. PRINT "Current scale in"
  144. PRINT "pixels per unit: "; pperu&
  145. PRINT
  146. PRINT "CHANGE TO: ";
  147.  
  148. CALL GetString(gs$, 5, 12, checknumpos$)
  149. IF gs$ <> "" THEN pperu& = VAL(gs$)
  150.  
  151. WINDOW CLOSE 3
  152. MENU ON
  153.  
  154. RETURN
  155.  
  156.  
  157. ViewDist:
  158.  
  159. WINDOW 3, "Set Viewing Distance", (0,65)-(311,130), 18, 2
  160. COLOR textpen%,0
  161. PRINT
  162. PRINT "Current viewing distance from"
  163. PRINT "projection plane in units: "; viewerdistance
  164. PRINT
  165. PRINT "CHANGE TO: ";
  166.  
  167. CALL GetString(gs$, 5, 12, checknumpos$)
  168. IF gs$ <> "" THEN
  169.   pperu& = pperu& * viewerdistance / VAL(gs$)
  170.   viewerdistance = VAL(gs$)
  171. END IF
  172.  
  173. WINDOW CLOSE 3
  174. MENU ON
  175.  
  176. RETURN
  177.  
  178.  
  179. ProjPlane:
  180.  
  181. WINDOW 3, "Set Projection Plane", (0,65)-(311,130), 18, 2
  182. COLOR textpen%,0
  183. PRINT
  184. PRINT "Current projection plane, Z = "; zplaneunit
  185. PRINT
  186. PRINT "CHANGE TO Z = ";
  187.  
  188. CALL GetString(gs$, 4, 15, checknum$)
  189. IF gs$ <> "" THEN zplaneunit = VAL(gs$)
  190.  
  191. WINDOW CLOSE 3
  192. MENU ON
  193.  
  194. RETURN
  195.  
  196.  
  197. LineSpacing:
  198.  
  199. WINDOW 3, "Set Line Spacing", (0,60)-(311,135), 18, 2
  200. COLOR textpen%,0
  201. PRINT
  202. PRINT "THESE VALUES DETERMINE THE DISTANCE,"
  203. PRINT "IN UNITS, BETWEEN EACH DRAWN LINE."
  204. PRINT
  205. PRINT "Current values"
  206. PRINT
  207. PRINT "X-axis: "; spacex ; TAB(20) ; "CHANGE TO: "
  208. PRINT "Y-axis: "; spacey ; TAB(20) ; "CHANGE TO: "
  209.  
  210. CALL GetString(gs$, 7, 31, checknumpos$)
  211. IF gs$ <> "" AND VAL(gs$) <> 0 THEN spacex = VAL(gs$)
  212. CALL GetString(gs$, 8, 31, checknumpos$)
  213. IF gs$ <> "" AND VAL(gs$) <> 0 THEN spacey = VAL(gs$)
  214.  
  215. WINDOW CLOSE 3
  216. MENU ON
  217.  
  218. RETURN
  219.  
  220.  
  221. PlotPrecision:
  222.  
  223. WINDOW 3, "Set Plot Precision", (0,55)-(311,145), 18, 2
  224. COLOR textpen%,0
  225. PRINT
  226. PRINT "THESE VALUES DETERMINE THE PRECISION"
  227. PRINT "OF THE PLOT AND THE SPEED IT WILL BE"
  228. PRINT "DRAWN.  THE VALUES REPRESENT THE DIS-"
  229. PRINT "TANCE IN UNITS BETWEEN PLOTTED PIXELS."
  230. PRINT
  231. PRINT "Current values"
  232. PRINT
  233. PRINT "X-axis: "; incx ; TAB(20) ; "CHANGE TO: "
  234. PRINT "Y-axis: "; incy ; TAB(20) ; "CHANGE TO: "
  235.  
  236. CALL GetString(gs$, 9, 31, checknumpos$)
  237. IF gs$ <> "" AND VAL(gs$) <> 0 THEN incx = VAL(gs$)
  238. CALL GetString(gs$, 10, 31, checknumpos$)
  239. IF gs$ <> "" AND VAL(gs$) <> 0 THEN incy = VAL(gs$)
  240.  
  241. WINDOW CLOSE 3
  242. MENU ON
  243.  
  244. RETURN
  245.  
  246.  
  247. PlotSpan:
  248.  
  249. WINDOW 3, "Set Plotting Ranges", (0,55)-(311,140), 18, 2
  250. COLOR textpen%,0
  251. PRINT
  252. PRINT "Current values"
  253. PRINT
  254. PRINT "X minimum: "; txmin; TAB(20) ; "CHANGE TO: "
  255. PRINT "X maximum: "; txmax; TAB(20) ; "CHANGE TO: "
  256. PRINT "Y minimum: "; tymin; TAB(20) ; "CHANGE TO: "
  257. PRINT "Y maximum: "; tymax; TAB(20) ; "CHANGE TO: "
  258.  
  259. CALL GetString(gs$, 4, 31, checknum$)
  260. IF gs$ <> "" THEN txmin = VAL(gs$)
  261.  
  262. Gettxmax:
  263. CALL GetString(gs$, 5, 31, checknum$)
  264. IF gs$ <> "" THEN txmax = VAL(gs$)
  265. IF txmax < txmin THEN Gettxmax
  266.  
  267. CALL GetString(gs$, 6, 31, checknum$)
  268. IF gs$ <> "" THEN tymin = VAL(gs$)
  269.  
  270. Gettymax:
  271. CALL GetString(gs$, 7, 31, checknum$)
  272. IF gs$ <> "" THEN tymax = VAL(gs$)
  273. IF tymax < tymin THEN Gettymax
  274.  
  275. WINDOW CLOSE 3
  276. MENU ON
  277.  
  278. RETURN
  279.  
  280.  
  281. AxesSpan:
  282.  
  283. WINDOW 3, "Set Axes Ranges", (0,55)-(311,145), 18, 2
  284. COLOR textpen%,0
  285. PRINT
  286. PRINT "Current values"
  287. PRINT
  288. PRINT "X minimum: "; axmin; TAB(20) ; "CHANGE TO: "
  289. PRINT "X maximum: "; axmax; TAB(20) ; "CHANGE TO: "
  290. PRINT "Y minimum: "; aymin; TAB(20) ; "CHANGE TO: "
  291. PRINT "Y maximum: "; aymax; TAB(20) ; "CHANGE TO: "
  292. PRINT "Z minimum: "; azmin; TAB(20) ; "CHANGE TO: "
  293. PRINT "Z maximum: "; azmax; TAB(20) ; "CHANGE TO: "
  294. PRINT "Precision: "; axesinc; TAB(20) ; "CHANGE TO: "
  295.  
  296. CALL GetString(gs$, 4, 31, checknum$)
  297. IF gs$ <> "" THEN axmin = VAL(gs$)
  298.  
  299. Getaxmax:
  300. CALL GetString(gs$, 5, 31, checknum$)
  301. IF gs$ <> "" THEN axmax = VAL(gs$)
  302. IF axmax < axmin THEN Getaxmax
  303.  
  304. CALL GetString(gs$, 6, 31, checknum$)
  305. IF gs$ <> "" THEN aymin = VAL(gs$)
  306.  
  307. Getaymax:
  308. CALL GetString(gs$, 7, 31, checknum$)
  309. IF gs$ <> "" THEN aymax = VAL(gs$)
  310. IF aymax < aymin THEN Getaymax
  311.  
  312. CALL GetString(gs$, 8, 31, checknum$)
  313. IF gs$ <> "" THEN azmin = VAL(gs$)
  314.  
  315. Getazmax:
  316. CALL GetString(gs$, 9, 31, checknum$)
  317. IF gs$ <> "" THEN azmax = VAL(gs$)
  318. IF azmax < azmin THEN Getazmax
  319.  
  320. CALL GetString(gs$, 10, 31, checknumpos$)
  321. IF gs$ <> "" THEN axesinc = VAL(gs$)
  322.  
  323. WINDOW CLOSE 3
  324. MENU ON
  325.  
  326. RETURN
  327.  
  328.  
  329. CHOn:
  330.  
  331. xdrawflag% = true%
  332. ydrawflag% = true%
  333. MENU 1,10,2
  334. MENU 1,11,1
  335. MENU ON
  336.  
  337. RETURN
  338.  
  339.  
  340. CHOff:
  341.  
  342. dummy = MOUSE(0)    ' Clear mouse settings
  343. WINDOW 3, "Crosshatch On Select", (0,75)-(311,125),18,2
  344. COLOR textpen%,0
  345. PRINT
  346. PRINT "  LINES DRAWN PARALLEL TO WHICH AXIS?"
  347. PRINT
  348. PRINT "    X    Y"; TAB(31) ; "CANCEL"
  349. LINE (28,20)-(42,34),,b
  350. LINE (68,20)-(82,34),,b
  351. LINE (236,20)-(290,34),,b
  352.  
  353. ChooseBox:
  354.  
  355. WHILE MOUSE(0) = 0 OR MOUSE(0) = -1 : WEND
  356. xclick& = MOUSE(3)
  357. yclick& = MOUSE(4)
  358. IF yclick& >= 20 AND yclick& <= 34 THEN
  359.   IF xclick& >= 28 AND xclick& <= 42 THEN
  360.     xdrawflag% = true%
  361.     ydrawflag% = false%
  362.     GOTO EndCHChoose
  363.   ELSEIF xclick& >= 68 AND xclick& <= 82 THEN
  364.     xdrawflag% = false%
  365.     ydrawflag% = true%
  366.     GOTO EndCHChoose
  367.   ELSEIF xclick& >= 236 AND xclick& <= 290 THEN
  368.     GOTO EndCHChoose2
  369.   ELSE
  370.   END IF
  371. END IF
  372. GOTO ChooseBox
  373.  
  374. EndCHChoose:
  375. MENU 1,10,1
  376. MENU 1,11,2 
  377. EndCHChoose2:
  378. WINDOW CLOSE 3
  379. MENU ON
  380.  
  381. RETURN
  382.  
  383.  
  384. AxesOn:
  385.  
  386. axesflag% = true%
  387. MENU 1,12,2
  388. MENU 1,13,1
  389. MENU ON
  390.  
  391. RETURN
  392.  
  393.  
  394. AxesOff:
  395.  
  396. axesflag% = false%
  397. MENU 1,12,1
  398. MENU 1,13,2
  399. MENU ON
  400.  
  401. RETURN
  402.  
  403.  
  404. Background:
  405.  
  406. CALL DrawColorWindow("Set Background Color")
  407. CALL SetColorBars(0,bkgred, bkggreen, bkgblue, -1, 0!, 0!, 0!)
  408. MENU ON
  409.  
  410. RETURN
  411.  
  412.  
  413. Graph:
  414.  
  415. CALL DrawColorWindow("Set Graph Colors")
  416. CALL SetColorBars(pennumbase%,graphfarred, graphfargreen, graphfarblue, pennummax%, graphnearred, graphneargreen, graphnearblue)
  417. MENU ON
  418.  
  419. RETURN
  420.  
  421.  
  422. Axes:
  423.  
  424. CALL DrawColorWindow("Set Axes Color")
  425. CALL SetColorBars(axespen%,axesred, axesgreen, axesblue, -1, 0!, 0!, 0!)
  426. MENU ON
  427.  
  428. RETURN
  429.  
  430.  
  431. Border:
  432.  
  433. CALL DrawColorWindow("Set Border Color")
  434. CALL SetColorBars(1,borderred, bordergreen, borderblue, -1, 0!, 0!, 0!)
  435. MENU ON
  436.  
  437. RETURN
  438.  
  439.  
  440. Text:
  441.  
  442. CALL DrawColorWindow("Set Text Color")
  443. CALL SetColorBars(textpen%,textred, textgreen, textblue, -1, 0!, 0!, 0!)
  444. MENU ON
  445.  
  446. RETURN
  447.  
  448.  
  449. SavePic:
  450.  
  451. ext$ = "3D"
  452. GOSUB GetFile
  453.  
  454. SavePicFile:
  455. IF filename$ <> "" THEN
  456.   IF filelock& = false% THEN
  457.     CLS
  458.     PRINT "The screen will be restored"
  459.     PRINT "when the save is complete."
  460.     OPEN filename$+".3D" FOR OUTPUT AS #1
  461.     FOR j% = 0 TO size%
  462.       PRINT#1, MKI$(pic%(j%));
  463.     NEXT
  464.     PRINT#1, equation$
  465.     CLOSE 1
  466.     picsave% = true%
  467.     GOTO SaveSets
  468.   ELSE
  469.     CLS
  470.     PRINT "File exists."
  471.     PRINT
  472.     INPUT "OVERWRITE (Y/N) ?? ",overwrite$
  473.     IF INSTR("Yy",LEFT$(overwrite$,1)) THEN
  474.       filelock& = false%
  475.       GOTO SavePicFile
  476.     END IF
  477.   END IF
  478. END IF
  479.  
  480. PUT (0,0), pic%, PSET
  481. MENU ON
  482.  
  483. RETURN
  484.  
  485.  
  486. SaveSets:
  487.  
  488. IF picsave% = false% THEN
  489.   ext$ = "SET"
  490.   GOSUB GetFile
  491.   SaveSetFile:
  492.   IF filename$ <> "" THEN
  493.     IF filelock& = false% THEN
  494.       CLS
  495.       PRINT "The screen will be restored"
  496.       PRINT "when the save is complete."
  497.     ELSE
  498.       CLS
  499.       PRINT "File exists."
  500.       PRINT
  501.       INPUT "OVERWRITE (Y/N) ?? ",overwrite$
  502.       IF INSTR("Yy",LEFT$(overwrite$,1)) THEN
  503.         filelock& = false%
  504.         GOTO SaveSetFile
  505.       ELSE
  506.         GOTO QuitSetSave
  507.       END IF
  508.     END IF
  509.   ELSE
  510.     GOTO QuitSetSave
  511.   END IF
  512. END IF
  513.  
  514. OPEN filename$+".SET" FOR OUTPUT AS #1
  515. PRINT #1, xbase&
  516. PRINT #1, ybase&
  517. PRINT #1, thetadegrees
  518. PRINT #1, phidegrees
  519. PRINT #1, deltadegrees
  520. PRINT #1, pperu&
  521. PRINT #1, viewerdistance
  522. PRINT #1, zplaneunit
  523. PRINT #1, txmin
  524. PRINT #1, txmax
  525. PRINT #1, tymin
  526. PRINT #1, tymax
  527. PRINT #1, spacex
  528. PRINT #1, spacey
  529. PRINT #1, incx
  530. PRINT #1, incy
  531. PRINT #1, xdrawflag%
  532. PRINT #1, ydrawflag%
  533. PRINT #1, axesflag%
  534. PRINT #1, axmin
  535. PRINT #1, axmax
  536. PRINT #1, aymin
  537. PRINT #1, aymax
  538. PRINT #1, azmin
  539. PRINT #1, azmax
  540. PRINT #1, axesinc
  541. CLOSE 1
  542.  
  543. QuitSetSave:
  544. PUT (0,0), pic%, PSET
  545. MENU ON
  546. picsave% = false%  ' reset flag
  547.  
  548. RETURN
  549.  
  550.  
  551. GetPic:
  552.  
  553. ext$ = "3D"
  554. GOSUB GetFile
  555.  
  556. GetPicFile:
  557. IF filename$ <> "" THEN
  558.   IF filelock& THEN
  559.     CLS
  560.     PRINT "The graph will appear when"
  561.     PRINT "retrieval is complete."
  562.     OPEN filename$+".3D" FOR INPUT AS #1
  563.     FOR j% = 0 TO size%
  564.       tempstr$ = INPUT$(2,1)
  565.       pic%(j%) = CVI(tempstr$)
  566.     NEXT
  567.     INPUT#1, eq$
  568.     IF eq$ = equation$ THEN
  569.       wrongequation% = false%
  570.     ELSE
  571.       wrongequation% = true%
  572.       equation$ = eq$
  573.     END IF
  574.     CLOSE 1
  575.     picget% = true%
  576.     GOTO GetSets
  577.   ELSE
  578.     CLS
  579.     PRINT "File does not exist. Press [RETURN].
  580.     WHILE INKEY$ <> CHR$(13) : WEND
  581.   END IF
  582. END IF
  583.  
  584. PUT (0,0), pic%, PSET
  585. MENU ON
  586.  
  587. RETURN WaitForMenu
  588.  
  589.  
  590. GetSets:
  591.  
  592. IF picget% = false% THEN
  593.   ext$ = "SET"
  594.   GOSUB GetFile
  595.   IF filename$ <> "" THEN
  596.     IF filelock& THEN
  597.       CLS
  598.       PRINT "The screen will be restored"
  599.       PRINT "when retrieval is complete."
  600.     ELSE
  601.       CLS
  602.       PRINT "File does not exist. Press [RETURN].
  603.       WHILE INKEY$ <> CHR$(13) : WEND
  604.       GOTO QuitGetSets
  605.     END IF
  606.   ELSE
  607.     GOTO QuitGetSets
  608.   END IF
  609. END IF
  610.  
  611. OPEN filename$+".SET" FOR INPUT AS #1
  612. INPUT #1, xbase&
  613. INPUT #1, ybase&
  614. INPUT #1, thetadegrees
  615. INPUT #1, phidegrees
  616. INPUT #1, deltadegrees
  617. INPUT #1, pperu&
  618. INPUT #1, viewerdistance
  619. INPUT #1, zplaneunit
  620. INPUT #1, txmin
  621. INPUT #1, txmax
  622. INPUT #1, tymin
  623. INPUT #1, tymax
  624. INPUT #1, spacex
  625. INPUT #1, spacey
  626. INPUT #1, incx
  627. INPUT #1, incy
  628. INPUT #1, xdrawflag%
  629. INPUT #1, ydrawflag%
  630. INPUT #1, axesflag%
  631. INPUT #1, axmin
  632. INPUT #1, axmax
  633. INPUT #1, aymin
  634. INPUT #1, aymax
  635. INPUT #1, azmin
  636. INPUT #1, azmax
  637. INPUT #1, axesinc
  638. CLOSE 1
  639. GOSUB SetEquationParameters
  640.  
  641. QuitGetSets:
  642. PUT (0,0), pic%, PSET
  643. MENU ON
  644. picget% = false%  ' reset flag
  645.  
  646. RETURN
  647.  
  648.  
  649. DrawGraph:
  650.  
  651. ' Don't draw graph if equation incorrect
  652. IF wrongequation% = true% THEN
  653.   GET (0,0)-(319,199), pic%
  654.   CLS
  655.   PRINT
  656.   PRINT "A graph has been retrieved from disk"
  657.   PRINT "and the equation does not match the"
  658.   PRINT "currently defined equation in the pro-"
  659.   PRINT "gram.  Please save current settings,"
  660.   PRINT "input the appropriate equation, re-run"
  661.   PRINT "the program, and retrieve the saved"
  662.   PRINT "settings."
  663.   LOCATE 15,30 : PRINT "OK"
  664.   LINE (229,109)-(249,121),,b
  665.  
  666.   GetDGClick:
  667.   dummy = MOUSE(0)
  668.   WHILE MOUSE(0) = 0 : WEND
  669.   xclick& = MOUSE(3)
  670.   yclick& = MOUSE(4)
  671.   IF yclick& >= 109 AND yclick& <= 121 THEN
  672.     IF xclick& >= 229 AND xclick& <= 249 THEN
  673.       PUT (0,0),pic%,PSET
  674.       MENU ON
  675.       RETURN
  676.     END IF
  677.   END IF
  678.   GOTO GetDGClick
  679. END IF
  680.  
  681. ' OK to draw graph
  682. MENU 1,2,0
  683. MENU 1,3,0
  684. MENU 1,4,0
  685. MENU 1,5,0
  686. MENU 3,3,0
  687. MENU 3,4,0
  688. MENU 4,1,0
  689. MENU 4,2,1
  690. MENU ON
  691.  
  692. plottinggraph% = true%
  693. CLS
  694. LOCATE 11,6
  695. PRINT "Please wait while preliminary"
  696. LOCATE 13,7
  697. PRINT "calculations are performed."
  698.  
  699. GOSUB SetEquationParameters
  700. GOSUB SetCoordinateParameters
  701. GOSUB DefineFunctions
  702.  
  703. '  CALCULATE MINIMUM & MAXIMUM DISTANCES FROM USER
  704.  
  705. ' Initialize minimum & maximum
  706.  
  707. tz = FNcalc(txmin,tymin)
  708. dtoplane = FNzcalc(txmin,tymin,tz)
  709. dmax = dtoplane
  710. dmin = dtoplane
  711.  
  712. ' Loop on X at constant Y's
  713.  
  714. IF xdrawflag% = true% THEN
  715.  
  716. FOR ty = tymin TO tymax STEP calcspacey
  717.   FOR tx = txmin TO txmax STEP calcincx
  718.     tz = FNcalc(tx,ty)
  719.     dtoplane = FNzcalc(tx,ty,tz)
  720.     dmax = FNmax(dmax,dtoplane)
  721.     dmin = FNmin(dmin,dtoplane)
  722.   NEXT tx
  723. NEXT ty
  724.  
  725. END IF
  726.  
  727. ' Loop on Y at constant X's
  728.  
  729. IF ydrawflag% = true% THEN
  730.  
  731. FOR tx = txmin TO txmax STEP calcspacex
  732.   FOR ty = tymin TO tymax STEP calcincy
  733.     tz = FNcalc(tx,ty)
  734.     dtoplane = FNzcalc(tx,ty,tz)
  735.     dmax = FNmax(dmax,dtoplane)
  736.     dmin = FNmin(dmin,dtoplane)
  737.   NEXT ty
  738. NEXT tx
  739.  
  740. END IF
  741.  
  742. ' Calculate distance spread and depth of each color range
  743.  
  744. spread = dmax - dmin
  745. colorspread = spread/numcolors%
  746. IF colorspread = 0 THEN colorspread = 1    'in case all points equidistant
  747.  
  748. ' PLOT THE GRAPH
  749.  
  750. ' Plot X's at constant Y's for specified range of Y
  751.  
  752. CLS
  753.  
  754. IF xdrawflag% = true% THEN
  755.   FOR ty = tymin TO tymax STEP spacey
  756.     backflag% = true%  ' Prevent last point from connecting with the next first point
  757.     FOR tx = txmin TO txmax STEP incx
  758.       GOSUB CalcAndPlot
  759.     NEXT tx
  760.   NEXT ty
  761. END IF
  762.  
  763. ' Plot Y's at constant X for specified range of X
  764.  
  765. IF ydrawflag% = true% THEN      ' Do only if user specified
  766.   FOR tx = txmin TO txmax STEP spacex
  767.     backflag% = true%  ' Prevent last point from connecting with the next first point
  768.     FOR ty = tymin TO tymax STEP incy
  769.       GOSUB CalcAndPlot
  770.     NEXT ty
  771.   NEXT tx
  772. END IF
  773.  
  774.  
  775. ' DRAW AXES
  776.  
  777. IF axesflag% = true% THEN    ' Do only if user specified
  778.  
  779. ' X-axis
  780.  
  781. IF axmax > axmin THEN   ' Do not plot if equal
  782.   ty = 0 : tz = 0
  783.   FOR tx = axmin TO axmax STEP axesinc
  784.     GOSUB AxesCalcAndPlot
  785.   NEXT tx
  786. END IF
  787.  
  788. ' Y-axis
  789.  
  790. IF aymax > aymin THEN
  791.   tx = 0 : tz = 0
  792.   FOR ty = aymin TO aymax STEP axesinc
  793.     GOSUB AxesCalcAndPlot
  794.   NEXT ty
  795. END IF
  796.  
  797. ' Z-axis
  798.  
  799. IF azmax > azmin THEN
  800.   tx = 0 : ty = 0
  801.   FOR tz = azmin TO azmax STEP axesinc
  802.     GOSUB AxesCalcAndPlot
  803.   NEXT tz
  804. END IF
  805.  
  806. END IF
  807.  
  808. plottinggraph% = false%
  809. GOTO StopGraph
  810.  
  811.  
  812. StopGraph:
  813.  
  814. MENU 1,2,1
  815. MENU 1,3,1
  816. MENU 1,4,1
  817. MENU 1,5,1
  818. MENU 3,3,1
  819. MENU 3,4,1
  820. MENU 4,1,1
  821. MENU 4,2,0
  822. MENU ON
  823.  
  824. IF plottinggraph% = true% THEN RETURN ClearStack
  825.  
  826. ClearStack:
  827. RETURN WaitForMenu
  828.  
  829.  
  830. InputEquation:
  831.  
  832. GET (0,0)-(319,199),pic%
  833. CLS
  834. WIDTH 38
  835. PRINT
  836. PRINT "The program will end and list the sub-"
  837. PRINT "routine SetUserParameters.  Change the"
  838. PRINT "equation in lines 1 AND 2 of this sub-"
  839. PRINT "routine, and then re-run the program."
  840. PRINT "You must save any picture and/or set-"
  841. PRINT "tings at this time or you will lose"
  842. PRINT "them when the program ends."
  843. PRINT
  844. PRINT
  845. PRINT " OK  CANCEL"
  846.  
  847. LINE (5,75)-(27,91),,b
  848. LINE (37,75)-(91,91),,b
  849.  
  850. GetIEClick:
  851. dummy = MOUSE(0)
  852. WHILE MOUSE(0) = 0 : WEND
  853. xclick& = MOUSE(3)
  854. yclick& = MOUSE(4)
  855. IF yclick& >= 75 AND yclick& <= 91 THEN
  856.   IF xclick& >= 5 AND xclick& <= 27 THEN
  857.     RETURN EndProg
  858.   ELSEIF xclick& >= 37 AND xclick& <= 91 THEN
  859.     PUT (0,0),pic%,PSET
  860.     MENU ON
  861.     RETURN
  862.   END IF
  863. END IF
  864. GOTO GetIEClick
  865.  
  866.  
  867. ShowEquation:
  868.  
  869. WINDOW 3, "Current Equation", (0,135)-(311,185), 26, 2
  870. COLOR textpen%,0
  871. WIDTH 38
  872. PRINT
  873. PRINT "Z = "
  874. PRINT
  875. PRINT equation$
  876. WHILE WINDOW(8) <> 0 : WEND
  877. WINDOW OUTPUT 2
  878. MENU ON
  879.  
  880. RETURN
  881.  
  882.  
  883. ShowSettings:
  884.  
  885. GET (0,0)-(319,199),pic%
  886. CLS
  887. PRINT "        ORIGIN: X ="; xbase&
  888. PRINT "                Y ="; ybase&
  889. PRINT "      ROTATION: Z ="; thetadegrees; "degrees"
  890. PRINT "                Y ="; phidegrees; "degrees"
  891. PRINT "                X ="; deltadegrees; "degrees"
  892. PRINT "         SCALE:"; pperu&; "pixels per unit"
  893. PRINT " VIEW DISTANCE:"; viewerdistance; "units"
  894. PRINT "    PROJ PLANE: Z ="; zplaneunit
  895. PRINT "  LINE SPACING: X-axis ="; spacex
  896. PRINT "                Y-axis ="; spacey
  897. PRINT "PLOT PRECISION: X-axis ="; incx
  898. PRINT "                Y-axis ="; incy
  899. PRINT "     PLOT SPAN: X min ="; txmin
  900. PRINT "                X max ="; txmax
  901. PRINT "                Y min ="; tymin
  902. PRINT "                Y max ="; tymax
  903. PRINT "     AXES SPAN: X min ="; axmin; "X max ="; axmax
  904. PRINT "                Y min ="; aymin; "Y max ="; aymax
  905. PRINT "                Z min ="; azmin; "Z max ="; azmax
  906. PRINT "AXES PRECISION:"; axesinc
  907. PRINT " CROSSHATCH IS: ";
  908. IF xdrawflag% = true% AND ydrawflag% = true% THEN
  909.   PRINT "ON"
  910. ELSE
  911.   PRINT "OFF  ";
  912.   IF xdrawflag% = true% THEN
  913.     PRINT "X-axis ON"
  914.   ELSE
  915.     PRINT "Y-axis ON"
  916.   END IF
  917. END IF
  918. PRINT "      AXES ARE: ";
  919. IF axesflag% = true% THEN
  920.   PRINT "ON"
  921. ELSE
  922.   PRINT "OFF"
  923. END IF
  924.  
  925. LOCATE 23,36 : PRINT "OK"
  926. LINE (276,172)-(298,186),,b
  927.  
  928. GetSSClick:
  929. dummy = MOUSE(0)
  930. WHILE MOUSE(0) = 0 : WEND
  931. xclick& = MOUSE(3)
  932. yclick& = MOUSE(4)
  933. IF yclick& >= 172 AND yclick& <= 186 THEN
  934.   IF xclick& >= 276 AND xclick& <= 298 THEN
  935.     PUT (0,0),pic%,PSET
  936.     MENU ON
  937.     RETURN
  938.   END IF
  939. END IF
  940. GOTO GetSSClick
  941.  
  942.  
  943. QuitProg:
  944.  
  945. WINDOW 3,"QUIT PROGRAM!!",(10,80)-(300,120),18,2
  946. PRINT "           Are You Sure?"
  947. LOCATE 4,12 : PRINT "YES"
  948. LOCATE 4,22 : PRINT "NO"
  949. LINE (84,20)-(114,34),,b
  950. LINE (164,20)-(186,34),,b
  951.  
  952. GetQPClick:
  953. dummy = MOUSE(0)
  954. WHILE MOUSE(0) = 0 : WEND
  955. xclick& = MOUSE(3)
  956. yclick& = MOUSE(4)
  957. IF yclick& >= 20 AND yclick& <= 34 THEN
  958.   IF xclick& >= 84 AND xclick& <= 114 THEN
  959.     WINDOW CLOSE 3
  960.     GOTO EndProg
  961.   ELSEIF xclick& >= 164 AND xclick& <= 186 THEN
  962.     WINDOW CLOSE 3
  963.     PUT (0,0),pic%,PSET
  964.     MENU ON
  965.     RETURN
  966.   END IF
  967. END IF
  968. GOTO GetQPClick
  969.  
  970.  
  971. '  **************  END THE PROGRAM GRACEFULLY  **************
  972.  
  973. EndProg:
  974. WINDOW CLOSE 2
  975. SCREEN CLOSE 2
  976. MENU RESET
  977. WIDTH 78
  978. LIST SetUserParameters
  979. END
  980.  
  981.  
  982. '  ******************  SUBROUTINES  ********************
  983.  
  984. SetUserParameters:
  985.  
  986. DEF FNcalc(X,Y) =  3.5*COS(1.75*(X*X+Y*Y))*EXP(-.8*(X*X+Y*Y))
  987. equation$ = "3.5*COS(1.75*(X*X+Y*Y))*EXP(-.8*(X*X+Y*Y))"
  988.  
  989. thetadegrees = 135    ' Rotation about Z
  990. phidegrees = 60      ' Rotation about Y
  991. deltadegrees = -45     ' Rotation about X
  992.  
  993. pperu& = 30    ' pixels per unit distance for X-axis
  994.  
  995. ' Plotting ranges
  996. txmin = -3 : txmax = 3
  997. tymin = -3 : tymax = 3
  998.  
  999. ' Spacing between lines
  1000. spacex = 1 : spacey = 1
  1001.  
  1002. ' Plot accuracy in units between plotted pixels
  1003. incx = (txmax-txmin)/60 : incy = incx
  1004.  
  1005. ' Axes ranges
  1006. axmin = -4 : axmax = 4
  1007. aymin = -4 : aymax = 4
  1008. azmin = -4 : azmax = 4
  1009.  
  1010. ' Axes plot precision
  1011. axesinc = .1
  1012.  
  1013. ' Origin projected perpendicular to projection plane
  1014. xbase& = 160 : ybase& = 100
  1015.  
  1016. ' Center of screen
  1017. xcenter& = 160 : ycenter& = 100
  1018.  
  1019. viewerdistance = 20     ' in units from projection plane
  1020. zplaneunit = 0          ' distance of projection plane from origin
  1021.  
  1022. ' Crosshatching on
  1023. xdrawflag% = true%
  1024. ydrawflag% = true%
  1025.  
  1026. axesflag% = true%    ' draw axes
  1027.  
  1028. RETURN
  1029.  
  1030.  
  1031. SetEquationParameters:
  1032.  
  1033. ' Viewer distance in pixels from projection plane
  1034. vp& = viewerdistance * pperu&
  1035.  
  1036. ' Distance in pixels of projection plane from origin
  1037. zplane& = zplaneunit * pperu&
  1038.  
  1039. aspectratio = .927     ' to correct y-axis
  1040. pi = 3.14159
  1041.  
  1042. ' Values to speed up min and max calcs to get colorspread
  1043. calcspacex = spacex : calcspacey = spacey
  1044. calcincx = 5*incx : calcincy = 5*incy
  1045.  
  1046. RETURN
  1047.  
  1048.  
  1049. SetColorPalette:
  1050.  
  1051. numcolors% = 16
  1052. pennumbase% = 14
  1053. pennummax% = pennumbase% + numcolors% - 1
  1054.  
  1055. axespen% = 2
  1056. textpen% = 3
  1057. COLOR textpen%,0
  1058.  
  1059. bkgred = 0 : bkggreen = 0 : bkgblue = 0   ' Black background
  1060. axesred = .5 : axesgreen = 0 : axesblue = 0    ' Red axes
  1061. borderred = .5 : bordergreen = .5 : borderblue = .5  ' Medium gray border
  1062. textred = .5 : textgreen = 0 : textblue = .5     ' Purple text
  1063. graphfarred = 0 : graphfargreen = 0 : graphfarblue = 1
  1064. graphnearred = 1 : graphneargreen = 1 : graphnearblue = 1
  1065.  
  1066. PALETTE 0,bkgred,bkggreen,bkgblue
  1067. PALETTE 1,borderred,bordergreen,borderblue
  1068. PALETTE axespen%,axesred,axesgreen,axesblue
  1069. PALETTE textpen%,textred,textgreen,textblue
  1070. PALETTE 30,0,.5,0  ' Green in menu
  1071. PALETTE 31,.8,.8,0  ' Yellow in menu
  1072.  
  1073.  
  1074. ' Set color scale for graph
  1075.  
  1076. FOR num% = pennumbase% TO pennummax%
  1077.   fractionred = graphfarred + (num% - pennumbase%) * (graphnearred - graphfarred) / numcolors%
  1078.   fractiongreen = graphfargreen + (num% - pennumbase%) * (graphneargreen - graphfargreen) / numcolors%
  1079.   fractionblue = graphfarblue + (num% - pennumbase%) * (graphnearblue - graphfarblue) / numcolors%
  1080.   PALETTE num%,fractionred,fractiongreen,fractionblue
  1081. NEXT num%
  1082.  
  1083. RETURN
  1084.  
  1085.  
  1086. DefineFunctions:
  1087.  
  1088. DEF FNmax(a,b) = -(a>=b)*a - (b>a)*b
  1089. DEF FNmin(a,b) = -(a<=b)*a - (b<a)*b
  1090.  
  1091. DEF FNxcalc(X,Y,Z) = xcoeffx * X + xcoeffy * Y + xcoeffz * Z
  1092. DEF FNycalc(X,Y,Z) = ycoeffx * X + ycoeffy * Y + ycoeffz * Z
  1093. DEF FNzcalc(X,Y,Z) = zcoeffx * X + zcoeffy * Y + zcoeffz * Z
  1094.  
  1095. RETURN
  1096.  
  1097.  
  1098. CalcAndPlot:
  1099.  
  1100. tz = FNcalc(tx,ty)
  1101. GOSUB Calculate
  1102.  
  1103. IF onscreen% = true% THEN
  1104.   dtoplane = FNzcalc(tx,ty,tz)
  1105.   pennum% = INT((dtoplane - dmin)/colorspread) + pennumbase%
  1106.   IF pennum% > pennummax% THEN pennum% = pennummax%
  1107.   IF pennum% < pennumbase% THEN pennum% = pennumbase%
  1108.   pixelcolor% = ReadPixel&(rp&,xp&,yp&)
  1109.   IF pixelcolor% <= pennum% THEN
  1110.     IF backflag% THEN
  1111.       PSET(xp&,yp&),pennum%
  1112.       backflag% = false%
  1113.     ELSE
  1114.       LINE -(xp&,yp&),pennum%
  1115.     END IF
  1116.   ELSE
  1117.     PSET(xp&,yp&), pixelcolor%
  1118.     backflag% = true%
  1119.   END IF
  1120. END IF
  1121.  
  1122. RETURN
  1123.  
  1124.  
  1125. AxesCalcAndPlot:
  1126.  
  1127. GOSUB Calculate
  1128.  
  1129. IF onscreen% = true% THEN
  1130.   pixelcolor% = ReadPixel&(rp&,xp&,yp&)
  1131.   dtoplane = FNzcalc(tx,ty,tz)
  1132.   potencolor% = INT((dtoplane - dmin)/colorspread) + pennumbase%
  1133.   IF potencolor% > pixelcolor% THEN PSET(xp&,yp&),axespen%
  1134. END IF
  1135.  
  1136. RETURN
  1137.  
  1138.  
  1139. Calculate:
  1140.  
  1141. xpixels = FNxcalc(tx,ty,tz) * pperu& + xbase& - xcenter&
  1142. ypixels = -FNycalc(tx,ty,tz) * pperu& + ybase& - ycenter&
  1143. zpixels = FNzcalc(tx,ty,tz) * pperu&
  1144.  
  1145. zdiff = vp& + zplane& - zpixels  ' negative if behind viewer
  1146.  
  1147. IF zdiff > 1 THEN
  1148.   tforline = vp& / (vp& + zplane& - zpixels)
  1149.   xp& = xpixels * tforline + xcenter&
  1150.   yp& = ypixels * tforline * aspectratio + ycenter&
  1151.   onscreen% = true%
  1152. ELSE
  1153.   xp& = -1
  1154.   yp& = -1
  1155.   onscreen% = false%
  1156. END IF
  1157.  
  1158. RETURN
  1159.  
  1160.  
  1161. SetCoordinateParameters:
  1162.  
  1163. theta = thetadegrees * pi / 180
  1164. phi = phidegrees * pi / 180
  1165. delta = deltadegrees * pi / 180
  1166.  
  1167. sintheta = SIN(theta)
  1168. sinphi = SIN(phi)
  1169. sindelta = SIN(delta)
  1170. costheta = COS(theta)
  1171. cosphi = COS(phi)
  1172. cosdelta = COS(delta)
  1173.  
  1174. ' Equation coefficients
  1175.  
  1176. xcoeffx = cosphi * costheta
  1177. xcoeffy = sindelta * sinphi * costheta + cosdelta * sintheta
  1178. xcoeffz = -cosdelta * sinphi * costheta + sindelta * sintheta
  1179.  
  1180. ycoeffx = -cosphi * sintheta
  1181. ycoeffy = -sindelta * sinphi * sintheta + cosdelta * costheta
  1182. ycoeffz = cosdelta * sinphi * sintheta + sindelta * costheta
  1183.  
  1184. zcoeffx = sinphi
  1185. zcoeffy = -sindelta * cosphi
  1186. zcoeffz = cosdelta * cosphi
  1187.  
  1188. RETURN
  1189.  
  1190.  
  1191. SetUpScreen:
  1192.  
  1193. xscreenmax% = 319
  1194. yscreenmax% = 199
  1195. SCREEN 2,320,200,5,1
  1196. WINDOW 2,,,16,2
  1197. rp& = WINDOW(8)
  1198.  
  1199. RETURN
  1200.  
  1201.  
  1202. GetFile:
  1203.  
  1204. GET (0,0)-(319,199), pic%
  1205.  
  1206. GetFile2:
  1207. CLS
  1208. GetFile3:
  1209. PRINT "Current Directory is:"
  1210. PRINT curdir$
  1211. PRINT
  1212. PRINT "C - change directory"
  1213. PRINT "D - show directory"
  1214. PRINT "[RETURN] - Abort"
  1215. PRINT
  1216. INPUT "Filename: ", filename$
  1217.  
  1218. IF filename$ = "" THEN
  1219.   filelock& = false%
  1220.   RETURN
  1221. ELSEIF INSTR("Cc",filename$) THEN
  1222.   CLS
  1223.   InputDir:
  1224.   PRINT "Input new directory, [RETURN] to Abort"
  1225.   INPUT "", newcurdir$
  1226.   IF newcurdir$ = "" THEN GetFile2
  1227.   dirlock& = Lock&(SADD(newcurdir$),-2)
  1228.   IF dirlock& = 0 THEN
  1229.     PRINT "Directory does not exist."
  1230.     PRINT
  1231.     GOTO InputDir
  1232.   END IF
  1233.   curdir$ = newcurdir$
  1234.   CHDIR curdir$
  1235.   success& = Execute&(SADD("cd "+curdir$+CHR$(0)),0,0)
  1236.   CALL UnLock(dirlock&)
  1237.   GOTO GetFile2
  1238. ELSEIF INSTR("Dd",filename$) THEN
  1239.   exstring$ = "list > ram:tempdir pat #?."+ext$+" quick"+CHR$(0)
  1240.   success& = Execute&(SADD(exstring$),0,0)
  1241.   IF success& THEN
  1242.     OPEN "ram:tempdir" FOR INPUT AS #1
  1243.     ShowDir:
  1244.     CLS
  1245.     numfiles% = 0
  1246.     WHILE NOT EOF(1) AND numfiles% < 20
  1247.       LINE INPUT#1, fline$
  1248.       PRINT fline$
  1249.       numfiles% = numfiles% + 1
  1250.     WEND
  1251.     PRINT
  1252.     INPUT "Filename: ", filename$
  1253.     IF filename$ = "" THEN
  1254.       IF numfiles% = 20 THEN
  1255.         GOTO ShowDir
  1256.       ELSE
  1257.         CLOSE 1
  1258.         KILL "ram:tempdir"
  1259.         GOTO GetFile2
  1260.       END IF
  1261.     ELSE
  1262.       CLOSE 1
  1263.       KILL "ram:tempdir"
  1264.       GOTO ExistFile
  1265.     END IF
  1266.   ELSE
  1267.     PRINT "Cannot obtain directory."
  1268.     GOTO GetFile3
  1269.   END IF
  1270. ELSE
  1271.   GOTO ExistFile
  1272. END IF
  1273.  
  1274.  
  1275. ExistFile:
  1276.  
  1277. filelock& = Lock&(SADD(filename$+"."+ext$+CHR$(0)),-2)
  1278. IF filelock& THEN CALL UnLock(filelock&)
  1279. RETURN
  1280.  
  1281.  
  1282. SetUpMenu:
  1283.  
  1284. MENU 1,0,1, " SET"
  1285. MENU 1,1,1, "Origin"
  1286. MENU 1,2,1, "Rotation"
  1287. MENU 1,3,1, "Scale"
  1288. MENU 1,4,1, "View Distance"
  1289. MENU 1,5,1, "Projection Plane"
  1290. MENU 1,6,1, "Line Spacing"
  1291. MENU 1,7,1, "Plot Precision"
  1292. MENU 1,8,1, "Plot Span"
  1293. MENU 1,9,1, "Axes Span"
  1294. MENU 1,10,2, "  Crosshatch On"
  1295. MENU 1,11,1, "  Crosshatch Off"
  1296. MENU 1,12,2, "  Axes On"
  1297. MENU 1,13,1, "  Axes Off"
  1298.  
  1299. MENU 2,0,1, "COLOR"
  1300. MENU 2,1,1, "Background"
  1301. MENU 2,2,1, "Graph"
  1302. MENU 2,3,1, "Axes"
  1303. MENU 2,4,1, "Border"
  1304. MENU 2,5,1, "Text"
  1305.  
  1306. MENU 3,0,1, "FILE"
  1307. MENU 3,1,1, "Save Picture"
  1308. MENU 3,2,1, "Save Settings"
  1309. MENU 3,3,1, "Get Picture"
  1310. MENU 3,4,1, "Get Settings"
  1311.  
  1312. MENU 4,0,1, "FUNCTION"
  1313. MENU 4,1,1, "Plot"
  1314. MENU 4,2,0, "Stop Plot"
  1315. MENU 4,3,1, "Input Equation"
  1316. MENU 4,4,1, "Show Equation"
  1317. MENU 4,5,1, "Show Settings"
  1318. MENU 4,6,1, "QUIT"
  1319.  
  1320. ON MENU GOSUB HandleMenu
  1321. MENU ON
  1322.  
  1323. RETURN
  1324.  
  1325.  
  1326. HandleMenu:
  1327.  
  1328. MENU OFF
  1329. ON MENU(0) GOTO Settings, ColorSet, File, FunctionSet
  1330.  
  1331. Settings:
  1332. ON MENU(1) GOTO Origin, Rotation, Scale, ViewDist, ProjPlane, LineSpacing, PlotPrecision, PlotSpan, AxesSpan, CHOn, CHOff, AxesOn, AxesOff
  1333.  
  1334. ColorSet:
  1335. ON MENU(1) GOTO Background, Graph, Axes, Border, Text
  1336.  
  1337. File:
  1338. ON MENU(1) GOTO SavePic, SaveSets, GetPic, GetSets
  1339.  
  1340. FunctionSet:
  1341. ON MENU(1) GOTO DrawGraph, StopGraph, InputEquation, ShowEquation, ShowSettings, QuitProg
  1342.  
  1343.  
  1344. '  ************************  SUB PROGRAMS  ****************************
  1345.  
  1346. SUB GetString(td$, down%, across%, checkstring$) STATIC
  1347.  
  1348. StartOfLoop:
  1349.  
  1350. LOCATE down%,across%
  1351. INPUT "",td$
  1352. IF td$ <> "" THEN
  1353.   strlen% = LEN(td$)
  1354.   FOR dummy = 1 TO strlen%
  1355.     IF INSTR(checkstring$,MID$(td$,dummy,1)) = 0 THEN
  1356.       LOCATE down%,across% : PRINT SPACE$(strlen%)
  1357.       GOTO StartOfLoop
  1358.     END IF
  1359.   NEXT
  1360. END IF
  1361.  
  1362. END SUB
  1363.  
  1364.  
  1365. SUB DrawColorWindow(title$) STATIC
  1366. SHARED textpen%
  1367.  
  1368. ' Set up window for color bars
  1369. WINDOW 3, title$, (0,0)-(311,75), 18, 2
  1370. COLOR textpen%,0
  1371.  
  1372. LINE (50,8)-(270,16),,b
  1373. LINE (50,24)-(270,32),,b
  1374. LINE (50,40)-(270,48),,b
  1375. PRINT
  1376. PRINT "  RED"
  1377. PRINT
  1378. PRINT "GREEN"
  1379. PRINT
  1380. PRINT " BLUE"
  1381.  
  1382. LINE (250,54)-(300,66),,b
  1383. LOCATE 8,33 : PRINT "RESET";
  1384. LINE (198,54)-(232,66),,b
  1385. LOCATE 8,27 : PRINT "OK";
  1386.  
  1387. END SUB
  1388.  
  1389.  
  1390. SUB SetColorBars(colorreg1%,red1,green1,blue1,colorreg2%,red2,green2,blue2) STATIC
  1391. SHARED numcolors%
  1392.  
  1393. ' Change color mix for specified register
  1394.  
  1395. totalbar = 220
  1396.  
  1397. ' Draw color boxes
  1398.  
  1399. IF colorreg2% >= 0 THEN
  1400.   LINE (32,54)-(44,66),colorreg1%,bf
  1401.   LOCATE 8,1 : PRINT "FAR";
  1402.   LINE (48,54)-(60,66),colorreg2%,bf
  1403.   LOCATE 8,9 : PRINT "NEAR";
  1404. END IF
  1405.  
  1406. SetInitialBars:
  1407.  
  1408. colorreg% = colorreg1%
  1409. redbar1 = red1
  1410. greenbar1 = green1
  1411. bluebar1 = blue1
  1412. PALETTE colorreg1%, red1, green1, blue1
  1413.  
  1414. IF colorreg2% >= 0 THEN
  1415.   LINE (46,52)-(62,68),0,b
  1416.   LINE (30,52)-(46,68),,b
  1417.   redbar2 = red2
  1418.   greenbar2 = green2
  1419.   bluebar2 = blue2
  1420.   PALETTE colorreg2%, red2, green2, blue2
  1421. END IF
  1422.  
  1423. GOSUB ClearBars
  1424.  
  1425. ' Set color ratios in bars
  1426. LINE (51,9)-(redbar1 * totalbar + 50,15),,bf
  1427. LINE (51,25)-(greenbar1 * totalbar + 50,31),,bf
  1428. LINE (51,41)-(bluebar1 * totalbar + 50,47),,bf
  1429.  
  1430. dummy = MOUSE(0)     ' clear mouse settings
  1431.  
  1432. SetUserBars:
  1433.  
  1434. WHILE MOUSE(0) = 0 OR MOUSE(0) = -1 : WEND
  1435. xclick& = MOUSE(5)
  1436. yclick& = MOUSE(6)
  1437.  
  1438. IF WINDOW(0) = 3 THEN
  1439.   IF yclick& >= 8 AND yclick& <= 48 THEN
  1440.     IF xclick& > 50 AND xclick& < 270 THEN
  1441.       IF yclick& >= 8 AND yclick& <= 16 THEN
  1442.         LINE (51,9)-(269,15),0,bf    ' clear bar
  1443.         LINE (51,9)-(xclick&,15),,bf    ' draw bar
  1444.         IF colorreg% = colorreg1% THEN
  1445.           redbar1 = (xclick& - 50)/totalbar
  1446.           PALETTE colorreg1%, redbar1, greenbar1, bluebar1
  1447.           IF colorreg2% >= 0 THEN GOSUB SetColorSpread
  1448.         ELSE
  1449.           redbar2 = (xclick& - 50)/totalbar
  1450.           GOSUB SetColorSpread
  1451.         END IF
  1452.       ELSEIF yclick& >= 24 AND yclick& <= 32 THEN
  1453.         LINE (51,25)-(269,31),0,bf    ' clear bar
  1454.         LINE (51,25)-(xclick&,31),,bf    ' draw bar
  1455.         IF colorreg% = colorreg1% THEN
  1456.           greenbar1 = (xclick& - 50)/totalbar
  1457.           PALETTE colorreg1%, redbar1, greenbar1, bluebar1
  1458.           IF colorreg2% >= 0 THEN GOSUB SetColorSpread
  1459.         ELSE
  1460.           greenbar2 = (xclick& - 50)/totalbar
  1461.           GOSUB SetColorSpread
  1462.         END IF
  1463.       ELSEIF yclick& >= 40 AND yclick& <= 48 THEN
  1464.         LINE (51,41)-(269,47),0,bf    ' clear bar
  1465.         LINE (51,41)-(xclick&,47),,bf    ' draw bar
  1466.         IF colorreg% = colorreg1% THEN
  1467.           bluebar1 = (xclick& - 50)/totalbar
  1468.           PALETTE colorreg1%, redbar1, greenbar1, bluebar1
  1469.           IF colorreg2% >= 0 THEN GOSUB SetColorSpread
  1470.         ELSE
  1471.           bluebar2 = (xclick& - 50)/totalbar
  1472.           GOSUB SetColorSpread
  1473.         END IF
  1474.       ELSE
  1475.       END IF
  1476.     END IF
  1477.   END IF
  1478.  
  1479.   IF yclick& >= 54 AND yclick& <=66 THEN
  1480.     IF xclick& >= 250 AND xclick& <= 300 THEN
  1481.       GOTO SetInitialBars   ' reset color
  1482.     ELSEIF xclick& >= 198 AND xclick& <= 232 THEN
  1483.       ' Lock in color and return
  1484.       red1 = redbar1
  1485.       red2 = redbar2
  1486.       green1 = greenbar1
  1487.       green2 = greenbar2
  1488.       blue1 = bluebar1
  1489.       blue2 = bluebar2
  1490.       WINDOW CLOSE 3
  1491.       EXIT SUB
  1492.     ELSEIF xclick& >= 32 AND xclick& <= 44 AND colorreg% = colorreg2% THEN
  1493.         colorreg% = colorreg1%
  1494.         LINE (46,52)-(62,68),0,b
  1495.         LINE (30,52)-(46,68),,b
  1496.         GOSUB ClearBars
  1497.         LINE (51,9)-(redbar1 * totalbar + 50, 15),,bf
  1498.         LINE (51,25)-(greenbar1 * totalbar + 50, 31),,bf
  1499.         LINE (51,41)-(bluebar1 * totalbar + 50, 47),,bf
  1500.     ELSEIF xclick& >= 48 AND xclick& <= 60 AND colorreg% = colorreg1% THEN
  1501.       IF colorreg2% >= 0 THEN
  1502.         colorreg% = colorreg2%
  1503.         LINE (30,52)-(46,68),0,b
  1504.         LINE (46,52)-(62,68),,b
  1505.         GOSUB ClearBars
  1506.         LINE (51,9)-(redbar2 * totalbar + 50, 15),,bf
  1507.         LINE (51,25)-(greenbar2 * totalbar + 50, 31),,bf
  1508.         LINE (51,41)-(bluebar2 * totalbar + 50, 47),,bf
  1509.       END IF
  1510.     ELSE
  1511.     END IF
  1512.   END IF
  1513. END IF
  1514.  
  1515. GOTO SetUserBars
  1516.  
  1517.  
  1518. SetColorSpread:
  1519.  
  1520. FOR num% = colorreg1% TO colorreg2%
  1521.   fractionred = redbar1 + (num% - colorreg1%) * (redbar2 - redbar1) / numcolors%
  1522.   fractiongreen = greenbar1 + (num% - colorreg1%) * (greenbar2 - greenbar1) / numcolors%
  1523.   fractionblue = bluebar1 + (num% - colorreg1%) * (bluebar2 - bluebar1) / numcolors%
  1524.   PALETTE num%,fractionred,fractiongreen,fractionblue
  1525. NEXT num%
  1526.  
  1527. RETURN
  1528.  
  1529.  
  1530. ClearBars:
  1531.  
  1532. LINE (51,9)-(269,15),0,bf
  1533. LINE (51,25)-(269,31),0,bf
  1534. LINE (51,41)-(269,47),0,bf
  1535.  
  1536. RETURN
  1537.  
  1538. END SUB
  1539.  
  1540.