home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / s85xx / s8506b.d64 / strubs.4.qp (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  20KB  |  681 lines
  1. 5 REM STRUBS4/4.9.83
  2. 10 '*******************************
  3. 15 '**  ---- STRUBS.4.QP ---     **
  4. 20 '** 4.9.83                    **
  5. 22 '** STRUBS.2  -CODE           **
  6. 25 '** BASIC PROG VORUEBERSETZEN **
  7. 30 '** UEBERSETZT MARKEN IN ZEI- **
  8. 32 '** LENNR. ( \NAME)           **
  9. 35 '** LOESCHT KOMMENTARE '...'  **
  10. 36 '**         UND BLANKS        **
  11. 40 '** BEFEHLE: MIT '!'          **
  12. 41 '**         LOOP,EXIT,ELOOP   **
  13. 43 '**         IF,ELSE,FI        **
  14. 45 '**         CASEOF,OF,ECASE   **
  15. 46 '**         WHILE,EWHILE      **
  16. 47 '**         REPEAT,UNTIL      **
  17. 48 '**         EXT:              **
  18. 49 '*******************************
  19. 50 '
  20. 51 PRINT"[147]";TAB(10);"*****************"
  21. 52 PRINT TAB(10);"* --STRUBS.4 -- *"
  22. 55 PRINT TAB(10);"*   M.TOERK     *"
  23. 57 PRINT TAB(10);"* 4352 HERTEN   *"
  24. 58 PRINT TAB(10);"*****************"
  25. 67 '
  26. 68 '
  27. 70 !IF PEEK(46)<40 OR (PEEK(46)=40 AND PEEK(45)<3)THEN'KEIN PROG IN EDITBEREICH
  28. 71 '
  29. 72 '   ** INIT EDIT U. VAR. BEREICH:
  30. 73 :   POKE46,40:POKE45,3:POKE 40*256,0:CLR
  31. 75 !FI
  32. 78 '
  33. 80 EA=40*256+1'  ** EDIT-BEREICH
  34. 100 GOSUB \INIT
  35. 140 GOTO \MENUE
  36. 148 '
  37. 149 '
  38. 200 '******************************
  39. 205 '**  -- NEXT ZEICHEN   ---   **
  40. 208 '** HOLT AB ADR NC NAECHSTES **
  41. 210 '** RELEVANTES ZEICHEN       **
  42. 212 '** UEBERLIEST BLANKS UND    **
  43. 214 '** KOMMENTARE ZWISCHEN      **
  44. 215 '** ' UND  ' BZW ZEILENDE    **
  45. 217 '** KOPIERT STRINGS UNVERAEN-**
  46. 218 '** DERT NACH Z$             **
  47. 220 '** EIN: NC   -CHAR ADR      **
  48. 222 '**      CODE-VARIABLEN      **
  49. 224 '** AUS: NC   -ADR NEXT CHAR **
  50. 226 '**      C    -CHAR-CODE     **
  51. 228 '** SEF: Z$   -ZEILENSTRING  **
  52. 247 '******************************
  53. 248 '
  54. 250 \NEXCHAR:IF PEEK(NC)=BL'ANK'  THEN NC=NC+1:GOTO \THIS ' **BLANKS UEBERLESEN
  55. 254 '
  56. 260 C=PEEK(NC)
  57. 265 IF C<>KO'MMENTAR' THEN \TESTSTRING
  58. 267 '
  59. 270 ' ** KOMMENTAR  UEBERLESEN
  60. 280 NC=NC+1:C=PEEK(NC):IF C AND C<>KO THEN \THIS
  61. 290 IF C THEN NC=NC+1:C=PEEK(NC)
  62. 295 IF C=BL THEN \NEXCHAR
  63. 298 '
  64. 320 \TESTSTRING:  IF C<>TE'XT' THEN NC=NC+1:RETURN
  65. 340 '
  66. 345 ' ** STRING NACH Z$ UEBERTRAGEN  **
  67. 350 Z$=Z$+CHR$(C):NC=NC+1:C=PEEK(NC):IF C AND C<>TE'XT' THEN \THIS
  68. 370 NC=NC+1
  69. 390 RETURN
  70. 395 '
  71. 500 '******************************
  72. 505 '** -SCHREIB ZEILE AUF DISK- **
  73. 510 '** EIN: Z$ - ZEILENSTRING   **
  74. 512 '** E/A: AA - LINKADRESSE    **
  75. 513 '**      DARF AUSSERHALB DIE-**
  76. 514 '**      SER ROUTINE NICHT!! **
  77. 515 '**      VERAENDERT WERDEN ! **
  78. 520 '** SEF: H%                  **
  79. 525 '** IMP: FNAD - ADRESSFUNKT. **
  80. 547 '******************************
  81. 548 '
  82. 550 \SCHREIBZEILE:IF LEN(Z$)<4 THEN RETURN' **LEERZEILE
  83. 555 PRINTFNAD(ZA+2)
  84. 560 AA=AA+LEN(Z$)+2 ' ** LINKADR
  85. 565 H%=AA/256
  86. 570 PRINT#1,CHR$(AA-256*H%);CHR$(H%);Z$;
  87. 580 RETURN
  88. 595 '
  89. 700 '*****************************
  90. 704 '** --- HOLNAME   ----      **
  91. 706 '** LIEST NAME AB ADR NC    **
  92. 708 '** BIS ":", ",", BLANK     **
  93. 709 '**     ODER ZEILENENDE     **
  94. 710 '** EIN: NC                 **
  95. 715 '** AUS: NC -ADR. NEXT CHAR **
  96. 720 '**      C  -LETZTES GELESE-**
  97. 722 '**         -NES ZEICHEN    **
  98. 728 '**      T$ -NAME           **
  99. 747 '*****************************
  100. 748 '
  101. 750 \HOLNAME:T$=""
  102. 780 ' **** NAME LESEN
  103. 790 !LOOP
  104. 795 :   C=PEEK(NC):IF C=DP OR C=KM OR C=BL OR C=0    THEN !EXIT
  105. 800 :   NC=NC+1:T$=T$+CHR$(C)
  106. 810 !ELOOP
  107. 820 NC=NC+1:IF C=BL'ANK' THEN GOSUB \NEXCHAR
  108. 830 RETURN
  109. 835 '
  110. 1000 '*****************************
  111. 1004 '** -- UEBERSETZE MARKE --  **
  112. 1020 '** EIN: Z$ -ZEILENANFANG   **
  113. 1022 '**      NC -AKT.CHAR ADR   **
  114. 1030 '** AUS: Z$ -Z$+SPRUNGZIEL  **
  115. 1032 '**      NC -AUF LETZTES    **
  116. 1033 '**          GELESENES CHAR **
  117. 1038 '** SEF: I,H,T$             **
  118. 1047 '*****************************
  119. 1048 '
  120. 1050 \MARKE:GOSUB \HOLNAME
  121. 1115 '
  122. 1120 !IF T$="THIS" THEN
  123. 1125 :    H=FNAD(ZA+2)
  124. 1130 !ELSE    '** MARKE SUCHEN  ****
  125. 1140 :    FOR I=0 TO MP:IF MA$(I)<>T$ THEN NEXT
  126. 1160 :    IF I>MP THEN ER=2:GOTO \ERROR:'UNDEFINED LABEL
  127. 1170 :    H=MA%(I)+DI
  128. 1175 !FI
  129. 1180 Z$=Z$+MID$(STR$(H),2)
  130. 1190 RETURN
  131. 1195 '
  132. 1495 '
  133. 1500 '*********************************
  134. 1504 '** --- BEFEHLE IM 1.LAUF ----  **
  135. 1510 '** SEF: SP,S%() STACK          **
  136. 1530 '**      I%()    IF/CASE TABELLE**
  137. 1532 '**      LO%(,)  LOOPTABELLE    **
  138. 1533 '**      ER,ER%(),EP -ERRORTAB. **
  139. 1535 '**      I,IN,TA,B$,H,L         **
  140. 1540 '** IMP: HOLNAME,ERROR,ABBRUCH  **
  141. 1547 '*********************************
  142. 1549 '
  143. 1550 \BEFEHL.L1:GOSUB \HOLNAME
  144. 1551 '
  145. 1560 FOR I=0 TO BM:IF T$<>BE$(I) THEN NEXT
  146. 1565 IF I>BM THEN ER=0:GOTO \ERROR ' FALSCHER BEFEHL
  147. 1567 B$=BE$(I):IF I=3 THEN B$="IF"
  148. 1568 '
  149. 1569 I=I+1  ' ** VERTEILER **
  150. 1570 ONIGOSUB\L1,\EX1,\EL1,\IF1,\ELS1,\FI1,\CA1,\OF1,\EC1,\ET1,\W1,\N1,\R1,\U1
  151. 1571 '
  152. 1572 '** BLOCKSTRUCKTUR AUSGEBEN **
  153. 1574 PRINTFNAD(ZA+2);
  154. 1575 IF IN'DENTMODUS'=0 THEN PRINT TAB(TA);B$:RETURN
  155. 1577 IF IN=1 THEN PRINT TAB(TA);B$:TA=TA+1:RETURN
  156. 1579 IF IN=2 THEN PRINT TAB(TA-1);B$:RETURN
  157. 1581 IF IN=3 THEN TA=TA-1:PRINT TAB(TA);B$:RETURN
  158. 1585 '
  159. 1586 RETURN
  160. 1588 '
  161. 1589 ' ****  LOOP  *****
  162. 1600 \L1: IF SP'TR'>SM'AX' THEN ER=3:GOTO \ABBRUCH
  163. 1605 :  IF LP>LM THEN ER=5:GOTO \ABBRUCH
  164. 1609 '  * ZEILENNR MERKEN:
  165. 1610 :  S'TACK'%(SP)=LP:SP=SP+1:LO%(LP,0)=FNAD(ZA+2)-DI:LP=LP+1
  166. 1615 :  IN'DENTMODUS'=1:RETURN
  167. 1628 '
  168. 1629 ' **** ELOOP  *****
  169. 1640 \EL1:SP=SP-1:IF S'TACK'P'OINTER'<0 THEN ER=1:GOTO \ABBRUCH
  170. 1649 '  * ZEILENNUMMERN ZU ENTSPRECHENDEM LOOP NACH LO%(,)
  171. 1650 :  LO'OP'%(S%(SP),1)=FNAD(ZA+2)-DI
  172. 1660 :  IN'DENTMODUS'=3:RETURN
  173. 1678 '
  174. 1679 ' ** EXIT     *****
  175. 1680 \EX1: IN'DENTMODUS'=0:RETURN
  176. 1688 '
  177. 1689 '
  178. 1700 ' ** WHILE    *****
  179. 1710 \W1: GOSUB \L1 'LOOP':RETURN
  180. 1715 '
  181. 1730 ' *** EWHILE ******
  182. 1740 \N1: GOSUB \EL1 'ELOOP':RETURN
  183. 1745 '
  184. 1800 ' ** REPEAT *******
  185. 1810 \R1: GOSUB \L1 'LOOP':RETURN
  186. 1815 '
  187. 1845 '
  188. 1850 ' ** UNTIL  *******
  189. 1860 \U1: GOSUB \EL1 'ELOOP':RETURN
  190. 1948 '
  191. 1990 '
  192. 2000 ' ****  IF  *******
  193. 2005 ' LISTENPLATZ FUER SPAETEREN SPRUNGZIELEINTRAG MERKEN:
  194. 2010 \IF1: IF SP>SM THEN ER=3:GOTO \ABBRUCH
  195. 2011 :     IF IP>IM THEN ER=4:GOTO \ABBRUCH
  196. 2020 :     S%(SP)=IP:IP=IP+1:SP=SP+1
  197. 2025 :     IN'DENTMODUS'=1:RETURN
  198. 2029 '
  199. 2030 ' **** ELSE *******
  200. 2035 ' ZEILENNR.+1 ALS SPRUNGZIEL FUER ZUGEHOERIGES IF EINTRAGEN:
  201. 2040 \ELS1:IF SP<1 THEN ER=1:GOTO \ABBRUCH
  202. 2041 :   IF IP>IM THEN ER=4:GOTO \ABBRUCH
  203. 2044 :   I%(S%(SP-1))=FNAD(ZA+2)+1-DI
  204. 2045 '   * INDEX FUER SPAETEREN SPRUNGZIELEINTRAG MERKEN:
  205. 2050 :   S%(SP-1)=IP:IP=IP+1
  206. 2052 :   IN'DENTMODUS'=2:RETURN
  207. 2058 '
  208. 2090 ' ****  FI  *******
  209. 2095 ' ZNR. ALS SPRUNGZIEL BEI IF BZW. ELSE EINTRAGEN
  210. 2100 \FI1: IF SP<1 THEN ER=1:GOTO \ABBRUCH
  211. 2105 :     SP=SP-1:I%(S%(SP))=FNAD(ZA+2)-DI
  212. 2107 :     IN'DENTMODUS'=3:RETURN
  213. 2108 '
  214. 2110 '
  215. 2150 ' **** CASEOF *****
  216. 2160 \CA1: IF SP>SM THEN ER=3:GOTO \ABBRUCH
  217. 2165 :     S%(SP)=-1:SP=SP+1
  218. 2170 :     GOSUB \IF1
  219. 2180 :     IN'DENTM.'=1:RETURN
  220. 2185 '
  221. 2200 ' ***** OF   ******
  222. 2210 \OF1: GOSUB \ELS1
  223. 2230 :     GOSUB \IF1
  224. 2240 :     IN'DENTM.'=2:RETURN
  225. 2245 '
  226. 2250 ' ***** ECASE *****
  227. 2260 \EC1: H=FNAD(ZA+2)-DI ' * ZEILENNR
  228. 2269 '  ** AUSGAENGE EINTRAGEN
  229. 2270 :  !LOOP
  230. 2275 :      IF SP<1 THEN ER=1:GOTO \ABBRUCH
  231. 2280 :      SP=SP-1:I=S%(SP)
  232. 2290 :      IF I<0 THEN !EXIT
  233. 2300 :      I%(I)=H
  234. 2310 :  !ELOOP
  235. 2320 :  IN'DENTM.'=3:RETURN
  236. 2330 '
  237. 2399 ' *** EXT/CONST ***
  238. 2400 \ET1: !LOOP
  239. 2410 :     IF MP>MM THEN ER=6:GOTO \ABBRUCH
  240. 2415 :     IF C AND C<>LA'BEL' THEN GOSUB \NEXCHAR:GOTO \THIS
  241. 2420 :     IF C THEN GOSUB \HOLNAME
  242. 2423 :     IF C THEN GOSUB \NEXCHAR
  243. 2425 :     IF C<48 OR C>57 THEN 'KEINE ZIFFER' ER=9:GOTO \ERROR
  244. 2430 :     MA$(MP)=T$:H=C
  245. 2438 '
  246. 2439 '     ** WERT DES LABELS: **
  247. 2440 :     GOSUB \HOLNAME
  248. 2450 :     MA%(MP)=VAL(CHR$(H)+T$)-DI
  249. 2460 :     MP=MP+1
  250. 2470 :     IF C=0 THEN !EXIT
  251. 2480 !ELOOP
  252. 2481 '
  253. 2485 IN'DENTM.'=0:RETURN
  254. 2495 '
  255. 2497 '
  256. 2500 '*********************************
  257. 2504 '** --- BEFEHLE IM 2.LAUF ----  **
  258. 2510 '** SEF: STACK                  **
  259. 2530 '**      IP,LP - TAB. POINTER   **
  260. 2534 '**      Z$  - ZEILENSTRING     **
  261. 2540 '** IMP: HOLNAME                **
  262. 2547 '*********************************
  263. 2549 '
  264. 2550 \BEFEHL.L2:GOSUB \HOLNAME
  265. 2551 '
  266. 2560 FOR I=0 TO BM:IF T$<>BE$(I) THEN NEXT
  267. 2565 IF I>BM THEN ER=0:GOTO \ERROR ' * FALSCHER BEFEHL
  268. 2567 '
  269. 2568 I=I+1  ' ** VERTEILER **
  270. 2570 ONIGOSUB\L2,\EX2,\EL2,\IF2,\ELS2,\FI2,\CA2,\OF2,\EC2,\ET2,\W2,\N2,\R2,\U2
  271. 2575 RETURN
  272. 2576 '
  273. 2589 ' ****  LOOP  *****
  274. 2590 \L2:IF C=0 THEN Z$=Z$+":"
  275. 2592 '   INDEX VON LOOP/ELOOP PAAR MERKEN
  276. 2595 :   S%(SP)=LP:SP=SP+1:LP=LP+1
  277. 2597 :   RETURN
  278. 2628 '
  279. 2629 ' **** ELOOP  *****
  280. 2630 \EL2: SP=SP-1
  281. 2639 '   * SPRUNG ZU ENTSPR. LOOP
  282. 2640 :   Z$=Z$+G'O'T'O'$+MID$(STR$(LO%(S%(SP),0)+DI),2)+NU$
  283. 2642 :   GOSUB \SCHREIBZEILE
  284. 2645 '   * FOLGEZEILE ALS SPRUNGZIEL GENERIEREN
  285. 2647 :   L=PEEK(ZA+2)+1:H=PEEK(ZA+3):IF L>255 THEN L=0:H=H+1
  286. 2648 :   Z$=CHR$(L)+CHR$(H) +":"
  287. 2650 :   RETURN
  288. 2652 '
  289. 2680 ' ****  EXIT  *****
  290. 2685 \EX2:B$="":IF RIGHT$(Z$,1)<>CHR$(167) 'THEN-CODE' THEN B$=G'O'T'O'$
  291. 2689 '   * SPRUNG ZU NAECHSTEM ELOOP
  292. 2693 :   Z$=Z$+B$+MID$(STR$(LO%(S%(SP-1),1)+DI+1),2)
  293. 2695 :   RETURN
  294. 2947 '
  295. 2955 '
  296. 3000 ' ****  IF  ********
  297. 3010 \IF2: Z$=Z$+I'F'C$+NO'T'$+"("+CHR$(C)
  298. 3020 :    GOSUB \NEXCHAR:IF C<>TH'EN' AND C THEN Z$=Z$+CHR$(C): GOTO \THIS
  299. 3030 :    Z$=Z$+")"+CHR$(TH'EN')+MID$(STR$(I%(IP)+DI),2)
  300. 3035 '
  301. 3036 :    IP=IP+1:C=0:RETURN
  302. 3039 '
  303. 3080 ' **** ELSE ********
  304. 3090 \ELS2: Z$=Z$+G'O'T'O'$+MID$(STR$(I%(IP)+DI),2)+NU$
  305. 3100 :    GOSUB \SCHREIBZEILE
  306. 3110 '   * FOLGEZEILE ALS SPRUNGZIEL GENERIEREN:
  307. 3120 :   L=PEEK(ZA+2)+1:H=PEEK(ZA+3):IF L>255 THEN L=0:H=H+1
  308. 3130 :   Z$=CHR$(L)+CHR$(H) +":"
  309. 3140 :   IP=IP+1:RETURN
  310. 3149 '
  311. 3180 ' ****  FI  ********
  312. 3190 \FI2: L=PEEK(ZA+2):H=PEEK(ZA+3)
  313. 3195 '   * ZEILE ALS SPRUNGZIEL GENERIEREN:
  314. 3200 :   Z$=CHR$(L)+CHR$(H) +":"
  315. 3210 :   RETURN
  316. 3255 '
  317. 3259 ' ***** CASEOF ****
  318. 3260 \CA2: GOSUB \IF2:RETURN
  319. 3299 '
  320. 3300 ' ***** OF   ******
  321. 3310 \OF2: GOSUB \ELS2
  322. 3320 :     Z$=LEFT$(Z$,LEN(Z$)-1) ' ":" WEG
  323. 3330 :     GOSUB \IF2
  324. 3340 :     RETURN
  325. 3345 '
  326. 3350 ' ***** ECASE *****
  327. 3360 \EC2: GOSUB \FI2
  328. 3370 :  RETURN
  329. 3380 '
  330. 3385 '
  331. 3399 ' *** EXT/CONST ***
  332. 3400 \ET2: Z$="":C=0:RETURN  ' *ZEILE LOESCHEN
  333. 3405 '
  334. 3448 '
  335. 3449 ' *** WHILE   *****
  336. 3450 \W2: GOSUB \L2 'LOOP'
  337. 3460 :    Z$=Z$+I'F'C'ODE'$+NO'T'$+"("
  338. 3469 '    ** BEDINGUNG KOPIEREN:
  339. 3470 :    IF C<>BE'FEHL' AND C THEN Z$=Z$+CHR$(C):GOSUB \NEXCHAR:GOTO \THIS
  340. 3480 :    Z$=Z$+")"+CHR$(TH'EN')
  341. 3488 '    ** ANALOG EXIT:
  342. 3490 :    Z$=Z$+MID$(STR$(LO%(S%(SP-1),1)+DI+1),2)
  343. 3495 :    C=0:RETURN
  344. 3497 '
  345. 3498 '
  346. 3549 ' *** EWHILE  *****
  347. 3550 \N2: GOSUB \EL2 'ELOOP':RETURN
  348. 3555 '
  349. 3557 '
  350. 3579 ' *** REPEAT  *****
  351. 3580 \R2: GOSUB \L2 'LOOP':RETURN
  352. 3585 '
  353. 3599 ' *** UNTIL   *****
  354. 3600 \U2: Z$=Z$+I'F'C$+NO'T'$+"("
  355. 3605 '
  356. 3609 '   * BEDINGUNG KOPIEREN
  357. 3610 :   IF C THEN Z$=Z$+CHR$(C):GOSUB \NEXCHAR:GOTO \THIS
  358. 3619 '   * ANALOG ELOOP
  359. 3620 :   SP=SP-1:IN'DENT'=3
  360. 3630 :   Z$=Z$+")"+CHR$(TH'EN')+MID$(STR$(LO%(S%(SP),0)+DI),2)
  361. 3640 :   RETURN
  362. 4000 '*****************************
  363. 4004 '** - BEARBEITE ZEILE  -    **
  364. 4020 '** EIN: ZA -ZEILENADR      **
  365. 4028 '** AUS: Z$ -ZEILENSTRING   **
  366. 4029 '**          UEBERSETZTE Z. **
  367. 4035 '**      LEFT$(Z$,2)=ZEILNR **
  368. 4040 '** IMP: \BEFEHL.L2         **
  369. 4045 '**      \MARKE             **
  370. 4047 '*****************************
  371. 4048 '
  372. 4050 ' ** ZEILENNR:       **
  373. 4060 \ZEILE:Z$=CHR$(PEEK(ZA+2))+CHR$(PEEK(ZA+3))
  374. 4080 NC=ZA+4:GOSUB \NEXCHAR ' 1.ZEICHEN DER ZEILE
  375. 4082 '
  376. 4089 ' **    'TABULATOR'  **
  377. 4090 IF C=DP THEN GOSUB \NEXCHAR
  378. 4098 '
  379. 4099 ' ** MARKE UEBERLESEN:  **
  380. 4100 !IF C=LA'BEL' THEN
  381. 4105 :   GOSUB \HOLNAME:IF C=DP THEN GOSUB \NEXCHAR
  382. 4108 :   IF C=0 THEN Z$=Z$+":"
  383. 4110 !FI
  384. 4111 '
  385. 4115 NC=NC-1:IF C=0 THEN Z$=Z$+NU'LL'$
  386. 4119 '
  387. 4120 ' ********  ZEILE LESEN   ********
  388. 4130 !LOOP: IF C=0 THEN !EXIT
  389. 4131 '
  390. 4132 :   GOSUB \NEXCHAR
  391. 4138 '
  392. 4150 :   !IF C=BE'FEHL' THEN
  393. 4155 :      GOSUB \BEFEHL.L2
  394. 4358 :   !ELSE
  395. 4360 :      IF C=LA'BEL' THEN GOSUB \MARKE
  396. 4378 :   !FI
  397. 4380 :   Z$=Z$+CHR$(C)
  398. 4395 ' ********  BIS  ZEILENENDE  *****
  399. 4396 !ELOOP
  400. 4398 RETURN
  401. 4399 '
  402. 5000 '*****************************
  403. 5005 '** --- UEBERSETZEN ---     **
  404. 5047 '*****************************
  405. 5048 '
  406. 5049 '
  407. 5050 \UEBERSETZEN:  PRINT"[147]   ***** UEBERSETZEN    ****"
  408. 5052 !IF FNAD(EA)<EA+5 OR FNAD(EA)>EA+83 THEN
  409. 5053 :    PRINT"KEIN PROGRAMM VORHANDEN":GOSUB \WARTEN:RETURN
  410. 5054 !FI
  411. 5057 '
  412. 5058 PRINT"BITTE DISK EINLEGEN  "
  413. 5059 '
  414. 5060 !LOOP  PRINT"NAME FUER OBJEKT-PROGRAMM"
  415. 5065 :   POKE198,1:POKE631,34 ' **  " FUER INPUT
  416. 5070 :   [133] F$
  417. 5080 :   [159] 1,8,1,F$[170]",P,W":[159] 15,8,15
  418. 5090 :   [132]15,E,E$:[139] E[178]0 [167] !EXIT
  419. 5095 :   [153]"DISK ERR:";E;E$
  420. 5096 :   [133]"NEUER VERSUCH";Z$
  421. 5098 :   [160]1:[160]15
  422. 5099 :   [139] Z$[179][177]"J" [167] [142]
  423. 5100 !ELOOP
  424. 5118 '
  425. 5119 '
  426. 5120 AA[178]EA
  427. 5130 [152]1,[199](AA [175] 256);[199](AA[173]256);'  [172][172] STARTADR.
  428. 5134 '
  429. 5135 [153]"1.LAUF"
  430. 5136 TA'BULA[164]R'[178]7 'FUER BLOCKSTRUKTUR AUSGABE
  431. 5140 [141] \1.LAUF
  432. 5142 '" ** ALLE BLOECKE GESCHLOSSEN?
  433. 5143 IF SP>0 THEN PRINT SP;:ER=8:GOTO \ABBRUCH
  434. 5144 '
  435. 5145 PRINT"2.LAUF"
  436. 5150 GOSUB \2.LAUF
  437. 5154 '
  438. 5160 PRINT#1,CHR$(0);CHR$(0);'  **** PROG.ENDE MARKE
  439. 5180 CLOSE1:PRINT"**";EP;" ERRORS **":GOSUB \WARTEN
  440. 5190 RETURN
  441. 5198 '
  442. 5199 '
  443. 5500 '*****************************
  444. 5504 '**  --- 1.LAUF   ---       **
  445. 5510 '** IMP: \NEXCHAR           **
  446. 5512 '**      \MARDEF            **
  447. 5514 '**      \BEFEHL.L1         **
  448. 5547 '*****************************
  449. 5548 '
  450. 5550 '  *** ZEILENAD.=EDITBEREICH ANF
  451. 5555 \1.LAUF:   ZA=EA
  452. 5557 '
  453. 5560 ' ** WHILE NICHT PROGR.ENDE DO ***
  454. 5570 !WHILE  ZA<>0  !DO
  455. 5580 :   NC=ZA+4:C=PEEK(NC):NC=NC+1  '1.ZEICHEN DER ZEILE
  456. 5584 '   ** TAB UEBERLESEN:
  457. 5585 :   IF C=D'OPPEL'P'UNKT' THEN GOSUB \NEXCHAR
  458. 5587 '
  459. 5589 '   ** MARKE DEFINIEREN
  460. 5590 :   IF C=LA'BEL' THEN GOSUB \MARDEF:IF C=DP THEN GOSUB \NEXCHAR
  461. 5599 '
  462. 5619 '   ** BEFEHL:
  463. 5620 :   IF C=BE'FEHL' THEN GOSUB \BEFEHL.L1
  464. 5920 :   ZA=FNAD(ZA)
  465. 5930 !EWHILE
  466. 5935 RETURN
  467. 5940 ' **** ENDWHILE ******************
  468. 5995 '
  469. 5996 '
  470. 6000 '*******************************
  471. 6004 '** --- MARKE DEFINIEREN  --- **
  472. 6015 '** EIN: ZA -ZEILENADR.       **
  473. 6020 '** AUS: VERAENDERTE MARKEN-  **
  474. 6022 '**      LISTE MA$(),MA%(),MP **
  475. 6030 '** SEF: NC,T$                **
  476. 6047 '*******************************
  477. 6048 '
  478. 6050 \MARDEF:    IF MP>MM'AX' THEN ER=6:GOTO \ABBRUCH
  479. 6070 GOSUB \HOLNAME
  480. 6095 '
  481. 6100 MA$(MP)=T$:MA%(MP)=FNAD(ZA+2)-DI:MP=MP+1
  482. 6120 RETURN
  483. 6130 '
  484. 6500 '*****************************
  485. 6504 '** --- 2.LAUF     ---      **
  486. 6510 '** IMP: \ZEILE             **
  487. 6512 '**      \SCHREIBZEILE      **
  488. 6547 '*****************************
  489. 6548 '
  490. 6550 \2.LAUF: Z'EILEN'A'DRESSE'=E'DITBEREICH'A'NFANG':Z1=FNAD(ZA) 'ADR. 2.ZEILE
  491. 6560 LP=0:SP=0:IP=0  ' * POINTER RUECKSETZEN
  492. 6575 '
  493. 6580 !REPEAT
  494. 6585 :  !IF PEEK(ZA+4)<>KO'MMENTAR' THEN
  495. 6590 :    GOSUB \ZEILE  ' BEARBEITEN
  496. 6600 :    GOSUB \SCHREIBZEILE
  497. 6649 '
  498. 6650 :  !FI
  499. 6655 :  ZA=Z1:Z1=FNAD(Z1) ' ADRESSE NAECHSTE ZEILE
  500. 6660 !UNTIL Z1=0
  501. 6670 ' * PROGR. ENDE *
  502. 6680 RETURN
  503. 6685 '
  504. 8000 '*****************************
  505. 8004 '** --- ERROR      -----    **
  506. 8047 '*****************************
  507. 8050 \ERROR:PRINT"ERROR IN";FNAD(ZA+2),ER$(ER)
  508. 8060 IF EP<EM THEN ER%(EP,0)=FNAD(ZA+2)-DI:ER%(EP,1)=ER:EP=EP+1
  509. 8080 Z$=LEFT$(Z$,2)+"***** ERR:"+ER$(ER)+"********"
  510. 8090 C$=NU$:C=0  'ZEILENENDE SETZEN
  511. 8099 RETURN
  512. 8799 '
  513. 8800 '*****************************
  514. 8805 '** UMSCHALTEN EDIT BEREICH **
  515. 8840 '** BASIC-ANFANG UMSETZEN   **
  516. 8847 '*****************************
  517. 8849 '
  518. 8850 '
  519. 8860 \EDIT:    PRINT"[147]"
  520. 8870 PRINTTAB(9);"*********************"
  521. 8880 PRINTTAB(9);"** ZURUECK MIT:    **"
  522. 8882 PRINTTAB(9);"** ' ! ' [RETURN]  **"
  523. 8940 PRINTTAB(9);"*********************"
  524. 8950 POKE44,EA/256:POKE EA-1,0:CLR:END
  525. 8990 END
  526. 40000 '****************************
  527. 40010 '**  --- MENUE ---         **
  528. 40048 '****************************
  529. 40049 '
  530. 40050 \MENUE:PRINT"[147]";TAB(10);"*****************"
  531. 40052 PRINT TAB(10);"* -- STRUBS  -- *"
  532. 40053 PRINT TAB(10);"*  PRECOMPILER  *"
  533. 40055 PRINT TAB(10);"* BITTE WAEHLEN *"
  534. 40058 PRINT TAB(10);"*****************"
  535. 40060 PRINT"E[146]DIT"
  536. 40070 PRINT"U[146]EBERSETZEN"
  537. 40080 PRINT"M[146]ARKEN-TABELLE AUSGEBEN"
  538. 40090 PRINT"F[146]EHLER-TABELLE AUSGEBEN"
  539. 40100 PRINT"S[146]CHLUSS"
  540. 40150 '
  541. 40160 GET Z$:IF Z$="" THEN \THIS
  542. 40170 IF Z$="E" THEN \EDIT
  543. 40180 IF Z$="U" THEN GOSUB \UEBERSETZEN:GOTO \MENUE
  544. 40190 IF Z$="S" THEN SYS 64738 '** KALTSTART
  545. 40195 IF Z$="M" THEN GOSUB \MARKENTAB-AUS:GOTO \MENUE
  546. 40200 IF Z$="F" THEN GOSUB \ERRORTAB-AUS:GOTO \MENUE
  547. 40495 GOTO \MENUE
  548. 45000 '****************************
  549. 45010 '*  --- INIT  ---           *
  550. 45048 '****************************
  551. 45049 '
  552. 45050 ' ** MARKEN-TABELLE:
  553. 45060 \INIT: MM'AX'=99:DIM MA$(MM),MA%(MM):MP=0
  554. 45069 '
  555. 45120 '
  556. 45130 ' ** LOOP-TABELLE:
  557. 45131 ' *LO(..,0)=ZNR.LOOP
  558. 45132 ' *LO(..,1)=ZNR. ZUGEHOERIGES ELOOP
  559. 45135 L'OOP'M'AX'=140:DIM LO'OP'%(LM,1):L'OOP'P'OINTER'=0
  560. 45138 '
  561. 45140 ' ** IF-TABELLE:
  562. 45145 IM'AX'=270:DIM I%(IM):IP=0
  563. 45149 '
  564. 45188 '
  565. 45189 ' ** STACK:
  566. 45190 SM'AX'=60:DIM S'TACK'%(SM):SP'TR'=0
  567. 45200 '
  568. 45209 '
  569. 45210 ' ** DIFFERENZ FUER ZEILENNR. IN INTEGER-ARRAY
  570. 45220 DI=32766
  571. 45225 '
  572. 45240 ' ** RELEVANTE ZEICHENCODES **
  573. 45250 DP=ASC(":"):KO'MMENTAR'=ASC("'"):LA'BEL'=ASC("\"):NU$=CHR$(0):BL=ASC(" ")
  574. 45253 BE'FEHL'=ASC("!"):TE'XT("")'=34:G'O'T'O-CODE'$=CHR$(137)
  575. 45254 I'F'C'ODE'$=CHR$(139):TH'EN-CODE'=167:NO'T'$=CHR$(168):K'OM'M'A-CODE'=44
  576. 45259 '
  577. 45260 '***** BEFEHLE:  ****************
  578. 45265 BM=13:DIM BE$(BM)
  579. 45270 FOR I=0 TO BM:READ BE$(I):NEXT
  580. 45271 BE$(3)=I'F'C'ODE'$
  581. 45272 DATA LOOP,EXIT,ELOOP,IF,ELSE,FI
  582. 45273 DATA CASEOF,OF,ECASE,EXT
  583. 45274 DATA WHILE,EWHILE,REPEAT,UNTIL
  584. 45399 '
  585. 45400 ' ** ADRESSBERECHNUNG:
  586. 45410 DEF FNAD(X)=PEEK(X)+256*PEEK(X+1)
  587. 45412 '
  588. 45415 '
  589. 45470 ' ** ERROR-TABELLE:
  590. 45480 EM=40:DIM ER%(EM,1):EP=0:DIM ER$(40)
  591. 45490 ' ** FEHLERMELDUNGEN
  592. 45500 FORI=0TO9:READ ER$(I):NEXT
  593. 45510 DATA "FALSCHER BEFEHL","BLOCKSCHACHTELUNG: ANFANG FEHLT"
  594. 45511 DATA "UNDEFINIERTE MARKE","STACK VOLL"
  595. 45512 DATA "ZU VIELE IF/ELSE/CASE/OF","ZU VIELE LOOP/WHILE/REPEAT"
  596. 45513 DATA "ZU VIELE MARKEN",,"BLOCK NICHT GESCHLOSSEN"
  597. 45514 DATA "EXTERN DECLARATION"
  598. 45595 '
  599. 45599 ' ** INTERPRETERERW. '!' = POKE44,8:RUN
  600. 45600 I=0:READ W
  601. 45610 POKE 704+I,W:I=I+1:READ W:IF W<256 THEN \THIS
  602. 45620 DATA 32,115,0,8,201,33,240,4,40,76,231,167
  603. 45630 DATA 169,8,133,44,169,138,76,231,167,999
  604. 45640 ' * UMSCHALTEN:
  605. 45650 FOR I=0 TO 10:READ W:POKE 750+I,W
  606. 45660 NEXT
  607. 45670 SYS 750
  608. 45680 DATA 169,192,141,8,3,169,2,141,9,3,96
  609. 45690 '
  610. 45999 RETURN
  611. 48000 '********************************
  612. 48003 '** - MARKENTABELLE AUSGEBEN - **
  613. 48048 '********************************
  614. 48049 '
  615. 48050 \MARKENTAB-AUS:IF MP=0 THEN RETURN
  616. 48055 H=0 ' FLAG
  617. 48057 PRINT"[147]      ** MARKENTABELLE AUSGEBEN **"
  618. 48060 INPUT" AUF DRUCKER (J/N)";B$
  619. 48070 !IF B$="J" THEN
  620. 48075 :   PRINT" DRUCKER AN?":GOSUB \WARTEN
  621. 48080 :   OPEN 1,4
  622. 48090 !ELSE
  623. 48100 :   OPEN 1,3 'BILDSCHIRM
  624. 48102 :   H=-1 ' FLAG
  625. 48104 !FI
  626. 48105 '
  627. 48120 FOR I=0 TO MP-1
  628. 48140 :   PRINT#1,MA%(I)+DI,MA$(I)
  629. 48150 :   IF I-INT(I/10)*10 =0 THEN IF I AND H THEN GOSUB \WARTEN
  630. 48180 NEXT
  631. 48185 CLOSE1:GOSUB \WARTEN
  632. 48190 RETURN
  633. 48195 '
  634. 49000 '********************************
  635. 49003 '** - FEHLERTABELLE AUSGEBEN - **
  636. 49048 '********************************
  637. 49049 '
  638. 49050 \ERRORTAB-AUS:IF EP=0 THEN RETURN
  639. 49055 H=0 ' FLAG
  640. 49057 PRINT"[147]      ** FEHLERTABELLE AUSGEBEN **"
  641. 49060 INPUT" AUF DRUCKER (J/N)";B$
  642. 49070 !IF B$="J" THEN
  643. 49075 :   PRINT" DRUCKER AN?":GOSUB \WARTEN
  644. 49080 :   OPEN 1,4
  645. 49090 !ELSE
  646. 49100 :   OPEN 1,3 'BILDSCHIRM
  647. 49102 :   H=-1 ' FLAG
  648. 49104 !FI
  649. 49105 '
  650. 49110 PRINT#1,EP;" ERRORS"
  651. 49120 FOR I=0 TO EP-1
  652. 49140 :   PRINT#1, ER%(I,0)+DI;ER$(ER%(I,1))
  653. 49150 :   IF I-INT(I/10)*10 =0 THEN IF I AND H THEN GOSUB \WARTEN
  654. 49180 NEXT
  655. 49185 CLOSE1
  656. 49191 GOSUB \WARTEN
  657. 49190 RETURN
  658. 49195 '
  659. 49500 '********************************
  660. 49503 '** --- AUF TASTE WARTEN   --- **
  661. 49548 '********************************
  662. 49549 '
  663. 49550 \WARTEN:PRINT"->[157][157]";
  664. 49560 GETB$:IF B$="" THEN \THIS
  665. 49570 RETURN
  666. 49598 '
  667. 49599 '
  668. 49950 '********************************
  669. 49955 '** --- PROGR.ABBRUCH      --- **
  670. 49958 '** SCHLIESST FILE             **
  671. 49970 '** GIBT FEHLERMELDUNG AUS     **
  672. 49975 '** EIN: ER -FEHLERCODE        **
  673. 49990 '********************************
  674. 50000 \ABBRUCH: PRINT "* FEHLER BEHEBEN, DANN NEU VERSUCHEN *"
  675. 50008 PRINT:PRINT ER$(ER);" IN ";FNAD(ZA+2)
  676. 50010 PRINT#1,CHR$(0);CHR$(0); '  **** PROG.ENDE MARKE
  677. 50020 CLOSE1
  678. 50030 GOSUB \WARTEN
  679. 50040 GOSUB \ERRORTAB-AUS
  680. 50050 RUN
  681.