The Best of Mecomp Multimedia 1/Mecomp-CD.iso/amiga/tools/misc/videotext5.41/src/videotext.p

Text File | 1997-06-15 | 32.3 KB | 938 lines

PROGRAM VideoText;
FROM vt USES startup,info; {$opt q,s+,i+ }
{ Hauptprogramm/Ereignisverwaltung zum Projekt VideoText }

CONST version = '$VER: VideoText 5.41  (15.06.97)';

{          global       sys }
{         /  |   \      /   }
{ pagelist decode cct  /    }
{       \    |    /   /     }
{        bildschirm _/      }
{            |              }
{          datei            }
{            |              }
{           jobs            }
{          /   \            }
{      info    startup      }
{                           }
{  HAUPTPROGRAMM VIDEOTEXT  }

CONST stacksize=10;

VAR l: Long;
    stop,searching,auto: Boolean;
    roundrobin: Byte;
    inputname,searchstr: Str80;
    j,toprequest,adip_count: Integer;
    pgstack: ARRAY[1..stacksize] OF RECORD pg,sp: Integer; END;
    stackptr,stackbot: Integer;
    lastslide: zeiteintrag;

PROCEDURE push(seite: p_onepage);
{ "vergeßlicher" Stack: Überlauf führt nicht zum Abweisen der neuen }
{ Seitennummer, sondern zum Vergessen der ältesten. }
BEGIN
  IF seite<>Nil THEN BEGIN
    pgstack[stackptr].pg := seite^.pg;
    pgstack[stackptr].sp := seite^.sp;
    Inc(stackptr); IF stackptr>stacksize THEN stackptr := 1;
    IF stackptr=stackbot THEN BEGIN
      Inc(stackbot); IF stackbot>stacksize THEN stackbot := 1;
    END;
  END;
END;

FUNCTION pop: p_onepage;
VAR seite: p_onepage;
BEGIN
  seite := Nil;
  WHILE (stackptr<>stackbot) AND (seite=Nil) DO BEGIN
    Dec(stackptr); IF stackptr=0 THEN stackptr := stacksize;
    seite := hunt_in_list(pgstack[stackptr].pg,pgstack[stackptr].sp,True);
  END;
  IF seite=Nil THEN short_msg('Weiter zurück geht''s nicht.',0);
  pop := seite;
END;

PROCEDURE topcleaner;
{ entfernt unnötige TOP-Seiten aus der Seitenliste, je nachdem welche noch }
{ gebraucht werden. }
VAR seite,hilf: p_onepage;
    i: Integer;
    refresh,kill: Boolean;
BEGIN
  refresh := False;
  FOR i := $1F0 TO $1F4 DO BEGIN
    seite := hunt_in_list(i,0,True);
    CASE i OF
      $1F0: kill := toprequest=0;
      $1F1: kill := (toprequest AND 2)=0;
      OTHERWISE kill := (toprequest AND 4)=0;
    END;
    IF kill AND (seite<>Nil) THEN BEGIN
      IF seite=visblpage THEN refresh := True;
      hilf := seite^.next; del_from_list(seite); update_list(hilf,-1);
    END;
  END;
  IF refresh THEN writepage(thispage,True);
END;

PROCEDURE topscan;
{ Schaut, was für TOP-Seiten schon eingetroffen sind, und führt ggf. die }
{ angeforderten Aktionen aus. }
VAR pg: ARRAY[0..4] OF p_onepage;
    i,n: Integer;
    schluss: Boolean;
BEGIN
  FOR i := 0 TO 4 DO
    pg[i] := hunt_in_list($1F0+i,0,True);
  { Anzahl ADIP-Seiten (ADditional Info Page) aus 1F0 ermitteln: }
  IF (pg[0]<>Nil) AND (toprequest AND 4<>0) AND (adip_count=0) THEN BEGIN
    i := 840; schluss := False;
    REPEAT
      CASE topcode[pg[0]^.chars[i]] OF { Magazinnummer }
        14: { Don't Care } ;
        15: schluss := True;
        16: { ungültige Ziffer } ;
        OTHERWISE IF topcode[pg[0]^.chars[i+7]]=2 THEN Inc(adip_count);
      END;
      i := i + 8;
    UNTIL (i=960) OR schluss;
    IF adip_count>3 THEN adip_count := 3; { Nee, so geht's ja auch nicht! }
    IF adip_count<3 THEN BEGIN  { zuviele Seiten angefordert }
      cancel_job($1f4);
      IF adip_count<2 THEN cancel_job($1f3);
      redraw_queue(-1);
    END;
  END;
  { Blockseiten (d. h. Themenbereichs-Leitseiten) anfordern: }
  IF (pg[0]<>Nil) AND (toprequest AND 1<>0) THEN BEGIN
    busy_pointer; topgrab(pg[0]); normal_pointer;
    short_msg('Blockseiten angefordert',0);
    toprequest := toprequest AND NOT 1; topcleaner;
  END;
  { TOP-Statistik: }
  IF (pg[0]<>Nil) AND (pg[1]<>Nil) AND (toprequest AND 2<>0) THEN BEGIN
    busy_pointer; short_msg('erstelle TOP-Statistik ...',0);
    topinfo(pg[0],pg[1]); short_msg('',0); normal_pointer;
    mark_list(False); thispage := hunt_in_list($999,1,False);
    mark_list(True); writepage(thispage,True);
    toprequest := toprequest AND NOT 2; topcleaner;
  END;
  { TOP-Text-Menue: }
  n := 0; FOR i := 1 TO adip_count DO IF pg[i+1]<>Nil THEN Inc(n);
  IF (pg[0]<>Nil) AND (n=adip_count) AND (toprequest AND 4<>0) THEN BEGIN
    busy_pointer; short_msg('erstelle TOP-Menüs ...',0);
    create_topmenu(pg[0],pg[2],pg[3],pg[4]); short_msg('',0); normal_pointer;
    thispage := hunt_in_list($900,0,False);
    redraw_list; writepage(thispage,True);
    toprequest := toprequest AND NOT 4; topcleaner;
  END;
END;

PROCEDURE write_checks;
{ Menuehäkchen an den Zustand der Programmvariablen anpassen }
VAR i: Integer;
BEGIN
  checkme($020301,asciifile);
  checkme($020302,NOT asciifile);
  checkme($020400,withicon);
  checkme($041200,fifo);
  checkme($050100,(testing AND 1)<>0);
  checkme($050300,(testing AND 2)<>0);
  FOR i := 1 TO 3 DO
    checkme($050600+i, tv_status=3-i);
  FOR i := 1 TO 2 DO
    checkme($050900+i, fontno=i);
  checkme($060200,silentrexx);
END;

PROCEDURE handle_menu(code: Long);
{ *die* zentrale Ereignisverarbeitung, viele Mausklick- und Tastatur- }
{ Ereignisse lassen sich hierauf abbilden! }
VAR item,subitem: Word;
    i,j: Integer;
    l: Long;
    s: str80;
    pg1,pg2: p_onepage;
    save_fifo,ok,refresh: Boolean;
    f: Text;
BEGIN
  menupicked := False;
  item := code SHR 8;
  subitem := code AND $FF;
  CASE item OF
    { *** Projekt *** }
    $0101: say_hello(version);
    $0102: helpme;
    $0103: IF write_to_icon THEN short_msg('aktuelle Parameter gesichert',0)
      ELSE short_msg('Fehler beim Schreiben der Parameter',2);
    $0105: CASE privateer OF
        2: short_msg('Ein ARexx-Skript läuft noch!',0);
        1: short_msg('PubScreen ist noch in Gebrauch!',0);
        OTHERWISE stop := True;
      END;
    { *** Datei *** }
    $0201: BEGIN { VT-Format laden }
        sleep; IF fileselect('VT-Seiten laden',False,inputname) THEN
          IF filetype(inputname)=1 THEN BEGIN
            busy_pointer; s := IntStr(getpages(inputname,True));
            short_msg(s+' Seiten gelesen',0); redraw_list; normal_pointer;
            writepage(thispage,True);
          END ELSE
            short_msg('keine VT-Seitendatei, sorry',0);
        wakeup;
      END;
    $0203: BEGIN { Ausgabeformat }
        asciifile := subitem=$01;
        fileinfo;
      END;
    $0204: BEGIN { Icons erzeugen }
        withicon := has_check($020400);
        fileinfo;
      END;
    $0206: BEGIN
        CASE subitem OF
          $01: BEGIN { Dateinamen ändern }
              sleep;
              IF fileselect('Ausgabedatei festlegen',True,outputname) THEN;
              wakeup;
            END;
          $02: namefrompage(outputname,visblpage); { Namen aus Titelzeile }
          $03: append_datestr(outputname,True);
        END;
        fileinfo;
      END;
    $0207: BEGIN
        sleep;
        IF ask_and_kill(outputname, True) THEN
          short_msg('Ausgabedatei überschrieben',0);
        wakeup;
      END;
    { *** Seiten *** }
    $0301: writepage(visblpage,False); { Rätseltaste }
    $0302: writepage(thispage,True); { Seite neu aufbauen }
    $0303: BEGIN auto := True; uhrzeit(lastslide); END;  { Automatik }
    $0304: BEGIN  { alle Seiten als "gesehen" markieren }
        pg1 := root;
        WHILE pg1<>Nil DO BEGIN
          pg1^.dejavu := True; pg1 := pg1^.next;
        END;
        redraw_list;
      END;
    $0306: BEGIN { Text suchen }
        sleep;
        IF stringrequest('Suchbegriff eingeben:', searchstr) THEN BEGIN
          busy_pointer;
          IF NOT hunt(searchstr, root, True) THEN
            short_msg('"'+searchstr+'" nicht gefunden', 0);
          normal_pointer;
        END;
        wakeup;
      END;
    $0307: IF thispage<>Nil THEN BEGIN  { Weitersuchen }
        sleep; busy_pointer;
        IF NOT hunt(searchstr, thispage^.next, True) THEN
          short_msg('"'+searchstr+'" nicht gefunden', 0);
        normal_pointer; wakeup;
      end;
    $0309: BEGIN { Textausdruck }
        IF incomplete THEN pg1 := thispage
          ELSE pg1 := visblpage;
        IF pg1<>Nil THEN BEGIN
          sleep; busy_pointer;
          short_msg('Seite wird gedruckt ... ',0);
          IF printpage(pg1) THEN add_msg('OK.',0)
          ELSE add_msg('Fehler!',2);
          normal_pointer; wakeup;
        END;
      END;
    $030A: BEGIN   { IFF-Bild }
        sleep;
        IF fileselect('IFF-Bild speichern',True,iffpicname) THEN BEGIN
          IF filetype(iffpicname)<>-1 THEN BEGIN
            s := iffpicname+' überschreiben?'
            ok := ja_nein(s);
          END ELSE
            ok := True;
          IF ok THEN BEGIN
            { IFF-Bild mit Standard-Farbreihenfolge: }
            make_colperms($01234567);
            REPEAT writepage(visblpage, concealed); newevent := False;
            UNTIL NOT incomplete;
            short_msg('IFF-Bild ... ',0); busy_pointer;
            IF iffdump(iffpicname, withicon) THEN add_msg('gespeichert',0)
              ELSE add_msg('Dateifehler!',2);
            normal_pointer;
            make_colperms(colperm); writepage(visblpage, concealed);
          END;
        END;
        wakeup;
      END;
    $030B: BEGIN  { Seite speichern }
        sleep; { save_action enthält meist Rückfragen }
        IF subitem=4 THEN
          j := save_action(root, 3)
        ELSE IF incomplete THEN
          j := save_action(thispage, subitem)
        ELSE
          j := save_action(visblpage, subitem);
        wakeup;
      END;
    $030C: BEGIN { Seite ins Clipboard }
        IF incomplete THEN pg1 := thispage
          ELSE pg1 := visblpage;
        IF pg1<>Nil THEN BEGIN
          page_to_clip(pg1);
          short_msg('Seitentext als Clip gespeichert',0);
        END;
      END;
    $030E: BEGIN { Seite löschen }
        CASE subitem OF
          $01: IF thispage<>Nil THEN BEGIN
              del_from_list(thispage); update_list(thispage,-1);
            END;
          $02: IF thispage<>Nil THEN BEGIN
              i := 0; j := thispage^.pg; pg1 := root;
              WHILE pg1<>Nil DO BEGIN
                pg2 := pg1; pg1 := pg1^.Next;
                IF pg2^.pg=j THEN BEGIN
                  del_from_list(pg2); Inc(i);
                END;
              END;
              update_list(thispage,-i);
            END;
          $03: BEGIN kill_list(thispage); redraw_list; END;
          $04: BEGIN kill_list(root); redraw_list; END;
          OTHERWISE;
        END;
        writepage(thispage,True);
      END;
    { *** Anfordern *** }
    $0401: BEGIN { Seite 100 }
        add_job('100',True); redraw_queue(-1);
      END;
    $0402: IF thispage<>Nil THEN BEGIN { diese Seite nochmal }
        s := hexstr(thispage^.pg,3)+'/'+hexstr(thispage^.sp,1);
        add_job(s,False); redraw_queue(-1);
      END;
    $0403: IF do_retry=0 THEN { die nicht gefundenen nochmal }
        { bzw. wenn keine "nicht gefundenen" Seiten da sind, und wenn die }
        { aktuelle eine Mehrfachseite ist, annehmen, daß der Benutzer in }
        { Wirklichkeit "diese mit allen Unterseiten nochmal" meint: }
        IF (thispage<>Nil) AND (thispage^.sp>0) THEN BEGIN
          cancel_job(thispage^.pg);
          { falls man auch schon "f8" gedrückt hatte ... }
          s := hexstr(thispage^.pg,3); add_job(s,False); redraw_queue(-1);
        END;
    $0404: BEGIN { Vorauswahl }
        busy_pointer; getconfig(subitem); normal_pointer;
      END;
    $0405,$0406,$0407: BEGIN  { Stichprobe (gefiltert/erweitert) }
        test(0);
        i := (item - $0404) MOD 3;
        CASE i OF
          1: short_msg('Stichprobe läuft ...',0);
          2: short_msg('gefilterte Stichprobe läuft ...',0);
          0: short_msg('erweiterte Stichprobe läuft ...',0);
        END;
        busy_pointer; page_grabber(i); normal_pointer;
      END;
    $0408: IF subitem=2 THEN BEGIN { Sendernamen kopieren }
        dump_title(visblpage); short_msg('Sendername als Clip gespeichert',0);
      END ELSE IF root<>Nil THEN BEGIN { Seitennummern kopieren }
        busy_pointer; dump_numbers; normal_pointer;
        short_msg('Seitennummern als Clip gespeichert',0);
      END;
    $0409,$040A: BEGIN { Vorauswahl/Senderliste editieren }
        short_msg('Editor-Aufruf ... ',0); sleep; busy_pointer;
        IF item=$0409 THEN ok := ed_config(thispage)
          ELSE ok := ed_stations;
        IF ok THEN add_msg('abgeschlossen',0)
          ELSE add_msg('DOS-Fehler',2);
        normal_pointer; wakeup;
      END;
    $040C: IF subitem=$01 THEN BEGIN { TOP-Verzeichnis erstellen }
        short_msg('TOP-Text-Seiten angefordert',0);
        toprequest := toprequest OR 4; adip_count := 0;
        hurricane;
        save_fifo := fifo; fifo := False;
        add_job('1f4',False); add_job('1f3',False); add_job('1f2',False);
        add_job('1f0-1',False);
        fifo := save_fifo;
        redraw_queue(-1);
      END ELSE BEGIN  { ... und löschen }
        pg1 := visblpage; kill_topmenu; redraw_list;
        IF thispage<>pg1 THEN writepage(thispage,True);
      END;
    $040D: BEGIN { TOP-Statistik }
        short_msg('TOP-Seiten angefordert',0);
        toprequest := toprequest OR 2;
        save_fifo := fifo; fifo := False;
        add_job('1f1',False); add_job('1f0-1',False);
        fifo := save_fifo;
        redraw_queue(-1);
      END;
    $040E: BEGIN { Blockseiten holen }
        short_msg('TOP-Leitseite angefordert',0);
        toprequest := toprequest OR 1;
        save_fifo := fifo; fifo := False;
        add_job('1f0-1',False);
        fifo := save_fifo;
        redraw_queue(-1);
      END;
    $0410: BEGIN  { Jobs löschen }
        kill_queue; redraw_queue(-1);
        toprequest := 0; topcleaner;
      END;
    $0411: BEGIN  { einen Job löschen }
        j := thisjob; kill_job(thisjob);
        IF j>=0 THEN  redraw_queue(j)  ELSE  redraw_queue(-1);
      END;
    $0412: BEGIN { FIFO }
        fifo := has_check($041200); redraw_queue(-1);
      END;
    { *** Extras *** }
    $0501: IF has_check($050100) THEN BEGIN  { Test/Uhr }
        testing := testing OR 1;
        test(testing OR $10);
        IF i2c_status<>0 THEN guru(i2c_status);
      END ELSE BEGIN
        testing := testing AND NOT 1;
        test(testing);
      END;
    $0502: IF (testing AND 1)<>0 THEN BEGIN  { VT-Zeit übernehmen }
        sleep; { Uhrzeit umstellen kann 'Zeit kosten' }
        gettime(s); force_time(s);
        wakeup; short_msg('Systemzeit von VT übernommen',0);
      END;
    $0503: IF has_check($050300) THEN BEGIN  { Sendernamen zeigen }
        testing := testing OR 2;
      END ELSE BEGIN
        testing := testing AND NOT 2;
        test(testing);
      END;
    $0505: BEGIN { Decoder-Reset }
        hurricane; init_CCT;
        short_msg('Decoder-Reset ausgeführt',0); redraw_queue(-1);
      END;
    $0506: TV_display(3-subitem); { Fernsehdarstellung }
    $0507: busmaster(NOT has_check($050700));
    $0509: BEGIN { Fontgröße }
        fontno := subitem; IF NOT newfontno THEN;
        redraw_all; write_checks;
      END;
    { *** ARexx *** }
    $0601: rexxhelp;
    $0602: silentrexx := has_check($060200);
    $0604..$060D: IF NOT rexxecute(item - $0603) THEN
        short_msg('Skriptaufruf fehlgeschlagen!',0);
    OTHERWISE;
  END;
END;

PROCEDURE handle_raw(code: Long);
{ für Sondertasten }
VAR i: integer;
    key: Byte;
    pg1,pg2: p_onepage;
    s: str80;
VAR shift,ctrl,alt,comm: Boolean;
BEGIN
  key := (code SHR 16) AND $7F;
  shift := (code AND $03)<>0; alt := (code AND $30)<>0;
  ctrl := (code AND $08)<>0; comm := (code AND $80)<>0;
  IF key=$5F THEN helpme;  { Help }
  IF key IN [$50..$59] THEN  { *** F-Tasten ... }
    IF NOT shift THEN CASE key OF  { ... normal }
      $50: handle_menu($040100); { F1 }
      $51: testpage;             { F2 }
      $53: handle_menu($040D00); { F4 }
      $54: handle_menu($040C01); { F5 }
      $55: IF alt THEN handle_menu($040700)
         ELSE
           handle_menu($040500); { F6 }
      $56: handle_menu($041000); { F7 }
      $57: handle_menu($040200); { F8 }
      $58: handle_menu($040900); { F9 }
      $59: IF alt THEN
           handle_menu($040403)
         ELSE
           handle_menu($040401); { F10 }
      OTHERWISE short_msg('F'+IntStr(key-$4F)+': ???',0);
    END ELSE CASE key OF  { ... geshiftet }
      $53: handle_menu($040E00); { Shift-F4 }
      $54: handle_menu($040C02); { Shift-F5 }
      $55: handle_menu($040600); { Shift-F6 }
      $56: handle_menu($041100); { Shift-F7 }
      $57: handle_menu($040300); { Shift-F8 }
      $58: handle_menu($040A00); { Shift-F9 }
      $59: IF alt THEN
           handle_menu($040404)
         ELSE
           handle_menu($040402); { Shift-F10 }
      OTHERWISE short_msg('Shift-F'+IntStr(key-$4F)+': ???',0);
    END;
  IF (key IN [$4C..$4F]) AND (thispage<>Nil) THEN BEGIN { *** Cursor-Tasten }
    mark_list(False);
    CASE key OF
      $4C: IF alt THEN
          thispage := prev_magazine(thispage)
        ELSE BEGIN
          IF thispage^.prev<>Nil THEN thispage := thispage^.prev;
          IF shift THEN
            WHILE (thispage^.prev<>Nil) AND (thispage^.dejavu)
            AND (thispage^.cbits AND PF_LOCAL=0) DO
               thispage := thispage^.prev;
          IF ctrl THEN
            WHILE (thispage^.prev<>Nil) AND (thispage^.cbits AND PF_LOCAL=0) DO
               thispage := thispage^.prev;
        END;
      $4D: IF alt THEN
          thispage := next_magazine(thispage)
        ELSE BEGIN
          IF thispage^.next<>Nil THEN thispage := thispage^.next;
          IF shift THEN
            WHILE (thispage^.next<>Nil) AND (thispage^.dejavu)
            AND (thispage^.cbits AND PF_LOCAL=0) DO
               thispage := thispage^.next;
          IF ctrl THEN
            WHILE (thispage^.next<>Nil) AND (thispage^.cbits AND PF_LOCAL=0) DO
               thispage := thispage^.next;
        END;
      $4E: IF shift OR alt THEN
          WHILE thispage^.next<>Nil DO thispage := thispage^.next
        ELSE
          FOR i := 1 TO colht DO
            IF thispage^.next<>Nil THEN thispage := thispage^.next;
      $4F: IF shift OR alt THEN
          thispage := root
        ELSE
          FOR i := 1 TO colht DO
            IF thispage^.prev<>Nil THEN thispage := thispage^.prev;
      OTHERWISE;
    END;
    mark_list(True); writepage(thispage,True);
  END;
END;

PROCEDURE handle_key(key: Char);
{ einzelne Eingabetaste untersuchen }
VAR pg: p_onepage;
    nr: Integer;
BEGIN
  taste := #0;
  CASE key OF
    '0'..'9','a'..'f','A'..'F','/','*','.','!':
      IF Length(queue_input) < 8 THEN BEGIN
        queue_input := queue_input + Upcase(key); queue_me;
      END;
    #8: IF Length(queue_input) > 0 THEN BEGIN
        queue_input[Length(queue_input)] := #0; queue_me;
      END;
    #13: BEGIN
        pg := Nil;
        IF (Length(queue_input)=3) THEN BEGIN { Sprungbefehl? }
          nr := hexval(queue_input); pg := hunt_in_list(nr,0,False);
          IF pg<>Nil THEN IF pg^.pg<>nr THEN pg := Nil;
          IF thispage<>Nil THEN IF thispage^.pg=nr THEN pg := Nil;
        END;
        IF pg<>Nil THEN BEGIN  { Seite nur anspringen }
          queue_input := ''; queue_me;
          push(thispage);
          mark_list(False); thispage := pg; mark_list(True);
          writepage(thispage,True);
        END ELSE BEGIN    { Seite (neu) anfordern }
          add_job(queue_input,True);
          queue_input := ''; redraw_queue(-1);
        END;
      END;
    '+','-': BEGIN    { Warteschlange blättern }
        mark_queue(False);
        IF key='-' THEN Inc(thisjob) ELSE Dec(thisjob);
        IF thisjob<-queued THEN thisjob := -queued;
        IF thisjob>=maxactive-1 THEN thisjob := maxactive-1;
        mark_queue(True);
        IF thisjob>=0 THEN
          display_select(thisjob);
      END;
    'h','H': handle_menu($030700);
    'i','I': BEGIN withicon := NOT withicon; write_checks; fileinfo; END;
    'n','N': BEGIN checkme($050300, (testing AND 2)=0); handle_menu($050300); END;
    #14: handle_menu($020602); { Ctrl-N }
    'r','R': handle_menu($050500);
    's': handle_menu($030B01);
    'S': handle_menu($030B02);
    #19: handle_menu($030B03); { Ctrl-S }
    't','T': BEGIN checkme($050100, (testing AND 1)=0); handle_menu($050100); END;
    ' ': writepage(thispage,True);
    '?': writepage(visblpage,False);
    #27: BEGIN { Esc: Rücksprung }
        pg := pop; IF pg<>Nil THEN BEGIN
          mark_list(False); thispage := pg;
          mark_list(True); writepage(thispage,True);
        END;
      END;
    #127: BEGIN { Del: erst noch die Qualifier abfragen }
        IF (rawcode AND $30)<>0 THEN handle_menu($030E04) { Alt }
        ELSE IF (rawcode AND $08)<>0 THEN handle_menu($030E03) { Ctrl }
        ELSE IF (rawcode AND $03)<>0 THEN handle_menu($030E02) { Shift }
        ELSE handle_menu($030E01);
      END;
    {'z': testpage;}
    #155: handle_raw(rawcode);
    OTHERWISE BEGIN
        IF key>' ' THEN short_msg(key+'?',0)
        ELSE short_msg('Ctrl-'+Chr(Ord(key)+64)+'?',0);
        Delay(20); short_msg('',0);
      END;
  END;
END;

PROCEDURE handle_click;
{ angeklickte Seitennummern aufsuchen/anfordern }
VAR nr,max,j: Integer;
    pg: p_onepage;
    code: Char;
BEGIN
  mouseclicked := False;
  nr := number_from_page(clickedx,clickedy);
  IF nr>=0 THEN BEGIN   { Nummer in einer Seite angeklickt }
    pg := hunt_in_list(nr,0,False);
    IF pg<>Nil THEN IF pg^.pg<>nr THEN pg := Nil;
    IF thispage<>Nil THEN IF thispage^.pg=nr THEN pg := Nil;
    IF pg<>Nil THEN BEGIN  { Seite nur anspringen }
      push(thispage);
      mark_list(False); thispage := pg; mark_list(True);
      writepage(thispage,True);
    END ELSE IF nr IN [$100..$899] THEN BEGIN    { Seite (neu) anfordern }
      nr := get_bcd(nr); max := nr;
      IF dblclicked THEN BEGIN
        max := number_from_page(clickedx+4,clickedy);
        IF max<0 THEN max := nr + 3 ELSE max := get_bcd(max);
        IF max<nr THEN max := nr;
        IF (max DIV 100)>(nr DIV 100) THEN max := 100*(nr DIV 100 + 1)-1;
      END;
      FOR j := nr TO max DO
        add_job(IntStr(j),False);
      redraw_queue(-1);
    END;
    Exit;
  END;
  pg := page_from_list(clickedx,clickedy);
  IF pg<>Nil THEN BEGIN
    IF thispage<>pg THEN BEGIN
      mark_list(False); thispage := pg; mark_list(True);
    END ELSE IF dblclicked THEN BEGIN
      del_from_list(thispage); update_list(thispage,-1);
    END;
    writepage(thispage,True);
    Exit;
  END;
  nr := pos_from_queue(clickedx,clickedy);
  IF nr<maxactive THEN BEGIN
    IF thisjob<>nr THEN BEGIN
      mark_queue(False); thisjob := nr; mark_queue(True);
    END ELSE IF dblclicked THEN
      handle_menu($041100);
    Exit;
  END;
  code := click_action(clickedx,clickedy);
  CASE code OF
    'N': handle_menu($020601);
    '+': handle_raw($4D0000);
    '0': handle_key(#27);
    '-': handle_raw($4C0000);
    'F': BEGIN asciifile := NOT asciifile; write_checks; fileinfo; END;
    'I': BEGIN withicon  := NOT withicon;  write_checks; fileinfo; END;
    'J': BEGIN fifo := NOT fifo; write_checks; redraw_queue(-1); END;
    'K': IF dblclicked THEN BEGIN
        kill_list(root); redraw_list;
      END ELSE
        short_msg('He, sachte da!',0);
    'T': BEGIN
        checkme($050100, (testing AND 1)=0); handle_menu($050100);
        IF dblclicked THEN BEGIN
          checkme($050300, (testing AND 2)=0); handle_menu($050300);
        END;
      END;
    'S': BEGIN
        kill_queue;
        IF dblclicked THEN getconfig(1);
        redraw_queue(-1);
      END;
    'L': IF thispage=root THEN handle_raw($4E0001)
        ELSE handle_raw($4F0001);
    OTHERWISE;
  END;
END;

PROCEDURE handle_rexx;
{ ARexx-Kommandostring auswerten und beantworten }
VAR k: rxkeyid;
    i,j,pg,sp,result: Integer;
    l: Long;
    s,s2: str80;
    pg1,pg2: p_onepage;
    redraw: Boolean;
    c: Char;
BEGIN
  i := 1; WHILE rexxzeile[i]>' ' DO BEGIN
    s[i] := UpCase(rexxzeile[i]); Inc(i);
  END; s[i] := #0;
  WHILE rexxzeile[i] IN [#1..' '] DO Inc(i);
  j := i; WHILE rexxzeile[j]<>#0 DO Inc(j);
  k := scn; WHILE (k<nul) AND (s<>rxkeys[k]) DO Inc(k);
  CASE k OF
    scn: BEGIN rexxreply(0,'');
        CASE UpCase(rexxzeile[i]) OF
          'A': handle_menu($040700);    { 'all' }
          'S': handle_menu($040600);    { 'selected' }
          OTHERWISE handle_menu($040500);
        END;
      END;
    top: BEGIN handle_menu($040C01); rexxreply(0,''); END;
    tos: BEGIN handle_menu($040D00); rexxreply(0,''); END;
    aut: BEGIN handle_menu($040E00); rexxreply(0,''); END;
    tok: BEGIN handle_menu($040C02); rexxreply(0,''); END;
    fif: BEGIN fifo := True; write_checks; redraw_queue(-1); rexxreply(0,''); END;
    lif: BEGIN fifo := False; write_checks; redraw_queue(-1); rexxreply(0,''); END;
    can: BEGIN handle_menu($041000); rexxreply(0,''); END;
    rty: IF do_retry>0 THEN rexxreply(0,'') ELSE rexxreply(5,'');
    clf: IF ask_and_kill(outputname, False) THEN rexxreply(0,'')
           ELSE rexxreply(10,'');
    l2c: BEGIN handle_menu($040801); rexxreply(0,''); END;
    p2c: BEGIN handle_menu($030C00); rexxreply(0,''); END;
    s2f: BEGIN showscreen(1); rexxreply(0,''); END;
    s2b: BEGIN showscreen(-1); rexxreply(0,''); END;
    scl: BEGIN sleep; gettime(s); force_time(s); wakeup; rexxreply(0,''); END;
    snp: BEGIN if write_to_icon THEN rexxreply(0,'') ELSE rexxreply(10,''); END;
    qit: IF privateer=0 THEN BEGIN stop := True; rexxreply(0,''); END
      ELSE rexxreply(10,'');
    pre: BEGIN
        busy_pointer;
        IF rexxzeile[i] IN ['1'..'9'] THEN
          getconfig(Ord(rexxzeile[i])-Ord('0')) ELSE getconfig(1);
        normal_pointer; rexxreply(0,'');
      END;
    enq: BEGIN
        add_job(Copy(rexxzeile,i,j-i),True); redraw_queue(-1); rexxreply(0,'');
      END;
    dsp: BEGIN
        pg1 := root;
        IF (UpCase(rexxzeile[i])='N') AND (thispage<>Nil) THEN
          pg1 := thispage^.next;
        IF rexxzeile[i] IN ['0'..'9'] THEN BEGIN
          pgstr2numbers(Copy(rexxzeile,i,j-i), pg, sp);
          IF sp<=0 THEN BEGIN
            pg1 := hunt_in_list(pg,0,False);
            IF pg1<>Nil THEN IF pg1^.pg<>pg THEN pg1 := Nil;
          END ELSE
            pg1 := hunt_in_list(pg,sp,True);
        END;
        IF pg1<>Nil THEN BEGIN
          mark_list(False); thispage := pg1; mark_list(True);
          writepage(thispage,True); rexxreply(0,'');
        END ELSE
          rexxreply(5,'');
      END;
    hnt: BEGIN
        result := 5;
        IF j>i THEN BEGIN
          searchstr := Copy(rexxzeile,i,j-i);
          busy_pointer;
          IF hunt(searchstr, root, False) THEN result := 0;
          normal_pointer;
        END ELSE IF thispage<>Nil THEN BEGIN
          busy_pointer;
          IF hunt(searchstr, thispage^.next, False) THEN result := 0;
          normal_pointer;
        END;
        rexxreply(result,'');
      END;
    kil: IF UpCase(rexxzeile[i]) IN ['0'..'9','T'] THEN BEGIN
        redraw := False;
        IF (UpCase(rexxzeile[i])='T') AND (thispage<>Nil) THEN BEGIN
          pg := thispage^.pg; sp := thispage^.sp;
        END ELSE
          pgstr2numbers(Copy(rexxzeile,i,j-i), pg, sp);
        pg1 := root;
        WHILE pg1<>Nil DO BEGIN
          pg2 := pg1; pg1 := pg1^.next;
          IF (pg2^.pg=pg) AND ((pg2^.sp=sp) OR (sp<=0)) THEN BEGIN
            IF pg1=Nil THEN pg1 := pg2^.prev;
            IF pg2=thispage THEN redraw := True;
            del_from_list(pg2); pg2 := Nil;
            IF pg1<>Nil THEN update_list(pg1,-1);
          END;
        END;
        IF pg2<>Nil THEN update_list(pg2,0);  { Listenende neu zeichnen }
        IF redraw THEN BEGIN mark_list(True); writepage(thispage,True); END;
        rexxreply(0,'');
      END ELSE BEGIN
        kill_list(root); redraw_list; rexxreply(0,'');
      END;
    sav: BEGIN
        IF rexxzeile[i] IN ['0'..'9'] THEN BEGIN
          pgstr2numbers(Copy(rexxzeile,i,j-i), pg, sp);
          IF sp>0 THEN BEGIN
            j := 1; pg1 := hunt_in_list(pg,sp,True);
          END ELSE BEGIN
            j := 2; pg1 := hunt_in_list(pg,0,False);
            IF pg1<>Nil THEN IF pg1^.pg<>pg THEN pg1 := Nil;
          END;
        END ELSE IF UpCase(rexxzeile[i])='T' THEN BEGIN
          j := 1; pg1 := visblpage
        END ELSE BEGIN
          j := 4; pg1 := root;
        END;
        sleep;
        IF pg1=Nil THEN rexxreply(5,'')
        ELSE IF save_action(pg1,j)=0 THEN rexxreply(0,'')
        ELSE rexxreply(10,'');
        wakeup;
      END;
    fnm: BEGIN
        s := outputname;
        outputname := Copy(rexxzeile,i,j-i); fileinfo; rexxreply(0, s);
      END;
    fmd: BEGIN
        IF asciifile THEN s := 'ASCII' ELSE s := 'VT';
        CASE UpCase(rexxzeile[i]) OF
          'A': BEGIN asciifile := True; fileinfo; rexxreply(0, s); END;
          'V': BEGIN asciifile := False; fileinfo; rexxreply(0, s); END;
          OTHERWISE rexxreply(20,'');
        END;
      END;
    ics: BEGIN
        withicon := UpCase(rexxzeile[i+1])<>'F'; fileinfo; rexxreply(0,'');
      END;
    ifd: BEGIN
        iffpicname := Copy(rexxzeile,i,j-i);
        { schwarzen Hintergrund erzwingen: }
        make_colperms($01234567);
        REPEAT writepage(visblpage,concealed); newevent := False;
        UNTIL NOT incomplete;
        busy_pointer;
        IF iffdump(iffpicname, withicon) THEN rexxreply(0,'')
          ELSE rexxreply(10,'');
        normal_pointer;
        make_colperms(colperm); writepage(visblpage,concealed);
      END;
    loa: BEGIN
        inputname := Copy(rexxzeile,i,j-i);
        IF filetype(inputname)=1 THEN BEGIN
          sleep; busy_pointer; IF getpages(inputname,True)=0 THEN;
          normal_pointer; wakeup;
          redraw_list; writepage(thispage,True);
          rexxreply(0,'');
        END ELSE
          rexxreply(10,'');
      END;
    laq: BEGIN
        i := queued+active; s := IntStr(i); IF i>0 THEN i := 5; rexxreply(i,s);
      END;
    gst: BEGIN
        c := UpCase(rexxzeile[i]);
        IF c IN ['L','R'] THEN BEGIN
          l := VTstat;
          IF (l AND 3)=3 THEN BEGIN     { Normalfall: Empfang OK }
            gethead(s);
            IF c='L' THEN BEGIN  { 'live' }
              name2dosname(s,s2); s := s2;
            END;  { sonst: 'raw' }
            rexxreply(0,s);
          END ELSE IF (l AND 1)=0 THEN
            rexxreply(6,'')    { überhaupt kein Empfang --> RC=6 }
          ELSE
            rexxreply(5,'');   { Sender ohne VT --> RC=5 }
        END ELSE BEGIN
          IF thispage=Nil THEN
            rexxreply(5,'')
          ELSE BEGIN
            namefrompage(s, thispage); rexxreply(0,s);
          END;
        END;
      END;
    gpn,gpi: IF thispage=Nil THEN
        rexxreply(5,'')
      ELSE BEGIN
        s := hexstr(thispage^.pg,3);
        IF k=gpi THEN s := s + hexstr(thispage^.sp,4);
        rexxreply(0,s);
      END;
    OTHERWISE rexxreply(20,'');
  END;
END;

PROCEDURE slideshow;
VAR jetzt: zeiteintrag;
BEGIN
  IF thispage=Nil THEN
    auto := False
  ELSE IF thispage^.next=Nil THEN
    auto := False
  ELSE BEGIN
    uhrzeit(jetzt);
    IF diff_time(lastslide,jetzt)>50*autotimer THEN BEGIN
      mark_list(False); thispage := thispage^.next; mark_list(True);
      lastslide := jetzt; writepage(thispage, True);
    END;
  END;
END;

VAR speak: Text;

BEGIN  { Hauptprogramm }
  { Eine Menge Variablen werden bereits in den Units, wo sie auch deklariert }
  { sind, initialisiert. }
  get_args; inputname := outputname; iffpicname := outputname;
  searchstr := '';
  stop := False; auto := listsize>0; thispage := root;
  AddExitServer(sysclean); sysinit(version);
  write_checks;
  roundrobin := 0; toprequest := 0; adip_count := 0;
  stackbot := 1; stackptr := stackbot;
  init_CCT; { SAA 5246 initialisieren }
  redraw_all; IF thispage=Nil THEN say_hello(version);
  REPEAT
    IF NOT newevent THEN event_scan(True);
    IF newevent THEN BEGIN
      newevent := False; short_msg('',0); auto := False;
      IF taste<>#0 THEN handle_key(taste);
      IF mouseclicked THEN handle_click;
      IF menupicked THEN handle_menu(menucode);
      IF rexxzeile<>'' THEN handle_rexx;
    END ELSE IF (testing<>0) OR incomplete OR (visblpage=Nil) OR auto OR
      (toprequest+queued+active>0) THEN BEGIN
      Delay(5);  { Multitasking-freundlich, wir haben Zeit ... }
      IF testing<>0 THEN test(testing OR $10);
      IF visblpage=Nil THEN say_hello(version)
        ELSE IF incomplete THEN writepage(visblpage,True);
      IF auto THEN slideshow;
      IF toprequest>0 THEN topscan;
      searching := queued+active>0;
      IF queued>0 THEN handle_queue;
      IF active>0 THEN BEGIN
        handle_jobs;
        attempt_input(roundrobin);
        roundrobin := (roundrobin+1) MOD maxactive;
      END;
      IF searching AND (queued+active=0) AND (speech<>'') THEN BEGIN { "Fertig!" }
        Rewrite(speak,'SPEAK:'); IF IOResult=0 THEN BEGIN
          Write(speak,speech+' '); Close(speak);
        END;
      END;
    END ELSE   { nichts mehr zu tun :-) }
      l := Wait(-1);
    IF (i2c_status<>0) AND (testing AND 1=0) THEN BEGIN
      testing := testing OR 1; test(testing OR $10);
      guru(i2c_status);
    END;
  UNTIL stop;
  SetStdIO(Nil); CloseConsole(Con);
  kill_list(root); sysclean;
END.