home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / COMP8809.ZIP / 3DSHAPES.BAS (.txt) next >
Encoding:
GW-BASIC  |  1988-06-02  |  31.9 KB  |  862 lines
  1. 5  DIM X(700), Y(700), Z(700), XI(700), YI(700), ZI(700), NALCAD%(100)
  2. 10  DIM IN%(1000),JN%(1000),N%(18), C%(18), OL$(18), L%(18), D%(18), DMP%(1)
  3. 15  DIM FL$(18), HE%(1500), SI$(18), EM$(10), LSTBOX%(43), COMBOX%(34)
  4. 16  DIM XPOS(50), YPOS(50), ZPOS(50), IND%(50), JND%(50),LT$(18)
  5. 100  ON ERROR GOTO 7700
  6. 110  GOTO 10000
  7. 197  REM
  8. 198  REM Set up highlight boxes
  9. 199  REM
  10. 200  DATA  68 , 9 ,-1 ,-1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-1
  11. 205  DATA -3841 ,-1 ,-1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-1 ,-3841
  12. 210  DATA -1 ,-1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-1 ,-3841 ,-1
  13. 215  DATA -1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-1 ,-3841 ,-1 ,-1
  14. 220  DATA -1 ,-1 , 240 , 0
  15. 225  FOR I=0 TO 43: READ LSTBOX%(I): NEXT I
  16. 250  DATA  52 , 9 ,-1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-3841 ,-1
  17. 255  DATA -1 ,-1 ,-16 ,-1 ,-1 ,-3841 ,-1 ,-1 ,-1 ,-16
  18. 260  DATA -1 ,-1 ,-3841 ,-1 ,-1 ,-1 ,-16 ,-1 ,-1 ,-3841
  19. 265  DATA -1 ,-1 ,-1 , 240 , 0
  20. 300  FOR I=0 TO 34: READ COMBOX%(I): NEXT I
  21. 320  DATA  111 , 14 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1
  22. 325  DATA -1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1
  23. 330  DATA -1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257
  24. 335  DATA -1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1 ,-1 ,-1
  25. 340  DATA -1 ,-1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1
  26. 345  DATA -257 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1 ,-1
  27. 350  DATA -1 ,-1 ,-1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1 ,-1
  28. 355  DATA -1 ,-257 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1
  29. 360  DATA -1 ,-1 ,-1 ,-1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1
  30. 365  DATA -1 ,-1 ,-257 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-257
  31. 370  DATA  0
  32. 375  FOR I=0 TO 100: READ NALCAD%(I): NEXT I
  33. 390  RETURN
  34. 797  REM
  35. 798  REM Set up main screen boxes
  36. 799  REM
  37. 800  SCREEN 2,0,0,0:KEY OFF
  38. 801  CLS
  39. 805  REM  LINE (117,5)-(542,18),,B
  40. 810  LINE (4,21)-(542,178),,B:LINE (545,21)-(636,194),,B
  41. 815  LINE (4,181)-(542,194),,B
  42. 820  LINE (545,32)-(636,32):LINE (77,181)-(77,194)
  43. 825  LOCATE 2,3: PRINT "3-D Shapes ": LOCATE 4, 71: PRINT "OBJECTS";HM$
  44. 830  PUT (4,5), NALCAD%, XOR: LOCATE 10,5
  45. 890  RETURN
  46. 897  REM
  47. 898  REM PRINT TO COMMAND LINE WITH COMBOX%
  48. 899  REM
  49. 900  LOCATE 24,2:PRINT HL$;:LOCATE 24,13: PRINT MI$;CHR$(11)
  50. 910  COMBOX1=95 : SL=1
  51. 912  PUT (COMBOX1,183), COMBOX%, XOR
  52. 915  A$=INKEY$: IF A$="" THEN 915
  53. 916  A1$=RIGHT$(A$,1): A1ASC=ASC(A1$)
  54. 920  IF A1ASC <>RI  AND A1ASC <>LE  AND A1ASC <>RET  THEN 915
  55. 925  IF A1ASC <>RI  THEN 950
  56. 930  COMBOX2=COMBOX1+64: IF COMBOX2=(95+NI*64) THEN COMBOX2=95
  57. 935  S0=SL+1: IF S0=NI+1 THEN S0=1
  58. 940  PUT (COMBOX1,183),COMBOX%,XOR : SL=S0 : COMBOX1=COMBOX2: GOTO 912
  59. 950  IF A1ASC <>LE  THEN 970
  60. 955  COMBOX2 = COMBOX1 - 64: IF COMBOX2=31 THEN COMBOX2=95+64*(NI-1)
  61. 960  S0=SL-1: IF S0=0 THEN S0= NI
  62. 965  PUT (COMBOX1,183),COMBOX%,XOR : SL=S0 : COMBOX1=COMBOX2: GOTO 912
  63. 970  PUT (COMBOX1,183), COMBOX%,XOR: RETURN
  64. 997  REM
  65. 998  REM Initialization
  66. 999  REM
  67. 1000  KEY OFF: RET$=CHR$(13): HM$=CHR$(11): ESCAPE=27:NODELIMIT=700:LINELIMIT=1000:EXCEED=0
  68. 1018  GOSUB 200
  69. 1020  XE=100: YE=100: ZE=100: EM=1: UP=72 : DOWN=80 : RI=77: LE=75: RET=13
  70. 1025  XC=5: YC=5: ZC=5 : SW=337: SH=157: LB=101: BB=22 : PI=3.14159
  71. 1030  SCALFAC=1: PW= SQR((XE-XC)^2+(YE-YC)^2+(ZE-ZC)^2)/SCALFAC: LO=0: LN=0: LL=0
  72. 1090  RETURN
  73. 1096  REM
  74. 1097  REM Project points in space to 3-D image plane
  75. 1099  REM
  76. 1100  FOR I%= P1 TO (P1+PQ-1)
  77. 1105  T1=(XE-XC)*(X(I%)-XC) + (YE-YC)*(Y(I%)-YC) + (ZE-ZC)*(Z(I%)-ZC)
  78. 1110  T2=(XC-XE)*(X(I%)-XE) + (YC-YE)*(Y(I%)-YE) + (ZC-ZE)*(Z(I%)-ZE)
  79. 1120  XI(I%)=(X(I%)-XE)*(T1/T2) + X(I%)
  80. 1125  YI(I%)=(Y(I%)-YE)*(T1/T2) + Y(I%)
  81. 1130  ZI(I%)=(Z(I%)-ZE)*(T1/T2) + Z(I%): NEXT I%: RETURN
  82. 1197  REM
  83. 1198  REM GET A NUMERIC VALUE FROM THE USER
  84. 1199  REM
  85. 1200  EC=3:GOSUB 1300: LOCATE 2,18: PRINT "INPUT"; HM$;: LOCATE 2,25
  86. 1202  PRINT PL$;: LOCATE 2,50: PRINT "DEFLT=";: LOCATE 2,58:
  87. 1203  PRINT USING "####.##"; DV;:PRINT HM$;: NUM = DV: COMBOX1 = 135: SL=1
  88. 1205  PUT (COMBOX1,7) , COMBOX%,XOR
  89. 1210  A$=INKEY$: IF A$="" THEN 1210
  90. 1215  A1$=RIGHT$(A$,1): A1ASC=ASC(A1$)
  91. 1220  IF A1ASC<> RI AND A1ASC <> LE AND A1ASC <> RET THEN 1210
  92. 1225  IF A1ASC=RET THEN 1240
  93. 1230  COMBOX2= -(COMBOX1=135)*391 - (COMBOX1=391)*135: SL=-(SL=1)*2 - (SL=2)*1
  94. 1235  PUT (COMBOX1,7), COMBOX%, XOR: COMBOX1=COMBOX2: GOTO 1205
  95. 1240  PUT (COMBOX1,7), COMBOX%,XOR: ON SL GOTO 1245,1290
  96. 1245  LOCATE 2,49: PRINT "                 "; HM$
  97. 1246  LOCATE 2,36: INPUT NUM: PRINT HM$;
  98. 1290  EC=3: GOSUB 1300:RETURN
  99. 1297  REM
  100. 1298  REM Erasing subroutine
  101. 1299  REM
  102. 1300  ON EC GOTO 1305, 1315, 1325, 1335, 1345
  103. 1305  LOCATE 24,2: PRINT "        ";HM$;
  104. 1310  LOCATE 24,13:PRINT"                                                     ";
  105. 1312  PRINT HM$;: GOTO 1390
  106. 1315  LOCATE 24,13:PRINT"                                                     ";
  107. 1316  PRINT HM$;: GOTO 1390
  108. 1325  LOCATE 2,18
  109. 1326  PRINT "                                                    ";HM$;:GOTO 1390
  110. 1335  FOR I= 4 TO 21: LOCATE I,2
  111. 1336  PRINT"                                                                  ";
  112. 1337  NEXT I
  113. 1338  LOCATE 22,2
  114. 1339  PRINT"                                                                  ";
  115. 1340  PRINT HM$;: GOTO 1390
  116. 1345  LOCATE 4,71: PRINT "         ";HM$;
  117. 1346  FOR I=1 TO NS+1: LOCATE 5+I,71: PRINT "         ";HM$;: NEXT I
  118. 1347  GOTO 1390
  119. 1390  RETURN
  120. 1396  REM
  121. 1397  REM Make a modified cylinder
  122. 1399  REM
  123. 1400  PL$="Bt radius=":DV=BOTRAD: GOSUB 1200 : BOTRAD=NUM: PL$="Tp radius="
  124. 1405  DV=BOTRAD: GOSUB 1200: TOPRAD=NUM
  125. 1407  PL$="# of sides": DV=4: GOSUB 1200: SIDES=NUM: GOSUB 7500: IF SIDETEST=1 THEN 1407
  126. 1408  PNODES=LN+2*SIDES: PLINES=LL+3*SIDES: GOSUB 7800: IF EXCEED=1 THEN 1800
  127. 1412  PL$=" Height = ": DV=HEIGHT: GOSUB 1200: HEIGHT=NUM
  128. 1413  PL$="Eccentr=" : DV=1: GOSUB 1200: ECC=NUM: PL$="Obj. name="
  129. 1415  LEGLEN=8: GOSUB 1600: OL$(LO+1)=LB$: LOCATE 6+LO, 71: PRINT LB$; HM$
  130. 1420  NS=NS+1: SI$(NS)= LB$: BOTRAD1=BOTRAD/COS(PI/SIDES)
  131. 1425  TOPRAD1=TOPRAD/COS(PI/SIDES): FOR I=1 TO SIDES
  132. 1430  AA=(I-1)*2*PI/SIDES + PI/SIDES: X(LN+I)= ECC*BOTRAD1*COS(AA)
  133. 1433  Z(LN+I)=BOTRAD1*SIN(AA): Y(LN+I)=0: X(LN+SIDES+I)=ECC*TOPRAD1*COS(AA)
  134. 1434  Z(LN+SIDES+I)=TOPRAD1*SIN(AA): Y(LN+SIDES+I)=HEIGHT: NEXT I
  135. 1435  FOR I=1 TO SIDES: IN%(LL+I)=LN+I: JN%(LL+I)=LN+I+1
  136. 1437  IN%(LL+2*SIDES+I)=LN+SIDES+I
  137. 1440  JN%(LL+2*SIDES+I)=LN+SIDES+I+1: IN%(LL+SIDES+I)=LN+I
  138. 1443  JN%(LL+SIDES+I)=LN+SIDES+I: NEXT I
  139. 1445  JN%(LL+SIDES)=LN+1: JN%(LL+3*SIDES)=LN+SIDES+1: LO=LO+1: N%(LO)=LN+1
  140. 1448  C%(LO)=2*SIDES
  141. 1450  L%(LO)=LL+1: D%(LO)=3*SIDES: LN=LN+2*SIDES: LL=LL+3*SIDES
  142. 1490  GOTO 1800
  143. 1596  REM
  144. 1597  REM Get an 8-character label
  145. 1599  REM
  146. 1600  LOCATE 2,18: PRINT PL$; HM$: LOCATE 2,30: INPUT LB$: PRINT HM$
  147. 1605  TEMP$="": FOR I=1 TO LEN(LB$): C=ASC(MID$(LB$,I,1)): IF NOT ((C>47 AND C<58) OR (C>64 AND C<91) OR (C>96 AND C<123)) THEN 1620
  148. 1610  IF C>96 THEN C = C AND 223
  149. 1615  TEMP$=TEMP$ + CHR$(C)
  150. 1620  NEXT I: LB$=TEMP$: IF LEN(LB$)=0 THEN EC=3: GOSUB 1300: GOTO 1600
  151. 1655  IF LEN(LB$) > LEGLEN THEN LB$ = LEFT$(LB$,LEGLEN)
  152. 1660  EC=3: GOSUB 1300: RETURN
  153. 1696  REM
  154. 1697  REM Begin the routine for drawing the shape(s) designated
  155. 1699  REM
  156. 1700  IF LO>=1 THEN 1705
  157. 1701  EM$=" An object must be created with...": GOSUB 3500: GOSUB 3550
  158. 1702  EM$=" MAKE, SPECIAL or LIBRAR before it can be drawn.": GOSUB 3500
  159. 1703  GOSUB 3550: GOTO 2400
  160. 1705  IF (XE<>XC OR ZE<>ZC) THEN 1715
  161. 1707  EM$=" Viewing location cannot be directly above center.": GOSUB 3500: GOSUB 3550
  162. 1708  EM$=" Change viewing location or CENTER...": GOSUB 3500: GOSUB 3550
  163. 1709  EM$=" before attempting to DRAW or REDRAW.": GOSUB 3500: GOSUB 3550: GOTO 2400
  164. 1715  GOSUB 3300: IF TARF=1 THEN 2400
  165. 1719  P1=N%(SL): PQ= C%(SL): L1=L%(SL): LQ= D%(SL): GOSUB 1100
  166. 1720  GOSUB 2100: GOSUB 2000: GOSUB 2200: GOSUB 2300: GOTO 2400
  167. 1797  REM
  168. 1798  REM DISPLAY "MAKE" MENU AND GET A SHAPE
  169. 1799  REM
  170. 1800  EC=1:GOSUB 1300:HL$="  MAKE": NI=5
  171. 1805  MI$=" LINE   POLYGN  MODCYL   CONE    QUIT": GOSUB 900
  172. 1810  ON SL GOTO 4000,3600,1400,3400,2400
  173. 1996  REM
  174. 1997  REM Change 3-D image plane points to 2-D
  175. 1999  REM
  176. 2000  FOR I%= P1 TO (P1+PQ-1)
  177. 2005  X2=(XI(I%)-XC)*IX + (YI(I%)-YC)*JX + (ZI(I%)-ZC)*KX
  178. 2010  Y2=(XI(I%)-XC)*IY + (YI(I%)-YC)*JY + (ZI(I%)-ZC)*KY
  179. 2015  XI(I%)=X2 : YI(I%)=Y2: NEXT I%: RETURN
  180. 2096  REM
  181. 2097  REM Calculate image plane cartesian vectors
  182. 2099  REM
  183. 2100  IX=(ZE-ZC)/SQR((ZE-ZC)^2 + (XE-XC)^2) : JX=0
  184. 2105  KX= -(XE-XC)/SQR((ZE-ZC)^2 + (XE-XC)^2)
  185. 2110  PA= (XE-XC)*(YC-YE): PB= (XC-XE)^2 + (ZC-ZE)^2 : PC=(ZE-ZC)*(YC-YE)
  186. 2115  VL= SQR(PA^2 + PB^2 + PC^2) : IY= PA/VL: JY=PB/VL : KY=PC/VL
  187. 2120  RETURN
  188. 2196  REM
  189. 2197  REM Change 2-D image plane points to screen points
  190. 2199  REM
  191. 2200  FOR I%=P1 TO (P1+PQ-1): XI(I%)=XI(I%)*(SW/PW)+SW/2 + LB
  192. 2205  YI(I%)=YI(I%)*(SH/PW)+SH/2+BB
  193. 2215  NEXT I%
  194. 2290  RETURN
  195. 2296  REM
  196. 2297  REM Draw lines on screen
  197. 2299  REM
  198. 2300  FOR I%= L1 TO (L1+LQ-1): XX1=XI(IN%(I%)): YY1=178-YI(IN%(I%)): XX2=XI(JN%(I%)): YY2= 178-YI(JN%(I%))
  199. 2305  IF NOT (XX1>8 AND XX1<534 AND YY1>24 AND YY1<175 AND XX2>8 AND XX2<534 AND YY2>24 AND YY2<175) THEN 2315
  200. 2310  LINE (XX1,YY1)-(XX2,YY2): GOTO 2360
  201. 2315  IF ABS(YY2-YY1) > ABS(XX2-XX1) THEN 2345
  202. 2320  IF XX2 < XX1 THEN SWAP XX1,XX2: SWAP YY1,YY2
  203. 2325  IF XX1 = XX2 THEN 2360
  204. 2330  MMM=(YY2-YY1)/(XX2-XX1): BBB= -MMM*XX1 + YY1: FOUND=0: FOR J=XX1 TO XX2 STEP 1: PY=MMM*J + BBB: IF (J>8 AND J<534 AND PY>24 AND PY<175) THEN FOUND=1:MARK1=J: PY1=PY: J=XX2
  205. 2335  NEXT J: IF FOUND=0 THEN 2360
  206. 2336  FOUND=0: FOR J=XX2 TO XX1 STEP -1: PY=MMM*J+BBB: IF (J>8 AND J<534 AND PY>24 AND PY<175) THEN FOUND=1:MARK2=J:PY2=PY:J=XX1
  207. 2337  NEXT J: IF FOUND=1 THEN LINE (MARK1,PY1)-(MARK2,PY2)
  208. 2338  GOTO 2360
  209. 2345  IF YY2<YY1 THEN SWAP YY1,YY2: SWAP XX1,XX2
  210. 2350  MMM=(XX2-XX1)/(YY2-YY1): BBB=-MMM*YY1 + XX1: FOUND=0: FOR J=YY1 TO YY2 STEP 1: PX=MMM*J + BBB: IF (PX>8 AND PX<534 AND J>24 AND J<175) THEN FOUND=1: MARK1=J: PX1=PX: J=YY2
  211. 2355  NEXT J: IF FOUND=0 THEN 2360
  212. 2356  FOUND=0: FOR J=YY2 TO YY1 STEP -1: PX=MMM*J+BBB: IF (PX>8 AND PX<534 AND J>24 AND J<175) THEN FOUND=1: MARK2=J: PX2=PX: J=YY1
  213. 2357  NEXT J: IF FOUND=1 THEN LINE (PX1,MARK1)-(PX2,MARK2)
  214. 2360  NEXT I%
  215. 2390  RETURN
  216. 2397  REM
  217. 2398  REM SHAPE OPTIONS
  218. 2399  REM
  219. 2400  EC=1: GOSUB 1300:HL$="  SHAPE "
  220. 2405  MI$=" MAKE   DELETE   MOVE    DRAW    WIPE    OTHER   QUIT"
  221. 2410  NI=7: GOSUB 900
  222. 2415  ON SL GOTO 1800,4200,2900,1700,2450,3700,10010
  223. 2450  EC=4:GOSUB 1300: GOTO 2400
  224. 2497  REM
  225. 2498  REM VIEW OPTIONS
  226. 2499  REM
  227. 2500  EC=1: GOSUB 1300: NI=4: HL$="  VIEW"
  228. 2505  MI$=" EYES   CENTER  TSCOPE   QUIT": GOSUB 900
  229. 2510  ON SL GOTO 2600,3800,7600,10010
  230. 2596  REM
  231. 2597  REM Change EYES location
  232. 2599  REM
  233. 2600  PL$="  X-eye = ": DV=XE: GOSUB 1200: XE=NUM: PL$="  Y-eye = ": DV=YE
  234. 2605  GOSUB 1200: YE=NUM: PL$="  Z-eye = ": DV=ZE: GOSUB 1200: ZE=NUM
  235. 2610  PW = SQR((XE-XC)^2 + (YE-YC)^2 + (ZE-ZC)^2)/SCALFAC : GOTO 2500
  236. 2696  REM
  237. 2697  REM Change CENTER location
  238. 2699  REM
  239. 2700  PL$="X-center= ": DV=XC: GOSUB 1200: XC=NUM: PL$="Y-center= ": DV=YC
  240. 2705  GOSUB 1200: YC=NUM: PL$="Z-center= ": DV=ZC: GOSUB 1200: ZC=NUM
  241. 2710  PW = SQR((XE-XC)^2 + (YE-YC)^2 + (ZE-ZC)^2)/SCALFAC : GOTO 2500
  242. 2796  REM
  243. 2797  REM Display SCREEN options
  244. 2799  REM
  245. 2800  EC=1: GOSUB 1300: HL$=" SCREEN ": NI=3: MI$=" WIPE   REDRAW   QUIT"
  246. 2805  GOSUB 900 : ON SL GOTO 2850,2855,10010
  247. 2850  EC=4: GOSUB 1300: GOTO 2800
  248. 2855  IF LO>=1 THEN 2860
  249. 2856  EM$="Can't REDRAW until an object exists.":GOSUB 3500:GOSUB 3550:GOTO 2800
  250. 2860  IF (XE<>XC OR ZE<>ZC) THEN 2864
  251. 2861  EM$=" Viewing location cannot be directly above center.": GOSUB 3500: GOSUB 3550
  252. 2862  EM$=" Change viewing location or CENTER...": GOSUB 3500: GOSUB 3550
  253. 2863  EM$=" before attempting to DRAW or REDRAW.": GOSUB 3500: GOSUB 3550: GOTO 2800
  254. 2864  P1=1: PQ=LN: L1=1: LQ=LL: GOSUB 1100: GOSUB 2100: GOSUB 2000: GOSUB 2200
  255. 2865  GOSUB 2300: GOTO 2800
  256. 2896  REM
  257. 2897  REM Display MOVE options
  258. 2899  REM
  259. 2900  IF LO>=1 THEN 2904
  260. 2901  EM$="Can't MOVE until an object is created.": GOSUB 3500: GOSUB 3550
  261. 2902  GOTO 2400
  262. 2904  EC=1: GOSUB 1300: HL$="  MOVE": NI=3
  263. 2905  MI$="TRNSLT  ROTATE   QUIT":GOSUB 900: ON SL GOTO 2950,2960,2400
  264. 2950  GOSUB 3300: IF TARF=1 THEN 2900
  265. 2951  OC=SL: GOTO 3100
  266. 2960  GOSUB 3300: IF TARF=1 THEN 2900
  267. 2961  OC=SL: GOTO 3000
  268. 2996  REM
  269. 2997  REM Rotate the selected object
  270. 2999  REM
  271. 3000  PL$= "X-rotat = ": DV=0: GOSUB 1200: AX=NUM: PL$="Y-rotat = ":DV=0
  272. 3003  GOSUB 1200: AY=NUM: PL$="Z-rotat = ": DV=0: GOSUB 1200: AZ=NUM
  273. 3007  X0=0: Y0=0: Z0=0: FOR I%=N%(OC) TO (N%(OC)+C%(OC)-1): X0=X0+X(I%)
  274. 3008  Y0=Y0+Y(I%): Z0=Z0+Z(I%): NEXT I%: X0=X0/C%(OC): Y0=Y0/C%(OC)
  275. 3009  Z0=Z0/C%(OC): FOR I%=N%(OC) TO (N%(OC) + C%(OC) -1)
  276. 3010  A=1: P1=X(I%): C1=X0: P2=Z(I%): C2=Z0: AN=AY
  277. 3011  IF AN=0 THEN 3026
  278. 3012  R=SQR((P1-C1)^2+(P2-C2)^2): IF R=0 THEN 3026
  279. 3014  SN=(P2-C2)/R: CO=(P1-C1)/R
  280. 3016  IF CO=0 THEN TH=-(PI/2)*(SN>0) - (3*PI/2)*(SN<0): GOTO 3024
  281. 3018  IF SN=0 THEN TH=-PI*(CO<0) : GOTO 3024
  282. 3020  Q1=-(SN>0 AND CO>0): Q2=-(SN>0 AND CO<0): Q3=-(SN<0 AND CO<0)
  283. 3021  Q4=-(SN<0 AND CO>0)
  284. 3022  TH=ATN(ABS(SN/CO)): TH=TH*Q1 + (PI-TH)*Q2 + (PI+TH)*Q3 + (2*PI-TH)*Q4
  285. 3024  TH=TH-AN*2*PI/360: P1=C1+R*COS(TH): P2=C2+R*SIN(TH)
  286. 3026  IF A=1 THEN X(I%)=P1:Z(I%)=P2:A=2:P1=Z(I%):C1=Z0:P2=Y(I%):C2=Y0:AN=AX:GOTO 3011
  287. 3028  IF A=2 THEN Z(I%)=P1:Y(I%)=P2:A=3:P1=Y(I%):C1=Y0:P2=X(I%):C2=X0:AN=AZ:GOTO 3011
  288. 3030  IF A=3 THEN Y(I%)=P1:X(I%)=P2
  289. 3032  NEXT I%
  290. 3090  GOTO 2900
  291. 3096  REM
  292. 3097  REM Translate the selected object
  293. 3099  REM
  294. 3100  PL$="X-transl =" : DV= 0: GOSUB 1200: XT=NUM
  295. 3102  PL$="Y-transl =" : DV= 0: GOSUB 1200: YT=NUM
  296. 3104  PL$="Z-transl =" : DV= 0: GOSUB 1200: ZT=NUM
  297. 3105  FOR I= N%(OC) TO (N%(OC) + C%(OC) -1): X(I)=X(I)+XT: Y(I)=Y(I)+YT
  298. 3110  Z(I)=Z(I) + ZT : NEXT I: GOTO 2900
  299. 3196  REM
  300. 3197  REM Print a list along the side
  301. 3199  REM
  302. 3200  EC=5: GOSUB 1300: LOCATE 4, 71: PRINT HT$;HM$;: FOR I=1 TO NS
  303. 3205  LOCATE 5+I, 71: PRINT SI$(I); HM$;: NEXT I
  304. 3290  RETURN
  305. 3296  REM
  306. 3297  REM Select an item with the LSTBOX
  307. 3299  REM
  308. 3300  LSTBOX1=39: SL=1 : TARF=0
  309. 3305  PUT (558, LSTBOX1), LSTBOX%, XOR
  310. 3310  A$= INKEY$: IF A$= "" THEN 3310
  311. 3315  A1$= RIGHT$(A$,1): A1ASC= ASC(A1$)
  312. 3320  IF A1ASC<>UP AND A1ASC<>DOWN AND A1ASC<>RET AND A1ASC<>ESCAPE THEN 3310
  313. 3321  IF A1ASC<>ESCAPE THEN 3325
  314. 3322  TARF=1: GOTO 3390
  315. 3325  IF A1ASC = RET THEN 3390
  316. 3330  IF A1ASC = UP THEN 3350
  317. 3335  S0=SL+1: IF S0 = NS+1 THEN S0=1
  318. 3340  LSTBOX2= LSTBOX1 + 8: IF LSTBOX2= (39 + 8*NS) THEN LSTBOX2 = 39
  319. 3345  GOTO 3360
  320. 3350  S0= SL-1: IF S0=0 THEN S0=NS
  321. 3355  LSTBOX2=LSTBOX1 - 8: IF LSTBOX2=31 THEN LSTBOX2 = 39+ 8*(NS-1)
  322. 3360  PUT (558, LSTBOX1), LSTBOX%, XOR: SL=S0: LSTBOX1=LSTBOX2: GOTO 3305
  323. 3390  PUT (558, LSTBOX1), LSTBOX%, XOR: RETURN
  324. 3396  REM
  325. 3397  REM  Add cone to object list
  326. 3399  REM
  327. 3400  PL$="Bt radius=":DV=RAD: GOSUB 1200 : RAD=NUM
  328. 3405  PL$="# of sides": DV=6: GOSUB 1200: SIDES=NUM: GOSUB 7500: IF SIDETEST = 1 THEN 3405
  329. 3406  PNODES=LN+SIDES+1: PLINES=LL+2*SIDES: GOSUB 7800: IF EXCEED=1 THEN 1800
  330. 3410  PL$=" Height = ": DV=HEIGHT: GOSUB 1200: HEIGHT=NUM
  331. 3412  PL$="Eccentr=": DV=1: GOSUB 1200: ECC=NUM
  332. 3415  PL$="Obj. name=": LEGLEN=8: GOSUB 1600: OL$(LO+1)=LB$: LOCATE 6+LO,71
  333. 3420  PRINT LB$; HM$;: NS=NS+1: SI$(NS)=LB$: RAD1=RAD/COS(PI/SIDES)
  334. 3425  FOR I=1 TO SIDES: AA=PI*(2*I-1)/SIDES: X(LN+I)=ECC*RAD1*COS(AA)
  335. 3430  Y(LN+I)=0: Z(LN+I)=RAD1*SIN(AA): NEXT I: X(LN+SIDES+1)=0
  336. 3435  Y(LN+SIDES+1)=HEIGHT: Z(LN+SIDES+1)=0: FOR I=1 TO SIDES
  337. 3440  IN%(LL+I)=LN+I: JN%(LL+I)=LN+I+1: IN%(LL+SIDES+I)=LN+I
  338. 3445  JN%(LL+SIDES+I)=LN+SIDES+1: NEXT I: JN%(LL+SIDES)=LN+1
  339. 3450  LO=LO+1: N%(LO)=LN+1: C%(LO)=SIDES+1: L%(LO)=LL+1: D%(LO)=2*SIDES
  340. 3455  LN=LN+SIDES+1: LL=LL+2*SIDES
  341. 3490  GOTO 1800
  342. 3496  REM
  343. 3497  REM Print to message line, 3550 begins erase
  344. 3499  REM
  345. 3500  LOCATE 2, 18: PRINT EM$;HM$;: RETURN
  346. 3550  A$=INKEY$: IF A$="" THEN 3550
  347. 3555  EC=3: GOSUB 1300: RETURN
  348. 3596  REM
  349. 3597  REM MAKE A POLYGON
  350. 3599  REM
  351. 3600  PL$="radius=": DV= RAD: GOSUB 1200: RAD=NUM
  352. 3603  PL$="# of sides= ":DV=4: GOSUB 1200: SIDES=NUM: GOSUB 7500: IF SIDETEST=1 THEN 3603
  353. 3604  PNODES=LN+SIDES: PLINES=LL+SIDES: GOSUB 7800: IF EXCEED=1 THEN 1800
  354. 3605  PL$="eccentr= ":DV=1: GOSUB 1200
  355. 3610  ECC=NUM: PL$="Obj. Name=": LEGLEN=8: GOSUB 1600: OL$(LO+1)=LB$
  356. 3615  LOCATE 6+LO,71:PRINT LB$;HM$:NS=LO+1:SI$(NS)=LB$:RAD1=RAD/COS(PI/SIDES)
  357. 3620  FOR I= 1 TO SIDES: KA= (I-1)*2*PI/SIDES + PI/SIDES
  358. 3625  X(LN+I)=ECC*RAD1*COS(KA) : Z(LN+I)=RAD1*SIN(KA) : Y(LN+I)=0 : NEXT I
  359. 3630  FOR I=1 TO SIDES: IN%(LL+I)=LN+I:JN%(LL+I)=LN+I+1:NEXT I
  360. 3633  JN%(LL+SIDES)=LN+1: LO=LO+1
  361. 3635  N%(LO)=LN+1: C%(LO)=SIDES: L%(LO)=LL+1: D%(LO)=SIDES: LL=LL+SIDES
  362. 3640  LN=LN+SIDES
  363. 3690  GOTO 1800
  364. 3696  REM
  365. 3697  REM Display other SHAPE operations
  366. 3699  REM
  367. 3700  EC=1: GOSUB 1300: HL$="  SHAPE": NI=6
  368. 3705  MI$="DUPLCT   SPECL  CMBINE  LIBRAR  RENAME   QUIT": GOSUB 900
  369. 3710  ON SL GOTO 4100,6300,4800,4300,6200,2400
  370. 3796  REM
  371. 3797  REM Display CENTER options
  372. 3799  REM
  373. 3800  EC=1: GOSUB 1300: NI=3: HL$= " CENTER"
  374. 3805  MI$=" AUTO   MANUAL   QUIT": GOSUB 900
  375. 3810  ON SL GOTO 3900, 2700, 2500
  376. 3896  REM
  377. 3897  REM Set viewing CENTER automatically
  378. 3899  REM
  379. 3900  IF LO <>0 THEN 3920
  380. 3905  EM$=" No AUTO centering yet...": GOSUB 3500: GOSUB 3550
  381. 3910  EM$="At least 1 object must be defined first.": GOSUB 3500: GOSUB 3550
  382. 3915  GOTO 3800
  383. 3920  XC=0: YC=0: ZC=0: FOR I=1 TO LN: XC=XC+X(I)/LN
  384. 3925  YC=YC+Y(I)/LN: ZC=ZC+Z(I)/LN: NEXT I
  385. 3930  PW = SQR((XE-XC)^2 + (YE-YC)^2 + (ZE-ZC)^2)/SCALFAC
  386. 3990  GOTO 3800
  387. 3996  REM
  388. 3997  REM Make a LINE in space
  389. 3999  REM
  390. 4000  PL$="      x1 =": DV=0: GOSUB 1200: X(LN+1)=NUM
  391. 4005  PL$="      y1 =": DV=0: GOSUB 1200: Y(LN+1)=NUM
  392. 4010  PL$="      z1 =": DV=0: GOSUB 1200: Z(LN+1)=NUM
  393. 4015  PL$="      x2 =": DV=X(LN+1): GOSUB 1200: X(LN+2)=NUM
  394. 4020  PL$="      y2 =": DV=Y(LN+1): GOSUB 1200: Y(LN+2)=NUM
  395. 4025  PL$="      z2 =": DV=Z(LN+1): GOSUB 1200: Z(LN+2)=NUM: PL$="Obj. name="
  396. 4030  LEGLEN=8: GOSUB 1600: OL$(LO+1) = LB$
  397. 4035  LOCATE 6+LO,71:PRINT LB$;HM$:NS=LO+1:SI$(NS)=LB$: IN%(LL+1)=LN+1
  398. 4040  JN%(LL+1)=LN+2: LO=LO+1: N%(LO)=LN+1: C%(LO)=2: L%(LO)=LL+1: D%(LO)=1
  399. 4045  LN=LN+2: LL=LL+1: GOTO 1800
  400. 4096  REM
  401. 4097  REM Duplicate an object
  402. 4099  REM
  403. 4100  IF LO>=1 THEN 4104
  404. 4102  EM$="Can't DUPLICATE until an object is defined." : GOSUB 3500: GOSUB 3550
  405. 4103  GOTO 3700
  406. 4104  GOSUB 3300: IF TARF=1 THEN 3700
  407. 4105  OC=SL:PNODES=LN+C%(OC):PLINES=LL+D%(OC):GOSUB 7800:IF EXCEED=1 THEN 2400
  408. 4107  FOR I=1 TO C%(OC): X(LN+I)=X(N%(OC)+I-1)
  409. 4108  Y(LN+I)=Y(N%(OC)+I-1)
  410. 4109  Z(LN+I)=Z(N%(OC)+I-1): NEXT I
  411. 4110  FOR I%=1 TO D%(OC): IN%(LL+I%)=IN%(L%(OC)+I%-1) + (LN+1) - N%(OC)
  412. 4115  JN%(LL+I%)=JN%(L%(OC)+I%-1) + (LN+1) -N%(OC): NEXT I%
  413. 4120  PL$="Obj. name=": LEGLEN=8: GOSUB 1600: OL$(LO+1)=LB$: NS=NS+1
  414. 4125  SI$(NS)=LB$:LOCATE 6+LO, 71: PRINT LB$; HM$
  415. 4130  LO=LO+1: N%(LO)=LN+1: C%(LO)=C%(OC): L%(LO)=LL+1: D%(LO)=D%(OC)
  416. 4135  LL=LL+D%(OC): LN=LN+C%(OC)
  417. 4190  GOTO 2400
  418. 4196  REM
  419. 4197  REM Delete an object from the object list
  420. 4199  REM
  421. 4200  GOTO 4250
  422. 4201  GOSUB 3300: IF TARF=1 THEN 2400
  423. 4202  OC=SL: GOSUB 5700
  424. 4206  ON SL GOTO 4207, 2400
  425. 4207  Q=C%(OC): Q1=Q: Q2=D%(OC): FOR I=N%(OC) TO (LN-Q): X(I)=X(I+Q)
  426. 4208  Y(I)=Y(I+Q): Z(I)=Z(I+Q): NEXT I: Q=D%(OC): FOR I=L%(OC) TO LL-Q
  427. 4209  IN%(I)=IN%(I+Q)
  428. 4210  JN%(I)=JN%(I+Q): NEXT I: DE=C%(OC): KE=N%(OC)+C%(OC): FOR I=1 TO LL
  429. 4215  IN%(I)=IN%(I) + DE*(IN%(I)>=KE): JN%(I)=JN%(I)+DE*(JN%(I)>=KE): NEXT I
  430. 4220  FOR I=OC+1 TO LO: N%(I)=N%(I)-Q1: L%(I)=L%(I)-Q2: NEXT I
  431. 4225  FOR I=OC TO LO-1: P=I+1: N%(I)=N%(P): C%(I)=C%(P): L%(I)=L%(P)
  432. 4226  D%(I)=D%(P)
  433. 4230  OL$(I)=OL$(P): SI$(I)=SI$(P): NEXT I: LN=LN-Q1: LL=LL-Q2:LO=LO-1:NS=NS-1
  434. 4240  HT$="OBJECTS": FOR I=1 TO LO: SI$(I)=OL$(I): NEXT I: GOSUB 3200: GOTO 4290
  435. 4250  IF LO>=1 THEN 4201
  436. 4255  EM$="Can't DELETE until an object is created.": GOSUB 3500: GOSUB 3550
  437. 4260  GOTO 2400
  438. 4290  GOTO 2400
  439. 4296  REM
  440. 4297  REM Display LIBRARY options
  441. 4299  REM
  442. 4300  EC=1: GOSUB 1300: HL$=" LIBRARY" : NI=4
  443. 4305  MI$=" GRAB    STASH  DELETE   QUIT" : GOSUB 900
  444. 4310  ON SL GOTO 5500,5600,6100,3700
  445. 4497  REM
  446. 4498  REM DISK OPTIONS
  447. 4499  REM
  448. 4500  EC=1: GOSUB 1300: HL$="  DISK": NI=5
  449. 4505  MI$=" LOAD   DELETE   SAVE   REPLAC   QUIT": GOSUB 900
  450. 4510  ON SL GOTO 4700,5200,7200,7300,10010
  451. 4596  REM
  452. 4597  REM Save Nalcad file to disk drive
  453. 4599  REM
  454. 4600  EM$="Place disk with DIRECTORY in drive...": GOSUB 3500: GOSUB 3550
  455. 4601  OPERATION$="SAVE": PL$="Filename=": LEGLEN=8: GOSUB 1600: NA$=LB$: EM=0
  456. 4602  OPEN "DIR" FOR INPUT AS #1: INPUT#1, NF: FOR I=1 TO NF: INPUT#1,FL$(I)
  457. 4605  IF FL$(I)=NA$ THEN EM=1
  458. 4607  NEXT I: CLOSE 1: IF EM=0 THEN 4620
  459. 4610  EM$=" Filename exists in Directory...": GOSUB 3500: GOSUB 3550
  460. 4617  EM$=" Restart SAVEing process.": GOSUB 3500: GOSUB 3550: GOTO 4600
  461. 4619  OPERATION$="REPLACE"
  462. 4620  OPEN NA$ FOR OUTPUT AS #1: PRINT#1, SCALFAC: PRINT#1,XE: PRINT#1,YE: PRINT#1,ZE
  463. 4622  PRINT#1, XC: PRINT#1,YC: PRINT#1,ZC: PRINT#1,LN: PRINT#1, LL: PRINT#1,LO
  464. 4625  FOR I%=1 TO LN: PRINT#1, X(I%): PRINT#1, Y(I%): PRINT#1,Z(I%): NEXT I%
  465. 4630  FOR I%=1 TO LL: PRINT#1, IN%(I%): PRINT#1, JN%(I%): NEXT I%
  466. 4635  FOR I%=1 TO LO: PRINT#1, OL$(I%): PRINT#1,N%(I%): PRINT#1, C%(I%)
  467. 4640  PRINT#1, L%(I%): PRINT#1, D%(I%): NEXT I%: CLOSE 1
  468. 4642  IF OPERATION$="REPLACE" THEN 5930
  469. 4645  OPEN "DIR" FOR INPUT AS #1: INPUT#1, NF: FOR I%=1 TO NF: INPUT#1, FL$(I%)
  470. 4650  NEXT I%: CLOSE 1: NF=NF+1: FL$(NF)=LB$: OPEN "DIR" FOR OUTPUT AS #1
  471. 4655  PRINT#1, NF: FOR I%=1 TO NF: PRINT#1, FL$(I%): NEXT I%: CLOSE 1
  472. 4660  GOTO 4500
  473. 4696  REM
  474. 4697  REM Load a 3-D Shapes file
  475. 4699  REM
  476. 4700  EM$="Place disk with DIRECTORY in drive...": GOSUB 3500: GOSUB 3550
  477. 4701  EC=5: GOSUB 1300: OPEN "DIR" FOR INPUT AS #1: INPUT#1, NS
  478. 4705  FOR I%=1 TO NS: INPUT#1, SI$(I%): NEXT I%: CLOSE 1: HT$=" FILES"
  479. 4710  GOSUB 3200: GOSUB 3300: IF TARF=1 THEN EC=5:GOSUB 1300: GOTO 4745
  480. 4711  FFF=SL:GOSUB 5700: ON SL GOTO 4712, 4792
  481. 4712  EC=5: GOSUB 1300
  482. 4714  REM OPEN SI$(FFF) FOR INPUT AS #1: INPUT#1,XE: INPUT#1,YE: INPUT#1,ZE
  483. 4715  OPEN SI$(FFF) FOR INPUT AS #1: INPUT#1, SCALFAC: INPUT#1,XE: INPUT#1,YE: INPUT#1,ZE
  484. 4720  INPUT#1,XC: INPUT#1, YC: INPUT#1,ZC: INPUT#1,LN: INPUT#1,LL
  485. 4725  INPUT#1,LO: FOR I%=1 TO LN: INPUT#1,X(I%): INPUT#1, Y(I%): INPUT#1,Z(I%)
  486. 4730  NEXT I%: FOR I%=1 TO LL: INPUT#1, IN%(I%): INPUT#1, JN%(I%): NEXT I%
  487. 4735  FOR I%=1 TO LO: INPUT#1,OL$(I%): INPUT#1,N%(I%): INPUT#1,C%(I%)
  488. 4740  INPUT#1,L%(I%): INPUT#1, D%(I%): NEXT I%: CLOSE 1
  489. 4745  HT$="OBJECTS": NS=LO: FOR I%=1 TO NS: SI$(I%)=OL$(I%)
  490. 4750  NEXT I%: GOSUB 3200
  491. 4755  PW = SQR((XE-XC)^2 + (YE-YC)^2 + (ZE-ZC)^2)/SCALFAC
  492. 4790  GOTO 4500
  493. 4792  EC=5: GOSUB 1300: GOTO 4500
  494. 4796  REM
  495. 4797  REM Combine two objects from the object list
  496. 4799  REM
  497. 4800  IF LO>=2 THEN 4804
  498. 4801  EM$="Before COMBINING, at least two objects must...": GOSUB 3500: GOSUB 3550
  499. 4802  EM$="be created using MAKE, SPECIAL or LIBRAR.": GOSUB 3500: GOSUB 3550
  500. 4803  GOTO 3700
  501. 4804  EM$=" Press a key, then select object #1 for combining...": GOSUB 3500: GOSUB 3550
  502. 4805  GOSUB 3300: IF TARF=1 THEN 3700
  503. 4806  O1=SL: EM$=" Press a key, then select object #2 for combining..."
  504. 4807  GOSUB 3500: GOSUB 3550:GOSUB 3300: IF TARF=1 THEN 3700
  505. 4808  O2=SL:GOSUB 5700: ON SL GOTO 4809, 4925
  506. 4809  IF O2<O1 THEN O3=O1: O1=O2: O2=O3: GOTO 4815
  507. 4810  IF O1=O2 THEN EM$=" Same object! ":GOSUB 3500: GOSUB 3550: GOTO 4800
  508. 4815  IF O2=O1+1 THEN 4910: REM Bypass
  509. 4817  PNODES=LN+C%(O2):PLINES=LL+D%(O2):GOSUB 7800: IF EXCEED=1 THEN 3700
  510. 4820  PII=N%(O1)+C%(O1):LA=N%(O2):SZ=C%(O2):FOR I%=1 TO LN:HE%(I%)=I%:NEXT I%
  511. 4825  FOR I%=LN TO PII STEP -1:B%=I%+SZ:X(B%)=X(I%):Y(B%)=Y(I%):Z(B%)=Z(I%):HE%(B%)=HE%(I%)
  512. 4830  NEXT I%:FOR I%=1 TO SZ:B%=PII+I%-1:C%=LA+SZ+I%-1:X(B%)=X(C%):Y(B%)=Y(C%)
  513. 4835  Z(B%)=Z(C%): HE%(B%)=HE%(C%): NEXT I%: FOR I%=LA+2*SZ TO LN+SZ:B%=I%-SZ: X(B%)=X(I%)
  514. 4840  Y(B%)=Y(I%): Z(B%)=Z(I%): HE%(B%)=HE%(I%) : NEXT I%
  515. 4843  FOR I%=1 TO LL: FOR J%=1 TO LN
  516. 4846  IF IN%(I%)=HE%(J%) THEN IN%(I%)=J%: J%=LN
  517. 4849  NEXT J%: NEXT I%
  518. 4852  FOR I%=1 TO LL: FOR J%=1 TO LN
  519. 4855  IF JN%(I%)=HE%(J%) THEN JN%(I%)=J%: J%=LN
  520. 4858  NEXT J%: NEXT I%
  521. 4861  FOR I%=1 TO LO: FOR J%=1 TO LN
  522. 4864  IF N%(I%)=HE%(J%) THEN N%(I%)=J%: J%=LN
  523. 4867  NEXT J%: NEXT I%
  524. 4875  PII=L%(O1) + D%(O1):LA=L%(O2):SZ=D%(O2):FOR I%=1 TO LL:HE%(I%)=I%:NEXT I%
  525. 4880  FOR I%=LL TO PII STEP -1:B%=I%+SZ:IN%(B%)=IN%(I%):JN%(B%)=JN%(I%):HE%(B%)=HE%(I%)
  526. 4881  NEXT I%
  527. 4885  FOR I%=1 TO SZ:B%=PII+I%-1:C%=LA+SZ+I%-1:IN%(B%)=IN%(C%):JN%(B%)=JN%(C%)
  528. 4890  HE%(B%)=HE%(C%):NEXT I%:FOR I%=LA+2*SZ TO LL+SZ:B%=I%-SZ:IN%(B%)=IN%(I%)
  529. 4895  JN%(B%)=JN%(I%): HE%(B%)=HE%(I%): NEXT I%
  530. 4900  FOR I%=1 TO LO: FOR J%=1 TO LL
  531. 4903  IF L%(I%)=HE%(J%) THEN L%(I%)=J%: J%=LL
  532. 4905  NEXT J%: NEXT I%
  533. 4910  C%(O1)=C%(O1) + C%(O2): D%(O1)=D%(O1) + D%(O2)
  534. 4915  FOR I%=O2 + 1 TO LO:B%=I%-1:N%(B%)= N%(I%): C%(B%)=C%(I%): L%(B%)=L%(I%)
  535. 4916  D%(B%)=D%(I%)
  536. 4920  OL$(B%)=OL$(I%): SI$(B%)=SI$(I%): NEXT I%: LO=LO-1: NS=LO
  537. 4925  HT$="OBJECTS" : GOSUB 3200: GOTO 3700
  538. 4997  REM
  539. 4998  REM DISPLAY OTHER MAIN MENU COMMANDS
  540. 4999  REM
  541. 5000  EC=2: GOSUB 1300: NI=3
  542. 5005  MI$= "STATUS   RESET   QUIT ": GOSUB 900
  543. 5010  ON SL GOTO 5300,6000,10010
  544. 5196  REM
  545. 5197  REM DELETE A Nalcad file
  546. 5199  REM
  547. 5200  EM$="Place disk with DIRECTORY in drive...": GOSUB 3500: GOSUB 3550
  548. 5205  EC=5: GOSUB 1300: OPEN "DIR" FOR INPUT AS #1: INPUT#1, NS
  549. 5210  FOR I=1 TO NS:INPUT#1, SI$(I):NEXT I:CLOSE 1:HT$=" FILES":GOSUB 3200: GOSUB 3300: IF TARF=1 THEN 5245
  550. 5215  OC=SL:GOSUB 5700: ON SL GOTO 5230, 5245
  551. 5230  KILL SI$(OC): FOR I=OC TO NS-1: SI$(I)=SI$(I+1):NEXT I: NS=NS-1
  552. 5235  OPEN "DIR" FOR OUTPUT AS #1: PRINT#1, NS: FOR I=1 TO NS
  553. 5240  PRINT#1, SI$(I): NEXT I: CLOSE 1
  554. 5245  EC=5: GOSUB 1300: NS=LO: FOR I=1 TO LO: SI$(I)=OL$(I): NEXT I
  555. 5250  HT$="OBJECTS": GOSUB 3200: GOTO 4500
  556. 5296  REM
  557. 5297  REM Display STATUS
  558. 5299  REM
  559. 5300  EM$=" Nodes remaining = " +STR$(700-LN): GOSUB 3500: GOSUB 3550
  560. 5305  EM$=" Lines remaining = " +STR$(1000-LL): GOSUB 3500: GOSUB 3550
  561. 5310  EM$=" Objects remaining = " +STR$(18-LO): GOSUB 3500: GOSUB 3550
  562. 5315  GOTO 5000
  563. 5496  REM
  564. 5497  REM GRAB an object from the Library
  565. 5499  REM
  566. 5500  EM$= " Insert disk with library files...": GOSUB 3500: GOSUB 3550
  567. 5505  EC=5: GOSUB 1300: OPEN "LIBRARY" FOR INPUT AS #1: INPUT#1, TQ: NS=TQ
  568. 5510  FOR I=1 TO NS: INPUT#1,SI$(I): NEXT I: CLOSE 1:HT$="LIBRARY": GOSUB 3200
  569. 5512  GOSUB 3300: IF TARF=1 THEN EC=5: GOSUB 1300: NS=LO: FOR I=1 TO NS: SI$(I)=OL$(I): NEXT I: HT$="OBJECTS": GOSUB 3200: GOTO 4300
  570. 5514  NM$=SI$(SL): OPEN NM$ FOR INPUT AS #1
  571. 5515  INPUT#1, NC: INPUT#1, LC: PNODES=LN+NC: PLINES=LL+LC:GOSUB 7800: IF EXCEED=0 THEN 5519
  572. 5517  CLOSE 1: EC=5: GOSUB 1300: NS=LO: FOR I=1 TO NS: SI$(I)=OL$(I): NEXT I: HT$="OBJECTS": GOSUB 3200: GOTO 4300
  573. 5519  FOR I=1 TO NC: INPUT#1, X(LN+I):INPUT#1,Y(LN+I)
  574. 5520  INPUT#1,Z(LN+I): NEXT I: FOR I=1 TO LC: INPUT#1, NU:IN%(LL+I)=LN+NU
  575. 5525  INPUT#1,NU: JN%(LL+I)=LN+NU: NEXT I: CLOSE 1
  576. 5526  EC=5: GOSUB 1300: NS=LO: FOR I=1 TO NS: SI$(I)=OL$(I): NEXT I
  577. 5530  NS=NS+1: SI$(NS)=NM$: HT$="OBJECTS": GOSUB 3200: LO=LO+1
  578. 5535  N%(LO)=LN+1: C%(LO)=NC: L%(LO)=LL+1: D%(LO)=LC: LN=LN+NC: LL=LL+LC
  579. 5540  OL$(LO)=NM$: GOTO 4300
  580. 5596  REM
  581. 5597  REM STASH an object in the library
  582. 5599  REM
  583. 5600  EM$=" Select object from list...": GOSUB 3500: GOSUB 3550
  584. 5601  GOSUB 3300: IF TARF=1 THEN 4300
  585. 5604  OC=SL: NM$=SI$(OC): PL$="STASH name": LEGLEN=8: GOSUB 1600
  586. 5605  EM=0: OPEN "LIBRARY" FOR INPUT AS #1 : INPUT#1, TQ: FOR I=1 TO TQ
  587. 5610  INPUT#1, LT$(I): IF LT$(I) = LB$ THEN EM=1
  588. 5615  NEXT I: CLOSE 1: IF EM=0 THEN 5620
  589. 5616  EM$= " Name already exists in Library...": GOSUB 3500: GOSUB 3550
  590. 5617  EM$= " Choose another name. ": GOSUB 3500: GOSUB 3550: GOTO 5600
  591. 5620  X0=0: Y0=0: Z0=0: FOR I=N%(OC) TO N%(OC)+C%(OC)-1: X0=X0+X(I):Y0=Y0+Y(I)
  592. 5625  Z0=Z0+Z(I): NEXT I: X0=X0/C%(OC): Y0=Y0/C%(OC): Z0=Z0/C%(OC)
  593. 5630  OPEN LB$ FOR OUTPUT AS #1: PRINT#1, C%(OC): PRINT#1, D%(OC)
  594. 5635  FOR I=N%(OC) TO N%(OC)+C%(OC)-1: PRINT#1, X(I)-X0: PRINT#1, Y(I)-Y0
  595. 5640  PRINT#1, Z(I)-Z0: NEXT I: FOR I=L%(OC) TO L%(OC)+D%(OC)-1
  596. 5642  PRINT#1, IN%(I)+1-N%(OC)
  597. 5645  PRINT#1, JN%(I)+1-N%(OC): NEXT I: CLOSE 1: OPEN "LIBRARY" FOR INPUT AS #1
  598. 5650  INPUT#1, TQ: FOR I=1 TO TQ: INPUT#1, LT$(I): NEXT I: CLOSE 1: TQ=TQ+1
  599. 5652  LT$(TQ)=LB$
  600. 5655  OPEN "LIBRARY" FOR OUTPUT AS #1: PRINT#1, TQ: FOR I=1 TO TQ
  601. 5660  PRINT#1, LT$(I): NEXT I: CLOSE 1: GOTO 4300
  602. 5696  REM
  603. 5697  REM "Are you sure?" subroutine
  604. 5699  REM
  605. 5700  EC=2: GOSUB 1300: NI=2: MI$="  YES   CANCEL  Are you sure?":GOSUB 900
  606. 5705  RETURN
  607. 5896  REM
  608. 5897  REM Save with REPLACE
  609. 5899  REM
  610. 5900  EM$=" Place disk with DIRECTORY in drive...": GOSUB 3500: GOSUB 3550
  611. 5903  EC=5: GOSUB 1300: HT$=" FILES" : OPEN "DIR" FOR INPUT AS #1
  612. 5905  INPUT#1, NS: FOR I=1 TO NS: INPUT#1, SI$(I): NEXT I: CLOSE 1
  613. 5910  GOSUB 3200: GOSUB 3300: IF TARF=1 THEN 5930
  614. 5914  OC=SL: GOSUB 5700: ON SL GOTO 5925, 5915
  615. 5915  EC=5: GOSUB 1300: HT$="OBJECTS": FOR I=1 TO LO: SI$(I)=OL$(I): NEXT I
  616. 5920  NS=LO: GOSUB 3200: GOTO 4500
  617. 5925  NA$=SI$(OC): GOTO 4619
  618. 5930  EC=5: GOSUB 1300: HT$="OBJECTS": FOR I=1 TO LO: SI$(I)=OL$(I): NEXT I
  619. 5935  NS=LO: GOSUB 3200: GOTO 4500
  620. 5996  REM
  621. 5997  REM RESET the Nalcad program
  622. 5999  REM
  623. 6000  EM$="RESET does a warm restart of 3-D Shapes ...": GOSUB 3500: GOSUB 3550
  624. 6005  EM$="All shape data is erased from RAM." : GOSUB 3500: GOSUB 3550
  625. 6010  GOSUB 5700: ON SL GOTO 6015, 5000
  626. 6015  EC=4: GOSUB 1300: EC=5: GOSUB 1300: NS=0: GOSUB 1020
  627. 6020  LOCATE 4, 71: PRINT "OBJECTS"; HM$: GOTO 10010
  628. 6096  REM
  629. 6097  REM DELETE a LIBRARY file
  630. 6099  REM
  631. 6100  EM$="Insert disk containing LIBRARY. Press any key.":GOSUB 3500
  632. 6105  GOSUB 3550: EC=5: GOSUB 1300: OPEN "LIBRARY" FOR INPUT AS #1
  633. 6110  INPUT#1, NS: FOR I=1 TO NS: INPUT#1, SI$(I): NEXT I: CLOSE 1:HT$="LIBRARY": GOSUB 3200
  634. 6115  GOSUB 3300: IF TARF=1 THEN 6135
  635. 6119  OC=SL: GOSUB 5700: ON SL GOTO 6120, 6135
  636. 6120  KILL SI$(OC): FOR I= OC TO NS-1 : SI$(I)=SI$(I+1):NEXT I
  637. 6125  OPEN "LIBRARY" FOR OUTPUT AS #1: PRINT#1, NS-1: FOR I=1 TO NS-1
  638. 6130  PRINT#1, SI$(I): NEXT I: CLOSE 1
  639. 6135  EC=5: GOSUB 1300: NS=LO: FOR I=1 TO NS: SI$(I)=OL$(I): NEXT I: HT$="OBJECTS": GOSUB 3200
  640. 6140  GOTO 4300
  641. 6196  REM
  642. 6197  REM RENAME an item in the object list
  643. 6199  REM
  644. 6200  IF LO>=1 THEN 6204
  645. 6201  EM$="Can't RENAME an object until one exists.": GOSUB 3500: GOSUB 3550
  646. 6202  GOTO 3700
  647. 6204  GOSUB 3300: IF TARF=1 THEN 3700
  648. 6205  OC=SL: PL$="New name =": LEGLEN=8: GOSUB 1600
  649. 6207  SI$(OC)=LB$: OL$(OC)=LB$: EC=5: GOSUB 1300: HT$="OBJECTS": GOSUB 3200
  650. 6210  GOTO 3700
  651. 6296  REM
  652. 6297  REM Create SPECIAL Object
  653. 6299  REM
  654. 6300  FOR I=1 TO 50: XPOS(I)=0: YPOS(I)=0: ZPOS(I)=0: IND%(I)=1: JND%(I)=1
  655. 6305  NEXT I: SPECNAME$=" ": GOSUB 6400: GOSUB 6500
  656. 6315  NDI=1: NDF=10: GOSUB 6600: LNI=1: LNF=10 : GOSUB 6700
  657. 6320  EC=1: GOSUB 1300: HL$=" SPECIAL": NI=5
  658. 6325  MI$="PARAMS   NODES   LINES  INSTAL   QUIT": GOSUB 900
  659. 6326  IF ((SL=2 AND SPECNODES <2) OR (SL=3 AND SPECLINES <1)) THEN GOSUB 7400: GOTO 6320
  660. 6330  ON SL GOTO 6800, 6900, 7000, 7100, 6336
  661. 6336  GOSUB 5700: ON SL GOTO 6340, 6320
  662. 6340  EC=4: GOSUB 1300: GOTO 3700
  663. 6396  REM
  664. 6397  REM Set up screen for special objects
  665. 6399  REM
  666. 6400  EC=4: GOSUB 1300: LINE (40,35)-(512,35): LINE (351,35)-(351,143)
  667. 6405  LOCATE 4,6: PRINT "Object name=";: LOCATE 4,30: PRINT "# of nodes=";
  668. 6410  LOCATE 4,49: PRINT "# of lines=";: LOCATE 6,19: PRINT "Node Data"
  669. 6415  LOCATE 6,51: PRINT "Line Data";:LOCATE 8,7
  670. 6420  PRINT "------------------------------------";: LOCATE 8,46
  671. 6425  PRINT "-------------------";HM$
  672. 6430  LOCATE 7,7: PRINT "No.       X         Y         Z";: LOCATE 7,46
  673. 6435  PRINT "No.  I-node  J-node";HM$
  674. 6490  RETURN
  675. 6496  REM
  676. 6497  REM Print Parameters
  677. 6499  REM
  678. 6500  LOCATE 4,19: PRINT "      ": LOCATE 4,19: PRINT SPECNAME$
  679. 6505  LOCATE 4,42: PRINT "   ": LOCATE 4,42: PRINT SPECNODES
  680. 6510  LOCATE 4,63: PRINT "   ": LOCATE 4,63: PRINT SPECLINES
  681. 6590  RETURN
  682. 6596  REM
  683. 6597  REM Print 10 special nodes
  684. 6599  REM
  685. 6600  N$="####.##"
  686. 6602  FOR I=9 TO 18: LOCATE I,8: PRINT "                                   ";
  687. 6605  NEXT I: FOR I=NDI TO NDF: LOCATE 9+I-NDI,8: PRINT I;: LOCATE 9+I-NDI,14
  688. 6610  PRINT USING N$; XPOS(I);: LOCATE 9+I-NDI,24: PRINT USING N$; YPOS(I);
  689. 6615  LOCATE 9+I-NDI,34: PRINT USING N$; ZPOS(I);: NEXT I: PRINT HM$;
  690. 6690  RETURN
  691. 6696  REM
  692. 6697  REM Print 10 special lines
  693. 6699  REM
  694. 6700  FOR I=9 TO 18: LOCATE I,47: PRINT "                  ";: NEXT I
  695. 6705  FOR I=LNI TO LNF: LOCATE 9+I-LNI,47: PRINT I;: LOCATE 9+I-LNI,53
  696. 6710  PRINT IND%(I);: LOCATE 9+I-LNI,60: PRINT JND%(I);: NEXT I: PRINT HM$;
  697. 6790  RETURN
  698. 6796  REM
  699. 6797  REM Set Parameters subroutine
  700. 6798  REM *********************
  701. 6799  REM
  702. 6800  EC=1: GOSUB 1300: NI=4: MI$=" NAME    NODES   LINES   QUIT"
  703. 6805  HL$=" PARAMS": GOSUB 900: ON SL GOTO 6810, 6820, 6830, 6320
  704. 6810  LEGLEN=8: PL$="Obj. name=": GOSUB 1600: SPECNAME$=LB$
  705. 6815  IF LB$=" " THEN BEEP: GOTO 6810
  706. 6818  GOSUB 6500: GOTO 6800
  707. 6820  PL$="# of nodes": DV=SPECNODES: GOSUB 1200: SPECNODES=NUM
  708. 6822  IF SPECNODES>50 THEN SPECNODES=50
  709. 6825  GOSUB 6500: GOTO 6800
  710. 6830  PL$="# of lines": DV=SPECLINES: GOSUB 1200: SPECLINES=NUM
  711. 6832  IF SPECLINES>50 THEN SPECLINES=50
  712. 6835  GOSUB 6500: GOTO 6800
  713. 6896  REM
  714. 6897  REM Special NODE Operations
  715. 6899  REM
  716. 6900  EC=1: GOSUB 1300: NI=3: HL$="  NODES": MI$="REVIEW    SET    QUIT"
  717. 6905  GOSUB 900: ON SL GOTO 6910, 6925, 6320
  718. 6910  PL$=" From # ": DV=1: GOSUB 1200: NDI=NUM
  719. 6915  IF NDI>=SPECNODES THEN NDI = SPECNODES -10
  720. 6917  IF NDI<1 THEN NDI=1
  721. 6920  NDF= -(NDI+9)*((NDI+9)<SPECNODES) - SPECNODES*((NDI+9)>=SPECNODES)
  722. 6922  GOSUB 6600: GOTO 6900
  723. 6925  IF SPECNODES >= 2 THEN 6935
  724. 6930  EM$="Minimum number of nodes is 2...": GOSUB 3500: GOSUB 3550
  725. 6933  EM$="Go to PARAMS option, reset No. of nodes.": GOSUB 3500: GOSUB 3550
  726. 6934  GOTO 6900
  727. 6935  PL$=" From # ": DV=1: GOSUB 1200: NDI=NUM
  728. 6940  IF NDI>=SPECNODES THEN NDI=SPECNODES -10
  729. 6945  IF NDI<1 THEN NDI=1
  730. 6947  PL$="   To # "
  731. 6948  DV=-(NDI+5)*((NDI+5)<=SPECNODES) - SPECNODES*((NDI+5)>SPECNODES)
  732. 6949  GOSUB 1200: NDF=NUM: IF (NDF>(NDI+9) AND (NDI+9)<SPECNODES) THEN NDF=NDI+9
  733. 6951  IF (NDF >= SPECNODES AND SPECNODES < (NDI+9)) THEN NDF=SPECNODES
  734. 6953  GOSUB 6600: FOR I=NDI TO NDF: PL$="  X("+STR$(I)+")=": DV= XPOS(I)
  735. 6955  GOSUB 1200: XPOS(I)=NUM: PL$="  Y("+STR$(I)+")=": DV= YPOS(I): GOSUB 1200
  736. 6957  YPOS(I)=NUM: PL$="  Z("+STR$(I)+")=": DV=ZPOS(I): GOSUB 1200: ZPOS(I)=NUM
  737. 6959  LOCATE 9+I-NDI,8 : PRINT "                                   ";
  738. 6961  LOCATE 9+I-NDI,8: PRINT I;: LOCATE 9+I-NDI,14: PRINT USING N$; XPOS(I);
  739. 6963  LOCATE 9+I-NDI,24: PRINT USING N$; YPOS(I);: LOCATE 9+I-NDI,34
  740. 6965  PRINT USING N$; ZPOS(I);: NEXT I: PRINT HM$
  741. 6990  GOTO 6900
  742. 6996  REM
  743. 6997  REM LINES Option of the Special option
  744. 6999  REM
  745. 7000  EC=1: GOSUB 1300: HL$="  LINES": NI=3: MI$="REVIEW    SET    QUIT"
  746. 7005  GOSUB 900: ON SL GOTO 7010,7040,6320
  747. 7010  IF SPECLINES >=1 THEN 7030
  748. 7015  EM$="Minimum number of lines is 1...": GOSUB 3500: GOSUB 3550
  749. 7020  EM$="Go to PARAMS option, reset No. of lines.": GOSUB 3500: GOSUB 3550
  750. 7025  GOTO 7000
  751. 7030  PL$="   From ": DV=1: GOSUB 1200: LNI=NUM
  752. 7032  IF LNI >= SPECLINES THEN LNI =SPECLINES -9
  753. 7034  IF LNI <1 THEN LNI=1
  754. 7036  LNF= LNI+9: IF LNF> SPECLINES THEN LNF=SPECLINES
  755. 7038  GOSUB 6700: GOTO 7000
  756. 7040  PL$="   From ": DV=1: GOSUB 1200: LNI=NUM
  757. 7042  IF LNI >= SPECLINES THEN LNI =SPECLINES -9
  758. 7044  IF LNI <1 THEN LNI=1
  759. 7046  PL$="   To":DV=-(LNI+9)*((LNI+9)<=SPECLINES)-SPECLINES*((LNI+9)>SPECLINES)
  760. 7048  GOSUB 1200: LNF=NUM: IF LNF > (LNI+9) THEN LNF=(LNI+9)
  761. 7050  IF LNF > SPECLINES THEN LNF = SPECLINES
  762. 7052  GOSUB 6700 : FOR I=LNI TO LNF
  763. 7054  PL$="I-node("+STR$(I)+")=": DV=IND%(I): GOSUB 1200
  764. 7056  IND%(I)=NUM: IF (NUM<1 OR NUM >SPECNODES) THEN BEEP: IND%(I)=1:GOTO 7054
  765. 7058  PL$="J-node("+STR$(I)+")=": DV=JND%(I): GOSUB 1200
  766. 7060  JND%(I)=NUM: IF (NUM<1 OR NUM >SPECNODES) THEN BEEP: JND%(I)=1:GOTO 7058
  767. 7062  LOCATE 9+I-LNI,47: PRINT "                  ";: LOCATE 9+I-LNI,47
  768. 7064  PRINT I;: LOCATE 9+I-LNI,53: PRINT IND%(I);: LOCATE 9+I-LNI,60
  769. 7066  PRINT JND%(I);: NEXT I: PRINT HM$
  770. 7090  GOTO 7000
  771. 7096  REM
  772. 7097  REM INSTALL the special object in the object list
  773. 7099  REM
  774. 7100  IF SPECNAME$<>" " AND SPECNODES>=2 AND SPECLINES>=1 THEN 7105
  775. 7101  EM$="Parameters are improperly set...": GOSUB 3500: GOSUB 3550
  776. 7102  EM$="Reset PARAMS or quit SPECIAL without INSTALLING.":GOSUB 3500
  777. 7103  GOSUB 3550: GOTO 6320
  778. 7105  PNODES=LN+SPECNODES:PLINES=LL+SPECLINES: GOSUB 7800:IF EXCEED=1 THEN 6320
  779. 7106  LOCATE 6+LO,71: PRINT SPECNAME$; HM$: NS=NS+1: SI$(NS)=SPECNAME$
  780. 7110  LO=LO+1: OL$(LO)=SPECNAME$: FOR I=1 TO SPECNODES: X(LN+I)=XPOS(I)
  781. 7115  Y(LN+I)=YPOS(I): Z(LN+I)=ZPOS(I): NEXT I: FOR I=1 TO SPECLINES
  782. 7120  IN%(LL+I)=LN+IND%(I): JN%(LL+I)=LN+JND%(I): NEXT I: N%(LO)=LN+1
  783. 7125  C%(LO)=SPECNODES: L%(LO)=LL+1: D%(LO)=SPECLINES: LN=LN+SPECNODES
  784. 7130  LL=LL+SPECLINES
  785. 7190  GOTO 6320
  786. 7195  REM
  787. 7196  REM Check to see if at least one object
  788. 7197  REM exists before savin a 3-D Shapes file
  789. 7198  REM
  790. 7200  IF LO > 0 THEN 4600
  791. 7205  EM$=" At least one object must exist...": GOSUB 3500: GOSUB 3550
  792. 7210  EM$=" before you can save a 3-D Shapes file to disk.": GOSUB 3500: GOSUB 3550
  793. 7290  GOTO 4500
  794. 7296  REM
  795. 7297  REM Check to make sure an object exists before
  796. 7298  REM a REPLAC operation can take place
  797. 7299  REM
  798. 7300  IF LO > 0 THEN 5900
  799. 7305  EM$=" At least one object must exist in RAM memory...": GOSUB 3500: GOSUB 3550
  800. 7310  EM$=" before you can replace a 3-D Shapes file on disk.": GOSUB 3500: GOSUB 3550
  801. 7390  GOTO 4500
  802. 7396  REM
  803. 7397  REM Print error message due to failure
  804. 7398  REM properly set PARAMS in SPECIAL operation
  805. 7399  REM
  806. 7400  EM$=" Node and line parameters must be properly set...": GOSUB 3500: GOSUB 3550
  807. 7405  EM$=" before invoking any NODES or LINES operations.": GOSUB 3500: GOSUB 3550
  808. 7490  RETURN
  809. 7496  REM
  810. 7497  REM Test for proper number of sides
  811. 7499  REM
  812. 7500  SIDETEST=0: IF (SIDES >=3 AND INT(SIDES) = SIDES) THEN 7590
  813. 7510  SIDETEST=1: EM$="# of sides must be an integer...": GOSUB 3500:GOSUB 3550
  814. 7520  EM$="...which is greater than or equal to 3.": GOSUB 3500:GOSUB 3550
  815. 7590  RETURN
  816. 7596  REM
  817. 7597  REM Change the scalefactor of the image
  818. 7598  REM
  819. 7600  PL$=" T-factor ": DV= SCALFAC: GOSUB 1200: SCALFAC=NUM
  820. 7605  IF (SCALFAC >=0.1 AND SCALFAC <= 10) THEN 7615
  821. 7607  EM$=" Value must be >= 0.1 and <= 10. Re-enter T-factor."
  822. 7608  GOSUB 3500: GOSUB 3550: GOTO 7600
  823. 7615  PW = SQR((XE-XC)^2 + (YE-YC)^2 + (ZE-ZC)^2)/SCALFAC
  824. 7690  GOTO 2500
  825. 7696  REM
  826. 7697  REM Error handling subroutine
  827. 7699  REM
  828. 7700  IF ERR<> 25 THEN 7715
  829. 7705  EM$=" Hardware error.  Check to make sure...": GOSUB 3500: GOSUB 3550
  830. 7710  EM$=" printer is turned on.": GOSUB 3500: GOSUB 3550: RESUME 10010
  831. 7715  IF ERR<> 53 THEN 7735
  832. 7720  EM$="Directory, Library or NalCad file not found...":GOSUB 3500:GOSUB 3550
  833. 7725  EM$="Insert proper disk in drive...": GOSUB 3500: GOSUB 3550
  834. 7730  EM$="Control is directed to Main Menu.": GOSUB 3500: GOSUB 3550: GOSUB 7780: RESUME 10010
  835. 7735  IF ERR<> 61 THEN 7750
  836. 7740  EM$=" Disk is full...": GOSUB 3500: GOSUB 3550: EM$="Insert a different Nalcad disk in drive...": GOSUB 3500: GOSUB 3550
  837. 7745  EM$="Control is directed to main menu.": GOSUB 3500: GOSUB 3550: RESUME 10010
  838. 7750  IF (ERR<> 70 AND ERR<> 71) THEN 7765
  839. 7755  EM$=" Disk is write-protected, or...": GOSUB 3500: GOSUB 3550: EM$="drive door is open...": GOSUB 3500: GOSUB 3550
  840. 7760  EM$="Control is directed to main menu.": GOSUB 3500: GOSUB 3550: GOSUB 7780: RESUME 10010
  841. 7765  EM$="ERROR. Control is directed to main menu.": GOSUB 3500: GOSUB 3550: GOSUB 7780: RESUME 10010
  842. 7779  REM Begin short subroutine for relisting objects
  843. 7780  HT$="OBJECTS": NS=LO: FOR I=1 TO NS: SI$(I)=OL$(I): NEXT I: GOSUB 3200: RETURN
  844. 7796  REM
  845. 7797  REM Test for excessive nodes or lines
  846. 7799  REM
  847. 7800  EXCEED=0: IF (PNODES < NODELIMIT AND PLINES < LINELIMIT) THEN 7890
  848. 7805  EXCEED=1: EM$="Operation disallowed...": GOSUB 3500: GOSUB 3550
  849. 7810  EM$="Node and/or line limit will be exceeded." :GOSUB 3500:GOSUB 3550
  850. 7890  RETURN
  851. 9996  END
  852. 9997  REM *********************
  853. 9998  REM Begin main program
  854. 9999  REM *********************
  855. 10000  GOSUB 1000: REM initialization
  856. 10005  GOSUB 800: REM draw main screen boxes
  857. 10010  EC=1: GOSUB 1300: REM clear menu block
  858. 10015  HL$="  MAIN": MI$=" DISK    SHAPE   VIEW   SCREEN   OTHER   QUIT"
  859. 10020  NI=6: GOSUB 900: ON SL GOTO 4500,2400,2500,2800,5000,10050
  860. 10050  GOSUB 5700: ON SL GOTO 10060, 10010
  861. 10060  LOCATE 20,2: SCREEN 0,0,0,0: END
  862.