UNIT Datei; {$project vt}
{ Dateioperationen zum Programm VideoText }

INTERFACE; FROM vt USES global,decode,sys;

FUNCTION filetype(name: Str80): Integer;
FUNCTION savepage(seite: p_onepage, name: str80): Boolean;
FUNCTION savebox(seite: p_onepage; name: str80; farbig: Boolean): Boolean;

{ ---------------------------------------------------------------------- }

IMPLEMENTATION;
{$ opt b- }

FUNCTION filetype{(name: Str80): Integer};
{ Typcodierung: }
{ -1: Datei existiert nicht }
{  0: unbekannter Typ (vermutlich roher ASCII-Text) }
{  1: programmeigener Typ 'VTPG'=$56545047 }
{  2: AmigaDOS-Programmdatei $000003F3 }
{  3: IFF-Datei 'FORM'=$464F524D }
VAR head: Long;
    i: Integer;
    ch: Char;
    datei: Text;
BEGIN
  Reset(datei,name);
  IF IOresult=0 THEN BEGIN
    head := 0;
    FOR i := 1 TO 4 DO BEGIN
      Read(datei,ch);
      head := head SHL 8 + Ord(ch);
    END;
    filetype := 0;
    IF head=$56545047 THEN filetype := 1;
    IF head=$000003F3 THEN filetype := 2;
    IF head=$464F524D THEN filetype := 3;
    Close(datei);
  END ELSE
    filetype := -1;
END;

FUNCTION savepage{(seite: p_onepage, name: str80): Boolean};
{ Seite abspeichern, drei Formate möglich: ASCII, rohe Daten, IFF-Bild }
VAR i, spalte, zeile, x0, y0, delta: Integer;
    j, k, bunt, packbar: Integer;
    l: Long;
    s: str80;
    bytes: ^ARRAY [1..41] OF Char;
    datei: Text;
PROCEDURE putshort(w: Word);
  BEGIN Write(datei,chr(Hi(w)),chr(Lo(w))); END;
PROCEDURE putlong(l: Long);
  BEGIN putshort(Word(l SHR 16)); putshort(Word(l AND $FFFF)); END;
BEGIN
  savepage := false;
  IF overwrite OR (AsciiRawIff=3) THEN
    rewrite(datei,name)
  ELSE BEGIN
    Reset(datei,name);
    IF (IOresult<>0) THEN { Datei existiert vermutlich nicht }
      Rewrite(datei,name);
  END;
  IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
    Exit;
  Seek(datei,FileSize(datei));
  CASE AsciiRawIff OF
    1: for zeile := 0 to 23 do begin   { ASCII-Textausgabe }
        makeascii(seite, zeile, true, s);
        writeln(datei,s);
      end;
    2: begin  { (beinahe) rohes VT-Format }
      WriteLn(datei,'VTPG');
      FOR zeile := 0 to 23 DO BEGIN
        bytes := Ptr(^seite^.chars[40*zeile]);
        BlockWrite(datei,bytes^,40);
        WriteLn(datei);
      END;
      Write(datei,seite^.pg,' ',seite^.sp,' $');
      { Steuerbits hexadezimal ausgeben: }
      FOR i := 3 DOWNTO 0 DO BEGIN
        j := (seite^.cbits SHR (4*i)) AND $F;
        IF j<10 THEN Write(datei,chr(j+ord('0')))
          ELSE Write(datei,chr(j-10+ord('A')));
      END;
      WriteLn(datei);
    end;
    3: BEGIN  { IFF-Grafik speichern, als LoRes, 320x256, 3 Bitplanes }
      write(datei,'FORM'); putlong(24080);  { wird später korrigiert }
      write(datei,'ILBM');
      write(datei,'BMHD'); putlong(20);
      putshort(320); putshort(216); { Breite, Höhe der Bitmap }
      putshort(0); putshort(0); { x/y-Offset }
      write(datei,chr(3)); { 3 Bitplanes }
      write(datei,chr(0)); { keine Maske }
      write(datei,chr(1)); { Grafikdaten mit Byte-Running gepackt !!! }
      write(datei,chr(0)); { Füllbyte }
      putshort(0); { transparente Farbe }
      write(datei, chr(10), chr(11));  { x/y-Verhältnis ~1:1 }
      putshort(320); putshort(256); { Breite, Höhe des Bildschirms }
      write(datei,'CMAP'); putlong(24);
      for i := 0 to 7 do
        write(datei,chr($F0*(i AND 1)),chr($78*(i AND 2)),chr($3C*(i AND 4)));
      write(datei,'CAMG'); putlong(4);
      putlong(0);  { ViewMode: weder HIRES noch LACE! }
      write(datei,'BODY'); putlong(24000);    { Wert wird später korrigiert }
      for zeile := 0 to 215 do begin
        for i := 0 to 2 do begin
          bytes := Ptr(Long(bitmapzeile(i,zeile))+39);
          { Zeile von bytes[] nach s[] packen (Byte-Running): }
          j := 1; k := 0;
          bunt := 0;
          repeat
            packbar := 1;
            while (bytes^[j+packbar]=bytes^[j+packbar-1]) AND (j+packbar<40) do
              Inc(packbar);
            if packbar>2 then begin { lohnt packen? }
              Inc(k); s[k] := chr(257-packbar); Inc(k); s[k] := bytes^[j];
              j := j + packbar; bunt := 0;
            end else begin
              Inc(bunt); if bunt=1 then Inc(k);
              Inc(k); s[k] := bytes^[j]; s[k-bunt] := chr(bunt-1);
              Inc(j);
            end;
          until j > 40;
          BlockWrite(datei,s,k);
        end;
      end;
      { Chunk-Größen korrigieren }
      l := filesize(datei);
      if Odd(l) then begin write(datei,chr(0)); Inc(l); end;
      seek(datei,4); putlong(l-8);
      seek(datei,88); putlong(l-92);
    END;
  END;
  Close(datei);
  savepage := True;
END;

FUNCTION savebox{(seite: p_onepage; name: str80; farbig: Boolean): Boolean};
{ Gibt eine auf der Seite befindliche Box in eine Textdatei aus. Wenn die }
{ Seite keine Box enthält, nur eine Leerzeile. }
{ <farbig> entscheidet, ob Farbsteuerzeichen als Klartext ausgegeben oder }
{ einfach unterdrückt werden. }
VAR zeile,i: Integer;
    s: str80;
    datei: Text;
    boxline: Boolean;
BEGIN
  savebox := False;
  Reset(datei,name);
  IF (IOresult<>0) THEN   { Datei existiert vermutlich nicht }
    Rewrite(datei,name);
  IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
    Exit;
  Seek(datei,FileSize(datei));
  FOR zeile := 0 to 23 DO BEGIN
    boxline := False;
    if seite<>Nil then for i := 0 to 39 do
      if (seite^.chars[zeile*40+i]=11) THEN
        boxline := True;
    IF boxline THEN BEGIN
      makeascii(seite, zeile, NOT farbig, s)
      WriteLn(datei, s);
    END;
  END;
  WriteLn(datei);
  Close(datei);
  savebox := True;
END;

BEGIN  { Initialisierungen }
END.