(*---------------------------------------------------------------------------
 :Program.      FixAmber.mod
 :Author.       Fridtjof Siebert
 :Address.      Nobileweg 67, D-7000 Stuttgart 40
 :Shortcut.     [fbs]
 :Copyright.    PD
 :Language.     OBERON
 :Translator.   Amiga Oberon Compiler V1.36
 :History.      V1.0, 07-Mar-91, [fbs]
 :Usage.        run FixAmber
---------------------------------------------------------------------------*)

MODULE FixAmber;

IMPORT e   := Exec,
       h   := Hardware,
       es  := ExecSupport,
       ol  := OberonLib,
       sys := SYSTEM;

VAR
  VertBIntr: e.InterruptPtr;

  port,oldport: e.MsgPortPtr;

CONST
  PortName = "AmberFlicker.port";


PROCEDURE * MyIntProc(); (* $StackChk- *)
BEGIN
  h.custom.color[0] := 0;
END MyIntProc;

(* $StackChk= *)


BEGIN

  e.Forbid;
    oldport := e.FindPort(PortName);
    IF oldport#NIL THEN
      e.Signal(oldport.sigTask,LONGSET{oldport.sigBit});
      e.Permit;
      HALT(0);
    END;
    port := es.CreatePort(PortName,0);
  e.Permit;

  IF port=NIL THEN HALT(20) END;

  INCL(ol.MemReqs,e.public);
  NEW(VertBIntr);
  EXCL(ol.MemReqs,e.public);

  VertBIntr^ := e.Interrupt(NIL,
                            NIL,
                            e.interrupt,
                            0,
                            sys.ADR("Gib AMBER keine Chance!"),
                            NIL,
                            NIL);

  VertBIntr.code := MyIntProc;

  e.AddIntServer(h.vertb,VertBIntr);
  REPEAT UNTIL port.sigBit IN e.Wait(LONGSET{port.sigBit});
  es.DeletePort(port);
  e.RemIntServer(h.vertb,VertBIntr);

END FixAmber.