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;
    palette: ARRAY[0..7] OF Word;
    colperm: Long;
    Con: Ptr;  { darf nicht vom ExitServer geschlossen werden, komisch }

PROCEDURE event_scan;
PROCEDURE check(code: Long; really: Boolean);
FUNCTION has_check(code: Long): Boolean;
FUNCTION ja_nein(message: Str): Boolean;
PROCEDURE create_icon(VAR src,dest: str80);
FUNCTION fileselect(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): 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 bitmapzeile(plane,line: Integer): Ptr;
PROCEDURE busy_pointer;
PROCEDURE normal_pointer;
PROCEDURE showscreen(mine: Boolean);
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);
PROCEDURE sysclean;

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

IMPLEMENTATION;

{$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
{$incl "intuition.lib", "graphics.lib" }
{$incl "diskfont.lib", "dos.lib", "req.lib", "icon.lib", "asl.lib" }
{$incl "exec.lib", "devices/timer.h", "devices/clipboard.h" }
{$incl "devices/console.h", "consolehandle.h" }

TYPE WordArr36 = ARRAY [1..36] OF Word;
     IntArr10 = ARRAY [1..10] OF Integer;

VAR NeuerScreen: ExtNewScreen;  STATIC;
    MyScreen: p_Screen;
    Tags: Array[1..10] OF TagItem;  STATIC;
    titel: Str80;  STATIC;
    NeuesWindow: NewWindow;  STATIC;
    myprocess: p_Process;
    MyWindow,oldwindowptr: p_Window;
    Strip, LastMenu: p_Menu;
    LastItem, LastSubItem: p_MenuItem;
    topazAttr,teleAttr: TextAttr;
    teleFont: p_TextFont;
    nextselect: Word;
    inpev: InputEvent;
    lastmsg: IntuiMessage; { kein Zeiger! }
    BusyPointerData: ^WordArr36;
    { für die req.library: }
    MyFileReq: p_ReqFileRequester;
    pfad: Array[0..DSIZE] OF Char; STATIC;
    name: Array[0..FCHARS] OF Char; STATIC;
    pfadname: Array[-DSIZE..FCHARS] OF Char; STATIC;
    { fürs clipboard.device: }
    clip_port: ^MsgPort;
    clipreq: ^IOClipReq; { erweiterte IO-Request-Struktur }
    clip_open: Boolean;
    { für den Aushilfs-Requester: }
    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;


{ PROCEDURE's desaster(), raster_line(), stretch_line() sowie die }
{ Menü-Erzeugung includen: }
CONST unit_sys=1701; {$path "PAS:prg/vt/"; incl "dbluse.p" }

PROCEDURE event_scan;
{ überträgt eingehende Tasten und ESC-Sequenzen sowie die Intuition- }
{ Ereignisse Mausklick und Menuewahl in globale Variablen. }
VAR Msg: ^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 nextselect<>MENUNULL THEN BEGIN
    menu_eval(nextselect); Exit;
  END;
  Msg := Get_Msg(MyWindow^.UserPort);
  IF Msg<>Nil THEN BEGIN
    CASE Msg^.class OF
      MENUPICK: IF Msg^.Code<>MENUNULL THEN menu_eval(Msg^.Code);
      MOUSEBUTTONS: IF Msg^.Code=SELECTDOWN THEN BEGIN
          newevent := True; mouseclicked := True;
          charx := MyWindow^.RPort^.TxWidth;
          chary := MyWindow^.RPort^.TxHeight;
          clickedx := 1 + (Msg^.MouseX - MyWindow^.BorderLeft) DIV charx;
          clickedy := 1 + (Msg^.MouseY - MyWindow^.BorderTop) DIV chary;
          dblclicked := DoubleClick(lastmsg.seconds,lastmsg.micros,
              Msg^.seconds,Msg^.micros);
          lastmsg := Msg^;
        END;
      RAWKEY: IF Msg^.Code<$80 THEN BEGIN { losgelassene Tasten ignorieren }
          inpev.ie_Code := Msg^.Code;
          inpev.ie_Qualifier := Msg^.Qualifier;
          pp := Msg^.IAddress;
          inpev.ie_position.ie_addr := pp^;
          IF RawKeyConvert(^inpev,^buf,10,Nil)>0 THEN BEGIN
            taste := buf[1];
            newevent := True;
          END;
          rawcode := Msg^.Qualifier OR (Long(Msg^.Code) SHL 16);
        END;
      {
      RAWKEY: IF Msg^.Code<$60 THEN BEGIN { "echte" Taste gedrückt }
          taste := #155; { naja, irgendwie muß man das ja melden ... }
          rawcode := Msg^.Qualifier OR (Long(Msg^.Code) SHL 16);
          newevent := True;
        END;
      VANILLAKEY: BEGIN
          taste := Chr(Msg^.Code); rawcode := Msg^.Qualifier;
          newevent := True;
        END;
      }
      OTHERWISE;
    END;
    Reply_Msg(Msg);
  END;
END;

PROCEDURE check{(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};
CONST charx=8; chary=8;
BEGIN
  ITxt[1] := IntuiText(2,1,JAM1,10,10,Nil,message,Nil);
  ITxt[2] := IntuiText(2,1,JAM1,6,3,Nil,'  JA  ',Nil);
  ITxt[3] := IntuiText(2,1,JAM1,6,3,Nil,' NEIN ',Nil);
  ja_nein := AutoRequest(MyWindow,^ITxt[1],^ITxt[2],^ITxt[3],0,0,
          (6+Length(message))*charx,3*(chary+2)+30);
END;

PROCEDURE create_icon{(VAR src,dest: Str80)};
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;

FUNCTION fileselect{(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): Boolean};
{ Benutzt, wenn vorhanden, den Filerequester der asl.library, }
{ sonst den aus der req.library, und notfalls ein Stringgadget. }
VAR i,p,l: Integer;
    Req: p_FileRequester;
    Msg: p_IntuiMessage;
    ende: Boolean;
    class: Long;
    b,h: Word;
    buf,ubuf: str80;
    muell: ARRAY[0..31] OF Byte;
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;
          pfad := Req^.rf_Dir; l := Length(pfad);
          name := Req^.rf_File;
          IF l=0 THEN
            selected := name
          ELSE IF pfad[l-1] IN [':','/'] THEN
            selected := pfad+name
          ELSE
            selected := pfad+'/'+name;
        END;
      FreeAslRequest(Req);
    END;
  END ELSE IF ReqBase<>Nil THEN BEGIN  { *** "req.library" benutzen }
    WITH MyFileReq^ DO BEGIN
      VersionNumber := REQVERSION;
      Title := was_los;
      PathName := pfadname;   { Str-Zeiger auf meinen Puffer setzen }
      Dir := pfad;
      _File := name;
      WindowLeftEdge := 128;
      WindowTopEdge := 25;
      Flags := FRQABSOLUTEXYM;
      IF speichern THEN
        Flags := Flags OR FRQSAVINGM
      ELSE
        Flags := Flags OR FRQLOADINGM;
      { dran denken, Hintergrund türkis }
      filenamescolor := 1;    { schwarz }
      dirnamescolor := 2;     { weiß }
      devicenamescolor := 1;  { schwarz }
      detailcolor := 6;       { grün }
      blockcolor := 1;        { schwarz }
      gadgettextcolor := 1;   { schwarz }
      stringgadgetcolor := 1; { schwarz }
      textmessagecolor := 7;  { gelb }
      stringnamecolor := 7;   { gelb }
      boxbordercolor := 5;    { blau }
      gadgetboxcolor := 5;    { blau }
    END;
    IF _FileRequester(MyFileReq) THEN BEGIN
      fileselect := True;
      selected := pfadname;
    END;
  END ELSE BEGIN  { *** einfacher Requester mit Stringgadget }
    buf := selected; ubuf := '';
    b := 8*50 + 30;  IF Length(was_los)>50  THEN b := 8*Length(was_los) + 30;
    h := 9 + 8 + 20;
    ITxt[1] := IntuiText(1,3,JAM1,15,6,Nil,was_los,Nil);
    TextBordXY := IntArr10(-1,8,400,8,400,-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*50) DIV 2,9+12,8*50,8,GADGHCOMP,
      RELVERIFY OR ENDGADGET, STRGADGET OR 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,70,90,b,h,0,0,^TextGad,^Borders[3],
        ^ITxt[1],0,(colperm SHR 12) AND $F,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=REQSET THEN
              IF NOT ActivateGadget(^TextGad,MyWindow,^MyRequest) THEN;
            IF class=REQCLEAR THEN ende := True;
          END;
        UNTIL Msg=Nil;
        IF NOT ende THEN class := Wait(-1);
      UNTIL ende;
      IF buf<>'' THEN BEGIN
        fileselect := True;
        selected := buf;
      END;
    END;
  END;
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 bitmapzeile{(plane,line: Integer): Ptr};
VAR map: p_BitMap;
    y0: Integer;
BEGIN
  map := MyWindow^.RPort^.BitMap;
  y0 := MyWindow^.TopEdge + MyWindow^.BorderTop;
  bitmapzeile := Ptr(Long(map^.Planes[plane]) + (y0+line)*map^.BytesPerRow);
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{(mine: Boolean)};
BEGIN
  IF mine THEN BEGIN
    ScreenToFront(MyScreen);
    IF ActivateWindow(MyWindow)<>0 THEN { %-| };
  END ELSE
    IF NOT WBenchToFront THEN { Workbench gar nicht offen, na toll };
END;

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

{ ## Dies sind *nicht* die Original-Funktionen aus dem Unit ExecSupport! }
{ ## Für meine Zwecke sind sie aber gut genug: }

FUNCTION CreatePort (name: Str; pri: Byte) : p_MsgPort;
VAR port   : p_MsgPort;
    sigbit : Byte;
BEGIN
  port := Ptr (Alloc_Mem (SizeOf(MsgPort), MEMF_CLEAR or MEMF_PUBLIC ));
  sigbit := AllocSignal(-1);
  IF sigbit <> -1 THEN
    WITH port^, mp_Node DO BEGIN
      ln_Name := name;
      ln_Pri := pri;
      ln_Type := NT_MSGPORT;
      mp_Flags := PA_SIGNAL;
      mp_SigBit := sigbit;
      mp_SigTask := FindTask(Nil);
      AddPort (port);
    END;
  CreatePort := port;
END;

PROCEDURE DeletePort (port: p_MsgPort);
BEGIN
  RemPort (port);
  port^.mp_Node.ln_Type := $FF;
  port^.mp_MsgList.lh_head := Ptr(-1);
  FreeSignal (port^.mp_SigBit);
  Free_Mem (Long(port), SizeOf (port^) )
END;

FUNCTION CreateExtIO (ioReplyPort: p_MsgPort; size: Long) : Ptr;
VAR ioReq: p_IORequest;
BEGIN
  IF ioReplyPort=Nil THEN
    CreateExtIO := Nil
  ELSE BEGIN
    ioReq := Ptr (Alloc_Mem (size, MEMF_CLEAR or MEMF_PUBLIC));
    WITH ioReq^, io_Message DO BEGIN
      mn_Node.ln_Type := NT_MESSAGE;
      mn_Length := size;
      mn_ReplyPort := ioReplyPort;
    END;
    CreateExtIO := ioReq;
  END;
END;

PROCEDURE DeleteExtIO (ioExt: Ptr);
VAR io: p_IoRequest;
BEGIN
  io := ioExt;
  IF io <> Nil THEN
    WITH io^ DO BEGIN
      io_Message.mn_Node.ln_Type := $FF;
      io_Device := Ptr(-1);
      io_Unit := Ptr(-1);
      Free_Mem (Long (ioExt), io^.io_Message.mn_Length)
    END;
END;

{ ## Ende der nachgemachten ExecSupport-Funktionen }

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 := CreatePort('VT-timer',0);
  t_ioreq := CreateExtIO(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;
  DeleteExtIO(t_ioreq);
  DeletePort(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 := CreatePort('clipper',0);
  clipreq := CreateExtIO(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
    DeleteExtIO(clipreq);
    DeletePort(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));
    DeleteExtIO(clipreq);
    DeletePort(clip_port);
    clip_open := False;
  END;
END;

{ *** mein Menü: }

PROCEDURE create_menu;
CONST Check = CHECKIT OR MENUTOGGLE;
      CheckOn = Check OR CHECKED;
VAR egal: Boolean;
BEGIN
  LastMenu := Nil;
  AddMenu(10, 'Projekt');
    AddItem(0, 0, 'Info',               '?');
    AddItem(0, 0, 'Hilfe        Help',  ' ');
    AddItem(0, 0, 'Parameter sichern',  ' ');
    AddItem(5, 0, 'Ende',               'Q');
  AddMenu(20, 'Datei');
    AddItem(0, 0, 'VT-Format laden',              'L');
    AddItem(5, 0, 'Ausgabeformat  »',             ' ');
      AddSubItem(0, Check,  '  ASCII',            'A'); MutEx(%10);
      AddSubItem(0, CheckOn,'  VT',               'V'); MutEx(%01);
    AddItem(0, CheckOn, '  Überschreiben',        'M');
    AddItem(5, 0, 'Dateinamen  »',                ' ');
      AddSubItem(0, 0, 'ändern ...',              'N');
      AddSubItem(0, 0, 'nach Titelzeile  Ctrl-N', ' ');
    AddItem(0, Check, '  Icons erzeugen      I',  ' ');
    AddItem(0, Check, '  numerierte Dateien  #',  ' ');
  AddMenu(20, 'Seiten');
    AddItem(0, 0, 'Zurückgehen        Esc',          ' ');
    AddItem(5, 0, 'Textausdruck',                    'P');
    AddItem(0 ,0, 'IFF-Bild ...',                    'I');
    AddItem(0, 0, 'Seite speichern  »',              ' ');
      AddSubItem(0, 0, 'nur diese                 S',' ');
      AddSubItem(0, 0, 'mit allen Unterseiten',      'S');
      AddSubItem(0, 0, 'alle Seiten          Ctrl-S',' ');
    AddItem(5, 0, 'Seite löschen  »',                ' ');
      AddSubItem(0, 0, 'nur diese                 Del',' ');
      AddSubItem(0, 0, 'mit a. Unterseiten  Shift-Del',' ');
      AddSubItem(0, 0, 'alle Seiten          Ctrl-Del',' ');
  AddMenu(20, 'Anfordern');
    AddItem(0, 0, 'Seite 100',                  '0');
    AddItem(0, 0, 'diese Seite nochmal    f8',  ' ');
    AddItem(0, 0, '1. Vorauswahl         f10',  ' ');
    AddItem(0, 0, '2. Vorauswahl         F10',  ' ');
    AddItem(0, 0, 'Stichprobe             f6',  ' ');
    AddItem(5, 0, 'Vorauswahl editieren  »',    ' ');
      AddSubItem(0, 0, 'erste   f9',            ' ');
      AddSubItem(0, 0, 'zweite  F9',            ' ');
    AddItem(0, 0, 'Seitennrn. kopieren',        '#');
    AddItem(5, 0, 'TOP-Verzeichnis  »',         ' ');
      AddSubItem(0, 0, 'erstellen  f5',         ' ');
      AddSubItem(0, 0, 'löschen    F5',         ' ');
    AddItem(0, 0, 'TOP-Statistik          f4',  ' ');
    AddItem(0, 0, 'Blockseiten holen      F4',  ' ');
    AddItem(5, 0, 'Seitensuche löschen    f7',  ' ');
    AddItem(0, 0, 'einen Job löschen      F7',  ' ');
    AddItem(0, CheckOn, '  FIFO',               'F');
  AddMenu(20, 'Extras');
    AddItem(0, 0,     'Rätseltaste             ?', ' ');
    AddItem(0, 0,     'Seite neu aufbauen  Space', ' ');
    AddItem(5, 0,     'Sendernamen zeigen      N', ' ');
    AddItem(0, Check, '  Test/Uhr              T', ' ');
    AddItem(0, 0,     'Uhrzeit übernehmen',        'T');
    AddItem(5, 0,     'Fernsehdarstellung  »',     ' ');
      AddSubItem(0, CheckOn, '  ein',              ' '); MutEx(%110);
      AddSubItem(0, Check,   '  transparent',      ' '); MutEx(%101);
      AddSubItem(0, Check,   '  aus',              ' '); MutEx(%011);
    AddItem(0, 0,     'Decoder-Reset          F8', ' ');
  MenuWidths;
  egal := SetMenuStrip(MyWindow,Strip);
END;

PROCEDURE sysinit{(version: Str)};
VAR i,breite,hoehe: Integer;
    egal: Long;
    Con2: ^ConsoleHandle;
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; ReqBase := Nil; AslBase := Nil;
  MyScreen := Nil; MyWindow := Nil; Strip := Nil; teleFont := Nil;
  myprocess := Nil; BusyPointerData := Nil; MyFileReq := Nil;
  { Filerequester-Struktur anlegen, muß mit Nullen vorbesetzt sein! }
  MyFileReq := Ptr(AllocMem(SizeOf(ReqFileRequester),MEMF_CLEAR));
  IF MyFileReq=Nil THEN Error('Out of memory!');
  { Libraries etc. öffnen: }
  IntuitionBase := OpenLibrary('intuition.library',0);
  GfxBase := OpenLibrary(GRAPHICSNAME,0);
  DiskFontBase := OpenLibrary('diskfont.library',0);
  IconBase := OpenLibrary('icon.library',0);
  AslBase := OpenLibrary(ASLNAME,0);
  IF AslBase=Nil THEN ReqBase := OpenLibrary('req.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 !!!');
  { Screen: }
  breite := 640; hoehe := 256;
  topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  { Verwendung der Default-Pens für den Screen erzwingen: }
  i := -1;
  Tags[1] := TagItem(SA_Pens,Long(^i));
  Tags[2] := TagItem(TAG_DONE,0);
  NeuerScreen := ExtNewScreen(0,0,breite,hoehe,3,0,1,HIRES,
    NS_EXTENDED OR CUSTOMSCREEN,^topazAttr,titel,Nil,Nil,^Tags[1]);
  MyScreen := OpenScreen(^NeuerScreen);
  IF MyScreen=Nil THEN Error('Can''t open screen!');
  FOR i := 0 TO 7 DO
    SetRGB4(^MyScreen^.ViewPort, (colperm SHR (4*(7-i))) AND $F,
      (palette[i] SHR 8) AND $F,(palette[i] SHR 4) AND $F,(palette[i]) AND $F);
  { Fenster und Menue: }
  i := MyScreen^.BarHeight + 5;
  NeuesWindow := NewWindow(0,i,breite,hoehe-i,0,1,
        MENUPICK OR MOUSEBUTTONS OR REQCLEAR OR REQSET OR RAWKEY,
        ACTIVATE OR BORDERLESS OR BACKDROP,Nil,Nil, Nil,
        MyScreen,Nil,170,100,breite,hoehe,CUSTOMSCREEN);
  MyWindow := OpenWindow(^NeuesWindow);                          
  IF MyWindow=Nil THEN Error('Can''t open window!');
  create_menu;
  { Font: }
  teleAttr := TextAttr('videotext.font',9,FS_NORMAL,FPF_DISKFONT);
  IF DiskFontBase<>Nil THEN
    teleFont := OpenDiskFont(^teleAttr);
  IF teleFont<>Nil THEN
    egal := SetFont(MyWindow^.RPort,teleFont)
  ELSE
    desaster('Can''t open videotext.font !!!');
  { Console einrichten: }
  Con := OpenConsole(MyWindow); SetStdIO(Con);
  Con2 := Con; ConsoleDevice := Con2^.ReadIO.io_Device;
  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;
END;

PROCEDURE sysclean;
BEGIN
  IF myprocess<>Nil THEN
    myprocess^.pr_WindowPtr := oldwindowptr;
  IF ReqBase<>Nil THEN BEGIN
    PurgeFiles(MyFileReq); CloseLibrary(ReqBase); END;
  IF MyFileReq<>Nil THEN FreeMem(MyFileReq,SizeOf(ReqFileRequester));
  IF MyWindow<>Nil THEN BEGIN
    IF Strip<>Nil THEN ClearMenuStrip(MyWindow); TrashMenu;
    CloseWindow(MyWindow);
  END;
  IF MyScreen<>Nil THEN IF CloseScreen(MyScreen) THEN;
  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);
  { festhalten, daß alles geschlossen ist: }
  ReqBase := Nil; MyFileReq := Nil;
  Strip := Nil; MyWindow := Nil; MyScreen := Nil;
  teleFont := Nil;
  BusyPointerData := Nil;
  IntuitionBase := Nil;
  GfxBase := Nil;
  DiskFontBase := Nil;
  IconBase := Nil;
  AslBase := Nil;
END;

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 := $01234567;
  clip_open := False;
  lastmsg.seconds := 0; nextselect := MENUNULL;
  newevent := False; mouseclicked := False; menupicked := False; taste := #0;
  inpev.ie_NextEvent := Nil;
  inpev.ie_Class := IECLASS_RAWKEY;
  inpev.ie_SubClass := 0;
END.