UNIT sys; {$project vt}
{ Betriebssystemnahe Funktionen zum Programm VideoText }

INTERFACE;

TYPE str80 = String[80];

VAR taste: Char;
    rawcode: Long;
    newevent, mouseclicked, dblclicked, menupicked: Boolean;
    clickedx, clickedy: Integer;
    menucode: Long;
    rexxzeile: String[256];
    palette: ARRAY[0..7] OF Word;
    colperm: Long;
    screenmode: Long;
    pubsname, portname: String[10];    { z. B. "WNVT0" }
    fontno: Integer;  { 1 oder 2, entspricht videotext/9 und /15 }
    datestyle: Byte;  { 0..3 }
    scriptnames: ARRAY[1..10] OF String[32];  { erscheinen im Menue }
    rxscripts: Integer;   { 0..10 }
    rexxpath: String[20];
    silentrexx: Boolean;  { Skripts unauffällig auf der Workbench? }
    Con: Ptr;  { darf nicht vom ExitServer geschlossen werden, komisch }

PROCEDURE event_scan(rexx_too: Boolean);
PROCEDURE rexxreply(x: Long; s: Str);
FUNCTION rexxecute(i: Integer): Boolean;
PROCEDURE scriptscan;
PROCEDURE ghostme(code: Long; really: Boolean);
PROCEDURE checkme(code: Long; really: Boolean);
FUNCTION has_check(code: Long): Boolean;
FUNCTION ja_nein(message: Str): Boolean;
FUNCTION ask_and_kill(name: Str; ask: Boolean): Boolean;
FUNCTION stringrequest(meldung: str80; VAR eingabe: str80): Boolean;
FUNCTION fileselect(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): Boolean;
PROCEDURE create_icon(src, dest: Str);
PROCEDURE append_datestr(VAR s: str80; smart: Boolean);
PROCEDURE desaster(meldung: str80);
PROCEDURE stretch_line(zeile, sp0, sp1: Integer);
PROCEDURE raster_line(zeile, sp0, sp1: Integer; farbe: Word);
PROCEDURE scroll_text(zl0,zl1, sp0,sp1, dy,dx: Integer);
FUNCTION newfontno: Boolean;
FUNCTION iffdump(VAR filename: str80; withicon: Boolean): Boolean;
PROCEDURE busy_pointer;             
PROCEDURE normal_pointer;
PROCEDURE showscreen(which: Integer);
PROCEDURE getpalette;              
PROCEDURE telltime(VAR day,min,tic: Long);
PROCEDURE force_time(VAR s: Str80);
PROCEDURE start_clip(size: Long);
PROCEDURE clip_it(s: Str; len: Long);
PROCEDURE end_clip;
PROCEDURE sysinit(version: Str);
FUNCTION privateer: Integer;
PROCEDURE sysclean;         

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

IMPLEMENTATION;

{$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
CONST INTUI_V36_NAMES_ONLY=1; { kein "intuition/iobsolete.h", bitte! }
{$incl "intuition.lib", "gadtools.lib", "graphics.lib", "diskfont.lib" }
{$incl "exec.lib", "dos.lib", "icon.lib", "asl.lib", "rexxsyslib.lib" }
{$incl "exec/libraries.h", "devices/timer.h", "devices/clipboard.h" }

CONST anzmenu=99;

TYPE WordArr36 = ARRAY [1..36] OF Word;
     NMArray = ARRAY [1..anzmenu] OF NewMenu;

VAR strstack: String[2000]; STATIC;
    Tags: Array[1..10] OF TagItem;  STATIC;
    TheMenu: NMArray;  STATIC;
    BusyPointerData: ^WordArr36;
    titel: Str80;  STATIC;
    myprocess: p_Process;
    MyScreen: p_Screen;
    MyWindow,oldwindowptr: p_Window;
    visinfo: Ptr;
    Strip: p_Menu;
    teleFont: p_TextFont;
    nextselect: Word;
    lastmsg: IntuiMessage; { kein Zeiger! }
    rexxport,replyport: p_MsgPort;
    rxm, scriptmess: p_RexxMsg;
    fenster: Text;
    { fürs clipboard.device: }
    clip_port: ^MsgPort;
    clipreq: ^IOClipReq; { erweiterte IO-Request-Struktur }
    clip_open: Boolean;


PROCEDURE event_scan{(rexx_too: Boolean)};
{ überträgt eingehende Tasten und ESC-Sequenzen sowie die Intuition- }
{ Ereignisse Mausklick und Menuewahl in globale Variablen. }
VAR im: p_IntuiMessage;
    i,charx,chary: Integer;
    pp: ^Ptr;
    buf: String[10];
PROCEDURE menu_eval(item: Word);
{ wird an zwei Stellen gebraucht ... }
VAR men,menitem,subitem: Word;
    item_address: ^MenuItem;
BEGIN
  newevent := True; menupicked := True;
  { Menue, Menuepunkt und Untermenue ermitteln und diese in ziemlich }
  { mutierter Form wieder gemeinsam in einem Langwort ablegen: }
  men := item AND $1F;
  menitem := (item SHR 5) AND $3F;
  subitem := (item SHR 11) AND $1F;
  menucode := (Long(men+1) SHL 16) OR ((menitem+1) SHL 8) OR (subitem+1);
  item_address := ItemAddress(Strip,item);
  nextselect := item_address^.NextSelect;
END;
BEGIN
  IF scriptmess<>Nil THEN       { ARexx-Skript gestartet }
    IF GetMsg(replyport)<>Nil THEN BEGIN  { ... und ist gerade zu Ende }
      Close(fenster);
      DeleteArgstring(scriptmess^.rm_Args[0]);
      DeleteRexxMsg(scriptmess); scriptmess := Nil;
      FOR i := 1 TO rxscripts DO
        ghostme($060300 + i*$100, False);
    END;
  IF nextselect<>MENUNULL THEN BEGIN
    menu_eval(nextselect); Exit;
  END;
  im := p_IntuiMessage(GetMsg(MyWindow^.UserPort));
  IF im<>Nil THEN BEGIN
    CASE im^.class OF
      IDCMP_MENUPICK: IF im^.Code<>MENUNULL THEN menu_eval(im^.Code);
      IDCMP_MOUSEBUTTONS: IF im^.Code=SELECTDOWN THEN BEGIN
          newevent := True; mouseclicked := True;
          charx := MyWindow^.RPort^.TxWidth;
          chary := MyWindow^.RPort^.TxHeight;
          clickedx := 1 + (im^.MouseX - MyWindow^.BorderLeft) DIV charx;
          clickedy := 1 + (im^.MouseY - MyWindow^.BorderTop) DIV chary;
          dblclicked := DoubleClick(lastmsg.seconds,lastmsg.micros,
              im^.seconds,im^.micros);
          lastmsg := im^;
        END;
      IDCMP_RAWKEY: IF im^.Code<$60 THEN BEGIN { "echte" Taste gedrückt }
          taste := #155; { naja, irgendwie muß man das ja melden ... }
          rawcode := im^.Qualifier OR (Long(im^.Code) SHL 16);
          newevent := True;
        END;
      IDCMP_VANILLAKEY: BEGIN
          taste := Chr(im^.Code); rawcode := im^.Qualifier;
          newevent := True;
        END;
      OTHERWISE;
    END;
    ReplyMsg(p_Message(im));
  END;
  IF newevent THEN Exit;
  IF rexx_too AND (rexxport<>Nil) AND (rxm=Nil) THEN BEGIN
    rxm := p_RexxMsg(GetMsg(rexxport));
    IF rxm<>Nil THEN BEGIN
      newevent := True;
      rexxzeile := rxm^.rm_Args[0];
    END;
    { geantwortet wird später! }
  END;
END;

PROCEDURE rexxreply{(x: Long; s: Str)};
{ Returncode und evtl. Ergebnisstring zurückgeben }
BEGIN
  IF rxm<>Nil THEN BEGIN
    rxm^.rm_Result1 := x;
    IF (rxm^.rm_Action AND RXFF_RESULT<>0) AND (s<>'') THEN
      rxm^.rm_Result2 := Long(CreateArgstring(s,Length(s)))
    ELSE
      rxm^.rm_Result2 := 0;
    ReplyMsg(p_Message(rxm));
    rxm := Nil; rexxzeile := '';
  END;
END;

FUNCTION rexxecute{(i: Integer): Boolean};
{ eins der 10 ARexx-Skripte starten, asynchron wohlgemerkt! }
VAR s: String[200];
    l: Long;
    rxmp: p_MsgPort;
BEGIN
  rexxecute := False;
  IF (i>rxscripts) OR (scriptmess<>Nil) THEN Exit;
  s := rexxpath + scriptnames[i];
  scriptmess := CreateRexxMsg(replyport, portname, Nil);
  IF scriptmess=Nil THEN Exit;
  scriptmess^.rm_Action := RXCOMM;
  scriptmess^.rm_Args[0] := CreateArgstring(s, Length(s));
  s := 'CON:/100/450//Skript-Aufruf "'+scriptnames[i]+'", Abbruch: Ctrl-C';
  IF silentrexx THEN
    s := s + '/INACTIVE'
  ELSE
    s := s + '/SCREEN'+pubsname;
  Reset(fenster, s);
  scriptmess^.rm_Stdin := FileHandle(fenster);
  scriptmess^.rm_Stdout := FileHandle(fenster);
  Forbid;
  rxmp := FindPort('REXX');
  IF rxmp<>Nil THEN BEGIN
    PutMsg(rxmp, p_Message(scriptmess)); 
    Permit;
    FOR i := 1 TO rxscripts DO
      ghostme($060300 + i*$100, True);
    rexxecute := True;
  END ELSE BEGIN
    Permit; 
    Close(fenster);
    DeleteArgstring(scriptmess^.rm_Args[0]);
    DeleteRexxMsg(scriptmess); scriptmess := Nil;
  END;
END;

PROCEDURE scriptscan;
{ Liest das "rexx/"-Verzeichnis }
VAR scanner: AnchorPath;
    pattern: str80;
    result: Long;
BEGIN
  rxscripts := 0;
  pattern := rexxpath + '~(#?.info)';
  scanner.ap_BreakBits := 0;
  scanner.ap_Strlen := 0;
  result := MatchFirst(^pattern, ^scanner);
  WHILE result=0 DO BEGIN
    IF (scanner.ap_Info.fib_DirEntryType<0) AND (rxscripts<10) THEN BEGIN
      Inc(rxscripts); 
      scriptnames[rxscripts] := scanner.ap_Info.fib_FileName;
    END;
    result := MatchNext(^scanner);
  END;
  MatchEnd(^scanner);
END;

PROCEDURE ghostme{(code: Long; really: Boolean)};
{ Menüpunkt abschalten/wieder einschalten }
VAR it: p_MenuItem;
    m,i,s: Integer;
    syscode: Word;
BEGIN
  m := (code SHR 16) - 1;
  i := ((code SHR 8) AND $FF) - 1;
  s := (code AND $FF) - 1;
  syscode := m OR (i SHL 5) OR (s SHL 11);
  it := ItemAddress(Strip,syscode);
  IF it=Nil THEN Exit;
  IF really THEN
    OffMenu(MyWindow, syscode)
  ELSE                       
    OnMenu(MyWindow, syscode);
END;

PROCEDURE checkme{(code: Long; really: Boolean)};
{ Menuehäkchen setzen/löschen }
VAR it: p_MenuItem;
    m,i,s: Integer;
    syscode: Word;
BEGIN
  m := (code SHR 16) - 1;
  i := ((code SHR 8) AND $FF) - 1;
  s := (code AND $FF) - 1;
  syscode := m OR (i SHL 5) OR (s SHL 11);
  it := ItemAddress(Strip,syscode);
  IF it=Nil THEN Exit;
  IF really THEN
    it^.Flags := it^.Flags OR CHECKED
  ELSE
    it^.Flags := it^.Flags AND NOT CHECKED;
END;

FUNCTION has_check{(code: Long): Boolean};
{ Menuehäkchen abfragen }
VAR it: p_MenuItem;
    m,i,s: Integer;
    syscode: Word;
BEGIN
  m := (code SHR 16) - 1;
  i := ((code SHR 8) AND $FF) - 1;
  s := (code AND $FF) - 1;
  syscode := m OR (i SHL 5) OR (s SHL 11);
  it := ItemAddress(Strip,syscode);
  IF it<>Nil THEN
    has_check := (it^.Flags AND CHECKED)<>0;
END;

FUNCTION ja_nein{(message: Str): Boolean};
VAR easy: EasyStruct;
    idcmp: Long;
BEGIN
  idcmp := 0;
  easy := EasyStruct(SizeOf(EasyStruct), 0, 'VideoText Request',
                     '%s', 'JA|NEIN');
  ja_nein := EasyRequestArgs(MyWindow, ^easy, ^idcmp, ^message) = 1;
END;

FUNCTION ask_and_kill{(name: Str; ask: Boolean): Boolean};
VAR easy: EasyStruct;
    idcmp, size: Long;
    arglist: ARRAY[1..2] OF Long;
    datei: Text;
BEGIN
  ask_and_kill := False;
  IF NOT ask THEN BEGIN
    ask_and_kill := DeleteFile(name)<>0;
    Exit;
  END;
  Reset(datei,name);
  IF IOResult<>0 THEN
    Exit;
  size := FileSize(datei);
  Close(datei);
  idcmp := 0;
  easy := EasyStruct(SizeOf(EasyStruct),0,'VideoText Request',
         '"%s"'\n'(%ld Byte) löschen?','JA|NEIN');
  arglist[1] := Long(name);
  arglist[2] := size;
  IF EasyRequestArgs(MyWindow,^easy,^idcmp,^arglist) = 1 THEN
    ask_and_kill := DeleteFile(name)<>0;
END;

FUNCTION stringrequest{(meldung: str80; VAR eingabe: str80): Boolean};
{ Erzeugt einen Intuition-Requester mit Stringgadget. }
TYPE IntArr10 = ARRAY [1..10] OF Integer;
CONST chars=20;
VAR i,p,l: Integer;
    Msg: p_IntuiMessage;
    ende: Boolean;
    class: Long;
    b,h,charx,chary: Word;
    buf,ubuf: str80;
    muell: ARRAY[0..31] OF Byte;
    MyRequest: Requester; STATIC;
    TextGad: Gadget; STATIC;
    TextInfo: StringInfo; STATIC;
    ITxt: ARRAY[1..5] OF IntuiText; STATIC;
    Borders: ARRAY[1..6] OF Border; STATIC;
    TextBordXY,MainBordXY: IntArr10; STATIC;    
BEGIN
  stringrequest := False;
  { Screenfont bestimmt das Aussehen des Requesters: }
  charx := MyScreen^.RastPort.TxWidth;  
  chary := MyScreen^.RastPort.TxHeight;
  buf := eingabe; ubuf := '';
  ITxt[1] := IntuiText(1,3,JAM1,15,6,MyScreen^.Font,meldung,Nil);
  b := IntuiTextLength(^ITxt[1]) + 30;
  IF b<chars*8 + 30  THEN b := chars*8 + 30;
  h := chary + 8 + 20;
  TextBordXY := IntArr10(-1,8,chars*8,8,chars*8,-1,-1,-1,-1,8);
  Borders[1] := Border(0,0,2,0,JAM1,3,^TextBordXY,^Borders[2]);
  Borders[2] := Border(0,0,1,0,JAM1,3,^TextBordXY[5],Nil);
  TextInfo := StringInfo(^buf,^ubuf,0,79,0,0,0,0,0,0,Nil,0,Nil);
  TextGad := Gadget(Nil,(b-8*chars) DIV 2,chary+12,8*chars,8,GFLG_GADGHCOMP,
    GACT_RELVERIFY OR GACT_ENDGADGET, GTYP_STRGADGET OR GTYP_REQGADGET,
    ^Borders[1], Nil,Nil,0,^TextInfo,2,Nil);
  MainBordXY := IntArr10(0,h-1,b-1,h-1,b-1,0,0,0,0,h-1);
  Borders[3] := Border(0,0,1,0,JAM1,3,^MainBordXY,^Borders[4]);
  Borders[4] := Border(0,0,2,0,JAM1,3,^MainBordXY[5],Nil);
  MyRequest := Requester(Nil,40,90,b,h,0,0,^TextGad,^Borders[3],
      ^ITxt[1],0,3,Nil,muell,Nil,Nil,Nil,muell);
  IF Request(^MyRequest,MyWindow) THEN BEGIN { Ereignisse abfragen }
    ende := False;
    REPEAT
      REPEAT              { Schleife, da mehrere Ereignisse möglich }
        Msg := Get_Msg(MyWindow^.UserPort);
        IF Msg<>Nil THEN BEGIN
          class := Msg^.Class;
          Reply_Msg(Msg);             { so schnell wie möglich antworten! }
          IF class=IDCMP_REQSET THEN
            IF NOT ActivateGadget(^TextGad,MyWindow,^MyRequest) THEN;
          IF class=IDCMP_REQCLEAR THEN ende := True;
        END;
      UNTIL Msg=Nil;
      IF NOT ende THEN class := Wait(-1);
    UNTIL ende;
    IF buf<>'' THEN BEGIN
      stringrequest := True;
      eingabe := buf;
    END;
  END;
END;

FUNCTION fileselect{(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): Boolean};
{ Benutzt den Filerequester der asl.library }
VAR i,p,l: Integer;
    Req: p_FileRequester;
    pfad,name: str80;
BEGIN
  fileselect := False;
  l := Length(selected);
  { selected in pfad und name spalten }
  p := 0; FOR i := 1 TO l DO
    IF selected[i] IN ['/',':'] THEN p := i;
  IF p=0 THEN pfad := '' ELSE pfad := Copy(selected,1,p);
  IF p=l THEN name := '' ELSE name := Copy(selected,p+1,l-p);
  IF AslBase<>Nil THEN BEGIN            { *** "asl.library" benutzen }
    Tags[1] := TagItem(ASL_Hail,Long(^was_los));
    Tags[2] := TagItem(ASL_Dir,Long(^pfad));
    Tags[3] := TagItem(ASL_File,Long(^name));
    Tags[4] := TagItem(ASL_Window,Long(MyWindow));
    Tags[5] := TagItem(ASL_FuncFlags,FILF_SAVE);
    i := 5; IF speichern THEN Inc(i);
    Tags[i] := TagItem(TAG_DONE,0);
    Req := AllocAslRequest(ASL_FileRequest,^Tags);
    IF Req<>NIL THEN BEGIN
      IF RequestFile(Req) THEN
        IF Req^.rf_File<>'' THEN BEGIN
          fileselect := True;
          selected := Req^.rf_Dir;
          IF NOT AddPart(selected, Req^.rf_File, 80) THEN { panic ;-) };
        END;
      FreeAslRequest(Req);
    END;
  END;
END;

PROCEDURE create_icon{(src, dest: Str)};
VAR icon: p_DiskObject;
BEGIN
  IF (IconBase<>Nil) AND (src<>'') THEN BEGIN
    icon := GetDiskObject(src);
    IF icon<>Nil THEN BEGIN
      icon^.do_CurrentX := NO_ICON_POSITION;
      icon^.do_CurrentY := NO_ICON_POSITION;
      icon^.do_Type := WBPROJECT;
      IF NOT PutDiskObject(dest,icon) THEN;
      FreeDiskObject(icon);
    END;
  END;
END;

PROCEDURE append_datestr{(VAR s: str80; smart: Boolean)};
{ Hängt das aktuelle Datum in der Form .15-08-96 an den übergebenen }
{ Filenamen an. Ist das Datum dort schon vorhanden, passiert nichts, für }
{ smart=True wird es in dem Fall sogar entfernt. }
VAR s1,s2,s3: String[LEN_DATSTRING];
    dt: DateTime;
    i: Integer;
BEGIN
  IF _DateStamp(^dt.dat_Stamp)<>Nil THEN;
  dt.dat_Format := datestyle;
  dt.dat_Flags := 0;
  dt.dat_StrDay := s1;
  dt.dat_StrDate := s2;
  dt.dat_StrTime := s3;
  IF DateToStr(^dt)<>0 THEN BEGIN
    i := Pos(s2,s);
    IF i=0 THEN
      s := s+'.'+s2
    ELSE IF smart THEN
      s[i-1] := #0;
  END;
END;

PROCEDURE desaster{(meldung: Str80)};
{ erzeugt einen Alert }
VAR egal: Boolean;
    buf: Str80;
    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;

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;
  x0 := (sp0-1)*charx; breite := (sp1-sp0+1)*charx;
  y0 := (zeile-1)*chary;
  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 raster_line{(zeile, sp0, sp1: Integer; farbe: Word)};
{ Grafikzeichen einer Zeile in seperate Rasterpunkte zerlegen, dazu dient }
{ Zeichen #159 des videotext.font }
VAR charx,chary,baseline,y0,x0,i,anz: Integer;
    dummy: str80;
    egal: Long;
BEGIN
  charx := MyWindow^.RPort^.TxWidth;
  chary := MyWindow^.RPort^.TxHeight;
  baseline := MyWindow^.RPort^.TxBaseline;
  x0 := (sp0-1)*charx; y0 := (zeile-1)*chary + baseline;
  anz := sp1-sp0+1;
  FOR i := 1 TO anz DO dummy[i] := #159;
  SetAPen(MyWindow^.RPort,farbe); SetDrMd(MyWindow^.RPort,JAM1);
  Move(MyWindow^.RPort,x0,y0); egal := _Text(MyWindow^.RPort,dummy,anz);
END;

PROCEDURE scroll_text{(zl0,zl1, sp0,sp1, dy,dx: Integer)};
{ einen Textblock verschieben, benutzt natürlich ScrollRaster() }
{ Zeilen und Spalten werden, wie bei GotoXY üblich, ab 1 gezählt! }
VAR charx,chary,i,x0,y0,x1,y1: Integer;
BEGIN
  charx := MyWindow^.RPort^.TxWidth;
  chary := MyWindow^.RPort^.TxHeight;
  dx := dx*charx; dy := dy*chary;
  x0 := (sp0-1)*charx; x1 := sp1*charx-1;
  y0 := (zl0-1)*chary; y1 := zl1*chary-1;
  ScrollRaster(MyWindow^.RPort,dx,dy,x0,y0,x1,y1);
END;

FUNCTION newfontno{: Boolean};
{ den über <fontno> eingestellten Font öffnen und darstellen }
{ Kann fehlschlagen, wenn der Font nicht da ist, oder wenn die gewählte }
{ Größe nicht zu den aktuellen Fensterausmaßen paßt. }
VAR teleAttr: TextAttr;
    lastFont: p_TextFont;
    l: Long;
    msg: str80;
BEGIN
  newfontno := True;
  IF DiskFontBase=Nil THEN Exit;
  lastFont := teleFont;
  teleAttr := TextAttr('videotext.font',9,FS_NORMAL,FPF_DISKFONT);
  IF fontno=2 THEN
    IF MyWindow^.GZZHeight>=390 THEN
      teleAttr.ta_YSize := 15
    ELSE BEGIN
      fontno := 1;
      newfontno := False;
    END;
  teleFont := OpenDiskFont(^teleAttr);
  IF teleFont<>Nil THEN BEGIN
    IF lastFont<>Nil THEN CloseFont(lastFont);
    l := SetFont(MyWindow^.RPort,teleFont);
  END ELSE BEGIN
    msg := 'Can''t open font: videotext/'+IntStr(teleAttr.ta_YSize)+' !!!';
    desaster(msg);
    newfontno := False;
    teleFont := lastFont;
  END;
END;

FUNCTION iffdump{(VAR filename: str80; withicon: Boolean): Boolean};
{ IFF-Bild erzeugen }
{ Annahmen: Die VT-Seite beginnt in Zeile 0, belegt die letzten 41 (!) }
{ Textspalten und überdeckt damit nicht mehr als 640 Pixel (=80 Byte). }
VAR i, j, k, zeile, bunt, packbar: Integer;
    rows, bpr, x0, w: Integer;
    l: Long;
    s: str80;
    bytes: ^ARRAY [1..1000] OF Char;
    tempscr: p_Screen;
    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, filename);
  IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
    Exit;
  IF withicon THEN
    create_icon('Icons/IFF', filename);
  { Abmessungen und Ort des zu speichernden Bildes: }
  w := MyWindow^.RPort^.TxWidth;
  bpr := (40 * w) DIV 8;
  rows := 24 * MyWindow^.RPort^.TxHeight;
  x0 := w * (MyWindow^.GZZWidth DIV w - 41); IF x0<0 THEN x0 := 0;
  { Temporären Screen in einem Bitplane-Screenmode (LoRes) einrichten: }
  Tags[1] := TagItem(SA_Width, 8*bpr);
  Tags[2] := TagItem(SA_Height, 2);     { Höhe 1 ist nicht zulässig! }
  Tags[3] := TagItem(SA_Depth, 3);
  Tags[4] := TagItem(SA_DisplayID, 0);
  Tags[5] := TagItem(SA_Behind, 1);
  Tags[6] := TagItem(TAG_DONE, 0);
  tempscr := OpenScreenTagList(Nil,^Tags[1]);
  IF tempscr=Nil THEN BEGIN
    Close(datei); Exit;
  END;
  { IFF-ILBM erzeugen, LoRes, 3 Bitplanes }
  Write(datei,'FORM'); putlong(10000);  { wird später korrigiert }
  Write(datei,'ILBM');
  Write(datei,'BMHD'); putlong(20);
  putshort(8*bpr); putshort(rows); { 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(8*bpr); putshort(rows); { Breite, Höhe des Bildschirms }
  Write(datei,'CMAP'); putlong(24);
  FOR j := 0 TO 7 DO
    Write(datei, Chr($F0*(j AND 1)), Chr($78*(j AND 2)), Chr($3C*(j AND 4)));
  Write(datei,'BODY'); putlong(10000);    { Wert wird später korrigiert }
  FOR zeile := 0 TO rows-1 DO BEGIN
    ClipBlit(MyWindow^.RPort,x0,zeile,^tempscr^.RastPort,0,0,8*bpr,1,$C0);
    FOR i := 0 TO 2 DO BEGIN
      bytes := Ptr(tempscr^.RastPort.BitMap^.Planes[i]);
      { 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<bpr) 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>bpr;
      BlockWrite(datei,s,k); IF IOResult<>0 THEN BEGIN 
        Close(datei); Exit; { wahrscheinlich Disk full oder so was }
      END; 
    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,76); putlong(l-80);
  Close(datei);
  IF CloseScreen(tempscr) THEN;
  iffdump := True;
END;

PROCEDURE busy_pointer;
BEGIN
  IF BusyPointerData<>Nil THEN
    SetPointer(MyWindow, BusyPointerData, 16, 16, -6, 0);
END;

PROCEDURE normal_pointer;
BEGIN
  ClearPointer(MyWindow);
END;

PROCEDURE showscreen{(which: Integer)};
{ -1: mein Screen nach hinten }
{  0: Workbench nach vorne }
{ +1: mein Screen nach vorne }
{ +2: mein Screen nach vorne und aktivieren }
BEGIN     
  IF which>0 THEN BEGIN
    ScreenToFront(MyScreen);
    IF which>1 THEN IF ActivateWindow(MyWindow)<>0 THEN;
  END ELSE IF which<0 THEN
    ScreenToBack(MyScreen)
  ELSE
    IF NOT WBenchToFront THEN { Workbench gar nicht offen, na toll };
END;

PROCEDURE getpalette;
VAR i, j: Integer;
BEGIN
  FOR i := 0 TO 7 DO BEGIN
    j := (colperm SHR (4*(7-i))) AND $F;
    palette[j] := GetRGB4(MyScreen^.ViewPort.ColorMap, i);
  END;
END;

PROCEDURE telltime{(VAR day,min,tic: Long)};
VAR time: DateStamp;
BEGIN
  IF _DateStamp(^time)<>Nil THEN BEGIN
    day := time.ds_Days;
    min := time.ds_Minute;
    tic := time.ds_Tick;
  END;
END;

PROCEDURE force_time{(VAR s: Str80)};
{ setzt die Systemzeit (Tageszeit), Datum bleibt unverändert }
VAR port: ^MsgPort;
    t_ioreq: ^TimeRequest;
    err: Integer;
    secs,w: Long;
    i,j: Integer;
CONST spd=60*60*24;
BEGIN
  { Uhrzeit-String "09:12:35", "912/35" o. ä. in Sekunden umrechnen }
  secs := 0; j := 0; w := 1; { w: Wert der Ziffer }
  FOR i := Length(s) DOWNTO 1 DO BEGIN
    IF s[i] IN ['0'..'9'] THEN BEGIN
      secs := secs + w*(Ord(s[i])-48);
      Inc(j);
      CASE j OF
        1,3,5: w := 10*w;
        2,4: w := 6*w;
        OTHERWISE w := 0;
      END;
    END;
  END;
  IF j<5 THEN Exit; { das kann keine Uhrzeit gewesen sein }
  { der ganze device-Ärger: }
  port := CreateMsgPort; 
  t_ioreq := CreateIORequest(port,SizeOf(TimeRequest));
  IF OpenDevice('timer.device',UNIT_VBLANK,Ptr(t_ioreq),0)=0 THEN BEGIN
    { Uhrzeit erst lesen: }
    t_ioreq^.tr_node.io_Command := TR_GETSYSTIME;
    err := DoIO(Ptr(t_ioreq));
    { Tageszeit ändern und neu setzten: }
    t_ioreq^.tr_node.io_Command := TR_SETSYSTIME;
    WITH t_ioreq^.tr_time DO BEGIN
      tv_secs := (tv_secs DIV spd)*spd + secs; tv_micro := 0;
    END;
    err := DoIO(Ptr(t_ioreq));
    { Und tschüss: }
    CloseDevice(Ptr(t_ioreq));
  END;
  DeleteIORequest(t_ioreq);
  DeleteMsgPort(port);
END;

PROCEDURE clip_it{(s: Str; len: Long)};
{ String ins Clipboard schreiben }
VAR err: Integer;
BEGIN
  IF clip_open THEN BEGIN
    clipreq^.io_Command := CMD_WRITE;
    clipreq^.io_Data := s;
    clipreq^.io_Length := len;
    err := DoIO(Ptr(clipreq));
  END;
END;

PROCEDURE start_clip{(size: Long)};
BEGIN
  IF clip_open THEN Exit;
  clip_port := CreateMsgPort;
  clipreq := CreateIORequest(clip_port,SizeOf(IOClipReq));
  IF OpenDevice('clipboard.device',PRIMARY_CLIP,Ptr(clipreq),0)=0 THEN BEGIN
    clipreq^.io_Offset := 0;
    clipreq^.io_ClipID := 0;
    clip_open := True;
    clip_it('FORM',4); { IFF-Header }
    size := size + 12; clip_it(Ptr(^size),4); size := size - 12;
    clip_it('FTXTCHRS',8);
    clip_it(Ptr(^size),4);
  END ELSE BEGIN
    DeleteIORequest(clipreq);
    DeleteMsgPort(clip_port);
  END;
END;

PROCEDURE end_clip;
VAR err: Integer;
BEGIN
  IF clip_open THEN BEGIN
    { melden, daß man fertig ist }
    clipreq^.io_Command := CMD_UPDATE;
    err := DoIO(Ptr(clipreq));
    { Und tschüss: }
    CloseDevice(Ptr(clipreq));
    DeleteIORequest(clipreq);
    DeleteMsgPort(clip_port);
    clip_open := False;
  END;
END;

{ *** mein Menü: }

PROCEDURE create_menu;
CONST tog = CHECKIT OR MENUTOGGLE;
      mut = CHECKIT;
VAR egal: Boolean;
    i,j,stacked: Integer;
    s: ^str80;
    gtlib: p_Library;
FUNCTION strcopy(s: Str): Str;
{ einen String in den globalen Stringpuffer kopieren }
VAR i: Integer;
    s2: ^str80;
BEGIN
  strcopy := ^strstack[stacked]; s2 := s; i := 0;
  REPEAT
    Inc(i); strstack[stacked] := s2^[i]; Inc(stacked); 
  UNTIL s2^[i]=chr(0);
END;
BEGIN
  stacked := 1;
  TheMenu := NMArray(
    NewMenu(NM_TITLE,0, 'Projekt',           Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Info',              '?', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Hilfe: Help',       Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Parameter sichern', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0,  Str(NM_BARLABEL),   Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Ende',              'Q', 0, 0, Nil),
    { 6 }
    NewMenu(NM_TITLE,0, 'Datei',                   Nil, 0,   0, Nil),
    NewMenu(NM_ITEM, 0, 'VT-Format laden',         'L', 0,   0, Nil),
    NewMenu(NM_ITEM, 0,  Str(NM_BARLABEL),         Nil, 0,   0, Nil),
    NewMenu(NM_ITEM, 0, 'Ausgabeformat',           Nil, 0,   0, Nil),
    NewMenu(NM_SUB,  0, 'ASCII',                   'A', mut, %10, Nil),
    NewMenu(NM_SUB,  0, 'VT',                      'V', mut, %01, Nil),
    NewMenu(NM_ITEM, 0, 'Icons erzeugen: I',       Nil, tog, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),          Nil, 0,   0, Nil),
    NewMenu(NM_ITEM, 0, 'Dateinamen',              Nil, 0,   0, Nil),
    NewMenu(NM_SUB,  0, 'ändern ...',              'N', 0,   0, Nil),
    NewMenu(NM_SUB,  0, 'nach Titelzeile: Ctrl-N', Nil, 0,   0, Nil),
    NewMenu(NM_SUB,  0, 'Datum anhängen',          'D', 0,   0, Nil),
    NewMenu(NM_ITEM, 0, 'Datei löschen',           'K', 0,   0, Nil),
    { 13 }
    NewMenu(NM_TITLE,0, 'Seiten',                      Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Rätseltaste: ?',              Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Neuaufbau: Space',            Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Automatik',                   'M', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'alle gesehen',                '.', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),              Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Text suchen ...',             'H', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Weitersuchen: H',             Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),              Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Textausdruck',                'P', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'IFF-Bild ...',                'I', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Seite speichern',             Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'nur diese: S',                Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'mit allen Unterseiten: Shift-S', Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'alle ab Cursor: Ctrl-S',      Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'alle',                        'S', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Ins Clipboard',               'C', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),              Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Seite löschen',               Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'nur diese: Del',              Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'mit a. Unterseiten: Shift-Del', Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'alle ab Cursor: Ctrl-Del',    Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'alle: Alt-Del',               Nil, 0, 0, Nil),
    { 23 }
    NewMenu(NM_TITLE,0, 'Anfordern',               Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Seite 100: f1',           Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'diese Seite nochmal: f8', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'nicht gefundene nochmal: F8', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Seitenvorauswahl',        Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'erste: f10',              Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'zweite: F10',             Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, '3.: Alt-f10',             Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, '4.: Alt-F10',             Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Stichprobe: f6',          Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'gefilterte Stichprobe: F6', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),          Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'ins Clipboard schreiben', Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'Seitennummern',           '#', 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'Sendernamen',             '+', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Vorauswahl editieren: f9', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Senderliste editieren: F9',Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),          Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'TOP-Verzeichnis',         Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'erstellen: f5',           Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'löschen: F5',             Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'TOP-Statistik: f4',       Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Blockseiten holen: F4',   Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),          Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Seitensuche löschen: f7', Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'einen Job löschen: F7',   Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'FIFO',                    'F', tog, 0, Nil),
    { 25 }
    NewMenu(NM_TITLE,0, 'Extras',                    Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Test/Uhr: T',               Nil, tog, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Uhrzeit übernehmen',        'T', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Sendernamen zeigen: N',     Nil, tog, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),            Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Decoder-Reset: R',          Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Fernsehdarstellung',        Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'ein',                       Nil, mut, %110, Nil),
    NewMenu(NM_SUB,  0, 'transparent',               Nil, mut, %101, Nil),
    NewMenu(NM_SUB,  0, 'aus',                       Nil, mut, %011, Nil),
    NewMenu(NM_ITEM, 0, 'I²C-Bus sperren',           'B', tog, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),            Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Font',                      Nil, 0, 0, Nil),
    NewMenu(NM_SUB,  0, 'klein',                     Nil, mut, %10, Nil),
    NewMenu(NM_SUB,  0, 'groß',                      Nil, mut, %01, Nil),
    { 15 }
    NewMenu(NM_TITLE,0, 'ARexx',              Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Kommandoübersicht',  'R', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, 'Skripts auf der WB', Nil, tog, 0, Nil),
    NewMenu(NM_ITEM, 0, Str(NM_BARLABEL),     Nil, 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[1],       '1', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[2],       '2', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[3],       '3', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[4],       '4', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[5],       '5', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[6],       '6', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[7],       '7', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[8],       '8', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[9],       '9', 0, 0, Nil),
    NewMenu(NM_ITEM, 0, scriptnames[10],      '0', 0, 0, Nil),
    { 14 }
    NewMenu(NM_END, 0, Nil, Nil, 0, 0, Nil)
  );
  gtlib := GadToolsBase;
  IF gtlib^.lib_Version>=39 THEN
    FOR i := 1 TO anzmenu-1 DO BEGIN
      IF Long(Ptr(TheMenu[i].nm_Label))=NM_BARLABEL THEN j := 0
      ELSE j := Pos(':',TheMenu[i].nm_Label);
      IF j>0 THEN BEGIN
        s := strcopy(TheMenu[i].nm_Label);  { Stringkonstante umkopieren }
        s^[j] := #0;           { ... und aufspalten }
        TheMenu[i].nm_Label := s;
        TheMenu[i].nm_CommKey := ^s^[j+2];
        TheMenu[i].nm_Flags := TheMenu[i].nm_Flags OR NM_COMMANDSTRING;  
        { gibt es erst ab GadTools V39 !!! }
      END;
    END;
  { einige Menüitems (je nach Anzahl der ARexx-Skripts) abhängen: }
  scriptscan;
  i := anzmenu - 10 + rxscripts; IF rxscripts=0 THEN Dec(i);
  TheMenu[i] := TheMenu[anzmenu];
  { Menü generieren: }
  Tags[1] := TagItem(GTMN_NewLookMenus,1);
  Tags[2] := TagItem(TAG_DONE,0);
  Strip := CreateMenusA(^TheMenu,^Tags[1]);
  egal := LayoutMenusA(Strip,visinfo,^Tags[1]);
  egal := SetMenuStrip(MyWindow,Strip);
END;

PROCEDURE sysinit{(version: Str)};
VAR i,j,breite,hoehe: Integer;
    syslib: p_Library;
    scr: p_Screen;
BEGIN
  titel := copy(version,7,length(version)-6);
  { Zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  IntuitionBase := Nil; GfxBase := Nil; DiskFontBase := Nil;
  IconBase := Nil; AslBase := Nil; GadToolsBase := Nil; 
  RexxSysBase := Nil; rexxport := Nil; replyport := Nil;
  MyScreen := Nil; MyWindow := Nil; Strip := Nil; teleFont := Nil;
  myprocess := Nil; BusyPointerData := Nil; 
  syslib := SysBase; IF syslib^.lib_Version<36 THEN
    Error('OS 2.0 required');
  syslib := DosBase; IF syslib^.lib_Version<36 THEN  
    Error('Need dos.library V36+!');
  { Libraries etc. öffnen: }
  IntuitionBase := OpenLibrary('intuition.library',36);
  GfxBase := OpenLibrary(GRAPHICSNAME,0);
  DiskFontBase := OpenLibrary('diskfont.library',0);
  IconBase := OpenLibrary('icon.library',0);
  AslBase := OpenLibrary(ASLNAME,0);
  GadToolsBase := OpenLibrary('gadtools.library',0);
  RexxSysBase := OpenLibrary(RXSNAME,0);
  IF IntuitionBase=Nil THEN Error('Need intuition V36+!');
  IF GadToolsBase=Nil THEN Error('Can''t open gadtools.library!');
  IF GfxBase=Nil THEN Error('Can''t open graphics.library!');
  IF DiskfontBase=Nil THEN desaster('Can''t open diskfont.library !!!');
  { Screen: }
  i := 0; REPEAT  { stellt mit einiger Wahrscheinlichkeit einen einmaligen }
    pubsname := 'WNVT'+IntStr(i); Inc(i);   { PubScreen-Namen sicher }
    scr := LockPubScreen(pubsname);
    IF scr<>Nil THEN UnlockPubScreen(Nil, scr);
  UNTIL scr=Nil;  
  i := -1;
  Tags[1] := TagItem(SA_Depth,3);
  Tags[2] := TagItem(SA_DisplayID,screenmode);
  Tags[3] := TagItem(SA_Title,Long(^titel));
  Tags[4] := TagItem(SA_Pens,Long(^i));
  Tags[5] := TagItem(SA_PubName,Long(^pubsname));
  Tags[6] := TagItem(TAG_DONE,0);
  MyScreen := OpenScreenTagList(Nil,^Tags[1]);
  IF MyScreen=Nil THEN Error('Can''t open screen!');
  i := PubScreenStatus(MyScreen, 0);   { Screen veröffentlichen }
  FOR i := 0 TO 7 DO BEGIN
    j := (colperm SHR (4*(7-i))) AND $F;
    SetRGB4(^MyScreen^.ViewPort, i,
      (palette[j] SHR 8) AND $F,(palette[j] SHR 4) AND $F,(palette[j]) AND $F);
  END;
  visinfo := GetVisualInfoA(MyScreen,Nil);
  { Fenster und Menue: }
  i := MyScreen^.BarHeight+2;
  breite := MyScreen^.Width; hoehe := MyScreen^.Height - i;
  Tags[1] := TagItem(WA_CustomScreen,Long(MyScreen));
  Tags[2] := TagItem(WA_Left,0);
  Tags[3] := TagItem(WA_Top,i); 
  Tags[4] := TagItem(WA_Width,breite);
  Tags[5] := TagItem(WA_Height,hoehe);
  Tags[6] := TagItem(WA_IDCMP, IDCMP_MENUPICK OR IDCMP_MOUSEBUTTONS
                     OR IDCMP_REQSET OR IDCMP_REQCLEAR 
                     OR IDCMP_RAWKEY OR IDCMP_VANILLAKEY);
  Tags[7] := TagItem(WA_Flags, WFLG_ACTIVATE OR WFLG_BORDERLESS
                     OR WFLG_BACKDROP OR WFLG_NEWLOOKMENUS);
  Tags[8] := TagItem(TAG_DONE,0)
  MyWindow := OpenWindowTagList(Nil,^Tags[1]);
  IF MyWindow=Nil THEN Error('Can''t open window!');
  create_menu;
  IF NOT newfontno THEN; { Font setzen }
  { Console einrichten: }
  Con := OpenConsole(MyWindow); SetStdIO(Con);
  BusyPointerData := Ptr(AllocMem(SizeOf(WordArr36),MEMF_CHIP));
  IF BusyPointerData<>Nil THEN
    BusyPointerData^ := WordArr36(
      $0000,$0000,
      $0400,$07C0,$0000,$07C0,$0100,$0380,$0000,$07E0,
      $07C0,$1FF8,$1FF0,$3FEC,$3FF8,$7FDE,$3FF8,$7FBE,
      $7FFC,$FF7F,$7EFC,$FFFF,$7FFC,$FFFF,$3FF8,$7FFE,
      $3FF8,$7FFE,$1FF0,$3FFC,$07C0,$1FF8,$0000,$07E0,
      $0000,$0000
    );
  { meine Task finden und System Requests auf meinen Screen umleiten }
  myprocess := Ptr(FindTask(Nil));
  IF myprocess<>Nil THEN BEGIN
    oldwindowptr := myprocess^.pr_WindowPtr;
    myprocess^.pr_WindowPtr := MyWindow;
  END;
  { ARexx-Port und Reply-Port einrichten: }
  IF RexxSysBase<>Nil THEN BEGIN
    rexxport := CreateMsgPort;
    IF rexxport<>Nil THEN BEGIN
      Forbid;
      i := 0; REPEAT
        portname := 'WNVT'+IntStr(i); Inc(i);
      UNTIL FindPort(portname)=Nil;  { einmaligen Portnamen sicherstellen }
      rexxport^.mp_Node.ln_Name := portname;
      AddPort(rexxport);  { Port öffentlich bekanntgeben }
      Permit;
    END;
    replyport := CreateMsgPort;  { der ist privat }
  END;
END;

FUNCTION privateer{: Integer};
{ Versucht, den PubScreen wieder als privat zu erklären, und stellt fest, }
{ ob das Programm anschließend beendet werden kann. Rückgabewerte: }
{ 0: OK, sysclean darf aufgerufen werden }
{ 1: Fehler, Pubscreen ist noch in Benutzung }
{ 2: Fehler, eins unserer ARexx-Skripts läuft noch }
BEGIN
  IF scriptmess<>Nil THEN
    privateer := 2
  ELSE IF (PubScreenStatus(MyScreen, PSNF_PRIVATE) AND 1)=0 THEN
    privateer := 1
  ELSE
    privateer := 0;
END;    

PROCEDURE sysclean;
{ Vorher muß privateer aufgerufen worden sein, und zwar erfolgreich! }
{ Sonst hinterläßt das Programm einen herrenlosen PubScreen oder einen }
{ ARexx-Prozeß ohne Fenster und Replyport. %-( }
BEGIN
  IF myprocess<>Nil THEN
    myprocess^.pr_WindowPtr := oldwindowptr;
  IF MyWindow<>Nil THEN BEGIN
    IF Strip<>Nil THEN BEGIN 
      ClearMenuStrip(MyWindow); FreeMenus(Strip);
    END;
    CloseWindow(MyWindow);
  END;
  IF MyScreen<>Nil THEN BEGIN
    FreeVisualInfo(visinfo);
    IF CloseScreen(MyScreen) THEN;
  END;
  IF rexxport<>Nil THEN BEGIN
    Forbid;
    IF rxm=Nil THEN
      rxm := p_RexxMsg(GetMsg(rexxport));
    WHILE rxm<>Nil DO BEGIN  { ausstehende Messages "beantworten" }
      rxm^.rm_Result1 := 10;
      rxm^.rm_Result2 := 0;
      ReplyMsg(p_Message(rxm));
      rxm := p_RexxMsg(GetMsg(rexxport));
    END;
    RemPort(rexxport); { Port abmelden }
    Permit;
    DeleteMsgPort(rexxport);
  END;
  IF replyport<>Nil THEN DeleteMsgPort(replyport);
  IF teleFont<>Nil THEN CloseFont(teleFont);
  IF BusyPointerData<>Nil THEN FreeMem(BusyPointerData,SizeOf(WordArr36));
  IF IntuitionBase<>Nil THEN CloseLibrary(IntuitionBase);
  IF GfxBase<>Nil THEN CloseLibrary(GfxBase);
  IF DiskFontBase<>Nil THEN CloseLibrary(DiskFontBase);
  IF IconBase<>Nil THEN CloseLibrary(IconBase);
  IF AslBase<>Nil THEN CloseLibrary(AslBase);
  IF GadToolsBase<>Nil THEN CloseLibrary(GadToolsBase);
  IF RexxSysBase<>Nil THEN CloseLibrary(RexxSysBase);
  { festhalten, daß alles geschlossen ist: }
  IntuitionBase := Nil; GfxBase := Nil; DiskFontBase := Nil;
  IconBase := Nil; AslBase := Nil; GadToolsBase := Nil; 
  RexxSysBase := Nil; rexxport := Nil; replyport := Nil;
  MyScreen := Nil; MyWindow := Nil; Strip := Nil; teleFont := Nil;
  myprocess := Nil; BusyPointerData := Nil; 
END;

VAR i: Integer;

BEGIN  { Initialisierungsteil }
  { RGB-Anteile der Farben in der Reihenfolge sw,rt,gn,gb,bl,vl,cn,ws: }
  palette[0] := $000; palette[1] := $F00; palette[2] := $0F0;
  palette[3] := $FF0; palette[4] := $00F; palette[5] := $F0F;
  palette[6] := $0FF; palette[7] := $FFF;
  colperm := $60712345;
  screenmode := HIRES; fontno := 1;
  datestyle := FORMAT_CDN;
  clip_open := False;
  lastmsg.seconds := 0; nextselect := MENUNULL;
  newevent := False; mouseclicked := False; menupicked := False; taste := #0;
  rexxzeile := ''; rxm := Nil; { <>Nil bedeutet, Antwort steht noch aus !!! }
  scriptmess := Nil; { <>Nil bedeutet, ein externes Skript läuft noch }
  rexxpath := 'rexx/';
  rxscripts := 0;
  silentrexx := False;
END.