home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 07 / dtp / asci2tex.pas < prev    next >
Pascal/Delphi Source File  |  1990-05-14  |  8KB  |  282 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ASCI2TEX.PAS                       *)
  3. (*         (c) 1990 Norbert Schmitt & TOOLBOX             *)
  4. (* ------------------------------------------------------ *)
  5.  
  6. PROGRAM ascii2tex;
  7. USES crt;
  8.  
  9. CONST
  10.       zeil_laenge    = 100 ;          (* max. Zeilenlänge *)
  11.             (* Zeilenumbruch erfolgt ab Spalte 60 bei ' ' *)
  12.  
  13. TYPE  zeil_range = 1..zeil_laenge;
  14.       zeile      = PACKED ARRAY [zeil_range] OF CHAR ;
  15.  
  16. VAR   ausdruck     : zeile ;
  17.       ch           : char;
  18.       charset      : SET OF char;
  19.       eingabefile,
  20.       ausgabefile  : TEXT;
  21.       datei,
  22.       txtdatei,
  23.       texdatei     : STRING;
  24.       pos_aus,i    : integer;
  25.       dt_Anf_z_Beg,
  26.       einf_Anf_z_Beg,
  27.       ok           : Boolean;
  28.  
  29. FUNCTION dateivorhanden (VAR xfile : TEXT;
  30.                              dateiname : STRING): Boolean;
  31. BEGIN
  32.   assign (xfile, dateiname);
  33.   {$I-}
  34.      reset(xfile);
  35.   {$I+}
  36.   IF IOResult = 0 THEN
  37.      dateivorhanden := TRUE
  38.   ELSE
  39.      dateivorhanden := FALSE;
  40. END;
  41.  
  42. PROCEDURE Paramtest;
  43. BEGIN
  44.    ok := FALSE;
  45.    IF ParamCount = 0 THEN BEGIN
  46.       GotoXY( 1, 5);
  47.       write('Path und Dateiname(ohne .TXT) : ');
  48.       readln(datei);
  49.       FOR i := 1 TO Length(datei) DO
  50.           datei[i] := UpCase(datei[i]);
  51.       ok := TRUE;
  52.    END;
  53.    IF ParamCount = 1 THEN BEGIN
  54.       datei := ParamStr(1);
  55.       ok := TRUE;
  56.    END;
  57.    IF ok THEN BEGIN
  58.       ok := FALSE;
  59.       txtdatei := datei + '.TXT';
  60.       IF NOT dateivorhanden(eingabefile, txtdatei) THEN
  61.       BEGIN
  62.          writeln;
  63.          writeln('Fehler: Datei ',txtdatei,
  64.          ' im Path nicht vorhanden.');
  65.          writeln;
  66.          writeln('Hinweis: Programm erneut aufrufen ',
  67.          'und den richtigen');
  68.          writeln('Path und Dateinamen ohne .TXT angeben');
  69.          writeln('Oder: Datei hat eine andere ',
  70.          'Endung als .TXT');
  71.          writeln('Das Programm wird jetzt abgebrochen');
  72.          writeln;
  73.          Halt(1);
  74.          ok := FALSE
  75.       END ELSE
  76.          ok := TRUE;
  77.    END;
  78. END;
  79.  
  80. PROCEDURE TxttoTex;
  81. (* Eröffnung einer TeX-Datei *)
  82. VAR antwort : char;
  83. BEGIN
  84.   antwort := 'N';
  85.   IF ok THEN BEGIN
  86.      texdatei := datei + '.TEX';
  87.      REPEAT
  88.        IF NOT dateivorhanden(ausgabefile, texdatei) THEN
  89.        BEGIN
  90.           rewrite(ausgabefile);
  91.           antwort := 'J';
  92.        END ELSE
  93.        BEGIN
  94.           writeln('Datei ',texdatei, ' bereits vorhanden!');
  95.           write('Überschreiben? (J/N) ');
  96.           readln(antwort);
  97.           IF antwort IN ['j', 'J'] THEN
  98.              rewrite(ausgabefile)
  99.                         (* bestehende Datei überschreiben *)
  100.           ELSE
  101.           BEGIN
  102.              writeln;
  103.              write('gewünschten Dateinamen ',
  104.              '(ohne Endung .TEX) eingeben: ');
  105.              readln(datei);
  106.              FOR i := 1 TO Length(datei) DO
  107.                  datei[i] := UpCase(datei[i]);
  108.              texdatei := datei + '.TEX';
  109.           END;
  110.        END;
  111.      UNTIL antwort IN ['j','J'];
  112.    END;
  113. END;
  114.  
  115. PROCEDURE einf_anf (ch : char;
  116.                    VAR ausd : zeile;
  117.                    VAR pos  : integer);
  118.             (* Auswertung der einfachen Anführungszeichen *)
  119. BEGIN
  120.   ausd[pos] := '\'; inc(pos);
  121.   IF einf_Anf_z_Beg THEN BEGIN
  122.      ausd[pos] := 'g'; inc(pos);
  123.      ausd[pos] := 'l'; inc(pos);
  124.      ausd[pos] := 'q'; inc(pos);
  125.      einf_anf_z_Beg := NOT einf_anf_z_Beg
  126.   END ELSE BEGIN
  127.      ausd[pos] := 'g'; inc(pos);
  128.      ausd[pos] := 'r'; inc(pos);
  129.      ausd[pos] := 'q'; inc(pos);
  130.      einf_anf_z_Beg := NOT einf_anf_z_Beg
  131.   END;
  132.   inc(pos);
  133. END;
  134.  
  135. PROCEDURE auswertung (ch : char;
  136.                       VAR ausd : zeile;
  137.                       VAR pos  : integer);
  138. BEGIN
  139.   IF ch IN charset THEN BEGIN
  140.      CASE ch OF
  141.         'ä' : BEGIN
  142.                 ausd[pos] := '"'; inc(pos);
  143.                 ausd[pos] := 'a';
  144.               END;
  145.         'Ä' : BEGIN
  146.                 ausd[pos] := '"'; inc(pos);
  147.                 ausd[pos] := 'A';
  148.               END;
  149.         'ö' : BEGIN
  150.                 ausd[pos] := '"'; inc(pos);
  151.                 ausd[pos] := 'o';
  152.               END;
  153.         'Ö' : BEGIN
  154.                 ausd[pos] := '"'; inc(pos);
  155.                 ausd[pos] := 'O';
  156.               END;
  157.         'ü' : BEGIN
  158.                 ausd[pos] := '"'; inc(pos);
  159.                 ausd[pos] := 'u';
  160.               END;
  161.         'Ü' : BEGIN
  162.                 ausd[pos] := '"'; inc(pos);
  163.                 ausd[pos] := 'U';
  164.               END;
  165.         'ß' : BEGIN
  166.                 ausd[pos] := '"'; inc(pos);
  167.                 ausd[pos] := 's';
  168.               END;
  169.         '"' : BEGIN
  170.                 ausd[pos] := '\'; inc(pos);
  171.                 IF dt_Anf_z_Beg THEN BEGIN
  172.                    ausd[pos] := 'g'; inc(pos);
  173.                    ausd[pos] := 'l'; inc(pos);
  174.                    ausd[pos] := 'q'; inc(pos);
  175.                    ausd[pos] := 'q'; inc(pos);
  176.                    dt_anf_z_Beg := NOT dt_anf_z_Beg
  177.                 END ELSE BEGIN
  178.                    ausd[pos] := 'g'; inc(pos);
  179.                    ausd[pos] := 'r'; inc(pos);
  180.                    ausd[pos] := 'q'; inc(pos);
  181.                    ausd[pos] := 'q'; inc(pos);
  182.                    dt_anf_z_Beg := NOT dt_anf_z_Beg
  183.                 END;
  184.               END;
  185.         '%' : BEGIN
  186.                 ausd[pos] := '\'; inc(pos);
  187.                 ausd[pos] := '%';
  188.               END;
  189.         '&' : BEGIN
  190.                 ausd[pos] := '\'; inc(pos);
  191.                 ausd[pos] := '&';
  192.               END;
  193.       END;
  194.    END
  195.    ELSE
  196.      ausd[pos] := ch;
  197.    inc(pos);
  198. END; (* auswertung *)
  199.  
  200. PROCEDURE lesen (VAR ausdruck : zeile);
  201. VAR
  202.     ch              : char;
  203.     pos_aus, k      : integer;
  204.     dt_Anf_z_Beg,
  205.     einf_Anf_z_Beg,
  206.     umbruch         : Boolean;
  207.  
  208. BEGIN
  209.   dt_anf_z_Beg := TRUE;
  210.   einf_Anf_z_Beg := TRUE;
  211.   umbruch := FALSE;
  212.   FOR pos_aus := 1 TO zeil_laenge DO
  213.       ausdruck[pos_aus]:=' ';
  214.   (* Ausdruck initialisieren *)
  215.   pos_aus := 1;
  216.   WHILE (NOT eoln(eingabefile))  AND (NOT
  217.   eof (EINGABEFILE)) DO
  218.   BEGIN
  219.     FOR pos_aus := 1 TO zeil_laenge DO
  220.         ausdruck[pos_aus]:=' ';
  221.                                (* Ausdruck initialisieren *)
  222.     pos_aus := 1; umbruch := FALSE;
  223.     WHILE (NOT eoln(eingabefile))  AND (NOT
  224.     eof (EINGABEFILE)) AND (pos_aus <= 60) DO
  225.     BEGIN
  226.       read(eingabefile,ch);
  227.       IF ord(ch) > 31 THEN    (* Steuerzeichen ignorieren *)
  228.          IF ord(ch) = 39 THEN
  229.             einf_anf(ch, ausdruck, pos_aus)
  230.                       (* ch = einfaches Anführungszeichen *)
  231.          ELSE
  232.            auswertung(ch, ausdruck, pos_aus)
  233.     END;
  234.     IF (pos_aus > 60) AND (NOT eoln(eingabefile)) THEN
  235.     BEGIN                           (* Zeilenformatierung *)
  236.        WHILE (NOT eoln(eingabefile))  AND (NOT
  237.        eof (EINGABEFILE)) AND (NOT umbruch) DO
  238.        BEGIN
  239.           read(eingabefile,ch);
  240.           IF ord(ch) > 31 THEN
  241.              IF ch <> ' ' THEN
  242.                 IF ord(ch) = 39 THEN
  243.                    einf_anf(ch, ausdruck, pos_aus)
  244.                 ELSE
  245.                    auswertung(ch, ausdruck, pos_aus)
  246.              ELSE
  247.                umbruch := true;
  248.        END;
  249.        IF eoln(eingabefile) OR eof(eingabefile) THEN
  250.           umbruch := true;
  251.        FOR k := 1 TO pos_aus DO
  252.                       (* Zeile des Ausgabefiles schreiben *)
  253.            write(ausgabefile,ausdruck[k]) ;
  254.        writeln(ausgabefile);
  255.        pos_aus := 1
  256.     END;
  257.   END;
  258.   IF NOT umbruch THEN BEGIN
  259.      FOR k := 1 TO pos_aus DO
  260.          write(ausgabefile,ausdruck[k]) ;
  261.      writeln(ausgabefile);
  262.   END;
  263. END; (* lesen *)
  264.  
  265. BEGIN (* Hauptprogramm *)
  266.   charset := ['ö','Ö','ä','Ä','ü','Ü','ß','"','%','&'];
  267.   ClrScr;
  268.   Paramtest;
  269.   TxttoTex;
  270.   WHILE NOT eof(eingabefile) DO
  271.   BEGIN
  272.       lesen (ausdruck) ;
  273.       IF NOT eof(eingabefile) THEN readln(eingabefile);
  274.   END;
  275.   close(eingabefile);
  276.   close(ausgabefile);
  277.   writeln;
  278.   writeln('Datei ',texdatei,' wurde erzeugt');
  279. END.
  280.  
  281.  
  282.