PROGRAM VTview;
FROM vt USES pagelist,decode;
{ Stellt roh abgespeicherte Videotextseiten auf einem eigenen Screen dar. }
CONST version = '$VER: VTview 1.3';

{ etwas Systemspezifisches: }
{$opt q,s+,i+ - keine Laufzeitprüfungen außer Stack und Feldindizes }
{$incl "exec.lib", "intuition.lib", "graphics.lib", "diskfont.lib" }
{$incl "dos.lib", "workbench/startup.h", "icon.lib" }

VAR NeuerScreen: NewScreen; STATIC;
    MyScreen: ^Screen;
    NeuesWindow: NewWindow; STATIC;
    MyWindow: ^Window;
    Con: ptr;
    sig: long;
    titel: Str80; STATIC;
    topazAttr,teleAttr: TextAttr; STATIC;
    MyFont: ^TextFont;

{ nun die anwendungsorientierten Variablen: }

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

{ ###################################################################### }
{ --------------------- Allgemeine Hilfsroutinen ----------------------- }
{ ###################################################################### }

procedure cursoroff;
begin
  write(#155'0 p');  { Cursor unsichtbar }
end;

procedure cursoron;
begin
  write(#155' p');  { Cursor wieder sichtbar }
end;

function readkey: char;
begin
  readkey := ReadCon(Con);
end;

function waitkey: char;
var taste: char;
    sig: long;
begin
  repeat
    sig := wait(-1);
    taste := ReadCon(Con);
  until taste <> chr(0);
  waitkey := taste;
end;

procedure desaster(meldung: str80);
{ erzeugt einen Alert }
var egal: boolean;
    buf: string;
    xpos: integer;
begin
  xpos := 320 - 4*length(meldung);
  buf := '   '+meldung;
  buf[1] := chr(Hi(xpos)); buf[2] := chr(Lo(xpos));
  buf[3] := chr(18);
  buf [length(meldung)+5] := chr(0);
  egal := DisplayAlert(RECOVERY_ALERT,buf,32);
end;

{ ###################################################################### }
{ ------------------------- 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 }
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 value(s: Str80): Long;
{ kann Hex- und Dezimalzahlen dekodieren (Hex muß mit "$" anfangen) }
{ Sehr primitive Version: Vorzeichen wird nicht berücksichtigt }
VAR i: Integer;
    x: Long;
BEGIN
  i := 1; x := 0;
  WHILE s[i]=' ' DO Inc(i);
  IF s[i]='$' THEN BEGIN
    Inc(i);
    WHILE s[i] IN ['0'..'9','A'..'F','a'..'f'] DO BEGIN
      x := x SHL 4 + ord(s[i]);
      CASE s[i] OF
        '0'..'9': x := x - ord('0');
        'A'..'F': x := x - ord('A') + 10;
        'a'..'f': x := x - ord('a') + 10;
      END;
      Inc(i);
    END;
  END ELSE
    WHILE s[i] IN ['0'..'9'] DO BEGIN
      x := x*10 + ord(s[i]) - ord('0');
      Inc(i);
    END;
  value := x;
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, gelesen: Integer;
    bytes: ^ARRAY[1..41] OF Char;
    datei: Text;
    zeile: Str80;
    seite: p_onepage;
BEGIN
  gelesen := 0;
  Reset(datei,filename);
  IF (IOresult<>0) THEN     { Datei existiert nicht }
    Exit;
  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;
      Read(datei,seite^.pg,seite^.sp); ReadLn(datei,zeile);
      seite^.cbits := value(zeile);
      add_to_list(seite); Inc(gelesen);
    END;
  END;
  Close(datei);
  getpages := gelesen;
END;

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

PROCEDURE stretch_line(zeile, sp0, sp1: Integer);
{ Streckt eine Textzeile am Bildschirm von sp0 bis einschließlich sp1 auf }
{ doppelte Höhe. }
{ Zeilen und Spalten werden, wie bei GotoXY üblich, ab 1 gezählt! }
VAR charx,chary,i,y0,x0,breite: Integer;
BEGIN
  charx := MyWindow^.RPort^.TxWidth;
  chary := MyWindow^.RPort^.TxHeight;
  y0 := (zeile-1)*chary;
  x0 := (sp0-1)*charx; breite := (sp1-sp0+1)*charx;
  FOR i := chary-1 DOWNTO 0 DO BEGIN
    ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i,breite,1,$C0);
    ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i+1,breite,1,$C0);
  END;
END;

PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
{ Seite am Bildschirm ausgeben }
var zeile,i,j,j0: Integer;
    out: bigstring;
    s: str80;
    dblheight,special: Boolean;
begin
  cursoron;
  dblheight := 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
      seite^.chars[0] := 7;  { Seitennummer weiß -> Seite komplett }
      dblheight := False;
    END;
    IF dblheight THEN
      dblheight := False
    ELSE BEGIN
      IF seite<>Nil THEN
        decode_line(seite, zeile, verdeckt, out, dblheight)
      ELSE
        out := blank40;
      GotoXY(1,zeile+2); Write(out,#155'0;37;40m');
      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(1,zeile+3); write(out,#155'0;37;40m');
        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+2,1+j0,1+j); special := False;
              END;
            OTHERWISE;
          END;
        IF special THEN
          stretch_line(zeile+2,1+j0,40);
      END;
    END;
    lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
    IF (lastkey<>chr(0)) OR stop THEN BEGIN
      cursoroff;
      exit;
    END;
  END;
  cursoroff;
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;

PROCEDURE sysinit;
CONST breite=320;
      hoehe=256;
var i: integer;
    egal: long;
begin
  { Zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  IntuitionBase := Nil; GfxBase := Nil; DiskFontBase := Nil;
  MyScreen := Nil; MyWindow := Nil; MyFont := Nil;
  { Libraries etc. öffnen: }
  IntuitionBase := OpenLibrary('intuition.library',0);
  GfxBase := OpenLibrary('graphics.library',0);
  DiskFontBase := OpenLibrary('diskfont.library',0);
  if IntuitionBase=Nil then Error('Can''t open intuition.library!');
  if GfxBase=Nil then Error('Can''t open graphics.library!');
  if DiskfontBase=Nil then desaster('Can''t open diskfont.library !!!');
  topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  titel := copy(version,7,length(version)-6)
           +' ('+IntStr(anzseiten)+' pages) ESC to quit';
  NeuerScreen := NewScreen(0,0,breite,hoehe,3,6,4,GENLOCK_VIDEO,
    CUSTOMSCREEN,^topazAttr,titel,Nil,Nil);
  MyScreen := OpenScreen(^NeuerScreen);
  for i := 0 to 7 do
    SetRGB4(^MyScreen^.ViewPort, i, 15*( i        and 1),
                                    15*((i div 2) and 1),
                                    15*((i div 4) and 1));
  NeuesWindow := NewWindow(0,11,breite,hoehe-11,2,1, 0,
           ACTIVATE or BORDERLESS or BACKDROP,
           Nil,Nil,Nil,MyScreen,Nil,170,100,breite,hoehe,CUSTOMSCREEN);
  MyWindow := OpenWindow(^NeuesWindow);
  teleAttr := TextAttr('videotext.font',9,FS_NORMAL,FPF_DISKFONT);
  if DiskFontBase<>Nil then
    MyFont := OpenDiskFont(^teleAttr);
  if MyFont<>Nil then
    egal := SetFont(MyWindow^.RPort,MyFont)
  else
    desaster('Can''t open videotext.font !!!');
  Con := OpenConsole(MyWindow);
  SetStdIO(Con);
end;

procedure sysclean;
begin
  if MyWindow<>Nil then  CloseWindow(MyWindow);
  if MyScreen<>Nil then if CloseScreen(MyScreen) then;
  if MyFont<>Nil then CloseFont(MyFont);
  if IntuitionBase<>Nil then CloseLibrary(IntuitionBase);
  if GfxBase<>Nil then CloseLibrary(GfxBase);
  if DiskFontBase<>Nil then CloseLibrary(DiskFontBase);
  { festhalten, daß alles geschlossen ist: }
  MyWindow := Nil;
  MyScreen := Nil;
  MyFont := Nil;
  IntuitionBase := Nil;
  GfxBase := Nil;
  DiskFontBase := Nil;
end;

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

procedure handle_key(key: char);
{ der Übersichtlichkeit halber aus dem Hauptprogramm herausgezogen }
var j,ok,ft: integer;
    s: String[20];
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);
    otherwise;
  end;
end;

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 BEGIN
      if (chars='A') then
        if (thispage^.prev<>Nil) then
          thispage := thispage^.prev;
      if (chars='B') then
        if (thispage^.next<>Nil) then
          thispage := thispage^.next;
      if chars='S' then
        thispage := next_magazine(thispage);
      if chars='T' then
        thispage := prev_magazine(thispage);
      IF (chars='C') THEN
        WHILE (thispage^.next<>Nil) DO
          thispage := thispage^.next;
      IF (chars='D') THEN
        thispage := root;
    END;
    writepage(thispage,conceal);
  END;
END;

begin   { Hauptprogramm }
  root := Nil;   { Seitenliste }
  thispage := Nil;
  get_args;   { u. a. Namen für Ausgabedatei holen }
  AddExitServer(sysclean); sysinit;
  cursoroff;
  stop := False;  countdown := timing;
  lastkey := #0;
  REPEAT
    if (thispage=Nil) AND (root<>Nil) then begin
      thispage := root;
      writepage(thispage,conceal);
    end;
    if lastkey=#0 then
      taste := ReadCon(Con)
    else begin
      taste := lastkey; lastkey := #0;
    end;
    if taste<>#0 then auto := False;
    if taste=#155 then begin { Sondertasten auswerten }
      s := '';
      repeat
        ch := readkey; if ch<>#0 then s := s + ch;
      until ch = #0;
      handle_escseq(s);
    end else if taste<>#0 then
      handle_key(taste)
    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
      sig := Wait(-1);
  until stop;
  SetStdIO(Nil); CloseConsole(Con);
  kill_list; sysclean;
end.