home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 07 / silben / array.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-02  |  3.3 KB  |  94 lines
  1. (* ------------------------------------------------------ *)
  2. (*                        ARRAY.PAS                       *)
  3. (*   Konvertiert die Listen der Buchstabenkombinationen   *)
  4. (*   und Wortfragmente für die Trennhilfe in typisierte   *)
  5. (*   ARRAYs OF CHAR  und schreibt sie  als FRAGMENT.INC   *)
  6. (*                   auf Datenträger                      *)
  7. (*                                                        *)
  8. (*          (C) 1989 Matthias Uphoff & TOOLBOX            *)
  9. (*                                                        *)
  10. (* ------------------------------------------------------ *)
  11.  
  12. USES Crt,Turbo3; (* Für Turbo 3.0 auskommentieren *)
  13.  
  14. Type   Str127 = String[127];
  15.  
  16. Var    Temp:      Array[0..999] of Char;
  17.        i,
  18.        count:     Integer;
  19.        ArrayName,
  20.        QuellName,
  21.        Zeile:     Str127;
  22.        Quelle,
  23.        Ziel:      Text;
  24.  
  25.  
  26. (* ------------------------------------------------------ *)
  27. (*    Erzeugt die Deklaration eines ARRAYs, ergänzt die   *)
  28. (*    Zeichen aus Temp durch Hochkommata und Kommas und   *)
  29. (*    schreibt das Ganze als Text in die Ausgabedatei     *)
  30. (* ------------------------------------------------------ *)
  31.  
  32. Procedure ArrayText;
  33.          var s: Str127;
  34.              i: Integer;
  35.  
  36. begin
  37.    if (count > 0) and (ArrayName <> '') then begin
  38.       str(count,s);                     (* Zahl -> String *)
  39.       Writeln(Ziel,ArrayName+': ARRAY[0..'+s+'] OF CHAR =');
  40.       s := '   (';
  41.       for i := 0 to count-1 do begin
  42.          if Length(s) > 75 then begin
  43.             Writeln(Ziel,s);        (* Zeile wegschreiben *)
  44.             s := '    '; (* Blanks für Einrücken vorgeben *)
  45.          end;
  46.          s := s+#39+Temp[i]+#39+',';   (* #39 = Hochkomma *)
  47.       end;
  48.       s := s + '#255);';        (* #255 als Endmarkierung *)
  49.       Writeln(Ziel,s);       (* letzte Zeile wegschreiben *)
  50.       Writeln(Ziel);           (* und noch eine Leerzeile *)
  51.    end;
  52. end;
  53.  
  54.  
  55. (* ------------------------ Main ------------------------ *)
  56.  
  57. begin
  58.    ClrScr;
  59.    Write('Name der Fragmentdatei: ');
  60.    ReadLn(QuellName);
  61.    Assign(Quelle, QuellName); Assign(Ziel,'FRAGMENT.INC');
  62.    Reset(Quelle); Rewrite(Ziel);
  63.    count := 0; ArrayName := '';
  64.    Writeln(Ziel,'CONST');
  65.  
  66.    While not Eof(Quelle) do begin
  67.       Readln(Quelle,Zeile);
  68.       if Zeile[1] = ';' then
  69.          Zeile := '';           (* Kommentarzeile löschen *)
  70.       if Length(Zeile) > 0 then
  71.          if Zeile[1] = '$' then begin      (* Neues Array *)
  72.             ArrayText;        (* Altes Array wegschreiben *)
  73.             count := 0;     (* Zeichenzähler zurücksetzen *)
  74.             ArrayName := Zeile;     (* Neuen Namen merken *)
  75.             Delete(ArrayName,1,1);           (* $ löschen *)
  76.          end
  77.          else begin
  78.             for i := 1 to Length(Zeile) do begin
  79.                Temp[count] := Zeile[i];    (* Zeichen in   *)
  80.                count := count + 1;         (* Temp ablegen *)
  81.             end;
  82.             Temp[count] := ' ';   (* Extrablank am Zeilen- *)
  83.             count := count + 1;   (* ende als Separator    *)
  84.          end;
  85.    end;
  86.    ArrayText;               (* letztes Array wegschreiben *)
  87.  
  88.    Close(Quelle); Close(Ziel);
  89.    Writeln;
  90.    Writeln('FRAGMENT.INC wurde erzeugt');
  91. end.
  92.  
  93. (* ------------------------------------------------------ *)
  94.