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

INTERFACE; FROM vt USES bildschirm;

VAR configpath: String[20];
             
FUNCTION filetype(name: Str80): Integer;
FUNCTION getpages(filename: Str80; sorted: Boolean): Integer;
FUNCTION printpage(seite: p_onepage): Boolean;
PROCEDURE page_to_clip(seite: p_onepage);
FUNCTION save_action(seite: p_onepage; mode: Integer): Integer;
PROCEDURE name2dosname(s: str80; VAR s2: str80);
PROCEDURE namefrompage(VAR filename: str80; seite: p_onepage);

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

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

FUNCTION getlong(VAR datei: Text): Long;
VAR l: Long;
    i: Integer;
    ch: Char;
BEGIN
  l := 0;
  FOR i := 1 TO 4 DO BEGIN
    Read(datei,ch);
    l := (l SHL 8) OR Ord(ch);
  END;
  getlong := l;
END;

FUNCTION filetype{(name: Str80): Integer};
{ Typcodierung: }
{ -1: Datei existiert nicht (oder ist leer) }
{  0: unbekannter Typ (vermutlich roher ASCII-Text) }
{  1: programmeigener Typ 'VTPG'=$56545047 }
{     VTex-Format 'FG24'=$46473234 }
{     oder TeleText 'TELE'=$54454C45 }
{  2: AmigaDOS-Programmdatei $000003F3 }
{  3: IFF-Datei 'FORM'=$464F524D }
{  4: Workbench-Icon $E310 }
VAR head: Long;
    datei: Text;
BEGIN
  Reset(datei,name);
  IF IOresult=0 THEN BEGIN
    filetype := 0;
    IF FileSize(datei)=0 THEN filetype := -1; { leere Datei }
    head := getlong(datei);
    IF head=$56545047 THEN filetype := 1;
    IF head=$46473234 THEN filetype := 1;
    IF head=$54454C45 THEN filetype := 1;
    IF head=$000003F3 THEN filetype := 2;
    IF head=$464F524D THEN filetype := 3;
    IF (head AND $FFFF0000)=$E3100000 THEN filetype := 4;
    Close(datei);
  END ELSE
    filetype := -1; { Datei existiert nicht }
END;

FUNCTION getpages{(filename: Str80; sorted: Boolean): Integer};
{ Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
{ einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
VAR i,j, jlpageno, gelesen: Integer;
    bytes: ^ARRAY[1..41] OF Char;
    datei: Text;
    zeile: Str80;
    seite: p_onepage;
    l: Long;
    c: Char;
CONST vtpg=$56545047;
      fg24=$46473234;
      tvtx=$54565458;
      tele=$54454C45;
      texd=$54455854;
       sub=$535542;
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
    l := 0;
    REPEAT
      Read(datei,c); l := l SHL 8 OR Ord(c);
    UNTIL (l=vtpg) OR (l=fg24) OR (l=tele) OR (l AND $FFFFFF=sub)
    OR EoF(datei);
    { mein eigenes Format lesen: }
    IF l=vtpg THEN BEGIN
      New(seite);
      Read(datei,c); { LF überlesen }
      FOR i := 0 TO 23 DO BEGIN
        bytes := Ptr(^seite^.chars[40*i]);
        BlockRead(datei,bytes^,40);
        Read(datei,c); { LF überlesen }
      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));
      seite^.dejavu := False;
      IF make_bcd(get_bcd(seite^.pg))<>seite^.pg THEN
        seite^.cbits := seite^.cbits OR PF_PSEUDO
      ELSE
        seite^.cbits := seite^.cbits AND NOT PF_PSEUDO;
      IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
      Inc(gelesen);
    END;
    { das Format der VTex-Software lesen: }
    IF l=fg24 THEN IF getlong(datei)=tvtx THEN BEGIN
      New(seite);
      seite^.pg := make_bcd(getlong(datei));
      seite^.sp := make_bcd(getlong(datei));
      seite^.cbits := 0;
      l := getlong(datei); { aus der Zeichensatz-Nummer die Steuerbits }
      FOR i := 14 DOWNTO 12 DO BEGIN { C12,C13,C14 "rekonstruieren" }
        IF Odd(l) THEN seite^.cbits := seite^.cbits OR (1 SHL i);
        l := l SHR 1;
      END;
      FOR i := 1 TO 18 DO Read(datei,c); { ??? }
      BlockRead(datei,seite^.chars,960);
      seite^.dejavu := False;
      IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
      Inc(gelesen);
    END;
    { Jan Leuverink's TeleText-Format lesen: }
    IF l=tele THEN IF getlong(datei)=texd THEN BEGIN  { header }
      jlpageno := 0;
      FOR i := 1 TO 3 DO BEGIN
        Read(datei,c); jlpageno := (jlpageno SHL 4) OR (Ord(c)-Ord('0'));
      END;
    END;
    IF (l AND $FFFFFF=sub) THEN BEGIN  { eine Seite }
      New(seite);
      seite^.pg := jlpageno;
      seite^.sp := 0;
      seite^.cbits := $4000;  { immer dt. Zeichensatz %-( }
      FOR i := 1 TO 4 DO BEGIN
        Read(datei,c); IF c>='0' THEN
          seite^.sp := (seite^.sp SHL 4) OR (Ord(c)-Ord('0'));
      END;
      BlockRead(datei,seite^.chars,960);
      seite^.dejavu := False;
      IF sorted THEN ins_to_list(seite) ELSE add_to_list(seite);
      Inc(gelesen);
    END;
  END;
  Close(datei);
  getpages := gelesen;
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;

PROCEDURE page_to_clip{(seite: p_onepage)};
{ Seitentext ins Clipboard schreiben }
VAR s: str80;
    i: Integer;
BEGIN
  IF seite=Nil THEN Exit;
  start_clip(24*41);
  FOR i := 0 TO 23 DO BEGIN
    makeascii(seite, i, True, s);
    s := s + Chr(10);
    clip_it(s,41);
  END;
  end_clip;
END;

FUNCTION savepage(seite: p_onepage; ascii: Boolean; VAR datei: Text): 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;
    is_stitle,is_headln,visible: Boolean;
BEGIN
  savepage := False; IF seite=Nil THEN Exit;
  IF ascii THEN BEGIN  { ASCII-Textausgabe }
    is_stitle := (seite^.cbits AND PF_STITLE)<>0;
    is_headln := (seite^.cbits AND PF_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); IF IOResult<>0 THEN Exit; { Disk full o. ä. }
      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); IF IOResult<>0 THEN Exit; { Disk full }
      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;
  savepage := 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=alle ab dieser, }
{ 4=wie 3, aber ohne Rückfrage }
{ Ergebnis: }
{ 0: OK, 1: Benutzer wollte nicht, 2: Anhängen unzulässig, 3: IO-Fehler }
VAR ft: Integer;
    pg1,pg2: p_onepage;
    ok: Boolean;
    s: str80;
    datei: Text;
BEGIN
  save_action := 1;
  IF seite=Nil THEN Exit;
  fileinfo;
  IF mode=3 THEN BEGIN  
    { Rückfrage, weil das etwas länger dauern könnte }
    IF seite=root THEN
      s := 'Alle '+IntStr(listsize)+' Seiten speichern?'
    ELSE
      s := IntStr(listsize-posn_in_list(seite))
          +' Seiten ab dieser speichern?';
    IF NOT ja_nein(s) THEN Exit;
  END;
  { Sicherheitsprüfung: Anhängen nur an geeignete Dateien erlauben: }
  ft := filetype(outputname);
  IF ft IN [2,3,4] THEN BEGIN
    CASE ft OF
      2: short_msg('Programmdatei',2);
      3: short_msg('IFF-Datei',2);
      4: short_msg('Icon-Datei',2);
    END;
    add_msg(', Anhängen unzulässig!',2);
    save_action := 2; Exit;
  END;
  { Alle Rückfragen überstanden -> speichern: }
  busy_pointer;
  Reset(datei,outputname);
  IF (IOresult<>0) THEN { Datei existiert vermutlich nicht }
    Rewrite(datei,outputname);
  IF IOresult<>0 THEN BEGIN    { wahrscheinlich 'Object in use' }
    short_msg('Kann die Ausgabedatei nicht öffnen!',2);
    Exit;
  END;
  IF withicon THEN IF FileSize(datei)=0 THEN
    IF asciifile THEN
      create_icon('Icons/ASCII', outputname)
    ELSE
      create_icon('Icons/VT', outputname);
  Buffer(datei, 500);
  Seek(datei, FileSize(datei));
  pg1 := root;
  { um aber auch Seiten speichern zu können, die nicht in der Liste stehen: }
  IF (seite^.prev=Nil) AND (root<>seite) THEN pg1 := seite;
  ok := False;
  WHILE pg1<>NIL DO BEGIN
    CASE mode OF
      1: ok := (pg1=seite);
      2: ok := (pg1^.pg=seite^.pg);
      3,4: IF pg1=seite THEN ok := True;
    END;
    IF ok THEN BEGIN
      short_msg('Seite '+hexstr(pg1^.pg,0)+'/',0);
      add_msg(hexstr(pg1^.sp,0)+' ...',0);
      IF savepage(pg1,asciifile,datei) THEN
        add_msg(' gespeichert.',0)
      ELSE BEGIN
        add_msg(' Dateifehler!',2);
        save_action := 3;
        pg1 := Nil;
      END;
    END;
    IF pg1<>Nil THEN pg1 := pg1^.next;
  END;
  Close(datei);
  normal_pointer;
  save_action := 0;
END;

PROCEDURE civilize(s: str80; VAR s2: str80;);
{ String als DOS-Namen tauglich machen }
VAR i,k,l: Integer;
    sonder: String[8];
    uebers: String[15];
BEGIN
  sonder := '{|}[\]~'; uebers := 'aeoeueAEOEUEss';
  i := 1; k := 1;
  REPEAT
    CASE s[i] OF
      ' ': s2[k] := '_'; { Leerzeichen }
      '/',':': s2[k] := '-'; { Verzeichnis-Begrenzer }
      OTHERWISE s2[k] := s[i];
    END;
    l := Pos(s[i],sonder);
    IF l>0 THEN BEGIN
      s2[k] := uebers[2*l-1]; Inc(k); s2[k] := uebers[2*l];
    END;
    Inc(i); Inc(k);
  UNTIL s[i] = #0;
  s2[k] := #0;
END;

PROCEDURE name2dosname{(s: str80; VAR s2: str80)};
{ Bekommt eine Titelzeile übergeben und liefert (normalerweise mit Hilfe }
{ der ".stations"-Liste) einen DOS-tauglichen Filenamen zurück. }
VAR zeile,name: str80;
    i,j,l: Integer;
    stnfile: Text;
    has_letters, complain: Boolean;
BEGIN
  s2 := ''; name := configpath+'.stations'; complain := False;
  Reset(stnfile, name);
  IF IOResult=0 THEN BEGIN
    Buffer(stnfile,100);
    WHILE NOT EoF(stnfile) AND (s2='') DO BEGIN
      ReadLn(stnfile,zeile); i := Pos('=',zeile);
      IF i>1 THEN BEGIN
        l := Length(zeile); WHILE l>0 DO BEGIN
          IF zeile[l]<=' ' THEN zeile[l] := #0 ELSE l := 1;
          Dec(l);
        END;
        l := Length(zeile);
        s2 := Copy(zeile,1,i-1);
        IF Pos(s2, s)>0 THEN  s2 := Copy(zeile,i+1,l-i)  ELSE s2 := '';
      END;
    END;
    Close(stnfile);
    IF s2='' THEN complain := True;
  END ELSE
    short_msg('Senderliste nicht gefunden',2);
  IF s2='' THEN BEGIN  { das 1. Wort nehmen, das auch Buchstaben enthält: }
    j := 1;
    REPEAT
      i := j;
      WHILE (s[i]=' ') DO Inc(i);
      j := i; has_letters := False;
      WHILE NOT (s[j] IN [' ', #0]) DO BEGIN
        IF s[j] IN ['a'..'z','A'..'Z'] THEN has_letters := True;
        Inc(j);
      END;
    UNTIL has_letters OR (s[i]=#0);
    IF j>i THEN BEGIN
      zeile := Copy(s, i, j-i); civilize(zeile, s2);
    END;
    IF complain THEN
      short_msg('"'+s2+'"'+' nicht in der Senderliste',0);
  END;
END;

PROCEDURE namefrompage{(VAR filename: str80; seite: p_onepage)};
{ Dateinamen nach der Titelzeile einer Seite abändern }
VAR i,j,l: Integer;
    pfad,name,s: str80;
    has_letters: Boolean;
BEGIN
  IF seite=Nil THEN Exit;
  { Dateinamen zerlegen: }
  l := Length(filename);
  j := 0; FOR i := 1 TO l DO
    IF filename[i] IN ['/',':'] THEN j := i;
  IF j=0 THEN pfad := '' ELSE pfad := Copy(filename,1,j);
  IF j=l THEN name := '' ELSE name := Copy(filename,j+1,l-j);
  { Titelzeile extrahieren: }
  FOR i := 1 TO 40 DO BEGIN
    s[i] := Chr(seite^.chars[i-1]); IF s[i]<' ' THEN s[i] := ' ';
  END;
  s[41] := #0;
  name2dosname(s, filename);
  IF filename<>'' THEN name := filename;
  filename := pfad + name;
END;

BEGIN  { Initialisierungen }
  configpath := 'presets/';  { bitte *nicht* mehr ändern! }
END.