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

INTERFACE; FROM vt USES bildschirm;

VAR iconpath: Str80;

FUNCTION filetype(name: Str80): Integer;
FUNCTION getpages(filename: Str80): Integer;
FUNCTION savepage(seite: p_onepage): Boolean;
FUNCTION printpage(seite: p_onepage): Boolean;
FUNCTION iffdump: Boolean;
FUNCTION save_action(seite: p_onepage; mode: Integer): Integer;

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

IMPLEMENTATION;
{$ opt q,s+,i+} { keine Laufzeitprüfungen außer Stack und Feldindizes }

CONST STITLE = $0040; { C6 }
      HEADLN = $0020; { C5 }

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 }
{  4: Workbench-Icon $E310 }
VAR head: Long;
    i: Integer;
    ch: Char;
    datei: Text;
BEGIN
  Reset(datei,name);
  IF IOresult=0 THEN BEGIN
    filetype := 0;
    head := 0;
    FOR i := 1 TO 4 DO BEGIN
      Read(datei,ch);
      head := head SHL 8 + Ord(ch);
      IF (i=2) AND (head=$E310) THEN filetype := 4;
    END;
    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 getpages{(filename: Str80): Integer};
{ Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
{ einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
VAR i,j, gelesen: Integer;
    bytes: ^ARRAY[1..41] OF Char;
    datei: Text;
    zeile: Str80;
    seite: p_onepage;
    c: Char;
PROCEDURE findword;
{ Hilft, zeile in Worte zu zerlegen. Parameter j: Startpunkt, Ergebnis: }
{ i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
BEGIN
  i := j; WHILE (zeile[i]=' ') AND (zeile[i]<>#0) DO Inc(i);
  j := i + 1; WHILE NOT (zeile[j] IN [' ',#0]) DO Inc(j);
END;
BEGIN
  gelesen := 0;
  Reset(datei,filename);
  IF (IOresult<>0) THEN     { Datei existiert nicht }
    Exit;
  Buffer(datei,200);
  WHILE NOT EoF(datei) DO BEGIN
    REPEAT
      ReadLn(datei,zeile);
    UNTIL (zeile='VTPG') OR EoF(datei);
    if zeile='VTPG' THEN BEGIN
      New(seite);
      FOR i := 0 to 23 DO BEGIN
        bytes := Ptr(^seite^.chars[40*i]);
        BlockRead(datei,bytes^,40);
        ReadLn(datei);
      END;
      ReadLn(datei,zeile); j := 1;
      findword; seite^.pg := hexval(Copy(zeile,i,j-i));
      findword; seite^.sp := hexval(Copy(zeile,i,j-i));
      findword; seite^.cbits := hexval(Copy(zeile,i,j-i));
      ins_to_list(seite); Inc(gelesen);
    END;
  END;
  Close(datei);
  getpages := gelesen;
END;

FUNCTION savepage{(seite: p_onepage): Boolean};
{ Seite abspeichern, ASCII oder rohes VT-Format }
{ ASCII-Text wird für Untertitel und Schlagzeilen 'komprimiert' ausgegeben: }
{ nur die auf der Seite befindliche Box (mindestens aber eine Leerzeile, bei }
{ Schlagzeilen zusätzlich die Kopfzeile). }
{ Bei Untertiteln werden die Farbsteuerzeichen in Klartext umgesetzt. }
VAR i, zeile: Integer;
    s: str80;
    bytes: ^ARRAY [1..41] OF Char;
    datei: Text;
    is_stitle,is_headln,visible: Boolean;
BEGIN
  savepage := False; IF seite=Nil THEN Exit;
  IF overwrite THEN
    Rewrite(datei,outputname)
  ELSE BEGIN
    Reset(datei,outputname);
    IF (IOresult<>0) THEN { Datei existiert vermutlich nicht }
      Rewrite(datei,outputname);
  END;
  IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
    Exit;
  IF withicon THEN IF FileSize(datei)=0 THEN BEGIN
    IF asciifile THEN  s := iconpath + 'ASCII'
    ELSE  s := iconpath + 'VT';
    create_icon(s,outputname);
  END;
  Buffer(datei,500);
  Seek(datei,FileSize(datei));
  IF asciifile THEN BEGIN  { ASCII-Textausgabe }
    is_stitle := (seite^.cbits AND STITLE)<>0;
    is_headln := (seite^.cbits AND HEADLN)<>0;
    FOR zeile := 0 to 23 DO BEGIN
      IF is_stitle OR is_headln THEN BEGIN
        visible := False;
        FOR i := 0 TO 39 DO
          IF (seite^.chars[zeile*40+i]=11) THEN visible := True;
        IF is_headln AND (zeile=0) THEN
          visible := True;
      END ELSE
        visible := True;
      IF visible THEN BEGIN
        makeascii(seite, zeile, NOT is_stitle, s);
        WriteLn(datei, s);
      END;
    END;
    WriteLn(datei);
  END ELSE 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,hexstr(seite^.pg,0)); Write(datei,' ');
    Write(datei,hexstr(seite^.sp,0)); Write(datei,' $');
    Write(datei,hexstr(seite^.cbits,4)); WriteLn(datei);
  END;
  Close(datei);
  savepage := True;
END;

FUNCTION printpage{(seite: p_onepage): Boolean};
{ Druckerausgabe, simpelste Ausführung }
VAR drucker: Text;
    i: Integer;
    s: Str80;
    monster: ^String[1000]
BEGIN
  printpage := False;
  Reset(drucker,'PRT:');
  IF IOResult<>0 THEN Exit;
  New(monster); monster^ := '';
  FOR i := 0 TO 23 DO BEGIN
    makeascii(seite, i, True, s);
    monster^ := monster^ + s + Chr(10);
  END;
  Write(drucker,monster^);
  Dispose(monster);
  Close(drucker); printpage := True;
END;

FUNCTION iffdump{: Boolean};
{ IFF-Bild erzeugen }
VAR i, j, k, zeile, 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
  iffdump := False;
  Rewrite(datei,iffpicname);
  IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
    Exit;
  IF withicon THEN BEGIN
    s := iconpath + 'IFF';
    create_icon(s,iffpicname);
  END;
  { IFF-ILBM erzeugen, LoRes, 320x256, 3 Bitplanes }
  Write(datei,'FORM'); putlong(10084);  { 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
    FOR j := 0 TO 7 DO
      IF (colperm SHR (4*(7-j))) AND $F = i THEN
        Write(datei,Chr($F0*(j AND 1)),Chr($78*(j AND 2)),
                        Chr($3C*(j AND 4)));
  Write(datei,'CAMG'); putlong(4);
  putlong(0);  { ViewMode: weder HIRES noch LACE! }
  Write(datei,'BODY'); putlong(10000);    { 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);
  Close(datei);
  iffdump := True;
END;

FUNCTION save_action{(seite: p_onepage; mode: Integer): Integer};
{ Verwaltungskram für savepage(). }
{ Bedeutung von <mode>: }
{ 1=nur <seite> speichern, 2=mit allen Unterseiten, 3=ganze Seitenliste }
{ Ergebnis: }
{ 0: OK, 1: Benutzer wollte nicht, 2: Anhängen unzulässig, 3: IO-Fehler }
VAR ft: Integer;
    save_ovrw: Boolean;
    pg1,pg2: p_onepage;
BEGIN
  save_action := 1;
  IF seite<>Nil THEN BEGIN
    fileinfo;
    IF mode=3 THEN BEGIN { Ctrl-S: *alle* Seiten Speichern }
      mainline; Write('Alle Seiten speichern? ');
      IF NOT ja_nein THEN Exit;
    END;
    ft := filetype(outputname); mainline;
    { Sicherheitsprüfungen: Überschreiben nur mit Bestätigung ... }
    IF overwrite THEN BEGIN
      IF ft<>-1 THEN BEGIN
        Write(']berschreiben - sicher? ');
        IF NOT ja_nein THEN Exit;
      END;
    { ... Anhängen nur an geeignete Dateien: }
    END ELSE BEGIN
      Write(#155'2m');
      IF ft IN [2,3,4] THEN BEGIN
        CASE ft OF
          2: Write('Programmdatei');
          3: Write('IFF-Datei');
          4: Write('Icon-Datei');
        END;
        Write(', Anh{ngen unzul{ssig!');
        save_action := 2; Exit;
      END;
      IF NOT asciifile AND NOT (ft IN [1,-1]) THEN BEGIN
        Write('VT nur an VT-Format anh{ngen!');
        save_action := 2; Exit;
      END;
    END;
    { Alle Rückfragen überstanden -> speichern: }
    busy_pointer; save_ovrw := overwrite;
    pg1 := root;
    WHILE pg1<>NIL DO BEGIN
      IF (mode=3) OR (pg1=seite)
         OR ((mode=2) AND (pg1^.pg=seite^.pg)) THEN BEGIN
        mainline;
        Write('Seite ',hexstr(pg1^.pg,0),'/',hexstr(pg1^.sp,0),' ...');
        IF savepage(pg1) THEN
          Write(' gespeichert.')
        ELSE BEGIN
          mainline; Write(#155'2mDateifehler - sorry!');
          save_action := 3;
          pg1 := Nil;
        END;
        overwrite := False;
      END;
      IF pg1<>Nil THEN pg1 := pg1^.next;
    END;
    normal_pointer; overwrite := save_ovrw;
    save_action := 0;
  END;
END;

BEGIN  { Initialisierungen }
  iconpath := 'Icons/';
END.