home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / 85xx / 8508.d64 / compiler (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1995-03-30  |  10.3 KB  |  480 lines
  1. 100 REM ****************************
  2. 110 REM *                          *
  3. 120 REM *       FORTH-COMPILER     *
  4. 130 REM *                          *
  5. 140 REM *           FUER           *
  6. 150 REM *                          *
  7. 160 REM *        COMMODORE-64      *
  8. 170 REM *                          *
  9. 180 REM ****************************
  10. 190 REM *                          *
  11. 200 REM *  ALEXANDER SCHINDOWSKI   *
  12. 210 REM *                          *
  13. 220 REM *  6000 FRANKFURT/MAIN 50  *
  14. 230 REM *                          *
  15. 240 REM * RUDOLF-HILFERDING-STR.49 *
  16. 250 REM *                          *
  17. 260 REM ****************************
  18. 270 REM *                          *
  19. 280 REM *  TELEPHON:(069)/570520   *
  20. 290 REM *                          *
  21. 300 REM ****************************
  22. 310 :
  23. 320 :
  24. 330 :
  25. 340 IF A=0 THENA=1:LOAD"VOCABULARY",8,1
  26. 350 DEF FNH(X)=(INT(X/256))
  27. 360 DEF FNL(X)=(X-256*FNH(X))
  28. 370 POKE 53272,23:PRINT"[147][154]";CHR$(8);
  29. 380 VOC=6*4096:BE=VOC:SP=0:Z1=0
  30. 390 POKE 55,FN L(BE):POKE 56,FN H(BE)
  31. 395 DIM ST(20),SC$(24),WO$(100),AD(100)
  32. 400 PRINT TAB(14);"[198]ORTH-[195]OMPILER"
  33. 410 PRINT TAB(17);"FUER DEN"
  34. 420 PRINT TAB(15);"[195]OMMODORE-64"
  35. 430 PRINT"----------------------------------------";
  36. 440 PRINT"     [214]ON [193]LEXANDER [211]CHINDOWSKI 1985"
  37. 450 DATA 38
  38. 460 DATA "+",49563
  39. 470 DATA "CLS",49158,"DEPTH",49968
  40. 480 DATA "@",50012,"DROP",49236
  41. 490 DATA "EMIT",49855,"EXPECT",49936
  42. 500 DATA "=",49410,"I",49766
  43. 510 DATA "KEY",49880
  44. 520 DATA "+LOOP",49821,"MOD",49733
  45. 530 DATA "NOT",49458,"OVER",49284
  46. 540 DATA ".",49163,"-",49578
  47. 550 DATA "SWAP",49248,">R",49751
  48. 560 DATA "AND",49497,"CR",49384
  49. 570 DATA "/",49721,"DO",49757,"!",49977
  50. 580 DATA "DUP",49239,"XOR",49541
  51. 590 DATA "GET",49862,">",49434
  52. 600 DATA "<",49452,"LOOP",49811
  53. 610 DATA "*",49596,"OR",49519
  54. 620 DATA "C@",50030,"C!",49996
  55. 630 DATA "R>",49745,"TYPE",49915
  56. 640 DATA "PICK",50062,"CALL",50047,"ROT",50085
  57. 650 READ AN
  58. 660 FOR I=1 TO AN
  59. 670 READ WO$(I),AD(I)
  60. 680 NEXT I:POKE 2,0:POKE 252,0
  61. 690 GOSUB 3830
  62. 693 :
  63. 695 REM **************************
  64. 700 REM *** BEFEHLS-AUSWERTUNG ***
  65. 705 REM **************************
  66. 708 :
  67. 710 GOSUB 2630
  68. 715 :
  69. 720 IF BE$=":" THEN 1540
  70. 725 :
  71. 730 FOR I=AN TO 1 STEP -1
  72. 740 IF BE$=WO$(I) THEN 760
  73. 750 NEXT I:GOTO 770
  74. 760 SYS AD(I):GOTO 700
  75. 765 :
  76. 770 GOSUB 3030
  77. 780 IF OK=0 THEN 830
  78. 790 POKE 781,FN L(XX)
  79. 800 POKE 780,FN H(XX)
  80. 810 SYS 49194
  81. 820 GOTO 700
  82. 825 :
  83. 830 IF BE$="RESET" THEN RUN
  84. 835 :
  85. 840 IF BE$="BASIC" THEN END
  86. 845 :
  87. 850 IF BE$<>"VLIST" THEN 900
  88. 860 PRINT:FOR I=AN TO 1 STEP-1
  89. 870 PRINT WO$(I)"  ";
  90. 880 NEXT:PRINT
  91. 890 GOTO 700
  92. 895 :
  93. 900 IF BE$<>"FORGET" THEN 950
  94. 910 GOSUB 2630:FOR I=AN TO 1 STEP-1
  95. 920 IF BE$<>WO$(I) THEN NEXT I
  96. 930 IF I>AN THEN PRINT BE$" [201] CAN'T FIND":GOTO 700
  97. 935 :
  98. 940 VOC=AD(I):AN=I-1:GOTO 700
  99. 950 IF BE$<>"(" THEN 980
  100. 960 IF BE$<>")" THEN GOSUB2630:GOTO960
  101. 970 GOTO 700
  102. 975 :
  103. 980 IF BE$<>"EDIT" THEN 1020
  104. 990 GOSUB 2630 :SC=VAL(BE$)
  105. 1000 PRINT"[211]CREEN:";SC:GOSUB 3280
  106. 1010 IF BE$="-->"THEN ZE$="":SC=SC+1:GOTO1000
  107. 1012 GOTO 700
  108. 1015 :
  109. 1020 IF BE$<>"LOAD" THEN 1050
  110. 1030 GOSUB 2630:SC=VAL(BE$)
  111. 1040 BLOCK=1:Z1=0:GOSUB 3110:GOTO 700
  112. 1050 IF BE$<>"-->" THEN 1070
  113. 1060 SC=SC+1:GOSUB3110:COMP=1:BLOCK=1:Z1=0:GOTO 700
  114. 1070 :
  115. 1080 IF BE$<>"VARIABLE" THEN 1145
  116. 1085 GOSUB 2630:AN=AN+1:WO$(AN)=BE$
  117. 1090 AD(AN)=VOC:XX=VOC+8
  118. 1095 GOSUB 3470:POKE VOC,169
  119. 1100 POKE VOC+1,FN H(XX)
  120. 1105 POKE VOC+2,162
  121. 1110 POKE VOC+3,FN L(XX)
  122. 1115 POKE VOC+4,32:POKE VOC+5,42
  123. 1120 POKE VOC+6,192:POKE VOC+7,96
  124. 1125 POKE VOC+8,FN L(X)
  125. 1130 POKE VOC+9,FN H(X)
  126. 1135 VOC=VOC+10
  127. 1140 GOTO 700
  128. 1145 :
  129. 1150 IF BE$<>"MEMORY" THEN 1220
  130. 1155 GOSUB 2630:AN=AN+1:WO$(AN)=BE$
  131. 1160 AD(AN)=VOC
  132. 1165 GOSUB 3470:POKE VOC,169
  133. 1170 POKE VOC+1,FN H(VOC+12)
  134. 1175 POKE VOC+2,162
  135. 1180 POKE VOC+3,FN L(VOC+12)
  136. 1185 POKE VOC+4,32:POKE VOC+5,42
  137. 1190 POKE VOC+6,192:AD=VOC+12+XX
  138. 1195 POKE VOC+7,96
  139. 1200 POKE VOC+8,FN L(AD):POKE VOC+9,FN H(AD)
  140. 1205 POKE VOC+10,FN L(XX):POKE VOC+11,FN H(XX)
  141. 1210 VOC=AD:GOTO 700
  142. 1220 :
  143. 1230 IF BE$<>"CONSTANT" THEN 1280
  144. 1240 GOSUB 2630:A$=": "+BE$+" "
  145. 1250 GOSUB 3470
  146. 1260 ZE$=A$+STR$(X)+" ;"+ZE$
  147. 1270 GOTO 700
  148. 1280 :
  149. 1290 IF BE$<>"CLEAR" THEN 1350
  150. 1300 GOSUB 2630:SC=VAL(BE$)
  151. 1310 FOR ZE=0 TO 24
  152. 1320 SC$(ZE)=""
  153. 1330 NEXT ZE:GOSUB3220
  154. 1340 GOTO700
  155. 1350 :
  156. 1360 IFBE$="SAVE-SYSTEM"THEN3510
  157. 1365 :
  158. 1370 IFBE$="LOAD-SYSTEM"THEN3720
  159. 1380 :
  160. 1390 IF BE$<>"FLOPPY" THEN 1420
  161. 1400 GOSUB2630
  162. 1410 OPEN1,8,15,BE$:CLOSE1:GOTO 700
  163. 1420 :
  164. 1430 IFBE$<>"LIST" THEN 1520
  165. 1440 GOSUB2630:SC=VAL(BE$):GOSUB3110
  166. 1450 INPUT"[193]UF [196]RUCKER (Y/N)";A$:A=3:IFA$="Y"THENA=4
  167. 1460 OPEN4,A,-7*(A=4)
  168. 1470 FOR Z=0 TO 23
  169. 1480 PRINT#4,RIGHT$(STR$(Z),2)":"SC$(Z)
  170. 1490 NEXT Z:CLOSE4
  171. 1500 IFA=3THENPOKE198,0:WAIT198,1
  172. 1510 COMP=0:GOTO700
  173. 1520 :
  174. 1530 PRINTBE$" [201] CAN'T FIND":GOTO 700
  175. 1533 :
  176. 1535 REM *************************
  177. 1540 REM ***     COMPILER      ***
  178. 1545 REM *************************
  179. 1548 :
  180. 1550 GOSUB2630:AN=AN+1:WO$(AN)=BE$
  181. 1560 AD(AN)=VOC:COMP=1
  182. 1570 :
  183. 1580 GOSUB 2630
  184. 1590 FOR I=1 TO ANZ
  185. 1600 IF BE$<>WO$(I) THEN NEXT I
  186. 1610 AD=AD(I)
  187. 1615 :
  188. 1620 IF BE$<>"BEGIN" THEN 1640
  189. 1630 ST(SP)=VOC:SP=SP+1:GOTO 1570
  190. 1635 :
  191. 1640 IF BE$<>"UNTIL" THEN 1730
  192. 1650 POKE VOC,32
  193. 1660 POKE VOC+1,180:POKE VOC+2,194
  194. 1670 POKE VOC+3,176:POKE VOC+4,3
  195. 1680 POKE VOC+5,76
  196. 1690 SP=SP-1:AD=ST(SP):IF SP<0 THEN65535
  197. 1700 POKE VOC+6,FN L(AD)
  198. 1710 POKE VOC+7,FN H(AD)
  199. 1720 VOC=VOC+8:GOTO 1570
  200. 1725 :
  201. 1730 IF BE$=";" THEN POKE VOC,96:VOC=VOC+1:COMP=0:GOTO 700
  202. 1735 :
  203. 1740 GOSUB 3030
  204. 1750 IF OK=0 THEN 1800
  205. 1760 POKE VOC,169:POKE VOC+1,FN H(XX)
  206. 1770 POKEVOC+2,162:POKEVOC+3,FN L(XX)
  207. 1780 POKE VOC+4,32:POKE VOC+5,42
  208. 1790 POKE VOC+6,192:VOC=VOC+7:GOTO 1570
  209. 1800 :
  210. 1810 IF BE$<>"IF" THEN 1870
  211. 1820 POKE VOC,32:POKE VOC+1,180
  212. 1830 POKE VOC+2,194:POKE VOC+3,176
  213. 1840 POKE VOC+4,3:POKE VOC+5,76
  214. 1850 ST(SP)=VOC+6:SP=SP+1
  215. 1860 VOC=VOC+8:GOTO 1570
  216. 1870 :
  217. 1880 IF BE$<>"ENDIF" THEN 1930
  218. 1890 SP=SP-1:AD=ST(SP)
  219. 1900 POKE AD,FN L(VOC)
  220. 1910 POKE AD+1,FN H(VOC)
  221. 1920 GOTO 1570
  222. 1930 :
  223. 1940 IF BE$<>"ELSE" THEN 2010
  224. 1950 AD=ST(SP-1)
  225. 1960 ST(SP-1)=VOC+1
  226. 1970 POKE VOC,76:VOC=VOC+3
  227. 1980 POKE AD,FN L(VOC)
  228. 1990 POKE AD+1,FN H(VOC)
  229. 2000 GOTO 1570
  230. 2010 :
  231. 2020 IF BE$="WHILE" THEN 1820
  232. 2030 :
  233. 2040 IF BE$<>"REPEAT" THEN 2110
  234. 2050 AD=ST(SP-1):A2=ST(SP-2)
  235. 2060 SP=SP-1
  236. 2070 POKE VOC,76
  237. 2080 POKE VOC+1,FN L(A2)
  238. 2090 POKE VOC+2,FN H(A2)
  239. 2100 VOC=VOC+3:GOTO 1980
  240. 2110 :
  241. 2120 IF BE$<>"."+CHR$(34) THEN 2225
  242. 2125 A$="":ZE$=MID$(ZE$,2)
  243. 2130 IF LEFT$(ZE$,1)<>CHR$(34) THEN A$=A$+LEFT$(ZE$,1):ZE$=MID$(ZE$,2):GOTO2130
  244. 2135 ZE$=MID$(ZE$,2):A$=A$+CHR$(0)
  245. 2140 AD=VOC+10
  246. 2145 POKE VOC,169
  247. 2150 POKE VOC+1,FN H(AD)
  248. 2155 POKE VOC+2,162
  249. 2160 POKE VOC+3,FN L(AD)
  250. 2165 POKE VOC+4,32:POKE VOC+5,234
  251. 2170 POKE VOC+6,194:POKE VOC+7,76
  252. 2175 AD=VOC+10+LEN(A$)
  253. 2180 POKE VOC+8,FN L(AD)
  254. 2185 POKE VOC+9,FN H(AD)
  255. 2190 VOC=VOC+10
  256. 2200 FOR I=0 TO LEN(A$)-1
  257. 2205 POKE VOC+I,ASC(MID$(A$,I+1,1))
  258. 2210 IF LEFT$(ZE$,1)=" " THEN ZE$=MID$(ZE$,2):GOTO 2210
  259. 2215 NEXT I
  260. 2220 VOC=AD:GOTO 1570
  261. 2225 :
  262. 2230 IF BE$<>"TEXT"+CHR$(34) THEN2320
  263. 2235 A$="":ZE$=MID$(ZE$,2)
  264. 2240 IF LEFT$(ZE$,1)<>CHR$(34) THEN A$=A$+LEFT$(ZE$,1):ZE$=MID$(ZE$,2):GOTO2240
  265. 2245 ZE$=MID$(ZE$,2):A$=A$+CHR$(0)
  266. 2250 AD=VOC+10
  267. 2255 POKE VOC,169
  268. 2260 POKE VOC+1,FN H(AD)
  269. 2265 POKE VOC+2,162
  270. 2270 POKE VOC+3,FN L(AD)
  271. 2273 POKE VOC+4,32:POKE VOC+5,42:POKE VOC+6,192
  272. 2275 POKE VOC+7,76
  273. 2280 AD=VOC+10+LEN(A$)
  274. 2285 POKE VOC+8,FN L(AD)
  275. 2290 POKE VOC+9,FN H(AD)
  276. 2295 VOC=VOC+10
  277. 2300 FOR I=0 TO LEN(A$)-1
  278. 2305 POKE VOC+I,ASC(MID$(A$,I+1,1)):NEXT
  279. 2310 IF LEFT$(ZE$,1)=" " THEN ZE$=MID$(ZE$,2):GOTO 2310
  280. 2315 VOC=AD:GOTO 1570
  281. 2320 :
  282. 2330 IF BE$<>"DO" THEN 2390
  283. 2340 POKE VOC,32
  284. 2350 POKE VOC+1,FN L(AD)
  285. 2360 POKE VOC+2,FN H(AD)
  286. 2370 VOC=VOC+3:ST(SP)=VOC
  287. 2380 SP=SP+1:GOTO 1570
  288. 2390 :
  289. 2400 IF BE$<>"LOOP" AND BE$<>"+LOOP" THEN 2500
  290. 2410 POKE VOC,32
  291. 2420 POKE VOC+1,FN L(AD)
  292. 2430 POKE VOC+2,FN H(AD)
  293. 2440 POKE VOC+3,176:POKE VOC+4,3
  294. 2450 SP=SP-1:AD=ST(SP)
  295. 2460 POKE VOC+5,76
  296. 2470 POKE VOC+6,AD-256*INT(AD/256)
  297. 2480 POKE VOC+7,INT(AD/256)
  298. 2490 VOC=VOC+8:GOTO 1570
  299. 2500 :
  300. 2510 IF BE$<>"(" THEN 2540
  301. 2520 GOSUB 2630:IF BE$<>")" THEN 2520
  302. 2530 GOTO 1570
  303. 2540 :
  304. 2550 IF BE$=";S" THEN POKE VOC,96:VOC=VOC+1:GOTO 1570
  305. 2560 :
  306. 2570 IF I>AN THEN PRINT BE$" [201] CAN'T FIND":COMP=0:GOTO 700
  307. 2575 :
  308. 2580 POKE VOC,32
  309. 2590 POKE VOC+1,AD-256*INT(AD/256)
  310. 2600 POKE VOC+2,INT(AD/256)
  311. 2610 VOC=VOC+3:GOTO 1570
  312. 2615 :
  313. 2620 REM ************************
  314. 2630 REM ** HOLE BEFEHL IN BE$ **
  315. 2635 REM ************************
  316. 2637 :
  317. 2640 IF ZE$="" THEN GOSUB 2750
  318. 2650 IF LEFT$(ZE$,1)=" "THEN ZE$=MID$(ZE$,2):GOTO 2650
  319. 2660 BE$="":FOR I=1 TO LEN(ZE$)
  320. 2670 IF LEFT$(ZE$,1)=" " THEN 2710
  321. 2680 BE$=BE$+LEFT$(ZE$,1)
  322. 2690 ZE$=MID$(ZE$,2)
  323. 2700 NEXT I
  324. 2710 RETURN
  325. 2720 :
  326. 2730 REM *************************
  327. 2740 REM *** HOLE ZEILE IN ZE$ ***
  328. 2750 REM *************************
  329. 2755 :
  330. 2760 IF BLOCK=1 THEN 2880
  331. 2770 IF COMP=0 THEN PRINT"  OK."
  332. 2780 SYS 42336
  333. 2790 ZE$=""
  334. 2800 FOR Z=512 TO 600
  335. 2810 A=PEEK(Z)
  336. 2820 IF A=0 THEN 2850
  337. 2830 ZE$=ZE$+CHR$(A)
  338. 2840 NEXT Z
  339. 2850 IF LEFT$(ZE$,1)=" "THEN ZE$=MID$(ZE$,2):GOTO 2850
  340. 2860 IF ZE$="" THEN 2770
  341. 2870 RETURN
  342. 2880 ZE$=SC$(Z1):PRINT RIGHT$(STR$(Z1),2);":";ZE$
  343. 2890 IF LEN(ZE$)<2 THEN ZE$="(  )"
  344. 2900 Z1=Z1+1
  345. 2910 IF Z1=24 THEN BLOCK=0
  346. 2920 RETURN
  347. 2980 :
  348. 2990 REM **************************
  349. 3000 REM **   WANDELE ZAHL UM    **
  350. 3010 REM **        IN XX         **
  351. 3020 REM **************************
  352. 3030 :
  353. 3040 OK=1:X=1
  354. 3050 IF LEFT$(BE$,1)="-" AND VAL(BE$)<0 THEN BE$=MID$(BE$,2):X=-1:GOTO 3080
  355. 3060 IF LEFT$(BE$,1)>="0" AND LEFT$(BE$,1)<="9" THEN 3080
  356. 3070 OK=0:RETURN
  357. 3080 XX=VAL(BE$)*X
  358. 3090 IF XX<0 THEN XX=(256*256)+XX
  359. 3100 RETURN
  360. 3103 :
  361. 3105 REM *************************
  362. 3110 REM *****  LADE SCREEN  *****
  363. 3115 REM *************************
  364. 3118 :
  365. 3120 OPEN1,8,15
  366. 3130 OPEN 2,8,2,"SCR"+STR$(SC)+",S,R"
  367. 3140 INPUT#1,A
  368. 3150 IF A<>0 THEN CLOSE2:CLOSE1:FOR I=0TO24:SC$(I)="":NEXT I:RETURN
  369. 3160 FOR ZE=0 TO 24:B$=""
  370. 3170 POKE251,2:SYS830
  371. 3180 FOR I=512 TO 600:X=PEEK(I):IF X THEN B$=B$+CHR$(X):NEXT I
  372. 3190 SC$(ZE)=B$
  373. 3200 NEXT ZE
  374. 3210 CLOSE2:CLOSE1:RETURN
  375. 3213 :
  376. 3215 REM **************************
  377. 3220 REM *****  SAVE  SCREEN  *****
  378. 3225 REM **************************
  379. 3228 :
  380. 3230 OPEN 1,8,2,"@:SCR"+STR$(SC)+",S,W"
  381. 3240 FOR ZE=0 TO 24
  382. 3250 PRINT#1,SC$(ZE)
  383. 3260 NEXT ZE
  384. 3270 CLOSE1:ZE$="":PRINT"[147]";:RETURN
  385. 3273 :
  386. 3275 REM ***********************
  387. 3280 REM **** EDIT A SCREEN ****
  388. 3285 REM ***********************
  389. 3288 :
  390. 3290 GOSUB 3400
  391. 3300 PRINT"";:COMP=1
  392. 3310 GOSUB 2750
  393. 3315 IF LEFT$(ZE$,1)="N" THEN GOSUB2630:GOSUB2630:SC=VAL(BE$):GOSUB3420:GOTO3300
  394. 3320 IF LEFT$(ZE$,1)="E" THEN ZE$="":COMP=0:GOTO 3220
  395. 3321 IF LEFT$(ZE$,1)<>"I" THEN 3330
  396. 3322 GOSUB 2630:GOSUB 2630:Z=VAL(BE$):IF Z<0 OR Z>23 THEN GOSUB 3420:GOTO 3300
  397. 3323 GOSUB 2630:A=VAL(BE$):IF A<0 OR A>23 THEN GOSUB 3420:GOTO 3300
  398. 3324 FOR I=22-A TO Z STEP-1:SC$(I+A)=SC$(I):SC$(I)="":NEXT
  399. 3325 GOSUB 3420:GOTO 3300
  400. 3330 IF LEFT$(ZE$,1)="S" THEN ZE$="":PRINT"[147]";:COMP=0:RETURN
  401. 3331 IF LEFT$(ZE$,1)<>"D" THEN 3337
  402. 3332 GOSUB 2630:GOSUB 2630:Z=VAL(BE$):IF Z<0 OR Z>23 THEN GOSUB3420:GOTO 3300
  403. 3333 GOSUB 2630:A=VAL(BE$):IF A<0 OR A>23 THEN GOSUB 3420:GOTO 3300
  404. 3334 FOR I=Z TO 22-A:SC$(I)=SC$(I+A):SC$(I+A)="":NEXT
  405. 3335 GOSUB 3420:GOTO 3300
  406. 3337 IF LEFT$(ZE$,1)="L" THEN GOSUB 3420:GOTO 3300
  407. 3340 ZE=VAL(ZE$)
  408. 3350 ZE$=MID$(ZE$,3)
  409. 3360 IF ZE>9 THEN ZE$=MID$(ZE$,2)
  410. 3370 SC$(ZE)=ZE$
  411. 3380 GOSUB 2630:IF BE$="-->" THEN GOTO 3220
  412. 3390 GOTO 3310
  413. 3393 :
  414. 3395 REM *************************
  415. 3400 REM *****  LIST SCREEN  *****
  416. 3405 REM *************************
  417. 3408 :
  418. 3410 GOSUB 3110
  419. 3420 PRINT"[147]";
  420. 3430 FOR ZE=0 TO 23
  421. 3440 PRINT RIGHT$(STR$(ZE),2);":";
  422. 3450 PRINT LEFT$(SC$(ZE),38)
  423. 3460 NEXT ZE:RETURN
  424. 3463 :
  425. 3465 REM ***********************
  426. 3470 REM ** HOLE WERT VOM TOS **
  427. 3475 REM ***********************
  428. 3480 AD=52992+PEEK(2)
  429. 3490 X=PEEK(AD-1)+256*PEEK(AD-2)
  430. 3500 POKE 2,PEEK(2)-2:RETURN
  431. 3503 :
  432. 3505 REM ***********************
  433. 3510 REM ***   SAVE-SYSTEM   ***
  434. 3515 REM ***********************
  435. 3518 :
  436. 3520 GOSUB 2630
  437. 3530 OPEN1,8,15,"S:"+BE$+".*":CLOSE1
  438. 3540 OPEN2,8,2,BE$+".VOC,P,W"
  439. 3550 PRINT#2,AN:PRINT#2,VOC
  440. 3560 FOR ZE=39 TO AN
  441. 3570 PRINT#2,WO$(ZE)
  442. 3580 PRINT#2,AD(ZE)
  443. 3590 NEXT ZE
  444. 3600 CLOSE 2:BE$=BE$+".CODE"
  445. 3610 POKE 187,FN L(720):POKE 188,FN H(720)
  446. 3620 FOR I=1 TO LEN(BE$)
  447. 3630 POKE 719+I,ASC(MID$(BE$,I,1))
  448. 3640 NEXT I:POKE 183,LEN(BE$)
  449. 3650 POKE 186,8:POKE 185,1
  450. 3660 POKE 251,FN L(BE):POKE 252,FN H(BE)
  451. 3670 POKE 780,251
  452. 3680 POKE 781,FN L(VOC)
  453. 3690 POKE 782,FN H(VOC)
  454. 3700 SYS 216+256*255
  455. 3710 GOTO 700
  456. 3713 :
  457. 3715 REM ***************************
  458. 3720 REM ****    LOAD SYSTEM    ****
  459. 3725 REM ***************************
  460. 3728 :
  461. 3730 GOSUB 2630
  462. 3740 OPEN 2,8,2,BE$+".VOC,P,R"
  463. 3750 INPUT#2,AN,VOC
  464. 3760 FOR ZE=39 TO AN
  465. 3770 INPUT#2,WO$(ZE)
  466. 3780 INPUT#2,AD(ZE)
  467. 3790 NEXT ZE:CLOSE 2
  468. 3800 SYS 50139,BE$+".CODE",8
  469. 3810 GOTO 700
  470. 3813 :
  471. 3815 REM ***************************
  472. 3820 REM ***        DATA         ***
  473. 3825 REM ***************************
  474. 3828 :
  475. 3830 DATA166,251, 32,198,255,160,  0, 32,207,255,201, 13,240,  7,153,  0
  476. 3840 DATA  2,200, 76, 69,  3,169,  0,153,  0,  2, 76,204,255
  477. 3850 FOR I= 830TO 858:READ A:POKE I,A:Z=Z+A:NEXT I
  478. 3860 IF Z<>3379 THEN PRINT"[198]EHLER IN [196]ATA[146]":END
  479. 3870 RETURN
  480.