home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 1 / Mecomp-CD.iso / amiga / tools / misc / videotext5.41 / src / datei.p < prev    next >
Encoding:
Text File  |  1997-06-15  |  12.6 KB  |  419 lines
  1. UNIT datei; {$project vt}
  2. { Dateioperationen zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES bildschirm;
  5.  
  6. VAR configpath: String[20];
  7.              
  8. FUNCTION filetype(name: Str80): Integer;
  9. FUNCTION getpages(filename: Str80; sorted: Boolean): Integer;
  10. FUNCTION printpage(seite: p_onepage): Boolean;
  11. PROCEDURE page_to_clip(seite: p_onepage);
  12. FUNCTION save_action(seite: p_onepage; mode: Integer): Integer;
  13. PROCEDURE name2dosname(s: str80; VAR s2: str80);
  14. PROCEDURE namefrompage(VAR filename: str80; seite: p_onepage);
  15.  
  16. { ---------------------------------------------------------------------- }
  17.  
  18. IMPLEMENTATION;
  19. {$ opt q,s+,i+} { keine Laufzeitprüfungen außer Stack und Feldindizes }
  20.  
  21. FUNCTION getlong(VAR datei: Text): Long;
  22. VAR l: Long;
  23.     i: Integer;
  24.     ch: Char;
  25. BEGIN
  26.   l := 0;
  27.   FOR i := 1 TO 4 DO BEGIN
  28.     Read(datei,ch);
  29.     l := (l SHL 8) OR Ord(ch);
  30.   END;
  31.   getlong := l;
  32. END;
  33.  
  34. FUNCTION filetype{(name: Str80): Integer};
  35. { Typcodierung: }
  36. { -1: Datei existiert nicht (oder ist leer) }
  37. {  0: unbekannter Typ (vermutlich roher ASCII-Text) }
  38. {  1: programmeigener Typ 'VTPG'=$56545047 }
  39. {     VTex-Format 'FG24'=$46473234 }
  40. {     oder TeleText 'TELE'=$54454C45 }
  41. {  2: AmigaDOS-Programmdatei $000003F3 }
  42. {  3: IFF-Datei 'FORM'=$464F524D }
  43. {  4: Workbench-Icon $E310 }
  44. VAR head: Long;
  45.     datei: Text;
  46. BEGIN
  47.   Reset(datei,name);
  48.   IF IOresult=0 THEN BEGIN
  49.     filetype := 0;
  50.     IF FileSize(datei)=0 THEN filetype := -1; { leere Datei }
  51.     head := getlong(datei);
  52.     IF head=$56545047 THEN filetype := 1;
  53.     IF head=$46473234 THEN filetype := 1;
  54.     IF head=$54454C45 THEN filetype := 1;
  55.     IF head=$000003F3 THEN filetype := 2;
  56.     IF head=$464F524D THEN filetype := 3;
  57.     IF (head AND $FFFF0000)=$E3100000 THEN filetype := 4;
  58.     Close(datei);
  59.   END ELSE
  60.     filetype := -1; { Datei existiert nicht }
  61. END;
  62.  
  63. FUNCTION getpages{(filename: Str80; sorted: Boolean): Integer};
  64. { Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
  65. { einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
  66. VAR i,j, jlpageno, gelesen: Integer;
  67.     bytes: ^ARRAY[1..41] OF Char;
  68.     datei: Text;
  69.     zeile: Str80;
  70.     seite: p_onepage;
  71.     l: Long;
  72.     c: Char;
  73. CONST vtpg=$56545047;
  74.       fg24=$46473234;
  75.       tvtx=$54565458;
  76.       tele=$54454C45;
  77.       texd=$54455854;
  78.        sub=$535542;
  79. PROCEDURE findword;
  80. { Hilft, zeile in Worte zu zerlegen. Parameter j: Startpunkt, Ergebnis: }
  81. { i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  82. BEGIN
  83.   i := j; WHILE (zeile[i]=' ') AND (zeile[i]<>#0) DO Inc(i);
  84.   j := i + 1; WHILE NOT (zeile[j] IN [' ',#0]) DO Inc(j);
  85. END;
  86. BEGIN
  87.   gelesen := 0;
  88.   Reset(datei,filename);
  89.   IF (IOresult<>0) THEN     { Datei existiert nicht }
  90.     Exit;
  91.   Buffer(datei,200);
  92.   WHILE NOT EoF(datei) DO BEGIN
  93.     l := 0;
  94.     REPEAT
  95.       Read(datei,c); l := l SHL 8 OR Ord(c);
  96.     UNTIL (l=vtpg) OR (l=fg24) OR (l=tele) OR (l AND $FFFFFF=sub)
  97.     OR EoF(datei);
  98.     { mein eigenes Format lesen: }
  99.     IF l=vtpg THEN BEGIN
  100.       New(seite);
  101.       Read(datei,c); { LF überlesen }
  102.       FOR i := 0 TO 23 DO BEGIN
  103.         bytes := Ptr(^seite^.chars[40*i]);
  104.         BlockRead(datei,bytes^,40);
  105.         Read(datei,c); { LF überlesen }
  106.       END;
  107.       ReadLn(datei,zeile); j := 1;
  108.       findword; seite^.pg := hexval(Copy(zeile,i,j-i));
  109.       findword; seite^.sp := hexval(Copy(zeile,i,j-i));
  110.       findword; seite^.cbits := hexval(Copy(zeile,i,j-i));
  111.       seite^.dejavu := False;
  112.       IF make_bcd(get_bcd(seite^.pg))<>seite^.pg THEN
  113.         seite^.cbits := seite^.cbits OR PF_PSEUDO
  114.       ELSE
  115.         seite^.cbits := seite^.cbits AND NOT PF_PSEUDO;
  116.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  117.       Inc(gelesen);
  118.     END;
  119.     { das Format der VTex-Software lesen: }
  120.     IF l=fg24 THEN IF getlong(datei)=tvtx THEN BEGIN
  121.       New(seite);
  122.       seite^.pg := make_bcd(getlong(datei));
  123.       seite^.sp := make_bcd(getlong(datei));
  124.       seite^.cbits := 0;
  125.       l := getlong(datei); { aus der Zeichensatz-Nummer die Steuerbits }
  126.       FOR i := 14 DOWNTO 12 DO BEGIN { C12,C13,C14 "rekonstruieren" }
  127.         IF Odd(l) THEN seite^.cbits := seite^.cbits OR (1 SHL i);
  128.         l := l SHR 1;
  129.       END;
  130.       FOR i := 1 TO 18 DO Read(datei,c); { ??? }
  131.       BlockRead(datei,seite^.chars,960);
  132.       seite^.dejavu := False;
  133.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  134.       Inc(gelesen);
  135.     END;
  136.     { Jan Leuverink's TeleText-Format lesen: }
  137.     IF l=tele THEN IF getlong(datei)=texd THEN BEGIN  { header }
  138.       jlpageno := 0;
  139.       FOR i := 1 TO 3 DO BEGIN
  140.         Read(datei,c); jlpageno := (jlpageno SHL 4) OR (Ord(c)-Ord('0'));
  141.       END;
  142.     END;
  143.     IF (l AND $FFFFFF=sub) THEN BEGIN  { eine Seite }
  144.       New(seite);
  145.       seite^.pg := jlpageno;
  146.       seite^.sp := 0;
  147.       seite^.cbits := $4000;  { immer dt. Zeichensatz %-( }
  148.       FOR i := 1 TO 4 DO BEGIN
  149.         Read(datei,c); IF c>='0' THEN
  150.           seite^.sp := (seite^.sp SHL 4) OR (Ord(c)-Ord('0'));
  151.       END;
  152.       BlockRead(datei,seite^.chars,960);
  153.       seite^.dejavu := False;
  154.       IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
  155.       Inc(gelesen);
  156.     END;
  157.   END;
  158.   Close(datei);
  159.   getpages := gelesen;
  160. END;
  161.  
  162.  
  163. FUNCTION printpage{(seite: p_onepage): Boolean};
  164. { Druckerausgabe, simpelste Ausführung }
  165. VAR drucker: Text;
  166.     i: Integer;
  167.     s: Str80;
  168.     monster: ^String[1000]
  169. BEGIN
  170.   printpage := False;
  171.   Reset(drucker,'PRT:');
  172.   IF IOResult<>0 THEN Exit;
  173.   New(monster); monster^ := '';
  174.   FOR i := 0 TO 23 DO BEGIN
  175.     makeascii(seite, i, True, s);
  176.     monster^ := monster^ + s + Chr(10);
  177.   END;
  178.   Write(drucker,monster^);
  179.   Dispose(monster);
  180.   Close(drucker); printpage := True;
  181. END;
  182.  
  183. PROCEDURE page_to_clip{(seite: p_onepage)};
  184. { Seitentext ins Clipboard schreiben }
  185. VAR s: str80;
  186.     i: Integer;
  187. BEGIN
  188.   IF seite=Nil THEN Exit;
  189.   start_clip(24*41);
  190.   FOR i := 0 TO 23 DO BEGIN
  191.     makeascii(seite, i, True, s);
  192.     s := s + Chr(10);
  193.     clip_it(s,41);
  194.   END;
  195.   end_clip;
  196. END;
  197.  
  198. FUNCTION savepage(seite: p_onepage; ascii: Boolean; VAR datei: Text): Boolean;
  199. { Seite abspeichern, ASCII oder rohes VT-Format }
  200. { ASCII-Text wird für Untertitel und Schlagzeilen 'komprimiert' ausgegeben: }
  201. { nur die auf der Seite befindliche Box (mindestens aber eine Leerzeile, bei }
  202. { Schlagzeilen zusätzlich die Kopfzeile). }
  203. { Bei Untertiteln werden die Farbsteuerzeichen in Klartext umgesetzt. }
  204. VAR i, zeile: Integer;
  205.     s: str80;
  206.     bytes: ^ARRAY [1..41] OF Char;
  207.     is_stitle,is_headln,visible: Boolean;
  208. BEGIN
  209.   savepage := False; IF seite=Nil THEN Exit;
  210.   IF ascii THEN BEGIN  { ASCII-Textausgabe }
  211.     is_stitle := (seite^.cbits AND PF_STITLE)<>0;
  212.     is_headln := (seite^.cbits AND PF_HEADLN)<>0;
  213.     FOR zeile := 0 to 23 DO BEGIN
  214.       IF is_stitle OR is_headln THEN BEGIN
  215.         visible := False;
  216.         FOR i := 0 TO 39 DO
  217.           IF (seite^.chars[zeile*40+i]=11) THEN visible := True;
  218.         IF is_headln AND (zeile=0) THEN
  219.           visible := True;
  220.       END ELSE
  221.         visible := True;
  222.       IF visible THEN BEGIN
  223.         makeascii(seite, zeile, NOT is_stitle, s);
  224.         WriteLn(datei, s); IF IOResult<>0 THEN Exit; { Disk full o. ä. }
  225.       END;
  226.     END;
  227.     WriteLn(datei);
  228.   END ELSE BEGIN   { (beinahe) rohes VT-Format }
  229.     WriteLn(datei,'VTPG');
  230.     FOR zeile := 0 to 23 DO BEGIN
  231.       bytes := Ptr(^seite^.chars[40*zeile]);
  232.       BlockWrite(datei,bytes^,40); IF IOResult<>0 THEN Exit; { Disk full }
  233.       WriteLn(datei);
  234.     END;
  235.     Write(datei,hexstr(seite^.pg,0)); Write(datei,' ');
  236.     Write(datei,hexstr(seite^.sp,0)); Write(datei,' $');
  237.     Write(datei,hexstr(seite^.cbits,4)); WriteLn(datei);
  238.   END;
  239.   savepage := True;
  240. END;
  241.  
  242. FUNCTION save_action{(seite: p_onepage; mode: Integer): Integer};
  243. { Verwaltungskram für savepage(). }
  244. { Bedeutung von <mode>: }
  245. { 1=nur <seite> speichern, 2=mit allen Unterseiten, 3=alle ab dieser, }
  246. { 4=wie 3, aber ohne Rückfrage }
  247. { Ergebnis: }
  248. { 0: OK, 1: Benutzer wollte nicht, 2: Anhängen unzulässig, 3: IO-Fehler }
  249. VAR ft: Integer;
  250.     pg1,pg2: p_onepage;
  251.     ok: Boolean;
  252.     s: str80;
  253.     datei: Text;
  254. BEGIN
  255.   save_action := 1;
  256.   IF seite=Nil THEN Exit;
  257.   fileinfo;
  258.   IF mode=3 THEN BEGIN  
  259.     { Rückfrage, weil das etwas länger dauern könnte }
  260.     IF seite=root THEN
  261.       s := 'Alle '+IntStr(listsize)+' Seiten speichern?'
  262.     ELSE
  263.       s := IntStr(listsize-posn_in_list(seite))
  264.           +' Seiten ab dieser speichern?';
  265.     IF NOT ja_nein(s) THEN Exit;
  266.   END;
  267.   { Sicherheitsprüfung: Anhängen nur an geeignete Dateien erlauben: }
  268.   ft := filetype(outputname);
  269.   IF ft IN [2,3,4] THEN BEGIN
  270.     CASE ft OF
  271.       2: short_msg('Programmdatei',2);
  272.       3: short_msg('IFF-Datei',2);
  273.       4: short_msg('Icon-Datei',2);
  274.     END;
  275.     add_msg(', Anhängen unzulässig!',2);
  276.     save_action := 2; Exit;
  277.   END;
  278.   { Alle Rückfragen überstanden -> speichern: }
  279.   busy_pointer;
  280.   Reset(datei,outputname);
  281.   IF (IOresult<>0) THEN { Datei existiert vermutlich nicht }
  282.     Rewrite(datei,outputname);
  283.   IF IOresult<>0 THEN BEGIN    { wahrscheinlich 'Object in use' }
  284.     short_msg('Kann die Ausgabedatei nicht öffnen!',2);
  285.     Exit;
  286.   END;
  287.   IF withicon THEN IF FileSize(datei)=0 THEN
  288.     IF asciifile THEN
  289.       create_icon('Icons/ASCII', outputname)
  290.     ELSE
  291.       create_icon('Icons/VT', outputname);
  292.   Buffer(datei, 500);
  293.   Seek(datei, FileSize(datei));
  294.   pg1 := root;
  295.   { um aber auch Seiten speichern zu können, die nicht in der Liste stehen: }
  296.   IF (seite^.prev=Nil) AND (root<>seite) THEN pg1 := seite;
  297.   ok := False;
  298.   WHILE pg1<>NIL DO BEGIN
  299.     CASE mode OF
  300.       1: ok := (pg1=seite);
  301.       2: ok := (pg1^.pg=seite^.pg);
  302.       3,4: IF pg1=seite THEN ok := True;
  303.     END;
  304.     IF ok THEN BEGIN
  305.       short_msg('Seite '+hexstr(pg1^.pg,0)+'/',0);
  306.       add_msg(hexstr(pg1^.sp,0)+' ...',0);
  307.       IF savepage(pg1,asciifile,datei) THEN
  308.         add_msg(' gespeichert.',0)
  309.       ELSE BEGIN
  310.         add_msg(' Dateifehler!',2);
  311.         save_action := 3;
  312.         pg1 := Nil;
  313.       END;
  314.     END;
  315.     IF pg1<>Nil THEN pg1 := pg1^.next;
  316.   END;
  317.   Close(datei);
  318.   normal_pointer;
  319.   save_action := 0;
  320. END;
  321.  
  322. PROCEDURE civilize(s: str80; VAR s2: str80;);
  323. { String als DOS-Namen tauglich machen }
  324. VAR i,k,l: Integer;
  325.     sonder: String[8];
  326.     uebers: String[15];
  327. BEGIN
  328.   sonder := '{|}[\]~'; uebers := 'aeoeueAEOEUEss';
  329.   i := 1; k := 1;
  330.   REPEAT
  331.     CASE s[i] OF
  332.       ' ': s2[k] := '_'; { Leerzeichen }
  333.       '/',':': s2[k] := '-'; { Verzeichnis-Begrenzer }
  334.       OTHERWISE s2[k] := s[i];
  335.     END;
  336.     l := Pos(s[i],sonder);
  337.     IF l>0 THEN BEGIN
  338.       s2[k] := uebers[2*l-1]; Inc(k); s2[k] := uebers[2*l];
  339.     END;
  340.     Inc(i); Inc(k);
  341.   UNTIL s[i] = #0;
  342.   s2[k] := #0;
  343. END;
  344.  
  345. PROCEDURE name2dosname{(s: str80; VAR s2: str80)};
  346. { Bekommt eine Titelzeile übergeben und liefert (normalerweise mit Hilfe }
  347. { der ".stations"-Liste) einen DOS-tauglichen Filenamen zurück. }
  348. VAR zeile,name: str80;
  349.     i,j,l: Integer;
  350.     stnfile: Text;
  351.     has_letters, complain: Boolean;
  352. BEGIN
  353.   s2 := ''; name := configpath+'.stations'; complain := False;
  354.   Reset(stnfile, name);
  355.   IF IOResult=0 THEN BEGIN
  356.     Buffer(stnfile,100);
  357.     WHILE NOT EoF(stnfile) AND (s2='') DO BEGIN
  358.       ReadLn(stnfile,zeile); i := Pos('=',zeile);
  359.       IF i>1 THEN BEGIN
  360.         l := Length(zeile); WHILE l>0 DO BEGIN
  361.           IF zeile[l]<=' ' THEN zeile[l] := #0 ELSE l := 1;
  362.           Dec(l);
  363.         END;
  364.         l := Length(zeile);
  365.         s2 := Copy(zeile,1,i-1);
  366.         IF Pos(s2, s)>0 THEN  s2 := Copy(zeile,i+1,l-i)  ELSE s2 := '';
  367.       END;
  368.     END;
  369.     Close(stnfile);
  370.     IF s2='' THEN complain := True;
  371.   END ELSE
  372.     short_msg('Senderliste nicht gefunden',2);
  373.   IF s2='' THEN BEGIN  { das 1. Wort nehmen, das auch Buchstaben enthält: }
  374.     j := 1;
  375.     REPEAT
  376.       i := j;
  377.       WHILE (s[i]=' ') DO Inc(i);
  378.       j := i; has_letters := False;
  379.       WHILE NOT (s[j] IN [' ', #0]) DO BEGIN
  380.         IF s[j] IN ['a'..'z','A'..'Z'] THEN has_letters := True;
  381.         Inc(j);
  382.       END;
  383.     UNTIL has_letters OR (s[i]=#0);
  384.     IF j>i THEN BEGIN
  385.       zeile := Copy(s, i, j-i); civilize(zeile, s2);
  386.     END;
  387.     IF complain THEN
  388.       short_msg('"'+s2+'"'+' nicht in der Senderliste',0);
  389.   END;
  390. END;
  391.  
  392. PROCEDURE namefrompage{(VAR filename: str80; seite: p_onepage)};
  393. { Dateinamen nach der Titelzeile einer Seite abändern }
  394. VAR i,j,l: Integer;
  395.     pfad,name,s: str80;
  396.     has_letters: Boolean;
  397. BEGIN
  398.   IF seite=Nil THEN Exit;
  399.   { Dateinamen zerlegen: }
  400.   l := Length(filename);
  401.   j := 0; FOR i := 1 TO l DO
  402.     IF filename[i] IN ['/',':'] THEN j := i;
  403.   IF j=0 THEN pfad := '' ELSE pfad := Copy(filename,1,j);
  404.   IF j=l THEN name := '' ELSE name := Copy(filename,j+1,l-j);
  405.   { Titelzeile extrahieren: }
  406.   FOR i := 1 TO 40 DO BEGIN
  407.     s[i] := Chr(seite^.chars[i-1]); IF s[i]<' ' THEN s[i] := ' ';
  408.   END;
  409.   s[41] := #0;
  410.   name2dosname(s, filename);
  411.   IF filename<>'' THEN name := filename;
  412.   filename := pfad + name;
  413. END;
  414.  
  415. BEGIN  { Initialisierungen }
  416.   configpath := 'presets/';  { bitte *nicht* mehr ändern! }
  417. END.
  418.  
  419.