(*
 * :Program.      ABlank.mod
 * :Author.       Achim Siebert
 * :Address.      Nobileweg 67, D-7000 Stuttgart 40
 * :Shortcut.     [acs]
 * :Copyright.    FreeWare
 * :Language.     Oberon-2
 * :Translator.   Amiga Oberon Compiler V2.30 (inofficial version)
 * :History.      V1.2: added mouse blanking; V1.3: added screen shuffle
 * :Contents.     screen blanker, drawing fractals
 * :Usage.        ABlank TIMEOUT/N,DEPTH/N,CHANGETIME/N,HOTKEY/K,QUAL=QUALIFIER/K,LACE/K,SHUFFLE/K,BLANKMOUSE/K,KEYMOUSE/K,MOUSETIME/N,Q=QUIT/S
 * :Remark.       code for blank handler by Fridtjof Siebert
 * :Remark.       version in C by Olaf Barthel (FracBlank)
 *)

MODULE ABlank;

IMPORT 
       Icon,
       Random,
       Strings,
       Arguments,
       Conversions,
       D:  Dos,
       M:  MathTrans,
       G:  Graphics,
       H:  Hardware,
       I:  Intuition,
       WB: Workbench,
       es: ExecSupport,
       e:  Exec,
       ie: InputEvent,
       in: Input,
       ol: OberonLib,
       S:  SYSTEM;

CONST

  portname = "ABLank by Achim";  (* port to tell me to quit *)

  cyclemax = 3;                  (* tenths of a second before colour cycling *)

VAR

  blankmax  : INTEGER;           (* blank timeout (seconds times 10) *)
  mousemax  : INTEGER;           (* mouse pointer timeout *)
  hotkey    : INTEGER;           (* rawkey code, hotkey invoking blanker and changing pattern *)
  qual,qualcode : INTEGER;       (* qualifier for hotkey *)
  chgpatmax : INTEGER;           (* time before changing pattern (seconds times 10) *)
  userdepth,depth: INTEGER;      (* screen depth *)
  numcolors : INTEGER;           (* number of colors on screen *)
  cyclecount: INTEGER;           (* 0 to cyclemax *)
  mousecount: INTEGER;           (* 0 to mousemax *)
  blankcnt,chgpatcnt: INTEGER;   (* counter for timer events *)

  ScP,screen : I.ScreenPtr;
  ns  : I.NewScreen;
  rp  : G.RastPortPtr;

  changepat,cycle : BOOLEAN;
  blankit,lace    : BOOLEAN;
  shuffle         : BOOLEAN;
  offmouse,keymouse : BOOLEAN;

(* ------  input handler:  ------ *)

VAR

  IDevPort,FindPort: e.MsgPortPtr;
  IReqBlock        : e.IOStdReqPtr;
  HandlerStuff     : e.Interrupt;
  HandlerActive,InputOpen: BOOLEAN;
  Me               : e.TaskPtr;
  MySig            : LONGINT;


(* -----  the working horse first:  ----- *)

PROCEDURE * Handler(Ev{8}: ie.InputEventPtr): ie.InputEventPtr; (* $StackChk- $SaveRegs+ *)

VAR
 ev: ie.InputEventPtr;
 ibLock : LONGINT;

BEGIN
  S.SETREG(13,S.REG(9));   (* Varbase *)
  ev := Ev;
  WHILE ev#NIL DO
    IF ev.class=ie.timer THEN
      IF blankcnt=blankmax THEN
         INC(cyclecount);INC(chgpatcnt);
         IF cyclecount >= cyclemax THEN
            cycle := TRUE;cyclecount := 0;
         END;
         IF chgpatcnt >= chgpatmax THEN
            changepat := TRUE;chgpatcnt := 0;
         END;
      ELSIF blankcnt<blankmax THEN
        INC(blankcnt);
        IF blankcnt=blankmax THEN
           blankit := TRUE;
           e.Signal(Me,LONGSET{MySig});
        END;
      END;
      IF mousecount<mousemax THEN
         INC(mousecount);
         IF mousecount=mousemax THEN
            offmouse := TRUE;
            G.WaitTOF;
            G.OffSprite;
            H.custom.spr[0].data := 0;
         END;
      END;
    ELSE
      IF blankcnt=blankmax THEN
        IF (ev.class = ie.rawkey) AND (hotkey>=0) AND (((ev.code = hotkey)
        AND ((ev.qualifier*{0,1,3..7}={qual}) OR (qual<0))) OR ((qual>=0)
        AND ((ev.code = qualcode) OR (ev.code = qualcode+128))))
        THEN
           IF ev.code = hotkey THEN changepat := TRUE;END;
           ev.class := ie.null;
        ELSIF (ev.code # hotkey+128)
           AND (ev.class # ie.diskremoved) AND (ev.class # ie.diskinserted)
        THEN IF e.SetTaskPri(Me,0)#0 THEN END; blankit := FALSE; blankcnt := 0;
        END;
      ELSE
        IF (ev.class = ie.rawkey) AND (hotkey>=0) AND (ev.code = hotkey)
        AND ((ev.qualifier*{0,1,3..7}={qual}) OR ((qual < 0) AND
            (ev.qualifier*{0,1,3..7}={})))
        THEN
           blankit := TRUE; blankcnt := blankmax;
           e.Signal(Me,LONGSET{MySig});
           ev.class := ie.null;
        ELSIF shuffle AND (ev.class = ie.rawkey) AND (((ev.code = 55) OR (ev.code = 55+128)) AND
              (6 IN ev.qualifier)) THEN
           ev.class := ie.null; blankcnt := 0;
           IF ev.code = 55 THEN
              ibLock := I.LockIBase(0);
              screen := I.int.firstScreen;
              I.ScreenToBack(screen);
              screen := I.int.firstScreen;
              IF screen.firstWindow#NIL THEN
                 I.OldActivateWindow(screen.firstWindow);
              END;
              I.UnlockIBase(ibLock);
           END;
        ELSE blankcnt := 0; mousecount := 0;
          IF offmouse AND (ev.class = ie.rawmouse) THEN
             offmouse := FALSE; G.OnSprite;
          END;
          IF keymouse AND (ev.class = ie.rawkey) AND
             (ev.qualifier*{0..7,9}={}) AND (ev.code<96) THEN
             offmouse := TRUE;
             G.WaitTOF;
             G.OffSprite;
             H.custom.spr[0].data := 0;
             mousecount := mousemax;
          END;
        END;
      END;
    END;
    ev := ev.nextEvent;
  END;
  RETURN Ev;

END Handler; (* $StackChk= *)

(* ---- Draw some fractals ---- *)

PROCEDURE Draw();

      (* Colours: *)
   
TYPE  TableType = ARRAY 75 OF INTEGER;

CONST Table = TableType(3840,3856,3872,3888,3904,
                        3920,3936,3952,3968,3984,
                        4000,4016,4032,4048,4064,
                        4080,3824,3568,3312,3056,
                        2800,2544,2288,2032,1776,
                        1520,1264,1008, 752, 496,
                         240, 225, 210, 195, 180,
                         165, 150, 135, 120, 105,
                          90,  75,  60,  45,  30,
                          15, 271, 527, 783,1039,
                        1295,1551,1807,2063,2319,
                        2575,2831,3087,3343,3599,
                        3855,3854,3853,3852,3851,
                        3850,3849,3848,3847,3846,
                        3845,3844,3843,3842,3841);

CONST deg45 = -0.707106781;

VAR x,y,yy,a,b,c,sx,sy,magx,magy: REAL;
    offsetx,offsety,wheel,wheel2,count: INTEGER;
    colors : ARRAY 16 OF INTEGER;
    chgpen,pencnt,numcolshalf : INTEGER;

   PROCEDURE NewPattern();

   BEGIN

      G.SetRast(rp,0);
      changepat := FALSE; cycle := FALSE;
      chgpatcnt := 0;     cyclecount := 0;
      pencnt:=0; x := 0; y := 0;
      a := Random.RND(300)/100;
      b := Random.RND(120)/100;
      c := Random.RND( 60)/100;      
      chgpen := (Random.RND(25)+8);
      magy := (M.Pow(Random.RND(28)+29,1.1))*deg45;
      magx := magy; IF ~lace THEN magy := magy/2 END;
      wheel := Random.RND(75);
      wheel2 := (wheel+8+Random.RND(59)) MOD 75;
      colors[1] := Table[wheel];
      G.SetAPen(rp,1);
      G.LoadRGB4(S.ADR(ScP.viewPort),colors,2);

   END NewPattern;

BEGIN

   colors[0] := 0;
   numcolshalf := (numcolors-1) DIV 2;

   offsetx := ScP.width  DIV 2;
   offsety := ScP.height DIV 2;

   NewPattern();

   I.ScreenToFront(ScP);
   G.WaitTOF;
   G.OffSprite;
   H.custom.spr[0].data := 0;

   IF e.SetTaskPri(Me,-1)#0 THEN END;

   LOOP
      IF (~blankit) THEN EXIT END;

      IF changepat THEN
         NewPattern();
      END;

      yy := a - x;

      IF x < 0 THEN x := y + M.Sqrt(ABS(b*x-c));
      ELSE          x := y - M.Sqrt(ABS(b*x-c));
      END;

      y := yy;

      sx := (magx * ( x + y)) + offsetx;
      sy := (magy * (-x + y)) + offsety;

      IF (sx>=0) AND (sy>=0) AND (sx<ScP.width) AND (sy<ScP.height) THEN

         IF G.WritePixel(rp,SHORT(SHORT(sx)),SHORT(SHORT(sy))) THEN END;

      END;

      IF cycle THEN
         cycle := FALSE;
         INC(wheel); IF wheel = 75 THEN wheel := 0 END;
         INC(wheel2); IF wheel2 = 75 THEN wheel2 := 0 END;
         FOR count := 0 TO (numcolshalf) DO
            colors[count+1] := Table[(wheel+count) MOD 75];
            IF count < numcolshalf THEN
               colors[count+numcolshalf+2] := Table[(wheel2+count) MOD 75];
            END;
         END;
         G.LoadRGB4(S.ADR(ScP.viewPort),colors,numcolors);
         INC(pencnt);
      END;

      IF pencnt >= chgpen THEN
         pencnt := 0;
         G.SetAPen(rp,Random.RND(numcolors-1)+1);
      END;

   END;

   I.ScreenToBack(ScP);
   G.OnSprite();

END Draw;


PROCEDURE GetHotKey(VAR string:e.STRPTR);

VAR keyname : e.STRING;

BEGIN

   COPY(string^,keyname);
   Strings.Upper(keyname);
   IF    keyname = "TAB"    THEN hotkey := 66;
   ELSIF keyname = "ESC"    THEN hotkey := 69;
   ELSIF keyname = "F1"     THEN hotkey := 80;
   ELSIF keyname = "F2"     THEN hotkey := 81;
   ELSIF keyname = "F3"     THEN hotkey := 82;
   ELSIF keyname = "F4"     THEN hotkey := 83;
   ELSIF keyname = "F5"     THEN hotkey := 84;
   ELSIF keyname = "F6"     THEN hotkey := 85;
   ELSIF keyname = "F7"     THEN hotkey := 86;
   ELSIF keyname = "F8"     THEN hotkey := 87;
   ELSIF keyname = "F9"     THEN hotkey := 88;
   ELSIF keyname = "F10"    THEN hotkey := 89;
   ELSIF keyname = "DEL"    THEN hotkey := 70;
   ELSIF keyname = "HELP"   THEN hotkey := 95;
   ELSIF keyname = "SPACE"  THEN hotkey := 64;
   ELSIF keyname = "RETURN" THEN hotkey := 68;
   ELSIF keyname = "ENTER"  THEN hotkey := 67;
   ELSIF keyname = "UP"     THEN hotkey := 76;
   ELSIF keyname = "DOWN"   THEN hotkey := 77;
   ELSIF keyname = "RIGHT"  THEN hotkey := 78;
   ELSIF keyname = "LEFT"   THEN hotkey := 79;
   ELSIF keyname = "NONE"   THEN hotkey := -128; END;

END GetHotKey;


PROCEDURE GetQualifier(VAR string:e.STRPTR);

VAR keyname : e.STRING;

BEGIN

   COPY(string^,keyname);
   Strings.Upper(keyname);
   IF    keyname = "LSHIFT"    THEN qual := ie.lShift;
   ELSIF keyname = "RSHIFT"    THEN qual := ie.rShift;
   ELSIF keyname = "CONTROL"   THEN qual := ie.control;
   ELSIF keyname = "LALT"      THEN qual := ie.lAlt;
   ELSIF keyname = "RALT"      THEN qual := ie.rAlt;
   ELSIF keyname = "LCOMMAND"  THEN qual := ie.lCommand;
   ELSIF keyname = "RCOMMAND"  THEN qual := ie.rCommand;
   ELSIF (keyname = "NONE") OR (hotkey<0) THEN qual := -128; qualcode := -128 END;
   IF qual >= 0 THEN qualcode := qual+96; END;
   keyname := "$VER: ABlank 1.2 (15.03.92)";

END GetQualifier;


PROCEDURE GetTools();

VAR string : e.STRPTR;
    int    : LONGINT;
    MyName : ARRAY 32 OF CHAR;
    wbdop  : WB.DiskObjectPtr;
    
    
   PROCEDURE FindTool(findstr: ARRAY OF CHAR):BOOLEAN;
   
   BEGIN

     string := Icon.FindToolType(wbdop.toolTypes,findstr);
     IF string # NIL THEN RETURN TRUE END;
     RETURN FALSE;

   END FindTool;


BEGIN

  Arguments.GetArg(0,MyName);
  IF MyName # "" THEN
     wbdop := Icon.GetDiskObject(MyName);
     IF wbdop # NIL THEN
        IF FindTool("TIMEOUT") THEN
           IF Conversions.StringToInt(string^,int) THEN
              IF (int > 0) AND ((int*10) < MAX(INTEGER)) THEN
                 blankmax := SHORT(int)*10;
              END;
           END;
        END;
        IF FindTool("DEPTH") THEN
           IF Conversions.StringToInt(string^,int) THEN
              IF (int > 0) AND (int < 4) THEN
                 userdepth := SHORT(int);
              END;
           END;
        END;
        IF FindTool("CHANGETIME") THEN
           IF Conversions.StringToInt(string^,int) THEN
              IF (int > 0) AND ((int*10) < MAX(INTEGER)) THEN
                 chgpatmax := SHORT(int)*10;
              END;
           END;
        END;
        IF FindTool("MOUSETIME") THEN
           IF Conversions.StringToInt(string^,int) THEN
              IF (int > 0) AND ((int*10) < MAX(INTEGER)) THEN
                 mousemax := SHORT(int)*10;
              END;
           END;
        END;
        IF FindTool("LACE") THEN
           Strings.Upper(string^);
           IF string^="OFF" THEN lace := FALSE END;
        END;
        IF FindTool("HOTKEY") THEN
           GetHotKey(string);
        END;
        IF FindTool("BLANKMOUSE") THEN
           Strings.Upper(string^);
           IF string^="OFF" THEN mousemax := MAX(INTEGER) END;
        END;
        IF FindTool("KEYMOUSE") THEN
           Strings.Upper(string^);
           IF string^="OFF" THEN keymouse := FALSE END;
        END;
        IF FindTool("SHUFFLE") THEN
           Strings.Upper(string^);
           IF string^="OFF" THEN shuffle := FALSE END;
        END;
        IF FindTool("QUALIFIER") THEN
           GetQualifier(string);
        END;
        Icon.FreeDiskObject(wbdop);
     END;
  END;

END GetTools;


PROCEDURE GetArgs();

VAR
   string       : e.STRPTR;
   rdargs       : D.RDArgsPtr;
   argarray     : ARRAY 11 OF LONGINT;
   argPtr       : POINTER TO LONGINT;
   i            : INTEGER;
   stop         : BOOLEAN;

   PROCEDURE OFF(VAR arg:LONGINT):BOOLEAN;
   
   BEGIN
   
      IF arg=0 THEN RETURN TRUE END;
      string := S.VAL(e.STRPTR,arg);
      Strings.Upper(string^);
      IF string^="OFF" THEN RETURN FALSE END;
      RETURN TRUE;
   
   END OFF;

BEGIN

        rdargs := D.ReadArgs("TIMEOUT/N,DEPTH/N,CHANGETIME/N,HOTKEY/K,QUAL=QUALIFIER/K,LACE/K,SHUFFLE/K,BLANKMOUSE/K,KEYMOUSE/K,MOUSETIME/N,Q=QUIT/S",argarray,NIL);
        stop := FALSE;

        IF rdargs = NIL THEN
           D.PrintF("USAGE: TIMEOUT/N    (blanking timeout in seconds,  default: 180)\n"
                    "       DEPTH/N      (screen depth:1-4, default: 4, i.e. 16 colors)\n"
                    "       CHANGETIME/N (time between changing pattern in seconds, default: 90)\n"
                    "       HOTKEY/K     (hotkey invoking blanker and changing pattern, default: ESC)\n");
           D.PrintF("       QUAL=QUALIFIER/K  (qualifier for hotkey, default: right Amiga)\n"
                    "       LACE/K       (interlaced screen ON|OFF, default: ON)\n"
                    "       SHUFFLE/K    (shuffle & window activate ON|OFF; key: lAmiga+m, default: ON)\n"
                    "       BLANKMOUSE/K (mouseblanker ON|OFF, default: ON)\n"
                    "       KEYMOUSE/K   (blank mouse on pressing any key, ON|OFF, default: ON)\n"
                    "       MOUSETIME/N  (mouse blanking timeout in seconds, default: 5)\n"
                    "       Q=QUIT/S     (unload)\n");
           HALT(0);
        END;
        IF argarray[0]#0 THEN
           argPtr := S.VAL(e.APTR,argarray[0]);
           IF (argPtr^ > 0) AND ((argPtr^*10) < MAX(INTEGER)) THEN
              blankmax := SHORT(argPtr^)*10;
           END;
        END;
        IF argarray[1]#0 THEN
           argPtr := S.VAL(e.APTR,argarray[1]);
           IF (argPtr^ > 0) AND (argPtr^ < 4) THEN
              userdepth := SHORT(argPtr^);
           END;
        END;
        IF argarray[2]#0 THEN
           argPtr := S.VAL(e.APTR,argarray[2]);
           IF (argPtr^ > 0) AND ((argPtr^*10) < MAX(INTEGER)) THEN
              chgpatmax := SHORT(argPtr^)*10;
           END;
        END;
        IF argarray[3]#0 THEN
           string := S.VAL(e.STRPTR,argarray[3]);
           GetHotKey(string);
        END;
        IF (argarray[4]#0) THEN
           string := S.VAL(e.STRPTR,argarray[4]);
           GetQualifier(string);
        END;
        lace    := OFF(argarray[5]);
        shuffle := OFF(argarray[6]);
        IF OFF(argarray[7]) THEN mousemax := MAX(INTEGER); keymouse := FALSE END;
        keymouse:= OFF(argarray[8]);
        IF argarray[9]#0 THEN
           argPtr := S.VAL(e.APTR,argarray[9]);
           IF (argPtr^ > 0) AND ((argPtr^*10) < MAX(INTEGER)) THEN
              mousemax := SHORT(argPtr^)*10;
           END;
        END;
        IF argarray[10]#0 THEN stop := TRUE END;

        D.FreeArgs(rdargs);

        IF stop THEN HALT(0) END;

END GetArgs;


BEGIN

  (* If I'm are already here, turn myself off and start from scratch *)
  
  e.Forbid;
  FindPort := e.FindPort(portname);
  IF FindPort # NIL THEN
     e.Signal(FindPort.sigTask,LONGSET{D.ctrlC});
     FindPort := NIL;
  END;
  e.Permit;

  blankmax  := 30*60;   (* blank timeout (seconds times 10), 3 min *)
  mousemax  :=  5*10;   (* mouse pointer timeout, 5 seconds        *)
  hotkey    :=    69;   (* hotkey invoking blanker and changing pattern (ESC)*)
  qual      :=     7;   (* qualifier: right Amiga-key              *)
  qualcode  :=   103;   (* 7+96                                    *)
  chgpatmax := 90*10;   (* time before changing pattern (seconds times 10) *)
  userdepth :=     4;
  lace      :=  TRUE;
  changepat := FALSE;
  blankit   := FALSE;
  keymouse  :=  TRUE;
  shuffle   :=  TRUE;
  offmouse  := FALSE;

  IF I.int.libNode.version>=37 THEN
     IF ol.wbStarted THEN
        GetTools();
     ELSE
        GetArgs();
     END;
     ns.width := -1; ns.height := -1;
  ELSE
     ns.width  := G.gfx.normalDisplayColumns;    (* 1.3 version without cli options & tooltypes *)
     ns.height := G.gfx.normalDisplayRows;
     lace := FALSE;
  END;

  MySig := -1;
  Me := S.VAL(e.TaskPtr,ol.Me);

(*------  Open everything we need:  ------*)

  MySig     := e.AllocSignal(-1);        IF MySig<0       THEN HALT(20) END;
  IDevPort  := es.CreatePort(portname,0);IF IDevPort=NIL  THEN HALT(20) END;
  IReqBlock := es.CreateStdIO(IDevPort); IF IReqBlock=NIL THEN HALT(20) END;
  IF e.OpenDevice("input.device",0,IReqBlock,LONGSET{})#0 THEN HALT(20) END;
  InputOpen := TRUE;

  HandlerStuff.data     := S.REG(13);  (* Varbase *)
  HandlerStuff.node.pri := 51;
  HandlerStuff.code     := S.VAL(e.PROC,Handler);
  IReqBlock.command := in.addHandler;
  IReqBlock.data    := S.ADR(HandlerStuff);
  e.OldDoIO(IReqBlock);

  HandlerActive := TRUE;
  mousecount:= 0;

  ns.type   := I.customScreen+{I.screenQuiet,I.screenBehind};
  ns.viewModes := {G.hires};
  IF lace THEN INCL(ns.viewModes,G.lace) END;

  WHILE ~(D.ctrlC IN e.Wait(LONGSET{MySig,D.ctrlC})) DO

    IF blankit THEN

      depth := userdepth;
      numcolors := ASH(1,depth);
      REPEAT
         ns.depth  := depth;
         ScP := I.OpenScreen(ns);
         IF ScP = NIL THEN DEC(depth); numcolors := numcolors DIV 2 END;
      UNTIL (ScP # NIL) OR (depth=0);

      IF ScP # NIL THEN
         rp := S.ADR(ScP.rastPort);
         Draw();
         I.OldCloseScreen(ScP); ScP := NIL;
      END;

    END;

  END;

CLOSE

  G.OnSprite;
  IF HandlerActive         THEN
    IReqBlock.command := in.remHandler;
    IReqBlock.data := S.ADR(HandlerStuff);
    e.OldDoIO(IReqBlock);
  END;
  IF InputOpen     THEN e.CloseDevice (IReqBlock) END;
  IF IDevPort#NIL  THEN es.DeletePort (IDevPort)  END;
  IF IReqBlock#NIL THEN es.DeleteStdIO(IReqBlock) END;
  IF MySig>=0      THEN e.FreeSignal  (MySig)     END;

END ABlank.