home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / SIGNUMRE.M < prev    next >
Encoding:
Text File  |  1992-02-19  |  12.2 KB  |  3 lines
  1. ⓪ MODULE SignumRead;
  2. ⓪ 
  3. ⓪ (*
  4. ⓪!* 19.02.92: '1' und '2' waren vertauscht.
  5. ⓪!*)
  6. ⓪ 
  7. ⓪ (*
  8. ⓪!* '#' markieren Fußnoten
  9. ⓪!* '@' stehen dort, wo Zeichen dichter als ihre Proportionen aufeinander liegen
  10. ⓪!* '@@@' markiert einen Bruch im Text
  11. ⓪!*)
  12. ⓪ 
  13. ⓪ IMPORT TOSIO, SimpleError;
  14. ⓪ 
  15. ⓪ FROM InOut IMPORT Write, WriteLn, WriteString, WriteCard, FlushKbd, WritePg,
  16. ⓪(WriteLHex, BusyRead, Read;
  17. ⓪ 
  18. ⓪ FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD, ASSEMBLER;
  19. ⓪ 
  20. ⓪ FROM GEMEnv IMPORT RC, InitGem, DeviceHandle;
  21. ⓪ 
  22. ⓪ FROM EasyGEM0 IMPORT HideMouse;
  23. ⓪ 
  24. ⓪ FROM EasyGEM1 IMPORT SelectMask, SelectFile;
  25. ⓪ 
  26. ⓪ FROM FileNames IMPORT ConcatPath;
  27. ⓪ 
  28. ⓪ FROM Strings IMPORT Compare, Relation, String, Concat, Assign, Insert, Empty,
  29. ⓪(Append;
  30. ⓪ 
  31. ⓪ FROM Binary IMPORT ReadBytes, ReadBlock, FilePos, FileSize;
  32. ⓪ 
  33. ⓪ IMPORT Text;
  34. ⓪ 
  35. ⓪ FROM Files IMPORT File, Open, Create, Close, Access, ReplaceMode,
  36. ⓪(EOF, State, ResetState;
  37. ⓪ 
  38. ⓪ FROM Storage IMPORT DEALLOCATE;
  39. ⓪ IMPORT Storage;
  40. ⓪ 
  41. ⓪ PROCEDURE ALLOCATE (VAR ad: ADDRESS; l: LONGCARD);
  42. ⓪"BEGIN
  43. ⓪$WriteLn;
  44. ⓪$WriteString ('ALLOCATE: ');
  45. ⓪$WriteCard (l,0);
  46. ⓪$WriteLn;
  47. ⓪$Storage.ALLOCATE (ad, l)
  48. ⓪"END ALLOCATE;
  49. ⓪ 
  50. ⓪ 
  51. ⓪ VAR out: File;
  52. ⓪$chsnames: ARRAY [0..7], [0..9] OF CHAR;
  53. ⓪$chOffset: ARRAY [0..7], [0..127] OF LONGCARD;
  54. ⓪$font: ARRAY [0..7] OF ADDRESS;
  55. ⓪$spaceWidth: INTEGER;
  56. ⓪ 
  57. ⓪ TYPE Str255 = ARRAY [0..255] OF CHAR;
  58. ⓪ 
  59. ⓪ PROCEDURE Space ( n: INTEGER ): Str255;
  60. ⓪"(*$L-*)
  61. ⓪"BEGIN
  62. ⓪$ASSEMBLER
  63. ⓪(MOVE    -(A3),D0
  64. ⓪(MOVE.L  A3,A0
  65. ⓪(ADDA.W  #256,A3
  66. ⓪(MOVEQ   #' ',D1
  67. ⓪(BRA     C
  68. ⓪&L MOVE.B  D1,(A0)+
  69. ⓪&C SUBQ    #1,D0
  70. ⓪(BPL     L
  71. ⓪(CLR.B   (A0)+
  72. ⓪$END
  73. ⓪"END Space;
  74. ⓪"(*$L=*)
  75. ⓪ 
  76. ⓪ PROCEDURE wait;
  77. ⓪"VAR c: CHAR;
  78. ⓪"BEGIN
  79. ⓪$FlushKbd;
  80. ⓪$Read (c)
  81. ⓪"END wait;
  82. ⓪ 
  83. ⓪ TYPE
  84. ⓪ 
  85. ⓪ (*
  86. ⓪"DocHead =     RECORD
  87. ⓪2kenn: ARRAY [0..7] OF CHAR;
  88. ⓪2lg: LONGCARD;
  89. ⓪2div: ARRAY [0..127] OF CHAR
  90. ⓪0END;
  91. ⓪ 
  92. ⓪"ChsBlock =    RECORD
  93. ⓪2kenn: ARRAY [0..3] OF CHAR;
  94. ⓪2lg: LONGCARD;
  95. ⓪0END;
  96. ⓪ 
  97. ⓪"Par1Block =   RECORD
  98. ⓪2kenn: ARRAY [0..3] OF CHAR;
  99. ⓪2lg: LONGCARD;
  100. ⓪2tabs: ARRAY [1..40] OF INTEGER;
  101. ⓪2list: ARRAY [1..15] OF INTEGER;
  102. ⓪0END;
  103. ⓪ 
  104. ⓪"PageBlock =   RECORD
  105. ⓪2kenn: ARRAY [0..3] OF CHAR;
  106. ⓪2lg: LONGCARD;
  107. ⓪2pages: LONGCARD;
  108. ⓪2kl: LONGCARD;
  109. ⓪2firstPnr: LONGCARD;
  110. ⓪2unused: ARRAY [0..5] OF LONGCARD
  111. ⓪0END;
  112. ⓪ 
  113. ⓪"Page =        RECORD
  114. ⓪2index: INTEGER;
  115. ⓪2physPnr: INTEGER;
  116. ⓪2logPnr: INTEGER;
  117. ⓪2lines: INTEGER;
  118. ⓪2lmargin: INTEGER;
  119. ⓪2rmargin: INTEGER;
  120. ⓪2tmargin: INTEGER;
  121. ⓪2bmargin: INTEGER;
  122. ⓪2numbpos: INTEGER;
  123. ⓪2kapitel: INTEGER;
  124. ⓪2intern: INTEGER;
  125. ⓪2unused: ARRAY [1..8] OF INTEGER
  126. ⓪0END;
  127. ⓪ 
  128. ⓪"TextHead =    RECORD
  129. ⓪2kenn: ARRAY [0..3] OF CHAR;
  130. ⓪2lg: LONGCARD;
  131. ⓪2lines: LONGCARD;
  132. ⓪2text: WORD (* ... *)
  133. ⓪0END;
  134. ⓪ 
  135. ⓪"Zeile =       RECORD
  136. ⓪2blLines: CARDINAL;
  137. ⓪2codeLen: CARDINAL;
  138. ⓪2code: CHAR (*...*)
  139. ⓪0END;
  140. ⓪ 
  141. ⓪"LineBit =     (unused0, unused1,
  142. ⓪1hauptZeile, absatz, formel, pgEnd, pgBegin, nonEdit);
  143. ⓪"LineBits =    SET OF LineBit;
  144. ⓪ 
  145. ⓪"DescBits =    SET OF [0..7];
  146. ⓪"DescWord =    WORD;
  147. ⓪ *)
  148. ⓪ 
  149. ⓪"Char =        RECORD
  150. ⓪2CASE : CARDINAL OF
  151. ⓪2| 1: mode: INTEGER;  (* negativ -> 'short' Modus *)
  152. ⓪2| 2: short: WORD
  153. ⓪2| 4: low: WORD; high: WORD
  154. ⓪2END;
  155. ⓪0END;
  156. ⓪ 
  157. ⓪"PtrChar = POINTER TO Char;
  158. ⓪ 
  159. ⓪ 
  160. ⓪ PROCEDURE taste (): BOOLEAN;
  161. ⓪"VAR ch: CHAR;
  162. ⓪"BEGIN
  163. ⓪$BusyRead (ch);
  164. ⓪$IF ch # 0C THEN
  165. ⓪&FlushKbd;
  166. ⓪&IF ch = 33C THEN RETURN TRUE END;
  167. ⓪&Read (ch);
  168. ⓪&IF ch = 33C THEN RETURN TRUE END;
  169. ⓪$END;
  170. ⓪$RETURN FALSE
  171. ⓪"END taste;
  172. ⓪ 
  173. ⓪ PROCEDURE toASCII (no: CARDINAL): CHAR;
  174. ⓪"(*$L-*)
  175. ⓪"BEGIN
  176. ⓪$ASSEMBLER
  177. ⓪(MOVE    -(A3),D0
  178. ⓪(LEA     tab(PC),A0
  179. ⓪(MOVE.B  0(A0,D0.W),(A3)+
  180. ⓪(ADDQ.L  #1,A3
  181. ⓪(RTS
  182. ⓪&tab:
  183. ⓪(ASC     ' ()/*0123456789'
  184. ⓪(ASC     '()/*0123456789'
  185. ⓪(ASC     '+-.§!"#$'
  186. ⓪(ASC     "%&'()*+,-./"
  187. ⓪(ASC     '0123456789'
  188. ⓪(ASC     ':;<=>?ü'
  189. ⓪(ASC     'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  190. ⓪(ASC     'öÜä^_`'
  191. ⓪(ASC     'abcdefghijklmnopqrstuvwxyz'
  192. ⓪(ASC     'Ö|Ä~ß@@@@@@@@@@@@@@@@@@@@@'
  193. ⓪(SYNC
  194. ⓪$END
  195. ⓪"END toASCII;
  196. ⓪"(*$L=*)
  197. ⓪ 
  198. ⓪ PROCEDURE decode (VAR sc: Char;
  199. ⓪2VAR ofs: INTEGER; VAR chNo: CARDINAL; VAR width: INTEGER;
  200. ⓪2VAR footNote: BOOLEAN): BOOLEAN;
  201. ⓪"VAR fontNo: INTEGER;
  202. ⓪&ok: BOOLEAN;
  203. ⓪&p: POINTER TO CHAR;
  204. ⓪"BEGIN
  205. ⓪$ASSEMBLER
  206. ⓪(MOVE.L  footNote(A6),A2
  207. ⓪(MOVE.L  sc(A6),A0
  208. ⓪(
  209. ⓪(MOVE.W  (A0),D2
  210. ⓪(MOVE.W  D2,D1
  211. ⓪(ANDI    #$7F,D2
  212. ⓪(BEQ     error
  213. ⓪(MOVE.L  chNo(A6),A1
  214. ⓪(MOVE    D2,(A1)
  215. ⓪(
  216. ⓪(MOVE.L  (A0),D0
  217. ⓪(BPL     l
  218. ⓪(
  219. ⓪(SWAP    D0
  220. ⓪(ROL.W   #7,D0
  221. ⓪(ANDI    #$003F,D0
  222. ⓪(LSR.W   #7,D1
  223. ⓪(ANDI    #3,D1
  224. ⓪(CLR.W   (A2)            ; keine Fußnote
  225. ⓪(BRA     e
  226. ⓪ 
  227. ⓪%error
  228. ⓪(CLR     ok(A6)
  229. ⓪(BRA     ee
  230. ⓪ 
  231. ⓪%l  BTST    #10,D1
  232. ⓪(SNE     D2
  233. ⓪(ANDI    #1,D2
  234. ⓪(MOVE    D2,(A2)         ; Fußnote
  235. ⓪(
  236. ⓪(BTST    #11,D0
  237. ⓪(BEQ     n1
  238. ⓪(BTST    #12,D0
  239. ⓪(BNE     error           ; groß- und kleinschrift geht nicht
  240. ⓪%n1 MOVE    D1,D2
  241. ⓪(ANDI    #0011100000000000%,D2
  242. ⓪(BNE     error           ; reserviert - müssen Null sein
  243. ⓪ 
  244. ⓪(ANDI    #$07FF,D0
  245. ⓪(LSR.W   #7,D1
  246. ⓪(ANDI    #7,D1
  247. ⓪(
  248. ⓪%e  MOVE.L  ofs(A6),A0
  249. ⓪(MOVE    D0,(A0)
  250. ⓪(MOVE    D1,fontNo(A6)
  251. ⓪(MOVE    #1,ok(A6)
  252. ⓪ 
  253. ⓪%ee
  254. ⓪$END;
  255. ⓪$IF NOT ok OR (font [fontNo] = NIL) THEN
  256. ⓪&RETURN FALSE
  257. ⓪$END;
  258. ⓪$p:= font [fontNo] + chOffset [fontNo][chNo] + 2L;
  259. ⓪$width:= ORD (p^);
  260. ⓪$(*
  261. ⓪&Write (toASCII (sc));
  262. ⓪&WriteCard (chNo, 4);
  263. ⓪&WriteCard (fontNo, 2);
  264. ⓪&WriteCard (spc, 3);
  265. ⓪&IF taste () THEN HALT END;
  266. ⓪&ASSEMBLER
  267. ⓪*MOVE.L p(A6),A0
  268. ⓪*BREAK
  269. ⓪&END;
  270. ⓪&WriteCard (ORD (p^), 3);
  271. ⓪&WriteLn;
  272. ⓪$*)
  273. ⓪$RETURN TRUE
  274. ⓪"END decode;
  275. ⓪ 
  276. ⓪ PROCEDURE advChar (VAR p: PtrChar);
  277. ⓪"(*$L-*)
  278. ⓪"BEGIN
  279. ⓪$ASSEMBLER
  280. ⓪(MOVE.L  -(A3),A0
  281. ⓪(MOVE.L  (A0),A1
  282. ⓪(TST.W   (A1)
  283. ⓪(BMI     w
  284. ⓪(ADDQ.L  #4,(A0)
  285. ⓪(RTS
  286. ⓪&w ADDQ.L  #2,(A0)
  287. ⓪$END
  288. ⓪"END advChar;
  289. ⓪"(*$L=*)
  290. ⓪ 
  291. ⓪ PROCEDURE peek (VAR p: ADDRESS; VAR d: ARRAY OF BYTE);
  292. ⓪"(*$L-*)
  293. ⓪"BEGIN
  294. ⓪$ASSEMBLER
  295. ⓪(MOVE.W  -(A3),D1
  296. ⓪(MOVE.L  -(A3),A1
  297. ⓪(MOVE.L  -(A3),A0
  298. ⓪(MOVE.L  (A0),A2
  299. ⓪&L MOVE.B  (A2)+,(A1)+
  300. ⓪(DBRA    D1,L
  301. ⓪(MOVE.L  A2,(A0)
  302. ⓪$END
  303. ⓪"END peek;
  304. ⓪"(*$L=*)
  305. ⓪ 
  306. ⓪ PROCEDURE wrln;
  307. ⓪"BEGIN
  308. ⓪$Text.WriteLn (out);
  309. ⓪"END wrln;
  310. ⓪ 
  311. ⓪ PROCEDURE wrstr (s: ARRAY OF CHAR);
  312. ⓪"BEGIN
  313. ⓪$Text.WriteString (out, s)
  314. ⓪"END wrstr;
  315. ⓪ 
  316. ⓪ PROCEDURE wr (c: CHAR);
  317. ⓪"BEGIN
  318. ⓪$Text.Write (out, c)
  319. ⓪"END wr;
  320. ⓪ 
  321. ⓪ PROCEDURE wrpg;
  322. ⓪"BEGIN
  323. ⓪$Text.WritePg (out)
  324. ⓪"END wrpg;
  325. ⓪ 
  326. ⓪ PROCEDURE beginOfPage (p: ADDRESS): BOOLEAN;
  327. ⓪"BEGIN
  328. ⓪$INC (p,2);
  329. ⓪$IF p^ # WORD (4) THEN RETURN FALSE END;
  330. ⓪$INC (p,2);
  331. ⓪$IF p^ # WORD ($C080) THEN RETURN FALSE END;
  332. ⓪$INC (p,2);
  333. ⓪$RETURN p^ # WORD (0)
  334. ⓪"END beginOfPage;
  335. ⓪ 
  336. ⓪ 
  337. ⓪ PROCEDURE parseText (ad: ADDRESS; len: LONGCARD);
  338. ⓪"
  339. ⓪"VAR p: PtrChar;
  340. ⓪&lastp, endp: ADDRESS;
  341. ⓪&lastseite, seite: CARDINAL;
  342. ⓪&error: BOOLEAN;
  343. ⓪ 
  344. ⓪"PROCEDURE scan (VAR p: PtrChar): BOOLEAN;
  345. ⓪$VAR chNo, blankLines, c1, c2, c3: CARDINAL;
  346. ⓪(ofs, lastWidth, width, i1, i2, i3: INTEGER;
  347. ⓪(l1, l2, l3: LONGCARD;
  348. ⓪(ch: CHAR;
  349. ⓪(sc: Char;
  350. ⓪(flag: SET OF [0..7];
  351. ⓪(p2: ADDRESS;
  352. ⓪(pos: CARDINAL;
  353. ⓪(lastFoot, footNote, ok: BOOLEAN;
  354. ⓪(s: ARRAY [0..255] OF CHAR;
  355. ⓪$BEGIN
  356. ⓪&(* Zeilenbeginn *)
  357. ⓪&peek (p, blankLines);
  358. ⓪&peek (p, c1);
  359. ⓪&IF c1 > 10000 THEN RETURN FALSE END;
  360. ⓪&p2:= ADDRESS (p) + LONG (c1);
  361. ⓪&peek (p, flag);
  362. ⓪&IF 7 IN flag THEN
  363. ⓪(IF 5 IN flag THEN
  364. ⓪*(*
  365. ⓪,wrpg ();
  366. ⓪**)
  367. ⓪(ELSIF 6 IN flag THEN
  368. ⓪*WriteString ('Seite ');
  369. ⓪*WriteCard (seite,0);
  370. ⓪*WriteLn;
  371. ⓪*INC (seite)
  372. ⓪(ELSE
  373. ⓪*(* eines von beiden muß es sein! *)
  374. ⓪*error:= TRUE;
  375. ⓪*RETURN FALSE;
  376. ⓪(END
  377. ⓪&ELSIF 3 IN flag THEN
  378. ⓪(wrln () (* Absatz *)
  379. ⓪&END;
  380. ⓪&peek (p, flag);
  381. ⓪&FOR c2:= 0 TO 7 DO
  382. ⓪(IF c2 IN flag THEN
  383. ⓪*peek (p, c3);
  384. ⓪(END
  385. ⓪&END;
  386. ⓪&pos:= 0; lastWidth:= 0;
  387. ⓪&lastFoot:= FALSE;
  388. ⓪&LOOP
  389. ⓪(IF ADDRESS (p) >= p2 THEN EXIT END;
  390. ⓪((* jedes Zeichen der Zeile *)
  391. ⓪(IF NOT decode (p^, ofs, chNo, width, footNote) THEN
  392. ⓪*error:= TRUE;
  393. ⓪*RETURN FALSE
  394. ⓪(END;
  395. ⓪(IF ofs < lastWidth THEN
  396. ⓪*s[pos]:= '@';
  397. ⓪*INC (pos)
  398. ⓪(ELSE
  399. ⓪*FOR i2:= 1 TO (ofs - lastWidth + spaceWidth - 4) DIV spaceWidth DO
  400. ⓪,IF pos >= SIZE (s) THEN RETURN FALSE END;
  401. ⓪,s[pos]:= ' ';
  402. ⓪,INC (pos);
  403. ⓪*END;
  404. ⓪(END;
  405. ⓪(IF pos >= SIZE (s) THEN RETURN FALSE END;
  406. ⓪(lastWidth:= width;
  407. ⓪(IF footNote THEN
  408. ⓪*IF NOT lastFoot THEN
  409. ⓪,lastFoot:= TRUE;
  410. ⓪,s[pos]:= '#';
  411. ⓪,INC (pos);
  412. ⓪,IF pos >= SIZE (s) THEN RETURN FALSE END;
  413. ⓪*END
  414. ⓪(ELSE
  415. ⓪*lastFoot:= FALSE
  416. ⓪(END;
  417. ⓪(s[pos]:= toASCII (chNo);
  418. ⓪(INC (pos);
  419. ⓪(IF pos >= SIZE (s) THEN RETURN FALSE END;
  420. ⓪(advChar (p);
  421. ⓪&END;
  422. ⓪&
  423. ⓪&IF pos > 0 THEN
  424. ⓪(s[pos]:= 0C;
  425. ⓪(wrstr (s);
  426. ⓪&END;
  427. ⓪&wrln ();
  428. ⓪$
  429. ⓪&IF error THEN RETURN FALSE END;
  430. ⓪$
  431. ⓪&RETURN TRUE
  432. ⓪$END scan;
  433. ⓪ 
  434. ⓪"BEGIN
  435. ⓪$endp:= ad + len;
  436. ⓪$(* rest vom header überlesen *)
  437. ⓪$seite:= 1;
  438. ⓪$p:= ad + 4L;
  439. ⓪$ASSEMBLER
  440. ⓪*MOVE.L  p(A6),A0
  441. ⓪*; BREAK
  442. ⓪$END;
  443. ⓪$
  444. ⓪$(* zeilen lesen *)
  445. ⓪$REPEAT
  446. ⓪&
  447. ⓪&error:= FALSE;
  448. ⓪&
  449. ⓪&LOOP
  450. ⓪(lastp:= p;
  451. ⓪(
  452. ⓪((*
  453. ⓪*IF ~(scan (p) & scan (p) & scan (p) & scan (p) & scan (p) & scan (p)) THEN
  454. ⓪,p:= lastp+2;
  455. ⓪*END;
  456. ⓪(*)
  457. ⓪(IF scan (p) THEN END;
  458. ⓪(
  459. ⓪(IF p >= endp THEN EXIT END;
  460. ⓪&END; (* LOOP *)
  461. ⓪&
  462. ⓪&IF error THEN
  463. ⓪(wrln ();
  464. ⓪(wrstr ('@@@');
  465. ⓪(wrln ();
  466. ⓪(wrln ();
  467. ⓪(WriteString ('Bruch!'); WriteLn;
  468. ⓪(
  469. ⓪(IF ODD (p) THEN INC (p) END;
  470. ⓪((*
  471. ⓪(REPEAT
  472. ⓪*INC (p,2);
  473. ⓪(UNTIL beginOfPage (p) OR (ADDRESS (p) >= endp)
  474. ⓪(*)
  475. ⓪&END;
  476. ⓪ 
  477. ⓪$UNTIL ADDRESS (p) >= endp;
  478. ⓪"END parseText;
  479. ⓪ 
  480. ⓪ PROCEDURE readFont (n: CARDINAL);
  481. ⓪"VAR
  482. ⓪$s8: ARRAY [0..7] OF CHAR;
  483. ⓪$len, lc: LONGCARD;
  484. ⓪$buf: ADDRESS;
  485. ⓪$ok: BOOLEAN;
  486. ⓪$s: String;
  487. ⓪$f: File;
  488. ⓪"BEGIN
  489. ⓪$Concat (chsnames [n], '.E24', s, ok);
  490. ⓪$ConcatPath (SelectMask, s, SelectMask);
  491. ⓪$SelectFile ('Font?', s, ok);
  492. ⓪$WritePg;
  493. ⓪$IF NOT ok THEN RETURN END;
  494. ⓪$Open (f, s, readOnly);
  495. ⓪$
  496. ⓪$ReadBlock (f, s8);
  497. ⓪$IF Compare ('eset0001', s8) # equal THEN
  498. ⓪&WriteString ("Dies ist keine Font-Datei!");
  499. ⓪&wait;
  500. ⓪&RETURN
  501. ⓪$END;
  502. ⓪$
  503. ⓪$ReadBlock (f, lc);
  504. ⓪$ALLOCATE (buf, lc);
  505. ⓪$IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;
  506. ⓪$ReadBytes (f, buf, lc, len);
  507. ⓪$IF lc # len THEN
  508. ⓪&WriteString ("EOF!");
  509. ⓪&wait;
  510. ⓪$END;
  511. ⓪$DEALLOCATE (buf, lc);
  512. ⓪$
  513. ⓪$ReadBlock (f, chOffset[n]);
  514. ⓪$ALLOCATE (font[n], chOffset[n][0]);
  515. ⓪$IF font[n] = NIL THEN WriteString ('Out of mem'); wait; RETURN END;
  516. ⓪$ReadBytes (f, font[n], chOffset[n][0], len);
  517. ⓪$IF chOffset[n][0] # len THEN
  518. ⓪&WriteString ("EOF!");
  519. ⓪&wait;
  520. ⓪$END;
  521. ⓪$Close (f);
  522. ⓪"END readFont;
  523. ⓪ 
  524. ⓪ VAR f: File;
  525. ⓪$ok: BOOLEAN;
  526. ⓪$s: String;
  527. ⓪$s8: ARRAY [0..7] OF CHAR;
  528. ⓪$s4: ARRAY [0..3] OF CHAR;
  529. ⓪$c: CARDINAL;
  530. ⓪$i: CARDINAL;
  531. ⓪$len, lc: LONGCARD;
  532. ⓪$fonts: BOOLEAN;
  533. ⓪$buf: ADDRESS;
  534. ⓪$dev: DeviceHandle;
  535. ⓪ 
  536. ⓪ BEGIN
  537. ⓪"InitGem (RC, dev, ok);
  538. ⓪"HideMouse;
  539. ⓪"WritePg;
  540. ⓪"SelectMask:= '*.sdo';
  541. ⓪"s:= '';
  542. ⓪"SelectFile ('Signum-Datei zum Lesen', s, ok);
  543. ⓪"WritePg;
  544. ⓪"IF NOT ok THEN RETURN END;
  545. ⓪"Open (f, s, readOnly);
  546. ⓪"
  547. ⓪"spaceWidth:= 9;
  548. ⓪"
  549. ⓪"ReadBlock (f, s8);
  550. ⓪"IF Compare ('sdoc0001', s8) # equal THEN
  551. ⓪$WriteString ("Dies ist keine Signum-Datei!");
  552. ⓪$wait;
  553. ⓪$RETURN
  554. ⓪"END;
  555. ⓪"
  556. ⓪"(* Info-Blocks überlesen *)
  557. ⓪"s4:= '';
  558. ⓪"fonts:= FALSE;
  559. ⓪"LOOP
  560. ⓪$ReadBlock (f, lc);
  561. ⓪$IF Compare ('cset', s4) = equal THEN
  562. ⓪&fonts:= TRUE;
  563. ⓪&ReadBlock (f, chsnames);
  564. ⓪&FOR i:= 0 TO 6 DO
  565. ⓪(IF NOT Empty (chsnames[i]) THEN
  566. ⓪*readFont (i);
  567. ⓪(END
  568. ⓪&END
  569. ⓪$ELSE
  570. ⓪&(* geht nur, wenn die Blöcke fehlerfrei sind:
  571. ⓪(ALLOCATE (buf, lc);
  572. ⓪(IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;
  573. ⓪(ReadBytes (f, buf, lc, len);
  574. ⓪(IF lc # len THEN
  575. ⓪*WriteString ("EOF vor 'tebu'!");
  576. ⓪*wait;
  577. ⓪*RETURN
  578. ⓪(END;
  579. ⓪(DEALLOCATE (buf, lc);
  580. ⓪&*)
  581. ⓪&IF fonts THEN
  582. ⓪(EXIT (* damit werden auch die restlichen Blocks als Text geladen *)
  583. ⓪&END
  584. ⓪$END;
  585. ⓪$ReadBlock (f, s4);
  586. ⓪$IF Compare ('tebu', s4) = equal THEN EXIT END;
  587. ⓪"END;
  588. ⓪"
  589. ⓪"(*
  590. ⓪#* Text einlesen
  591. ⓪#*)
  592. ⓪"(* Länge der Text-Daten:  ReadBlock (f, lc); *)
  593. ⓪"lc:= FileSize (f) - FilePos (f); (* Ganzen Datei-Rest lesen *)
  594. ⓪"WriteString ('Textpos: '); WriteLHex (FilePos(f), 0); WriteLn;
  595. ⓪"WriteString ('Textlänge: '); WriteLHex (lc, 0); WriteLn;
  596. ⓪"ALLOCATE (buf, lc);
  597. ⓪"IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;
  598. ⓪"ReadBytes (f, buf, lc, len);
  599. ⓪"IF lc # len THEN
  600. ⓪$WriteString ("Datei ist zu kurz! Weiter...");
  601. ⓪$wait;
  602. ⓪$WriteLn;
  603. ⓪"END;
  604. ⓪"
  605. ⓪"Close (f);
  606. ⓪ 
  607. ⓪"SelectMask:= '*.txt';
  608. ⓪"s:= 'output.txt';
  609. ⓪"SelectFile ('Ausgabe-Datei', s, ok);
  610. ⓪"WritePg;
  611. ⓪"IF NOT ok THEN RETURN END;
  612. ⓪"Create (out, s, writeOnly, replaceOld);
  613. ⓪"WriteString ('Start...');
  614. ⓪"WriteLn;
  615. ⓪"parseText (buf, len);
  616. ⓪"Close (out);
  617. ⓪ 
  618. ⓪"WriteLn;
  619. ⓪"WriteString ('Ende');
  620. ⓪"wait
  621. ⓪ END SignumRead.
  622. ⓪ ə
  623. (* $FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$00001AB9$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7Ç$00000050T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000026CD$0000289A$000028FE$00002A91$00002ADD$00002ABD$00000E11$00000050$00002B34$00002ADD$00002096$00002111$0000208C$000026D7$000028AB$0000289AáÇé*)
  624.