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

INTERFACE;

TYPE Str80 = String[80];

VAR Con: Ptr;  { darf nicht vom ExitServer geschlossen werden, komisch }
    stop,mouseclicked: Boolean;
    clickedx,clickedy: Integer;  { Intuition-Ereignisse }
    palette: ARRAY[0..7] OF Word;
    colperm: Long;

PROCEDURE intui_events;
FUNCTION readkey: Char;
FUNCTION waitkey: Char;
FUNCTION fileselect(was_los: str80; speichern: boolean;
                                   var selected: str80): Boolean;
PROCEDURE create_icon(VAR src,dest: Str80);
PROCEDURE scroll_text(zl0,zl1, sp0,sp1, dy,dx: Integer);
PROCEDURE stretch_line(zeile, sp0, sp1: Integer);
PROCEDURE raster_line(zeile, sp0, sp1: Integer; farbe: Word);
FUNCTION bitmapzeile(plane,line: Integer): Ptr;
PROCEDURE busy_pointer;
PROCEDURE normal_pointer;
PROCEDURE showscreen(mine: Boolean);
PROCEDURE force_time(VAR s: Str80);
PROCEDURE start_clip(size: Long);
PROCEDURE clip_it(s: Str; len: Long);
PROCEDURE end_clip;
PROCEDURE telltime(VAR day,min,tic: Long);
PROCEDURE desaster(meldung: Str80);
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" }

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

VAR NeuerScreen: ExtNewScreen;  STATIC;
    MyScreen: p_Screen;
    Tags: Array[1..5] OF TagItem;  STATIC;
    Pens: Array[0..NUMDRIPENS] OF Integer;  STATIC;
    titel: Str80;  STATIC;
    NeuesWindow: NewWindow;  STATIC;
    myprocess: p_Process;
    MyWindow,oldwindowptr: p_Window;
    Menue1: Menu; STATIC;
    Mi: Array[1..5] OF MenuItem; STATIC;
    MiT: Array[1..5] OF IntuiText; STATIC;
    breite,hoehe: Integer;
    topazAttr,teleAttr: TextAttr;
    teleFont: p_TextFont;
    BusyPointerData: ^WordArr36;
    { für die req.library: }
    MyFileReq: ReqFileRequester; STATIC;
    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;
    Ueberschrift: IntuiText; STATIC;
    Borders: ARRAY [1..6] OF Border; STATIC;
    TextBordXY,MainBordXY: IntArr10; STATIC;

PROCEDURE intui_events;
{ überträgt Intuition-Ereignisse (z. B. Menuepunkt 'Quit') in globale }
{ Variablen. }
VAR Msg: ^IntuiMessage;
    item,men,menitem,subitem: Word;
    item_address: ^MenuItem;
    charx,chary: Integer;
BEGIN
  REPEAT
    Msg := Get_Msg(MyWindow^.UserPort);
    IF Msg<>Nil THEN BEGIN
      CASE Msg^.class OF
        MOUSEBUTTONS: IF Msg^.code=SELECTDOWN THEN BEGIN
            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;
          END;
        MENUPICK: BEGIN
          item := Msg^.Code;
          WHILE item<>MENUNULL DO BEGIN
            { item nach Menue, Menuepunkt und Untermenue aufschlüsseln }
            men:=item AND %00011111;
            menitem:=(item SHR 5) AND %00111111;
            subitem:=(item SHR 11) AND %00011111;
            IF (men=0) AND (menitem=0) THEN
              stop := True;
            item_address := ItemAddress(^Menue1,item);
            item := item_address^.NextSelect;
          END;
        END;
        OTHERWISE;
      END;
      Reply_Msg(Msg);
    END;
  UNTIL Msg=Nil;
END;

FUNCTION readkey{: Char};
BEGIN
  readkey := ReadCon(Con);
END;

FUNCTION waitkey{: Char};
VAR taste: Char;
    sig: Long;
BEGIN
  REPEAT
    sig := Wait(-1);
    taste := ReadCon(Con);
  UNTIL taste <> Chr(0);
  waitkey := taste;
END;

FUNCTION fileselect{(was_los: str80; speichern: Boolean;
                                   VAR selected: str80): Boolean};
{ Benutzt, wenn vorhanden, den Filerequester der req.library, }
{ sonst den aus der asl.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(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 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;
    Ueberschrift:=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],
        ^Ueberschrift,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 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;

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;

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 #128 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] := #128;
  SetAPen(MyWindow^.RPort,farbe); SetDrMd(MyWindow^.RPort,INVERSVID);
  Move(MyWindow^.RPort,x0,y0); egal := _Text(MyWindow^.RPort,dummy,anz);
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
    ScreenToFront(MyScreen)
  ELSE
    IF NOT WBenchToFront THEN { Workbench gar nicht offen, na toll };
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;

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 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 sysinit{(version: Str)};
CONST charx = 8;  { für Menuetexte }
      chary = 8;
VAR i: Integer;
    flags, cflags, breit: Word;
    egal: Long;
    for_vtview: Boolean;
BEGIN
  titel := copy(version,7,length(version)-6);
  for_vtview := (titel[2]='T');  { Wer ruft sysinit() auf? }
  { 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; teleFont := Nil;
  oldwindowptr := Nil; BusyPointerData := Nil;
  { Filerequester-Struktur initialisieren (in C wäre das nicht nötig!), }
  { muß an dieser Stelle geschehen, damit PurgeFiles nicht abstürzt! }
  FOR i := 0 TO SizeOf(ReqFileRequester)-1 DO
    Mem[Long(^MyFileReq)+i] := 0;
  { Libraries etc. öffnen: }
  IntuitionBase := OpenLibrary('intuition.library',0);
  GfxBase := OpenLibrary(GRAPHICSNAME,0);
  DiskFontBase := OpenLibrary('diskfont.library',0);
  IF NOT for_vtview THEN BEGIN
    IconBase := OpenLibrary('icon.library',0);
    AslBase := OpenLibrary(ASLNAME,0);
    IF AslBase=Nil THEN ReqBase := OpenLibrary('req.library',0);
  END;
  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; IF for_vtview THEN breite := 320;
  hoehe := 256;
  topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  { DrawInfo-Pens für den Screen angeben, damit das Depth-Gadget unter }
  { Kick 2.0 gut aussieht. }
  Pens[_DETAILPEN] := 0;    { \_ Screen-Titelleiste, wird aber von den }
  Pens[_BLOCKPEN] := 1;     { /  entspr. Feldern im ExtNewScreen überstimmt }
  Pens[TEXTPEN] := 1;   { Text in inaktiven Fensterleisten etc. }
  Pens[SHINEPEN] := 2;     { \_für 3D- }
  Pens[SHADOWPEN] := 1;    { /  Rahmen }
  Pens[FILLPEN] := 3;         { \_Titelleiste aktiver }
  Pens[FILLTEXTPEN] := 1;     { /  Fenster }
  Pens[BACKGROUNDPEN] := 0;  { System-Requests, Gadgets inaktiver Fenster }
  Pens[HIGHLIGHTTEXTPEN] := 2;   { "wichtiger Text" (???) }
  Pens[9] := -1;
  Tags[1] := TagItem(SA_Pens,Long(^Pens[0]));
  Tags[2] := TagItem(TAG_DONE,0);
  NeuerScreen := ExtNewScreen(0,0,breite,hoehe,3,0,1,HIRES or GENLOCK_VIDEO,
    NS_EXTENDED OR CUSTOMSCREEN,^topazAttr,titel,Nil,Nil,^Tags[1]);
  IF for_vtview THEN
    NeuerScreen := ExtNewScreen(0,0,breite,hoehe,3,6,4,GENLOCK_VIDEO,
            CUSTOMSCREEN,^topazAttr,titel,Nil,Nil,Nil);
  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);
  IF for_vtview THEN FOR i := 0 TO 7 DO
    SetRGB4(^MyScreen^.ViewPort, i, 15*(i AND 1), 15*((i DIV 2) AND 1),
                                    15*((i DIV 4) AND 1));
  { Fenster und Menue: }
  NeuesWindow := NewWindow(0,16,breite,hoehe-16,0,1,
        MENUPICK OR MOUSEBUTTONS OR REQCLEAR OR REQSET,
        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!');
  Menue1 := Menu(Nil,10,0,8*charx,0,MENUENABLED,'Projekt',^Mi[1],0,0,0,0);
  { besonders häufige Flagkombinationen: }
  Flags := ITEMTEXT or ITEMENABLED or HIGHCOMP; CFlags := Flags or COMMSEQ;
  { Menueeinträge und Texte: }
  { Projekt: Quit }
  breit := (4+3)*charx + COMMWIDTH;
  FOR i := 1 TO 1 DO
    Mi[i] := MenuItem(Nil,0,(chary+2)*(i-1),breit,chary+2,CFlags,
                   0,^MiT[i],Nil,chr(0),Nil,MENUNULL);
  Mi[1].NextItem := Nil;    Mi[1].Command := 'Q';
  MiT[1] := IntuiText(0,7,JAM1,5,1,Nil, 'Quit',Nil);
  IF NOT for_vtview THEN
    IF NOT SetMenuStrip(MyWindow,^Menue1) THEN
      Error('Cannot install the menues - damn!');
  { 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);
  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));
  oldwindowptr := myprocess^.pr_WindowPtr;
  myprocess^.pr_WindowPtr := MyWindow;
END;

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