PROGRAM VTview;
FROM vt USES pagelist,decode,sys; {$opt q,s+,i+ }
{ Stellt roh abgespeicherte Videotextseiten auf einem eigenen Screen dar. }
CONST version = '$VER: VTview 1.6  (19.06.95)';

{$incl "dos.lib", "workbench/startup.h", "icon.lib" }

VAR j, timing, countdown, anzseiten: integer;
    auto, cycle, conceal: boolean;
    taste,ch: Char;
    titel,s: Str80; STATIC;
    l: Long;

{ ###################################################################### }
{ ------------------------- Dateibehandlung ---------------------------- }
{ ###################################################################### }

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));
      add_to_list(seite); Inc(gelesen);
    END;
  END;
  Close(datei);
  getpages := gelesen;
END;

{ ###################################################################### }
{ -------------------------- Bildschirmausgabe ------------------------- }
{ ###################################################################### }

PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
{ Seite am Bildschirm ausgeben }
CONST xoff = 1;
VAR zeile,i,j,j0: Integer;
    farbe,farbe0: Word;
    out: bigstring;
    x: Byte;
    s,attrib: str80;
    dblheight,rastergfx,special: Boolean;
    normal: String[10];
BEGIN
  normal := #155'0;3'+colperms[7]+';4'+colperms[0]+'m'; { weiß auf schwarz }
  dblheight := False; rastergfx := False;
  seite^.chars[0] := 2;  { Seitennummer zunächst grün }
  for i := 0 to 24 do begin
    zeile := i MOD 24;
    IF i=24 THEN BEGIN
      { Überreste von doppelthohen Zeichen in der untersten Zeile einer }
      { alten Seite löschen: }
      IF NOT dblheight THEN BEGIN
        GotoXY(xoff,25); Write(#155'0m',blank40,' ');
      END;
      { 1. Zeile nochmal, mit weißer Seitennummer: }
      IF seite<>Nil THEN seite^.chars[0] := 7;
      dblheight := False;
    END;
    IF dblheight THEN
      { auf eine doppelthohe Zeile folgt nur eine leere Zeile }
      dblheight := False
    ELSE BEGIN
      { normale Zeile ausgeben }
      IF seite<>Nil THEN
        decode_line(seite, zeile, verdeckt, out, attrib, dblheight, rastergfx)
      ELSE
        out := blank40;
      GotoXY(xoff,zeile+1); Write(normal,out,normal,' ');
      IF rastergfx THEN BEGIN  { Zeile, die gerasterte Grafikzeichen enthält }
        special := False; farbe := 0;
        FOR j := 0 TO 39 DO BEGIN  { zu rasternde Abschnitte suchen }
          farbe0 := farbe; farbe := Ord(attrib[j+1]);
          IF (farbe<>farbe0) AND special THEN BEGIN
            raster_line(zeile+1,xoff+j0,xoff+j-1,farbe0 AND 7);
            j0 := j; special := (farbe AND 16<>0);
          END;
          IF (farbe AND 16<>0) AND NOT special THEN BEGIN
            j0 := j; special := True;
          END;
        END;
        IF special THEN
          raster_line(zeile+1,xoff+j0,xoff+39,farbe0 AND 7);
      END;
      IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
        special := False;
        FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
          { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
          IF out[j] = #155 THEN special := True;
          IF NOT special THEN out[j] := ' ';
          IF out[j] = 'm' THEN special := False;
        END;
        GotoXY(xoff,zeile+2); Write(normal,out,normal,' ');
        special := False;
        FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
          CASE seite^.chars[40*zeile+j] OF
            13: BEGIN j0 := j; special := True; END;
            12: IF special THEN BEGIN
                stretch_line(zeile+1,xoff+j0,xoff+j); special := False;
              END;
            OTHERWISE;
          END;
        IF special THEN
          stretch_line(zeile+1,xoff+j0,79);
      END;
    END;
    lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
    intui_events; { kann nicht schaden }
    IF (lastkey<>chr(0)) OR stop THEN
      Exit;
  END;
END;

{ ###################################################################### }
{ -------------------------- Initialisierungen ------------------------- }
{ ###################################################################### }

PROCEDURE get_args;
{ Wertet CLI- oder WorkBench-Argumente aus: Die spezifizierten Dateien }
{ werden mit getpages() eingelesen. }
{ ToolTypes:                  CLI-Parameter:  }
{ MODE=MAN|AUTO|CYCLE         -a -c }
{ FLAGS=REVEAL|CONCEAL        -r }
{ TIMING=<secs>               -t<secs> }
VAR c: char;
    s: bigstring;
    len,i,j,ok: integer;
    hail: p_WBStartup;
    arg: p_WBArg;
    olddir: BPTR;
    icon: p_DiskObject;
    entry: Str;
    name: Str80;
FUNCTION is_space(ch: Char): Boolean;
BEGIN  is_space := (ch=' ') OR (ch=#9) OR (ch=#10) OR (ch=#13);  END;
BEGIN
  conceal := True;
  auto := False;
  cycle := False;
  timing := 2;
  anzseiten := 0;
  IF fromWB then BEGIN
    OpenLib(IconBase,'icon.library',0);
    hail := StartupMessage;
    arg := hail^.sm_ArgList;
    for i := 1 to hail^.sm_NumArgs do BEGIN
      olddir := CurrentDir(arg^.wa_Lock);
      name := arg^.wa_Name;
      if filetype(name)=1 THEN    { nur VTPG-Dateien lesen }
        anzseiten := anzseiten + getpages(name);
      icon := GetDiskObject(arg^.wa_Name);
      if icon<>Nil then BEGIN
        entry := FindToolType(icon^.do_ToolTypes, 'MODE');
        IF ptr(entry)<>Nil THEN BEGIN
          IF MatchToolValue(entry,'MAN') THEN auto := False;
          IF MatchToolValue(entry,'AUTO') THEN BEGIN
            auto := True; cycle := False; END;
          IF MatchToolValue(entry,'CYCLE') THEN BEGIN
            auto := True; cycle := True; END;
        END;
        entry := FindToolType(icon^.do_ToolTypes, 'FLAGS');
        IF ptr(entry)<>Nil THEN BEGIN
          IF MatchToolValue(entry,'REVEAL') THEN conceal := False;
          IF MatchToolValue(entry,'CONCEAL') THEN conceal := True;
        END;
        entry := FindToolType(icon^.do_ToolTypes, 'TIMING');
        if ptr(entry)<>Nil then
          Val(entry,timing,ok);
        FreeDiskObject(icon);
      END;
      olddir := CurrentDir(olddir);
      { auf nächsten WBArg-Zeiger zugreifen: }
      arg := ptr(long(arg)+SizeOf(WBArg));
    END;
    CloseLib(IconBase);
  end else if ParameterLen>0 then BEGIN
    s := copy(ParameterStr,1,ParameterLen);
    len := length(s);
    { Parameterzeile in Worte zerlegen, wie der argv[] in C es schon ist :-( }
    i := 1; while i<=len do BEGIN
      while is_space(s[i]) do Inc(i);
      j := i + 1;
      if s[i]='"' then BEGIN
        Inc(i); while (s[j]<>'"') AND (j<=len) do Inc(j);
      end else BEGIN
        while NOT is_space(s[j]) AND (j<=len) do Inc(j);
      END;
      { Zeiger i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
      if s[i]='-' then BEGIN
        i := i+2;
        case s[i-1] of
          't': Val(copy(s,i,j-i),timing,ok);
          'r': conceal := False;
          'a': auto := True;
          'c': BEGIN auto := True; cycle := True; END;
          otherwise BEGIN
            writeln('usage:');
            writeln('VTview <file> <file> ... -r[eveal] -a[uto] -c[ycle] -t<secs> ');
            writeln('with <file> containing raw VideoText pages ("VTPG" format)');
          END;
        END;
      END ELSE
        IF filetype(copy(s,i,j-i))=1 THEN
          anzseiten := anzseiten + getpages(copy(s,i,j-i))
        ELSE
          Writeln('Keine VTPG-Datei: ',copy(s,i,j-i));
      i := j + 1;
    END;
  END;
END;

{ ###################################################################### }
{ ------------------ Hauptprogramm/Ereignisverwaltung ------------------ }
{ ###################################################################### }

PROCEDURE handle_escseq(chars: str80);
{ wie handle_key, aber für die ESC-Sequenzen der Sondertasten }
VAR i,page,page2: Integer;
BEGIN
  { Cursor: Seitenliste durchblättern }
  IF Pos(chars,'ABCDST')>0 THEN BEGIN
    IF thispage<>Nil THEN
      CASE chars[1] OF
        'A': IF (thispage^.prev<>Nil) THEN
          thispage := thispage^.prev;
        'B': IF (thispage^.next<>Nil) THEN
          thispage := thispage^.next;
        'S': thispage := next_magazine(thispage);
        'T': thispage := prev_magazine(thispage);
        'C': WHILE (thispage^.next<>Nil) DO
          thispage := thispage^.next;
        'D': thispage := root;
        OTHERWISE;
      END;
    writepage(thispage,conceal);
  END;
END;

PROCEDURE handle_key(key: char);
VAR j,ok,ft: integer;
    s: Str80;
BEGIN
  case key of
    #27: stop := True;
    #127: if thispage<>Nil then BEGIN  { Del: eine Seite löschen }
          del_from_list(thispage);
          writepage(Nil,true);
        END;
    ' ': writepage(thispage,true);
    '?': writepage(thispage,false);
    #155: BEGIN { Sondertasten auswerten }
        s := '';
        REPEAT  ch := readkey; s := s + ch;  UNTIL ch >= '@';
        handle_escseq(s);
      END;
    OTHERWISE;
  END;
END;

BEGIN   { Hauptprogramm }
  get_args;   { Parameter holen, Seiten einlesen }
  titel := Copy(version,1,17)+' ('+IntStr(anzseiten)+' pages)  ESC to quit';
  colperm := $01234567; colperms := '01234567';
  AddExitServer(sysclean); sysinit(titel);
  Write(#155'0 p'); { Cursor aus }
  countdown := timing;
  lastkey := #0; stop := False;
  thispage := root;
  writepage(thispage,conceal);
  REPEAT
    intui_events; { Msg-Port abfragen }
    IF lastkey=#0 THEN
      taste := readkey
    ELSE BEGIN
      taste := lastkey; lastkey := #0;
    END;
    IF taste<>#0 THEN BEGIN
      auto := False;
      handle_key(taste)
    END ELSE IF auto THEN BEGIN
      Delay(50); Dec(countdown);
      IF countdown<=0 THEN
        IF thispage<>Nil THEN BEGIN
          IF thispage^.next=Nil THEN
            IF cycle THEN thispage := root ELSE stop := True
          ELSE
            thispage := thispage^.next;
          IF NOT stop THEN BEGIN
            writepage(thispage,conceal);
            countdown := timing;
          END;
        END ELSE
          stop := True;
    END ELSE
      l := Wait(-1);
  UNTIL stop;
  SetStdIO(Nil); CloseConsole(Con);
  kill_list; sysclean;
END.