home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / press.pas < prev    next >
Pascal/Delphi Source File  |  1986-10-12  |  5KB  |  135 lines
  1. (* -------------------------------------------------------------------------
  2.        Ein Utility zum platzsparenden Abspeichern von ASCII-Dateien
  3.    ------------------------------------------------------------------------- *)
  4. PROGRAM press (INPUT, OUTPUT);
  5.  
  6. VAR   eindatnam, ausdatnam     : STRING [20];
  7.       eindatei, ausdatei       : TEXT;
  8.  
  9. (* ------------------------------------------------------------------------- *)
  10.  
  11. PROCEDURE HoleDatNam;
  12.  
  13. BEGIN
  14.   WriteLn; WriteLn;
  15.   WriteLn ('------------------------');
  16.   WriteLn ('     P R E S S  v0.1    ');
  17.   WriteLn ('------------------------');
  18.   WriteLn; WriteLn;
  19.   Write ('Welche Datei soll bearbeitet werden ? ');
  20.   Read (eindatnam);
  21.   WriteLn; WriteLn;
  22.   Write ('Wie soll die Ausgabedatei heissen   ? ');
  23.   Read (ausdatnam);
  24.   WriteLn; WriteLn;
  25. END; (* HoleDatNam *)
  26.  
  27. (* ------------------------------------------------------------------------- *)
  28.  
  29. PROCEDURE OeffneDateien;
  30.  
  31. BEGIN
  32.   Assign (eindatei, eindatnam);                            (* Quelldatei zum *)
  33.   Reset (eindatei);                                        (* lesen oeffnen. *)
  34.   Assign (ausdatei, ausdatnam);                        (* Zieldatei zum      *)
  35.   Rewrite (ausdatei);                                  (* schreiben oeffnen. *)
  36. END; (* OeffneDateien *)
  37.  
  38. (* ------------------------------------------------------------------------- *)
  39.  
  40. PROCEDURE Press;
  41.  
  42. CONST EofMarker = 26;                    (* Markiert Ende der Datei bei CP/M *)
  43.             ESC = 27;
  44.            Mask = 128;                         (* 8. Bit setzen bei Wordende *)
  45.           Blank = ' ';
  46.  
  47. VAR   chein, chalt    : CHAR;
  48.       einanz, ausanz,
  49.       zaehler         : INTEGER;
  50.  
  51.  
  52.   (* -----------------------------------------------------------------------
  53.      Anzahl der aufeinanderfolgenden, gleichen Zeichen ermitteln und diese
  54.      ueberlesen (max. 255 an einem Stueck ).                                 *)
  55.  
  56.   PROCEDURE NextChar;
  57.  
  58.   BEGIN
  59.     zaehler := 0;
  60.     REPEAT
  61.       zaehler := Succ (zaehler);
  62.       IF NOT Eof (eindatei) THEN
  63.          Read (eindatei, chein);
  64.     UNTIL (chein <> chalt) OR (zaehler = 255) OR Eof (eindatei);
  65.   END; (* NextChar *)
  66.  
  67.   (* -----------------------------------------------------------------------
  68.      Wenn Leerzeichen gelesen, dann bei vorrangegangenem Zeichen Bit 7
  69.      setzen und naechstes Zeichen lesen.                                     *)
  70.  
  71.   PROCEDURE WortEnde;
  72.  
  73.   BEGIN
  74.     IF NOT Eof (eindatei) THEN
  75.       IF (chalt <> Blank) AND (chein = Blank) THEN
  76.         BEGIN
  77.           Read (eindatei, chein);
  78.           einanz := Succ (einanz);
  79.           chalt := Chr (Ord (chalt) + Mask);
  80.         END;
  81.   END; (* WortEnde *)
  82.  
  83. (* ------------------------------------------------------------------------- *)
  84.  
  85. BEGIN (* Press *)
  86.   einanz := 0; ausanz := 0;
  87.   Read (eindatei, chalt);
  88.   REPEAT
  89.     NextChar;
  90.     einanz := einanz + zaehler;
  91.     WortEnde;
  92.     ausanz := Succ (ausanz);
  93.     CASE zaehler OF
  94.               1 : Write (ausdatei, chalt);     (* ein einzelnes Zeichen, ok! *)
  95.               2 : BEGIN                        (* ein Zeichenpaar:           *)
  96.                     IF Ord (chalt) < Mask THEN (* nicht Wordende, Bit 7 des  *)
  97.                       Write (ausdatei, chalt)  (* ersten Zeichens ist normal *)
  98.                     ELSE                       (* sonst Bit zuruecksetzen.   *)
  99.                       Write (ausdatei, Chr (Ord (chalt) - Mask));
  100.                     Write (ausdatei, chalt);   (* und zweites Zeichen.       *)
  101.                     ausanz := Succ (ausanz);
  102.                   END;
  103.       EofMarker : BEGIN                          (* bei dieser Anzahl glei-  *)
  104.                     Write (ausdatei, Chr (ESC)); (* cher Zeichen eine Son-   *)
  105.                     Write (ausdatei, Chr (ESC)); (* derbehandlung.           *)
  106.                     Write (ausdatei, chalt);
  107.                     ausanz := ausanz + 2;
  108.                   END
  109.              ELSE                                (* sonst gleiche Zeichen    *)
  110.                   BEGIN                          (* komprimiert ausgeben.    *)
  111.                     Write (ausdatei, Chr (ESC));
  112.                     Write (ausdatei, chalt);
  113.                     Write (ausdatei, Chr (zaehler));
  114.                     ausanz := ausanz + 2;
  115.                   END;
  116.     END;
  117.     chalt := chein;
  118.     IF einanz MOD 1024 < 2 THEN     (* Damit man sieht, dass sich etwas tut. *)
  119.       Write ('.');
  120.   UNTIL Eof (eindatei);
  121.   Close (eindatei);
  122.   Close (ausdatei);
  123.   WriteLn; WriteLn;
  124.   WriteLn (einanz:7,' Zeichen aus ''',eindatnam,''' gelesen,');
  125.   WriteLn (ausanz:7,' Zeichen nach ''',ausdatnam,''' geschrieben.');
  126. END; (* Press *)
  127.  
  128.  
  129. BEGIN
  130.   HoleDatNam;
  131.   OeffneDateien;
  132.   Press;
  133. END.
  134.  
  135.