(*----------------------------------------------------------------------------
:Program.     AnimBusyPointer.mod
:Contents.    Animates the OS2+ busy stop watch
:Author.      Christian Stiens
:Address.     Snail-Mail:           E-Mail:
:Address.     Heustiege 2           UUCP: Christian_Stiens@ouzonix.bo.open.de
:Address.     D-59348 Lüdinghausen  FIDO: 2:243/4802.25
:Copyright.   public domain
:Language.    Oberon-2
:Translator.  Amiga Oberon 3.01d
:History.     v1.0, 03.09.93:  Patches only SetPointer
:History.     v1.1, 25.09.93:  Patches SetWindowPointer too
:History.     v1.2, 09.10.93:  Quit on restart
:Remark.      Don't compile with SmallData !!!
----------------------------------------------------------------------------*)


MODULE AnimBusyPointer;

(* $IFNOT SmallData *)

  IMPORT
    d  := Dos,
    e  := Exec,
    es := ExecSupport,
    hw := Hardware,
    g  := Graphics,
    I  := Intuition,
    ol := OberonLib,
    u  := Utility,
    SYS:= SYSTEM;



  CONST
    version = "\o$VER: animbusypointer 1.2 (3.11.93)";
    waBusyPointer  = I.waDummy + 035H;


  TYPE
    Array32 = ARRAY 32 OF INTEGER;
    DataPtr = UNTRACED POINTER TO ARRAY 18 OF LONGINT;

    SetPointerProc       = PROCEDURE(win{8}:I.WindowPtr; ptr{9}:DataPtr; height{0},width{1},xOffset{2},yOffset{3}:INTEGER);
    SetWindowPointerProc = PROCEDURE(win{8}:I.WindowPtr; tags{9}:u.TagItemPtr);


  VAR
    sig       : LONGSET;
    int       : e.InterruptPtr;
    i,j       : INTEGER;
    delay     : INTEGER;
    rd        : d.RDArgsPtr;
    args      : STRUCT delay: UNTRACED POINTER TO LONGINT END;
    running   : BOOLEAN;
    ok        : BOOLEAN;
    v39       : BOOLEAN;
    dataPlus4 : UNTRACED POINTER TO Array32;
    data      : UNTRACED POINTER TO ARRAY 36 OF INTEGER;
    myPort    : e.MsgPortPtr;
    myName    : e.STRPTR;
    oldSetPointerProc       : SetPointerProc;
    newSetPointerProc       : SetPointerProc;
    oldSetWindowPointerProc : SetWindowPointerProc;
    newSetWindowPointerProc : SetWindowPointerProc;


  TYPE TheClocks = ARRAY 16 OF Array32;

  CONST AnimClockData = TheClocks(
    (* 00 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01EF8U, 01FF0U,03EFCU, 03FF8U,07EFEU, 03FF8U,07EFEU,
    07FFCU,0FEFFU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 01 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FB8U, 01FF0U,03FBCU, 03FF8U,07F7EU, 03FF8U,07F7EU,
    07FFCU,0FEFFU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 02 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FECU, 03FF8U,07FDEU, 03FF8U,07FBEU,
    07FFCU,0FF7FU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 03 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FE6U,
    07FFCU,0FF9FU, 07EFCU,0FF7FU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 04 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FF03U, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 05 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FF7FU, 07FFCU,0FF9FU, 03FF8U,07FE6U,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 06 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FFFFU, 07FFCU,0FF7FU, 03FF8U,07FBEU,
    03FF8U,07FDEU, 01FF0U,03FECU, 007C0U,01FF8U, 00000U,007E0U,
    (* 07 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FFFFU, 07FFCU,0FEFFU, 03FF8U,07F7EU,
    03FF8U,07F7EU, 01FF0U,03FBCU, 007C0U,01FB8U, 00000U,007E0U,
    (* 08 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FFFFU, 07FFCU,0FEFFU, 03FF8U,07EFEU,
    03FF8U,07EFEU, 01FF0U,03EFCU, 007C0U,01EF8U, 00000U,007E0U,
    (* 09 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FFFFU, 07FFCU,0FEFFU, 03FF8U,07DFEU,
    03FF8U,07DFEU, 01FF0U,03BFCU, 007C0U,01BF8U, 00000U,007E0U,
    (* 10 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FFFFU, 07FFCU,0FDFFU, 03FF8U,07BFEU,
    03FF8U,077FEU, 01FF0U,02FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 11 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,0FDFFU, 07FFCU,0F3FFU, 03FF8U,04FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 12 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,07FFEU,
    07FFCU,0FFFFU, 07EFCU,081FFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 13 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,03FFCU, 03FF8U,07FFEU, 03FF8U,04FFEU,
    07FFCU,0F3FFU, 07EFCU,0FDFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 14 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01FF8U, 01FF0U,02FFCU, 03FF8U,077FEU, 03FF8U,07BFEU,
    07FFCU,0FDFFU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
    (* 15 *)
    00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
    007C0U,01BF8U, 01FF0U,03BFCU, 03FF8U,07DFEU, 03FF8U,07DFEU,
    07FFCU,0FEFFU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
    03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U);


  (* $StackChk- $NilChk- $RangeChk- $OvflChk- $ClearVars- *)

  PROCEDURE TheInterrupt;
  BEGIN
    SYS.INLINE(048E7H,00118H);        (* Save D7,A3,A4 *)
    IF i <= 0 THEN
      dataPlus4^ := AnimClockData[j];
      j := (j+1) MOD 16;
      i := delay;
    END;
    DEC(i);
    SYS.INLINE(04CDFH,01880H);        (* Restore D7,A3,A4 *)
    SYS.SETREG(0,0);
  END TheInterrupt;


  (* $SaveRegs+ *)

  PROCEDURE SetPointerPatch (win {8}: I.WindowPtr;
                             ptr {9}: DataPtr;
                             height {0},width  {1}: INTEGER;
                             xOffset{2},yOffset{3}: INTEGER);
  BEGIN
    IF (~ODD(SYS.VAL(LONGINT,ptr))) &
       (ptr[01] = 0040007C0H) &
       (ptr[02] = 0000007C0H) &
       (ptr[03] = 001000380H) &
       (ptr[04] = 0000007E0H) &
       (ptr[05] = 007C01FF8H) &
       (ptr[06] = 01FF03FECH) &
       (ptr[07] = 03FF87FDEH) &
       (ptr[08] = 03FF87FBEH) &
       (ptr[09] = 07FFCFF7FH) &
       (ptr[10] = 07EFCFFFFH) &
       (ptr[11] = 07FFCFFFFH) &
       (ptr[12] = 03FF87FFEH) &
       (ptr[13] = 03FF87FFEH) &
       (ptr[14] = 01FF03FFCH) &
       (ptr[15] = 007C01FF8H) &
       (ptr[16] = 0000007E0H)
    THEN
      ptr := SYS.VAL(SYS.PTR,data);
      xOffset := -6;
      yOffset := +0;
      height := 16;
      width  := 16;
    END;
    oldSetPointerProc(win,ptr,height,width,xOffset,yOffset);
  END SetPointerPatch;



  (* $SaveRegs+ *)

  PROCEDURE SetWindowPointerPatch (win {8}: I.WindowPtr;
                                   tags{9}: u.TagItemPtr);
    TYPE
      TagListPtr = UNTRACED POINTER TO u.Tags2;
    VAR
      busy: BOOLEAN;
      a6: LONGINT;
  BEGIN
    a6 := SYS.REG(14);

    busy := u.GetTagData(waBusyPointer,I.LFALSE,SYS.VAL(TagListPtr,tags)^) # I.LFALSE;

    SYS.SETREG(14,a6);

    IF busy THEN oldSetPointerProc(win,SYS.VAL(e.APTR,data),16,16,-6,0)
            ELSE oldSetWindowPointerProc(win,tags)                      END;
  END SetWindowPointerPatch;



BEGIN
  myName := SYS.ADR(version[7]);

  IF I.int.libNode.version < 37 THEN HALT(d.fail) END;

  v39 := (I.base.libNode.version >= 39);


  e.Forbid;

  myPort := e.FindPort(myName^);
  IF myPort # NIL THEN
    e.Signal(myPort.sigTask,LONGSET{d.ctrlC});
    myPort := NIL;
    e.Permit;
    HALT(0);
  END;
  myPort := es.CreatePort(myName^,0);

  e.Permit;


  delay := 25;

  IF ~ol.wbStarted THEN
    rd := d.ReadArgs("DELAY/N",args,NIL);

    IF rd=NIL THEN
      SYS.SETREG(0,d.PrintFault(d.IoErr(),NIL));
      HALT(d.warn)
    END;

    IF args.delay#NIL THEN delay := SHORT(args.delay^) END;

    d.FreeArgs(rd);
  END;


  INCL(ol.MemReqs,e.public);

  NEW(int);

  int.node.type := e.interrupt;
  int.node.pri  := -20;
  int.data      := SYS.REG(13);
  int.code      := TheInterrupt;

  INCL(ol.MemReqs,e.chip);

  NEW(data);
  dataPlus4 := SYS.VAL(SYS.PTR,SYS.VAL(LONGINT,data)+4);

  e.AddIntServer(hw.vertb,int); running := TRUE;

  e.Forbid;
  oldSetPointerProc := SYS.VAL(SetPointerProc,e.SetFunction(I.int,-270,SYS.VAL(e.PROC,SetPointerPatch)));
  IF v39 THEN oldSetWindowPointerProc := SYS.VAL(SetWindowPointerProc,e.SetFunction(I.int,-816,SYS.VAL(e.PROC,SetWindowPointerPatch))) END;
  e.Permit;

  REPEAT
    sig := e.Wait(LONGSET{d.ctrlC});

    e.Forbid;

    newSetPointerProc := SYS.VAL(SetPointerProc,e.SetFunction(I.int,-270,SYS.VAL(e.PROC,oldSetPointerProc)));
    IF v39 THEN newSetWindowPointerProc := SYS.VAL(SetWindowPointerProc,e.SetFunction(I.int,-816,SYS.VAL(e.PROC,oldSetWindowPointerProc))) END;

    IF (newSetPointerProc # SetPointerPatch) OR (v39 & (newSetWindowPointerProc # SetWindowPointerPatch)) THEN
      SYS.SETREG(0,e.SetFunction(I.int,-270,SYS.VAL(e.PROC,newSetPointerProc)));
      IF v39 THEN SYS.SETREG(0,e.SetFunction(I.int,-816,SYS.VAL(e.PROC,newSetWindowPointerProc))) END;
      ok := FALSE;
    ELSE
      ok := TRUE;
    END;

    e.Permit;

    IF ~ok & ~ol.wbStarted THEN d.PrintF("Can't unpatch. Someone else patched too!\n") END;

  UNTIL ok;

  IF ~ol.wbStarted THEN d.PrintF("*** Break\n") END;


CLOSE

  IF running THEN e.RemIntServer(hw.vertb,int) END;
  IF myPort # NIL THEN es.DeletePort(myPort) END;

(* $END *)

END AnimBusyPointer.