home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22b.dsk / ARCHITECT.bas < prev    next >
BASIC Source File  |  2023-02-26  |  31KB  |  622 lines

  1. 10  REM  ********1.18.85*********
  2. 20  REM  *      ARCHITECT       *
  3. 30  REM  *  BY I. LARRY MORRIS  *
  4. 40  REM  *  COPYRIGHT (C) 1985  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80  HOME : VTAB 6: HTAB 12: PRINT "NIBBLE ARCHITECT": IF  PEEK(104) < >64  THEN  POKE 103,1: POKE 104,64: POKE 16384,0: PRINT  CHR$(4)"RUN ARCHITECT"
  9. 90  POKE 105,0: POKE 106,8: POKE 107,0: POKE 108,8: POKE 109,0: POKE 110,8
  10. 100 ST$ = "T":SA = 8192:BY = 0:TR = 0:OC = 0:FL = 0:N1 = 1024:N1% = 255:N2% = 128:N3% = 32:N2 = 8063:N3 = 984:E$ =  CHR$(27)
  11. 110 ST = 2:MV = 0:FH = 0:FV = 0:AS = .86:HS = 3:VS = 3:C = 0:TF = 0:TI = 0
  12. 120 C$ = "Z":XC = 0:YC = 0:XF = 0:YF = 0:XS = 0:YS = 0:L = 0:N = 0:CL = 3:CR = 0:F = 0:G = 0:P5 = .5:Q$ =  CHR$(34):PR = .017453:P4 = .7854:A = 0:WS = 6
  13. 130  GOTO 280
  14. 140  REM  MOVING CURSOR
  15. 150  XDRAW 3 AT HS +HR *XC,VS +VR *YC: RETURN 
  16. 160  REM  FIXED CURSOR
  17. 170  XDRAW 2 AT HS +HR *XF,VS +VR *YF: RETURN 
  18. 180  REM  MOVES
  19. 190 CA =  PEEK( -16384) -128: IF CA <0  THEN 190
  20. 200  POKE  -16368,0
  21. 210  IF CA = 73  AND YC >Y1  THEN  GOSUB 140:YC = YC -ST:FL = 1:FV = 0: RETURN 
  22. 220  IF CA = 74  AND XC >X1  THEN  GOSUB 140:XC = XC -ST:FL = 1:FH = 0: RETURN 
  23. 230  IF CA = 75  AND XC <X2  THEN  GOSUB 140:XC = XC +ST:FL = 1:FH = 0: RETURN 
  24. 240  IF CA = 77  AND YC <Y2  THEN  GOSUB 140:YC = YC +ST:FL = 1:FV = 0: RETURN 
  25. 250  IF CA = 74  OR CA = 75  THEN FH = 1
  26. 260  IF CA = 73  OR CA = 77  THEN FV = 1
  27. 270 FL = 0: RETURN 
  28. 280  REM  PREAMBLE
  29. 290  GOSUB 770
  30. 300  GET C$
  31. 310  IF C$ = "N"  THEN  GOSUB 3190
  32. 320  IF C$ = "O"  THEN  GOSUB 4480
  33. 330  IF N = 0  THEN 300
  34. 340  REM  MONITOR
  35. 350  GOSUB 180
  36. 360  IF FL = 1  THEN MV = 1: GOSUB 140: GOTO 350
  37. 370 CS = CA -64
  38. 380  IF CA = 42  THEN  GOSUB 5750
  39. 390  IF CA = 35  THEN  GOSUB 5830
  40. 400  IF CA = 60  THEN  GOSUB 6130
  41. 410  IF CA = 62  THEN  GOSUB 6160
  42. 420  IF CA = 63  THEN  GOSUB 6190
  43. 430  IF CS <0  THEN 350
  44. 440  ON CS GOSUB 1500,1730,1890,2050,2260,2400,2420,2690,2990,2990,2990,3010,2990,3190,4480,4050,4200,4240,4480,4920,5200,5280,5450,5530
  45. 450  GOTO 350
  46. 460  REM  BUSY
  47. 470  HCOLOR= 0: FOR I = 184 TO 191: HPLOT 252,I TO 279,I: NEXT : HCOLOR= 3
  48. 480 IV = 1:VL = 0:VT = 24:HT = 37: GOSUB 640: RETURN 
  49. 490  REM  EDIT
  50. 500 IV = 1:VL = 0:VT = 24:HT = 37:ST$ = "EDIT": GOSUB 640: RETURN 
  51. 510  REM  DRAW CIRCLE
  52. 520 XG = P5 *(A%(AI,2) +A%(AI,4)):YG = P5 *(A%(AI,3) +A%(AI,5))
  53. 530 D = P5 *(A%(AI,4) -A%(AI,2)):D% = VR *D:WA = 0:WB = 2 *WS:AG = 15 *PR
  54. 540  IF D% >10  THEN AG = 12 *PR
  55. 550  IF D% >25  THEN AG = 9 *PR
  56. 560  IF D% >35  THEN AG = 8 *PR
  57. 570  IF D% >45  THEN AG = 6 *PR
  58. 580  IF D% >55  THEN AG = 5 *PR
  59. 590  FOR I = T1 TO T2  STEP AG
  60. 600 X = (XG +D * COS(I)):Y = (YG -D * SIN(I))
  61. 610  IF X <WA  OR Y <WA  OR X >WB +L1  OR Y >WB +W1  THEN 630
  62. 620  HPLOT HS +HR *X,VS +VR *Y
  63. 630  NEXT : RETURN 
  64. 640  REM  ALPHABET
  65. 650  IF VL = 0  THEN BA = N2 +N2% *VT -N3 * INT((VT -1)/8) +HT
  66. 660  FOR I = 1 TO  LEN(ST$): IF VL = 1  THEN BA = N2 +N2% *VT -N3 * INT((VT -1)/8) +HT
  67. 670 CH =  ASC( MID$ (ST$,I,1)) -N3%
  68. 680  IF CH = 0  THEN 730
  69. 690  IF IV = 1  THEN 720
  70. 700  FOR J = 0 TO 7: POKE BA +N1 *J,AL%(CH,J): NEXT 
  71. 710  GOTO 730
  72. 720  FOR J = 0 TO 7: POKE BA +N1 *J,N1% -AL%(CH,J): NEXT 
  73. 730 BA = BA +(VL = 0):VT = VT +(VL = 1): NEXT : RETURN 
  74. 740  REM  MENU
  75. 750  PRINT L$(6)L$(7)L$(8)L$(9)L$(10)L$(11)L$(12)L$(13)L$(14)L$(15)
  76. 760  RETURN 
  77. 770  REM  INITIALIZE
  78. 780  VTAB 12: PRINT  SPC( 39);: HTAB 13: FLASH : PRINT " READING MENU ": NORMAL 
  79. 790 D$ =  CHR$(4): REM  CTRL-D
  80. 800 CR$ =  CHR$(13): REM  C/R
  81. 810 AD = 0:LN = 1179
  82. 820 AD =  PEEK(107) +256 * PEEK(108)
  83. 830  PRINT D$"BLOAD ARCHITECT.ALPH,A"AD
  84. 840  POKE 110, INT((AD +LN)/256)
  85. 850  POKE 109,AD +LN -256 * INT((AD +LN)/256)
  86. 860 NL = 67: DIM A%(52,7),L$(NL),D(5),F$(5),E(1),G$(3),V%(383)
  87. 870  DEF  FN IN(W) = XF > = WS  AND XF < = WS +L1  AND YF > = WS  AND YF < = WS +W1
  88. 880  DEF  FN OT(X) = XF < = WS  OR XF > = WS +L1  OR YF < = WS  OR YF > = WS +W1
  89. 890  DEF  FN HO(U) = A%(U,5) -A%(U,3) <WS +.1: DEF  FN VE(V) = A%(V,4) -A%(V,2) <WS +.1
  90. 900  DEF  FN BB(B) = MX *(B >MX) +B *(B > = 0  AND B < = MX)
  91. 910  DEF  FN BD(D) = MY *(D >MY) +D *(D > = 0  AND D < = MY)
  92. 920  DEF  FN VH(J) = A%(I,J) <WS -ST: DEF  FN RH(J) = A%(I,J) >WS +L1 +ST
  93. 930  DEF  FN BV(J) = A%(I,J) >WS +W1 +ST
  94. 940 M$ = "ARCHITECT.MENU": PRINT D$"OPEN "M$: PRINT D$"READ "M$
  95. 950  FOR I = 0 TO 1:L$(I) = ""
  96. 960  GET C$: IF C$ < >CR$  THEN L$(I) = L$(I) +C$: GOTO 960
  97. 970 X =  FRE(0): NEXT 
  98. 980  FOR I = 2 TO NL: INPUT L$(I): NEXT 
  99. 990  FOR H = 832 TO 880: INPUT X: POKE H,X: NEXT 
  100. 1000  FOR I = 1 TO 2: INPUT X,Y: POKE X,Y: NEXT 
  101. 1010  FOR J = 768 TO 831: INPUT X: POKE J,X: NEXT 
  102. 1020  PRINT D$"CLOSE "M$: SCALE= 1
  103. 1030  ONERR  GOTO 1110
  104. 1040  DIM DF$(42):M$ = "ARCHITECT.DIR": PRINT D$"OPEN "M$: PRINT D$"READ "M$
  105. 1050  INPUT DF$(0):DF =  VAL(DF$(0)): IF DF = 0  THEN 1070
  106. 1060  FOR I = 1 TO DF: INPUT DF$(I): NEXT 
  107. 1070  PRINT D$"CLOSE "M$
  108. 1080  VTAB 1: PRINT L$(3)"*" SPC( 38)"*"L$(4)"*" SPC( 38)"*"L$(5)"*" SPC( 38)"*"L$(3)
  109. 1090  VTAB 8: CALL  -958: PRINT : PRINT L$(0): PRINT : GOSUB 740: PRINT : PRINT L$(16);
  110. 1100  RETURN 
  111. 1110  CALL  -3288: POKE 216,0: PRINT D$"CLOSE":DF = 0: GOSUB 4810: GOTO 1080
  112. 1120  REM  INPUT ANYTHING
  113. 1130  CALL 54572: FOR H = 512 TO 768: IF  PEEK(H) < >0  THEN 1150
  114. 1140 IN$ = "":AD =  VAL(IN$) + PEEK(131) +256 * PEEK(132): POKE AD,H -512: POKE AD +1,0: POKE AD +2,2:IN$ =  MID$ (IN$,1):H = 768
  115. 1150  NEXT : RETURN 
  116. 1160  REM  TEXT
  117. 1170  HOME : POKE  -16303,0: RETURN 
  118. 1180  REM  GRAPHICS
  119. 1190  POKE  -16304,0: RETURN 
  120. 1200  REM  FIXED & MOVING CURSORS
  121. 1210  GOSUB 140: GOSUB 160: RETURN 
  122. 1220  REM  RECTANGLE
  123. 1230 MX = A%(2,4):MY = A%(2,5)
  124. 1240 XL = A%(AI,2):YT = A%(AI,3):XR = A%(AI,4):YB = A%(AI,5)
  125. 1250  IF A%(AI,7) < >0  AND A%(AI,0) = 2  THEN  GOSUB 5080: RETURN 
  126. 1260 XL =  FN BB(XL):XR =  FN BB(XR):YT =  FN BD(YT):YB =  FN BD(YB)
  127. 1270 LX = HS +HR *XL:RX = HS +HR *XR:TY = VS +VR *YT:BY = VS +VR *YB
  128. 1280  IF A%(AI,0) = 3  THEN  GOSUB 5490: RETURN 
  129. 1290  IF A%(AI,0) = 5  THEN T1 = 0:T2 = 359 *PR: GOSUB 510: RETURN 
  130. 1300  HPLOT LX,TY TO RX,TY TO RX,BY TO LX,BY TO LX,TY
  131. 1310  IF A%(AI,0) = 4  THEN  GOSUB 5550
  132. 1320  RETURN 
  133. 1330  REM  GRID SPACING
  134. 1340 XM = 262:YM = 172
  135. 1350 HR = XM/(L1 +2 *WS):VR = YM/(W1 +2 *WS)
  136. 1360  IF VR <AS *HR  THEN HR = VR/AS: GOTO 1380
  137. 1370 VR = AS *HR
  138. 1380 HD = S1 *HR:VD = S1 *VR:XZ = WS *HR:YZ = WS *VR
  139. 1390 XM = HR *(L1 +WS):YM = VR *(W1 +WS)
  140. 1400 X1 = WS -1:X2 = L1 +WS +1:Y1 = WS -1:Y2 = W1 +WS +1: RETURN 
  141. 1410  REM  GRID LAYOUT
  142. 1420  IF YZ +VD >YM -1  THEN 1460
  143. 1430  FOR I = VS +YZ +VD TO VS +YM -1  STEP VD
  144. 1440  FOR J = HS +XZ +HS TO HS +XM -1  STEP HS
  145. 1450  HPLOT J,I: NEXT : NEXT 
  146. 1460  IF XZ +HD >XM -1  THEN  RETURN 
  147. 1470  FOR I = HS +XZ +HD TO HS +XM -1  STEP HD
  148. 1480  FOR J = VS +YZ +VS TO VS +YM -1  STEP VS
  149. 1490  HPLOT I,J: NEXT : NEXT : RETURN 
  150. 1500  REM  A...ALTER
  151. 1510  IF L = 0  OR A%(0,1) = 2  THEN  RETURN 
  152. 1520 A = 1:ST$ = "A": GOSUB 460: FOR AI = 3 TO A%(0,1):OB = A%(AI,0)
  153. 1530  IF A%(AI,1) = 0  THEN 1720
  154. 1540  GOSUB 3070
  155. 1550  GOSUB 180
  156. 1560  IF FL = 1  THEN MV = 1: GOSUB 140: GOTO 1550
  157. 1570  IF CA = 65  THEN 1630
  158. 1580  IF CA = 71  THEN  GOSUB 2420
  159. 1590  IF CA = 70  THEN  GOSUB 2400
  160. 1600  IF CA = 60  THEN  GOSUB 6130
  161. 1610  IF CA = 62  THEN  GOSUB 6160
  162. 1620  GOTO 1550
  163. 1630  IF MV = 0  THEN  GOSUB 3070: GOTO 1720
  164. 1640  IF  FN OT(XF) = 0  AND (OB = 3  OR OB = 4)  THEN 1550
  165. 1650 A = 2: GOSUB 1200: HCOLOR= 0:CR = 3:CL = 0: GOSUB 4330: HCOLOR= 3:CR = 0:CL = 3
  166. 1660  IF OB = 2  THEN  GOSUB 1730
  167. 1670  IF OB = 3  THEN  GOSUB 5450
  168. 1680  IF OB = 4  AND A%(AI,6) = 0  AND A%(AI,7) = 0  THEN  GOSUB 5530: GOTO 1710
  169. 1690  IF OB = 4  THEN  GOSUB 2050
  170. 1700  IF OB = 5  THEN  GOSUB 5750
  171. 1710 A = 0: GOSUB 3070:A = 1
  172. 1720  NEXT :A = 0: GOSUB 490: RETURN 
  173. 1730  REM  B...BOX
  174. 1740  IF MV = 0  THEN  RETURN 
  175. 1750  IF A = 0  THEN ST$ = "B": GOSUB 1820:A%(AI,0) = 2
  176. 1760 A%(AI,2) = XC:A%(AI,4) = XF
  177. 1770  IF XC >XF  THEN A%(AI,2) = XF:A%(AI,4) = XC
  178. 1780 A%(AI,3) = YC:A%(AI,5) = YF
  179. 1790  IF YC >YF  THEN A%(AI,3) = YF:A%(AI,5) = YC
  180. 1800  IF A = 0  THEN A%(AI,6) = 1:A%(AI,7) = 0
  181. 1810  GOSUB 1220: GOSUB 1860: RETURN 
  182. 1820  REM  ADD
  183. 1830  IF C = 0  THEN  GOSUB 460: GOSUB 1200
  184. 1840 AI = A%(0,1) +1: IF AI >52  THEN  GOSUB 1160: VTAB 12: HTAB 10: FLASH : PRINT " "L$(42);: NORMAL :DL = 3000: GOSUB 2380: GOSUB 1180: GOSUB 490:C = 0: GOSUB 1200: POP : RETURN 
  185. 1850 A%(0,1) = AI:A%(AI,1) = 0: RETURN 
  186. 1860  REM  RETURN
  187. 1870 MV = 0: IF A = 0  THEN  GOSUB 490
  188. 1880  GOSUB 1200: RETURN 
  189. 1890  REM  C...COPY
  190. 1900  IF L = 0  OR MV = 0  OR A%(0,1) = 2  THEN  RETURN 
  191. 1910 C = 1:ST$ = "C": GOSUB 460: GOSUB 1200:XH = XC -XF:YH = YC -YF
  192. 1920  FOR AN = 3 TO A%(0,1):OB = A%(AN,0)
  193. 1930  IF A%(AN,1) = 0  THEN 2040
  194. 1940  IF (OB = 3  OR OB = 4)  AND  FN OT(XF) = 0  THEN 2040
  195. 1950  IF (OB = 2  OR OB = 5)  AND  FN IN(XF) = 0  THEN 2040
  196. 1960 XE = XH:YE = YH
  197. 1970  IF (OB = 3  OR OB = 4)  AND  FN HO(AN)  THEN YE = 0: IF YF >WS  AND YF <WS +W1  THEN 2040
  198. 1980  IF (OB = 3  OR OB = 4)  AND  FN VE(AN)  THEN XE = 0: IF XF >WS  AND XF <WS +L1  THEN 2040
  199. 1990  GOSUB 1820:A%(AI,0) = A%(AN,0)
  200. 2000 A%(AI,2) = A%(AN,2) +XE:A%(AI,3) = A%(AN,3) +YE
  201. 2010 A%(AI,4) = A%(AN,4) +XE:A%(AI,5) = A%(AN,5) +YE
  202. 2020 A%(AI,6) = A%(AN,6):A%(AI,7) = A%(AN,7)
  203. 2030  GOSUB 4330
  204. 2040  NEXT :C = 0: GOSUB 1860: RETURN 
  205. 2050  REM  D...DOOR
  206. 2060  IF  FN OT(XF) = 0  OR MV = 0  THEN  RETURN 
  207. 2070 ST$ = "D": IF F = 1  THEN ST$ = "X"
  208. 2080  IF A = 0  THEN  GOSUB 1820:A%(AI,0) = 4
  209. 2090 A6 = 0:A7 = 0: GOSUB 2120
  210. 2100  IF F = 1  THEN A%(AI,6) = 0:A%(AI,7) = 0
  211. 2110  GOSUB 1220: GOSUB 1860: RETURN 
  212. 2120  REM  POSITION
  213. 2130  IF XF < = WS  AND YF <YC  THEN A2 = 0:A4 = WS:A3 = YF:A5 = YC:A7 = 1
  214. 2140  IF XF > = WS +L1  AND YF <YC  THEN A2 = WS +L1:A4 = 2 *WS +L1:A3 = YF:A5 = YC:A7 = 2
  215. 2150  IF XF < = WS  AND YF >YC  THEN A2 = 0:A4 = WS:A3 = YC:A5 = YF:A7 = 4
  216. 2160  IF XF > = WS +L1  AND YF >YC  THEN A2 = WS +L1:A4 = 2 *WS +L1:A3 = YC:A5 = YF:A7 = 3
  217. 2170  IF YF < = WS  AND XF <XC  THEN A2 = XF:A4 = XC:A3 = 0:A5 = WS:A6 = 1
  218. 2180  IF YF > = WS +W1  AND XF <XC  THEN A2 = XF:A4 = XC:A3 = WS +W1:A5 = 2 *WS +W1:A6 = 4
  219. 2190  IF YF < = WS  AND XF >XC  THEN A2 = XC:A4 = XF:A3 = 0:A5 = WS:A6 = 2
  220. 2200  IF YF > = WS +W1  AND XF >XC  THEN A2 = XC:A4 = XF:A3 = WS +W1:A5 = 2 *WS +W1:A6 = 3
  221. 2210 A%(AI,2) = A2:A%(AI,3) = A3:A%(AI,4) = A4:A%(AI,5) = A5:A%(AI,6) = A6:A%(AI,7) = A7: RETURN 
  222. 2220  REM  ARC
  223. 2230 CQ = CI *2 -1
  224. 2240  HPLOT HS +XG *HR,VS +YG *VR TO HS +(XG +D * COS(CQ *P4)) *HR,VS +(YG +D * SIN(CQ *P4)) *VR
  225. 2250 AG = 10 *PR:WA = WS:WB = WS: GOSUB 590: RETURN 
  226. 2260  REM  E...ERASE
  227. 2270  IF L = 0  OR A%(0,1) = 2  THEN  RETURN 
  228. 2280 ST$ = "E": GOSUB 460: GOSUB 1200: HCOLOR= 0:CR = 3:CL = 0:E = 1: GOSUB 2320
  229. 2290 DL = 1000: GOSUB 2380: GOSUB 1160: VTAB 12: HTAB 13: PRINT L$(34);
  230. 2300  GET C$: IF C$ = "Y"  THEN E = 0:L = 0
  231. 2310  HCOLOR= 3:CR = 0:CL = 3: GOSUB 1180: GOSUB 2320: GOSUB 490: GOSUB 1200: RETURN 
  232. 2320  REM  ERASING
  233. 2330  FOR AI = 3 TO A%(0,1)
  234. 2340  IF A%(AI,1) = 0  THEN 2370
  235. 2350 A%(AI,0) = E *A%(AI,0):A%(AI,1) = E *A%(AI,1)
  236. 2360  IF E = 1  THEN  GOSUB 4330
  237. 2370  NEXT : RETURN 
  238. 2380  REM  DELAY
  239. 2390  FOR I = 1 TO DL: NEXT : RETURN 
  240. 2400  REM  F...FIX
  241. 2410  GOSUB 160:XF = XC:YF = YC: GOSUB 160:MV = 0: RETURN 
  242. 2420  REM  G...GET DATA
  243. 2430  GOSUB 1160
  244. 2440  INVERSE : HTAB 5: PRINT L$(19): NORMAL : VTAB 4: PRINT L$(1): PRINT L$(2): VTAB 9: PRINT L$(17)
  245. 2450  INVERSE : VTAB 13: HTAB 9: PRINT "V";: HTAB 15: PRINT L$(37)
  246. 2460  HTAB 9: PRINT "E";: HTAB 12: PRINT "D": HTAB 9: PRINT "R";: HTAB 13: PRINT "I"
  247. 2470  HTAB 9: PRINT "T";: HTAB 14: PRINT "A": HTAB 9: PRINT "I";: HTAB 15: PRINT "G"
  248. 2480  HTAB 9: PRINT "C";: HTAB 16: PRINT "O": HTAB 9: PRINT "A";: HTAB 17: PRINT "N"
  249. 2490  HTAB 9: PRINT "L";: HTAB 18: PRINT "A": HTAB 19: PRINT "L": NORMAL 
  250. 2500  GOSUB 2570
  251. 2510  GOSUB 180: GOSUB 2570
  252. 2520  IF FL = 1  THEN MV = 1: GOSUB 140: GOTO 2510
  253. 2530  IF CA = 32  THEN  GOSUB 1180: RETURN 
  254. 2540  IF CA = 60  THEN  GOSUB 6130
  255. 2550  IF CA = 62  THEN  GOSUB 6160
  256. 2560  GOTO 2510
  257. 2570  REM  DISTANCES
  258. 2580 XD = XC -XF:YD = YC -YF
  259. 2590  IF FH = 1  THEN  FLASH 
  260. 2600 DD =  ABS(XD):VT = 13:HT = 26: GOSUB 2650
  261. 2610  IF FV = 1  THEN  FLASH 
  262. 2620 DD =  ABS(YD):VT = 22:HT = 7: GOSUB 2650
  263. 2630 DD =  INT( SQR(XD *XD +YD *YD)):VT = 22:HT = 21: GOSUB 2650
  264. 2640  VTAB 9: HTAB 34: RETURN 
  265. 2650  REM  COUNTERS
  266. 2660  VTAB VT: HTAB HT: PRINT  SPC( 4);: HTAB HT: PRINT DD;Q$
  267. 2670 FT =  INT(DD/12):IN = DD -FT *12
  268. 2680  HTAB HT: PRINT  SPC( 8);: HTAB HT: PRINT "("FT"'"IN;Q$")";: NORMAL : RETURN 
  269. 2690  REM  H...HARDCOPY
  270. 2700  GOSUB 1160: HTAB 13: INVERSE : PRINT L$(44): NORMAL : VTAB 4: HTAB 3: PRINT L$(46): PRINT : HTAB 3: PRINT L$(47): PRINT : HTAB 3: PRINT L$(67)
  271. 2710  VTAB 11: HTAB 10: PRINT L$(35): PRINT : HTAB 3: PRINT L$(17);
  272. 2720  GET C$: IF C$ = " "  THEN  GOSUB 1180: RETURN 
  273. 2730  IF C$ = "1"  THEN N% = 1: GOTO 2770
  274. 2740  IF C$ = "2"  THEN N% = 2: GOTO 2770
  275. 2750  IF C$ = "3"  THEN 2870
  276. 2760  GOTO 2720
  277. 2770  VTAB 4: HTAB 3: CALL  -958: PRINT L$(39):H = 8:I2 = 58:J = 6:K = 40: GOSUB 2970
  278. 2780  VTAB 11: HTAB 3: PRINT L$(48);:DL = 1500: GOSUB 2380: IF C$ = "R"  THEN  CALL 62450: GOSUB 1180: GOSUB 4260
  279. 2790  GOSUB 1180: PRINT : PRINT D$"PR#1": FOR I = 1 TO 3 *N%: PRINT : NEXT : PRINT E$"1":TM = 5 +20/(N% *N%)
  280. 2800  FOR BY = 39 TO 0  STEP  -1: PRINT CR$;: POKE 36,TM:K =  -1: FOR TR = 0 TO 80  STEP 40: FOR OC = 0 TO 896  STEP 128: FOR FL = 0 TO 7168  STEP 1024:K = K +1
  281. 2810 V%(K) =  PEEK(SA +TR +OC +FL +BY): IF N% = 2  THEN  POKE 768,V%(K): CALL 771:V%(K) =  PEEK(769):V%(K +192) =  PEEK(770)
  282. 2820  NEXT : NEXT : NEXT : FOR H = 0 TO N% *192 -1  STEP 192: IF H = 192  THEN  PRINT CR$;: POKE 36,TM
  283. 2830  FOR I = H TO H +191  STEP 96/N%: PRINT E$"K" CHR$(96) CHR$(0);: FOR J = I TO I -1 +96/N%: FOR I2 = 1 TO N%: POKE 49296,V%(J)
  284. 2840  IF  PEEK(49601) <0  THEN 2840
  285. 2850  NEXT : NEXT :KC =  PEEK( -16384): IF KC = 160  THEN  POKE  -16368,0: PRINT E$"2": PRINT D$"PR#0": GOTO 2700
  286. 2860  NEXT : NEXT : NEXT : PRINT E$"2": PRINT D$"PR#0": RETURN 
  287. 2870  VTAB 4: HTAB 3: CALL  -958: PRINT L$(32)": ";: GOSUB 1120:F$ = IN$: GOSUB 4860: VTAB 4: HTAB 20: PRINT F$;: CALL  -868
  288. 2880  ONERR  GOTO 2950
  289. 2890 H = 7:I2 = 41:J = 9:K = 40: GOSUB 2970:VI = 66:VJ = 1
  290. 2900  PRINT D$: PRINT D$"BSAVE PIC."F$",A$2000,L$2000"
  291. 2910  VTAB 4: CALL  -958
  292. 2920 I2 = 60:K = 17: GOSUB 2970:VI = 65:VJ = 2: IF C$ < >" "  THEN 2920
  293. 2930  PRINT D$: PRINT D$"VERIFY ARCHITECT.DIR"
  294. 2940  GOSUB 1180: RETURN 
  295. 2950  CALL  -3288: VTAB 4: CALL  -958: HTAB 15: FLASH : PRINT " "L$(VI);: NORMAL :DL = 3000: GOSUB 2380
  296. 2960  HTAB 15: INVERSE : PRINT " "L$(VI);: NORMAL : ON VJ GOTO 2890,2920
  297. 2970  REM  PROMPTS
  298. 2980  VTAB H: HTAB 3: PRINT L$(I2): VTAB J: HTAB 3: PRINT L$(K);: GET C$: RETURN 
  299. 2990  REM  I,J,K,M
  300. 3000  GOSUB 140:DL = 100: GOSUB 2380: GOSUB 140: RETURN 
  301. 3010  REM  L...LATCH
  302. 3020  IF A%(0,1) = 2  THEN  RETURN 
  303. 3030 ST$ = "L": GOSUB 460: FOR AI = 3 TO A%(0,1)
  304. 3040  IF XC <A%(AI,2)  OR YC <A%(AI,3)  OR XC >A%(AI,4)  OR YC >A%(AI,5)  OR A%(AI,0) = 0  OR A%(AI,1) = 1  THEN 3060
  305. 3050 A%(AI,1) = 1: GOSUB 3070
  306. 3060  NEXT : GOSUB 490:L = 1: RETURN 
  307. 3070  REM  LATCHED
  308. 3080 XS = P5 *(A%(AI,2) +A%(AI,4)):YS = P5 *(A%(AI,3) +A%(AI,5))
  309. 3090  GOSUB 3130: IF A = 1  THEN  XDRAW 1 AT HS +HR *XS,VS +VR *YS: GOTO 3120
  310. 3100  IF A = 2  THEN  XDRAW 1 AT HS +HR *XS,VS +VR *YS
  311. 3110  XDRAW 4 AT HS +HR *XS,VS +VR *YS
  312. 3120  RETURN 
  313. 3130  REM  LATCH CHECK
  314. 3140  IF XS <X1 -2  THEN XS = X1 -2
  315. 3150  IF XS >X2 +2  THEN XS = X2 +2
  316. 3160  IF YS <Y1 -2  THEN YS = Y1 -2
  317. 3170  IF YS >Y2 +2  THEN YS = Y2 +2
  318. 3180  RETURN 
  319. 3190  REM  N...NEW
  320. 3200  IF N = 0  THEN TI$ = "":TG = 0: FOR I = 0 TO 5:D(I) = 0:F$(I) = " ": NEXT : GOTO 3250
  321. 3210  GOSUB 1160: VTAB 12: HTAB 13: PRINT L$(34);
  322. 3220  GET C$: IF C$ < >"Y"  AND TG = 1  THEN TG = 0: GOSUB 3610: RETURN 
  323. 3230  IF C$ < >"Y"  THEN  GOSUB 1180: RETURN 
  324. 3240  HTAB 12: FLASH : PRINT " "L$(43);: NORMAL :DL = 1000: GOSUB 2380:II = A%(0,1): FOR I = 0 TO II: FOR J = 0 TO 1:A%(I,J) = 0: NEXT : NEXT :L = 0
  325. 3250  HOME : VTAB 2: HTAB 7: INVERSE : PRINT L$(26): NORMAL : VTAB 5: HTAB 16: PRINT L$(27): VTAB 7: HTAB 3
  326. 3260  PRINT L$(28): VTAB 9: HTAB 3: PRINT L$(29): VTAB 11: HTAB 3: PRINT L$(30): VTAB 14: HTAB 3: PRINT L$(45)":": VTAB 20: HTAB 10: PRINT L$(31)
  327. 3270  PRINT : HTAB 3: PRINT L$(17);: HTAB 29: PRINT "CORD": GOSUB 3380: GOSUB 3450: GOSUB 3530
  328. 3280  IF L1 <W1  THEN L1 = W1:W1 = Z
  329. 3290 A%(0,0) = 1:A%(0,1) = 2:A%(0,2) = S1
  330. 3300 A%(0,3) = 1:A%(0,4) = L1:A%(0,5) = W1
  331. 3310 A%(1,0) = 2:A%(2,0) = 2:A%(1,1) = 1:A%(2,1) = 0
  332. 3320 A%(1,2) = WS:A%(1,3) = WS
  333. 3330 A%(1,4) = L1 +WS:A%(1,5) = W1 +WS
  334. 3340 A%(2,2) = 0:A%(2,3) = 0
  335. 3350 A%(2,4) = L1 +2 *WS:A%(2,5) = W1 +2 *WS
  336. 3360 A%(0,6) = 0:A%(0,7) = 0:A%(1,6) = 1:A%(1,7) = 0:A%(2,6) = 1:A%(2,7) = 0
  337. 3370  GOSUB 3610: RETURN 
  338. 3380  REM  CHECK
  339. 3390 W1 = D(1) +12 *D(0):L1 = D(3) +12 *D(2):S1 = D(5) +12 *D(4):Z = L1
  340. 3400 FM = 1: IF W1 = 0  OR L1 = 0  OR S1 = 0  THEN FM = 0
  341. 3410  RETURN 
  342. 3420  REM  CONVERT
  343. 3430 FT =  INT(D(K +1)/12):D(K) = D(K) +FT:D(K +1) = D(K +1) -12 *FT
  344. 3440 F$(K) =  STR$(D(K)):F$(K +1) =  STR$(D(K +1)): RETURN 
  345. 3450  REM  DIMENSIONS
  346. 3460  FOR J = 0 TO 2:K = 2 *J
  347. 3470  IF F$(K) = "--"  OR F$(K +1) = "--"  THEN 3500
  348. 3480  GOSUB 3420
  349. 3490  IF D(K) >99  THEN F$(K) = "**":F$(K +1) = "**":FM = 0:D(K) = 0:D(K +1) = 0
  350. 3500  VTAB 7 +K: HTAB 18: PRINT  RIGHT$(" " +F$(K),2);
  351. 3510  HTAB 28: PRINT  RIGHT$(" " +F$(K +1),2);: IF G = 1  THEN  RETURN 
  352. 3520  NEXT : VTAB 14: HTAB 13: PRINT TI$: VTAB 22: HTAB 36: RETURN 
  353. 3530  REM  MODIFY
  354. 3540  GET C$: IF C$ = " "  AND FM = 1  THEN  RETURN 
  355. 3550  IF C$ = " "  THEN  CALL 64477
  356. 3560 CS =  ASC(C$) -65: IF CS <0  OR CS >6  THEN 3540
  357. 3570  IF CS = 6  THEN  GOSUB 6110: GOTO 3540
  358. 3580 F$(CS) = "--": GOSUB 3450: VTAB 17: HTAB 3: PRINT L$(33)": ";
  359. 3590  GOSUB 1120: VTAB 17: CALL  -868
  360. 3600 D(CS) =  ABS( VAL(IN$)):F$(CS) = " ": GOSUB 3380: GOSUB 3450: GOTO 3540
  361. 3610  REM  OUTLINE
  362. 3620 MV = 0:FH = 0:FV = 0:FL = 0:ST = 2:N = 1: GOSUB 1330
  363. 3630 XC = P5 *(X1 +X2):YC = P5 *(Y1 +Y2):XF = XC:YF = YC
  364. 3640  HCOLOR= 3: POKE 230,32: CALL 62450: POKE  -16297,0: POKE  -16302,0: POKE  -16304,0: GOSUB 4260: RETURN 
  365. 3650  REM  CLEAR
  366. 3660  VTAB 22: HTAB 1: CALL  -868: VTAB 21: CALL  -868: RETURN 
  367. 3670  REM  FILES
  368. 3680  POKE 34,5: POKE 35,20: VTAB 6: HTAB 1: FOR I = 1 TO DF  STEP 3: FOR J = I TO I +2: IF J >DF  THEN 3730
  369. 3690  PRINT " ";: IF J = TI  THEN  INVERSE 
  370. 3700  IF J = TF  THEN  FLASH 
  371. 3710  PRINT  RIGHT$(" " + STR$(J) +" ",3) LEFT$(DF$(J) +"         ",9);: NORMAL : REM  9 SPACES
  372. 3720  NEXT : PRINT " ";: NEXT 
  373. 3730  POKE 34,0: POKE 35,24: VTAB 24: HTAB 36 +(N = 0) *2: RETURN 
  374. 3740  REM  PROMPT
  375. 3750  IF DF = 0  THEN K = 63: GOSUB 3950
  376. 3760  GOSUB 3650: HTAB 3: PRINT L$(33)": "S$;: GOSUB 1120:TF =  VAL(IN$)
  377. 3770  IF TF <1  OR TF >DF  THEN K = 59: GOSUB 3950
  378. 3780  GOSUB 3670: IF C$ < >"D"  AND C$ < >"R"  THEN  RETURN 
  379. 3790  VTAB 22: HTAB 13: INVERSE : PRINT L$(34);: NORMAL : GET B$
  380. 3800  IF B$ < >"Y"  THEN  POP : GOTO 4640
  381. 3810  IF C$ = "R"  OR C$ = "Q"  THEN  RETURN 
  382. 3820 M$ = "A." +DF$(TF): PRINT D$: PRINT D$"DELETE "M$: RETURN 
  383. 3830  REM  PROMPT2
  384. 3840  GOSUB 3650: IF N = 0  AND TG = 0  THEN K = 62: GOSUB 3950
  385. 3850  IF C$ = "S"  THEN 3900
  386. 3860  IF TI = 0  THEN 3740
  387. 3870 TF = TI: GOSUB 3650: GOSUB 3670: VTAB 21: HTAB 3: PRINT L$(33)": "S$TI: HTAB 13: INVERSE : PRINT L$(34);: NORMAL : GET B$
  388. 3880  IF B$ < >"Y"  THEN  POP : GOTO 4640
  389. 3890  RETURN 
  390. 3900  GOSUB 3650: VTAB 21: HTAB 3: PRINT L$(57)": "S$;: GOSUB 1120:F$ =  LEFT$(IN$,9): GOSUB 4860: VTAB 21: HTAB 20: PRINT F$;: CALL  -868: PRINT 
  391. 3910  IF TM < >0  THEN  HTAB 3: INVERSE : PRINT L$(64);: NORMAL : GET B$: IF B$ = "Y"  THEN TF = TM: GOSUB 3670: RETURN 
  392. 3920  IF TM < >0  THEN  POP : GOTO 4640
  393. 3930  IF DF = 42  THEN K = 61: GOSUB 3950
  394. 3940 DF = DF +1:DF$(DF) = F$:TF = DF: GOSUB 3670: RETURN 
  395. 3950  REM  MESSAGES
  396. 3960  IF K = 66  THEN  PRINT D$: PRINT D$"CLOSE"
  397. 3970  VTAB 22: HTAB 1: CALL  -868:HT =  INT((39 - LEN(L$(K)))/2): HTAB HT: INVERSE : PRINT L$(K);: NORMAL :TF = 0: GOSUB 3670
  398. 3980  POP : POP : GOTO 4530
  399. 3990  REM  DELETE
  400. 4000  IF TF = DF  THEN 4020
  401. 4010  FOR I = TF TO DF -1:DF$(I) = DF$(I +1): NEXT 
  402. 4020  IF TI = TF  THEN TI = 0
  403. 4030  IF TI >TF  THEN TI = TI -1
  404. 4040 DF = DF -1: RETURN 
  405. 4050  REM  P...PLACE
  406. 4060  IF L = 0  OR MV = 0  OR A%(0,1) = 2  THEN  RETURN 
  407. 4070 ST$ = "P": GOSUB 460: GOSUB 1200:XH = XC -XF:YH = YC -YF
  408. 4080  FOR AI = 3 TO A%(0,1):OB = A%(AI,0)
  409. 4090  IF A%(AI,1) = 0  THEN 4190
  410. 4100  IF (OB = 3  OR OB = 4)  AND  FN OT(XF) = 0  THEN 4190
  411. 4110  IF (OB = 2  OR OB = 5)  AND  FN IN(XF) = 0  THEN 4190
  412. 4120 XE = XH:YE = YH
  413. 4130  IF (OB = 3  OR OB = 4)  AND  FN HO(AI)  THEN YE = 0: IF YF >WS  AND YF <WS +W1  THEN 4190
  414. 4140  IF (OB = 3  OR OB = 4)  AND  FN VE(AI)  THEN XE = 0: IF XF >WS  AND XF <WS +L1  THEN 4190
  415. 4150  HCOLOR= 0:CR = 3:CL = 0: GOSUB 4330
  416. 4160 A%(AI,2) = A%(AI,2) +XE:A%(AI,3) = A%(AI,3) +YE
  417. 4170 A%(AI,4) = A%(AI,4) +XE:A%(AI,5) = A%(AI,5) +YE
  418. 4180  HCOLOR= 3:CR = 0:CL = 3: GOSUB 4330
  419. 4190  NEXT :XF = XC:YF = YC: GOSUB 1860: RETURN 
  420. 4200  REM  Q...QUIT
  421. 4210  GOSUB 1160: VTAB 12: HTAB 13: PRINT L$(34);
  422. 4220  GET C$: IF C$ = "Y"  THEN  POKE 106,8: POKE 105,0: HOME : END 
  423. 4230  GOSUB 1180: RETURN 
  424. 4240  REM  R...REDRAW
  425. 4250  CALL 62450: GOSUB 1160: VTAB 12: HTAB 10: FLASH : PRINT " "L$(50);: NORMAL :DL = 1000: GOSUB 2380: GOSUB 4370: GOSUB 1180
  426. 4260  IF A%(0,3) = 1  THEN  GOSUB 1410
  427. 4270  FOR AI = 1 TO A%(0,1)
  428. 4280  GOSUB 4330: NEXT : IF A%(1,1) = 0  THEN 4310
  429. 4290 IV = 0:VL = 1:VT = 1:HT = 40:ST$ = L$(49): GOSUB 640
  430. 4300 VL = 0:VT = 24: IF TI$ < >""  THEN HT = 1 + INT((35 - LEN(TI$))/2):ST$ = TI$: GOSUB 640
  431. 4310  GOSUB 490
  432. 4320  GOSUB 1200: RETURN 
  433. 4330  REM  DRAW OBJECTS
  434. 4340  IF A%(AI,0) > = 2  AND A%(AI,0) < = 5  THEN  GOSUB 1220
  435. 4350  IF AI >2  AND A%(AI,1) = 1  THEN  GOSUB 3070
  436. 4360  RETURN 
  437. 4370  REM  HOUSKEEPING
  438. 4380 X =  FRE(0)
  439. 4390 AN = A%(0,1):AI = 2: IF AN = 2  THEN  RETURN 
  440. 4400  FOR I = 3 TO AN
  441. 4410  IF A%(I,0) = 0  THEN 4460
  442. 4420  IF A%(I,1) = 0  AND ( FN VH(2) * FN VH(4)  OR  FN RH(2) * FN RH(4)  OR  FN VH(3) * FN VH(5)  OR  FN BV(3) * FN BV(5))  THEN 4460
  443. 4430 AI = AI +1: IF AI = I  THEN 4460
  444. 4440  FOR J = 0 TO 7
  445. 4450 A%(AI,J) = A%(I,J): NEXT 
  446. 4460  NEXT :A%(0,1) = AI: IF AI = 2  THEN AI = 3
  447. 4470  RETURN 
  448. 4480  REM  S...SAVE
  449. 4490  ONERR  GOTO 4800
  450. 4500  GOSUB 1160: INVERSE : HTAB 12: PRINT L$(54): NORMAL : PRINT : HTAB 3: PRINT L$(55): HTAB 3: PRINT L$(56): VTAB 24: HTAB 3: PRINT L$(17);
  451. 4510  IF N = 0  THEN  HTAB 3: PRINT "PRESS COMMAND KEY OR SPACE BAR...";
  452. 4520  GOSUB 3670
  453. 4530  GET C$
  454. 4540  IF C$ = " "  AND TG = 1  THEN TG = 0: GOSUB 3610: RETURN 
  455. 4550  IF C$ = " "  AND N = 0  THEN CA = 78: POP : GOTO 370
  456. 4560  IF C$ = " "  THEN  GOSUB 1180: RETURN 
  457. 4570  IF C$ = "N"  THEN CA = 78: POP : GOTO 370
  458. 4580  IF C$ = "Q"  THEN  GOSUB 3790: HOME : END 
  459. 4590  IF C$ = "D"  THEN S$ = "DELETE ": GOSUB 3740: GOSUB 3990: GOSUB 4810: POKE 34,5: POKE 35,20: CALL  -936: GOTO 4640
  460. 4600  IF C$ = "G"  THEN S$ = "GET ": GOSUB 3740: GOSUB 4650:TG = 1: GOTO 4640
  461. 4610  IF C$ = "S"  THEN S$ = "SAVE ": GOSUB 3830: GOSUB 4750: GOSUB 4810: GOTO 4640
  462. 4620  IF C$ = "R"  THEN S$ = "REVISE ": GOSUB 3830: GOSUB 4750: GOTO 4640
  463. 4630  GOTO 4530
  464. 4640 X =  FRE(0):TF = 0: GOSUB 3650: GOSUB 3670: GOTO 4530
  465. 4650  REM  GET
  466. 4660 M$ = "A." +DF$(TF): VTAB 22: PRINT D$: PRINT D$"OPEN "M$: PRINT D$"READ "M$
  467. 4670  GOSUB 1120:TI$ =  MID$ (IN$,1)
  468. 4680  FOR I = 0 TO 7: INPUT A%(0,I): NEXT 
  469. 4690  FOR I = 1 TO A%(0,1): FOR J = 0 TO 7: INPUT A%(I,J): NEXT : NEXT 
  470. 4700 W1 = A%(0,5):L1 = A%(0,4):S1 = A%(0,2):TI = TF:D(0) = 0:D(2) = 0:D(4) = 0:D(1) = W1:D(3) = L1:D(5) = S1
  471. 4710  GOSUB 1330: FOR J = 0 TO 2:K = 2 *J: GOSUB 3420: NEXT 
  472. 4720  PRINT D$"CLOSE "M$:L = 0: IF A%(0,1) = 2  THEN  RETURN 
  473. 4730  FOR I = 3 TO A%(0,1): IF A%(I,1) = 1  THEN L = 1: RETURN 
  474. 4740  NEXT : RETURN 
  475. 4750  REM  PUT
  476. 4760 M$ = "A." +DF$(TF): VTAB 22: PRINT D$: PRINT D$"OPEN "M$: PRINT D$"CLOSE": PRINT D$"DELETE "M$
  477. 4770  PRINT D$"OPEN "M$: PRINT D$"WRITE "M$
  478. 4780  PRINT TI$: FOR I = 0 TO A%(0,1): FOR J = 0 TO 7: PRINT A%(I,J): NEXT : NEXT :TI = TF
  479. 4790  PRINT D$"CLOSE "M$: RETURN 
  480. 4800  CALL  -3288:K = 66: GOSUB 3950
  481. 4810  REM  DIRECTORY
  482. 4820 M$ = "ARCHITECT.DIR": PRINT D$"OPEN "M$: PRINT D$"CLOSE": PRINT D$"DELETE "M$
  483. 4830  PRINT D$"OPEN "M$: PRINT D$"WRITE "M$
  484. 4840 DF$(0) =  STR$(DF): FOR I = 0 TO DF: PRINT DF$(I): NEXT 
  485. 4850  PRINT D$"CLOSE "M$: RETURN 
  486. 4860  REM  MATCH
  487. 4870  IF  RIGHT$(F$,1) = " "  THEN F$ =  MID$ (F$,1, LEN(F$) -1): GOTO 4870
  488. 4880 Z$ = "": FOR I = 1 TO  LEN(F$):T$ =  MID$ (F$,I,1): IF T$ < >","  AND T$ < >":"  THEN Z$ = Z$ +T$
  489. 4890  NEXT :F$ = Z$
  490. 4900 TM = 0: FOR I = 1 TO DF: IF F$ = DF$(I)  THEN TM = I:I = DF
  491. 4910  NEXT : RETURN 
  492. 4920  REM  T...TURN
  493. 4930  IF L = 0  OR  FN IN(XF) = 0  OR A%(0,1) = 2  THEN  RETURN 
  494. 4940 ST$ = "T": GOSUB 460: GOSUB 1200:XD = XC -XF:YD = YC -YF:XE = XF:YE = YF
  495. 4950  FOR AI = 3 TO A%(0,1):OB = A%(AI,0)
  496. 4960  IF A%(AI,1) = 0  OR OB = 3  OR OB = 4  OR (OB = 5  AND (XD < >0  OR YD < >0))  THEN 5070
  497. 4970  HCOLOR= 0: GOSUB 4330: IF XD = 0  AND YD = 0  THEN 5000
  498. 4980 A%(AI,6) = XD:A%(AI,7) = YD: IF XD = 0  THEN XE = P5 *(A%(AI,2) +A%(AI,4)):YE = P5 *(A%(AI,3) +A%(AI,5)):A%(AI,6) = 1:A%(AI,7) = 0: GOTO 5000
  499. 4990  GOTO 5060
  500. 5000 XL = XE -YE +A%(AI,3):YT = YE +XE -A%(AI,2)
  501. 5010 XR = XE -YE +A%(AI,5):YB = YE +XE -A%(AI,4)
  502. 5020 A%(AI,2) = XL:A%(AI,4) = XR
  503. 5030  IF XL >XR  THEN A%(AI,2) = XR:A%(AI,4) = XL
  504. 5040 A%(AI,3) = YT:A%(AI,5) = YB
  505. 5050  IF YT >YB  THEN A%(AI,3) = YB:A%(AI,5) = YT
  506. 5060  HCOLOR= 3: GOSUB 4330
  507. 5070  NEXT : GOSUB 490: GOSUB 1200: RETURN 
  508. 5080  REM  ROTATE RECTANGLE
  509. 5090 XN = P5 *(XL +XR):YX = P5 *(YT +YB):CX = A%(AI,6):SI = A%(AI,7)
  510. 5100 DD =  SQR(CX *CX +SI *SI):CX = CX/DD:SI = SI/DD
  511. 5110 XX = P5 *(XR -XL):YY = P5 *(YT -YB)
  512. 5120 XA = XN +XX *CX -YY *SI:YA = YX +XX *SI +YY *CX
  513. 5130 XB = XN +XX *CX +YY *SI:YB = YX +XX *SI -YY *CX
  514. 5140 XU = XN -XX *CX +YY *SI:YU = YX -XX *SI -YY *CX
  515. 5150 XV = XN -XX *CX -YY *SI:YV = YX -XX *SI +YY *CX
  516. 5160 XA =  FN BB(XA):XB =  FN BB(XB):XU =  FN BB(XU):XV =  FN BB(XV)
  517. 5170 YA =  FN BD(YA):YB =  FN BD(YB):YU =  FN BD(YU):YV =  FN BD(YV)
  518. 5180 XA = HS +HR *XA:XB = HS +HR *XB:XU = HS +HR *XU:XV = HS +HR *XV:YA = VS +VR *YA:YB = VS +VR *YB:YU = VS +VR *YU:YV = VS +VR *YV
  519. 5190  HPLOT XA,YA TO XB,YB TO XU,YU TO XV,YV TO XA,YA: RETURN 
  520. 5200  REM  U...UNLATCH
  521. 5210  IF A%(0,1) = 2  THEN  RETURN 
  522. 5220 ST$ = "U": GOSUB 460: FOR AI = 3 TO A%(0,1)
  523. 5230  IF A%(AI,1) = 1  THEN  GOSUB 5250:A%(AI,1) = 0
  524. 5240  NEXT : GOSUB 490:L = 0: RETURN 
  525. 5250  REM  UNLATCHED
  526. 5260 XS = P5 *(A%(AI,2) +A%(AI,4)):YS = P5 *(A%(AI,3) +A%(AI,5))
  527. 5270  GOSUB 3130: XDRAW 4 AT HS +HR *XS,VS +VR *YS: RETURN 
  528. 5280  REM  V...VERIFY
  529. 5290  GOSUB 1160: INVERSE : HTAB 10: PRINT L$(25)
  530. 5300  VTAB 3: HTAB 4: PRINT L$(36);: HTAB 14: PRINT L$(37);: HTAB 28: PRINT L$(38): NORMAL 
  531. 5310 VT = 5:VI = 20: VTAB VT: HTAB 4: PRINT L$(VI)
  532. 5320 HT = 14:DD = L1: GOSUB 2650
  533. 5330 HT = 28:DD = W1: GOSUB 2650
  534. 5340  IF L = 0  THEN 5420
  535. 5350 VJ = 1: FOR I = 3 TO A%(0,1)
  536. 5360  IF A%(I,1) = 0  THEN 5410
  537. 5370 VT = VT +3:VI = A%(I,0) +19: VTAB VT: HTAB 4: PRINT L$(VI)
  538. 5380 DD = A%(I,4) -A%(I,2):HT = 14: GOSUB 2650
  539. 5390 DD = A%(I,5) -A%(I,3):HT = 28: GOSUB 2650
  540. 5400 VJ = VJ +1: IF VJ >5  THEN 5420
  541. 5410  NEXT 
  542. 5420  VTAB 24: HTAB 3: PRINT L$(17);
  543. 5430  GET C$: IF C$ = " "  THEN  GOSUB 1180: RETURN 
  544. 5440  GOTO 5430
  545. 5450  REM  W...WINDOW
  546. 5460  IF  FN OT(XF) = 0  OR MV = 0  THEN  RETURN 
  547. 5470  IF A = 0  THEN ST$ = "W": GOSUB 1820:A%(AI,0) = 3
  548. 5480 A6 = 0:A7 = 0: GOSUB 2120: GOSUB 1220: GOSUB 1860: RETURN 
  549. 5490  REM  BAR
  550. 5500  IF A%(AI,6) < >0  THEN  HPLOT LX,TY TO LX,BY: HPLOT RX,TY TO RX,BY:TY = P5 *(TY +BY):BY = TY
  551. 5510  IF A%(AI,7) < >0  THEN  HPLOT LX,TY TO RX,TY: HPLOT LX,BY TO RX,BY:LX = P5 *(LX +RX):RX = LX
  552. 5520  HPLOT LX,TY TO RX,BY: RETURN 
  553. 5530  REM  X...EXIT W/O DOOR
  554. 5540 F = 1: GOSUB 2050:F = 0: RETURN 
  555. 5550  REM  DOORWAY
  556. 5560  HCOLOR= CR:MX = 262:MY = 172
  557. 5570  IF  FN HO(AI)  THEN LX = LX +1:LX =  FN BB(LX):RX = RX -1:RX =  FN BB(RX): HPLOT LX,TY TO RX,TY: HPLOT LX,BY TO RX,BY
  558. 5580  IF  FN VE(AI)  THEN TY = TY +1:TY =  FN BD(TY):BY = BY -1:BY =  FN BD(BY): HPLOT LX,TY TO LX,BY: HPLOT RX,TY TO RX,BY
  559. 5590  HCOLOR= CL
  560. 5600  IF A%(AI,6) = 0  THEN 5670
  561. 5610 D = XR -XL:CI = A%(AI,6):T1 = 180 *PR:T2 = 360 *PR
  562. 5620  IF CI = 1  THEN XG = XL:YG = YB: GOSUB 2220
  563. 5630  IF CI = 2  THEN XG = XR:YG = YB: GOSUB 2220
  564. 5640 T2 = T1:T1 = 0
  565. 5650  IF CI = 3  THEN XG = XR:YG = YT: GOSUB 2220
  566. 5660  IF CI = 4  THEN XG = XL:YG = YT: GOSUB 2220
  567. 5670  IF A%(AI,7) = 0  THEN  RETURN 
  568. 5680 D = YB -YT:CI = A%(AI,7):T1 =  -90 *PR:T2 = 90 *PR
  569. 5690  IF CI = 1  THEN XG = XR:YG = YT: GOSUB 2220
  570. 5700  IF CI = 4  THEN XG = XR:YG = YB: GOSUB 2220
  571. 5710 T1 = T2:T2 = 270 *PR
  572. 5720  IF CI = 2  THEN XG = XL:YG = YT: GOSUB 2220
  573. 5730  IF CI = 3  THEN XG = XL:YG = YB: GOSUB 2220
  574. 5740  RETURN 
  575. 5750  REM  *...CIRCLE
  576. 5760  IF MV = 0  THEN  RETURN 
  577. 5770  IF A = 0  THEN ST$ = "*": GOSUB 1820:A%(AI,0) = 5
  578. 5780 XD = XC -XF:YD = YC -YF:D =  INT( SQR(XD *XD +YD *YD))
  579. 5790 A%(AI,2) = XF -D:A%(AI,4) = XF +D
  580. 5800 A%(AI,3) = YF -D:A%(AI,5) = YF +D
  581. 5810 A%(AI,6) = 0:A%(AI,7) = 0
  582. 5820  GOSUB 1220: GOSUB 1860: RETURN 
  583. 5830  REM  #...GRID & TITLE
  584. 5840 G$(0) = "ON":G$(1) = "OFF":G$(2) = "ON":G$(3) = "OFF":FM = 0:G = 1:E(0) = A%(0,3):E(1) = A%(1,1)
  585. 5850  GOSUB 1160: HTAB 11: INVERSE : PRINT L$(51): NORMAL : VTAB 4: HTAB 3: PRINT L$(52): PRINT : HTAB 3: PRINT L$(53)
  586. 5860  VTAB 9: HTAB 16: PRINT L$(27): PRINT : HTAB 3: PRINT L$(30): VTAB 14: HTAB 3: PRINT L$(45)":": VTAB 20: HTAB 10: PRINT L$(31): PRINT : HTAB 3: PRINT L$(17)
  587. 5870  GOSUB 6020
  588. 5880  GET C$: IF C$ = " "  AND FM = 0  THEN  GOSUB 1180:G = 0: RETURN 
  589. 5890  IF C$ = " "  AND S1 = 0  THEN  CALL 64477: GOTO 5880
  590. 5900  IF C$ = " "  THEN  CALL 62450: GOSUB 1180:G = 0: GOSUB 4260: RETURN 
  591. 5910 CC =  ASC(C$) -65: IF CC <0  OR CC >6  THEN 5880
  592. 5920 FM = 1: IF CC = 0  AND A%(0,3) = 0  THEN A%(0,3) = 1:E(0) = 1: GOTO 6010
  593. 5930  IF CC = 1  AND A%(0,3) = 1  THEN A%(0,3) = 0:E(0) = 0: GOTO 6010
  594. 5940  IF CC = 2  AND A%(1,1) = 0  THEN A%(1,1) = 1:E(1) = 1: GOTO 6010
  595. 5950  IF CC = 3  AND A%(1,1) = 1  THEN A%(1,1) = 0:E(1) = 0: GOTO 6010
  596. 5960  IF CC > = 0  AND CC < = 3  THEN 5880
  597. 5970  IF CC = 6  THEN  GOSUB 6110: GOTO 5880
  598. 5980 F$(CC) = "--":K = 4: GOSUB 3470: VTAB 17: HTAB 3: PRINT L$(33)": ";
  599. 5990  GOSUB 1120: VTAB 17: CALL  -868:D(CC) =  ABS( VAL(IN$)):F$(CC) = " ": GOSUB 3470:FM = 1
  600. 6000 S1 = D(5) +12 *D(4):HD = S1 *HR:VD = S1 *VR: VTAB 22: HTAB 36: GOTO 5880
  601. 6010  GOSUB 6020: GOTO 5880
  602. 6020  REM  ENTRIES
  603. 6030  FOR J = 0 TO 1:K = 2 *J: VTAB 4 +K: HTAB 18
  604. 6040  IF E(J) = 1  THEN  INVERSE 
  605. 6050  PRINT G$(K);: HTAB 28: NORMAL 
  606. 6060  IF E(J) = 0  THEN  INVERSE 
  607. 6070  PRINT G$(K +1);: NORMAL : NEXT 
  608. 6080 K = 4: GOSUB 3470
  609. 6090  VTAB 14: HTAB 13: PRINT TI$
  610. 6100  VTAB 22: HTAB 36: RETURN 
  611. 6110  REM  TITLE
  612. 6120  VTAB 14: HTAB 13: PRINT  SPC( 35): VTAB 14: HTAB 13: GOSUB 1120:TI$ =  LEFT$(IN$,35): VTAB 14: HTAB 13: PRINT TI$;: CALL  -868: VTAB 22: HTAB 36: RETURN 
  613. 6130  REM  <...SMALLER STEP
  614. 6140  IF ST >1  THEN ST = ST -1
  615. 6150  RETURN 
  616. 6160  REM  >...LARGER STEP
  617. 6170  IF ST <3  THEN ST = ST +1
  618. 6180  RETURN 
  619. 6190  REM  ?...HELP
  620. 6200  GOSUB 1160: INVERSE : PRINT L$(0): NORMAL : PRINT : GOSUB 740: PRINT : PRINT : PRINT L$(1): PRINT L$(2): PRINT : PRINT : PRINT L$(17);
  621. 6210  GET C$: IF C$ = " "  THEN  GOSUB 1180: RETURN 
  622. 6220  GOTO 6210