UNIT SysSup;
{ nov 23 91 tb
  has screen blanker for programs that call allowkey
  August 11 92 tb  minor spelling fix for 'tuesday'
  aug 23 92 1.520 set blank time to 5 minutes
}

{$D-,S-}

INTERFACE

USES Crt,Dos,Win;

CONST
  bs=08;
  esc=27;
  left=18; {75}
  right=04; {77}
  up=5; {72}
  down=24 {80};
  space = 32;
  return = 13;
  hotkey = 59; {59}
  blanks='                                                                                ';

TYPE
  keysettype= SET OF CHAR;
  helpstr= STRING[8];

VAR
  helpon,inhelp: BOOLEAN;
  curhelp: helpstr;
  hasmouse: BOOLEAN;
  blankerstr: STRING[80];

FUNCTION abs(a: INTEGER): INTEGER;

FUNCTION max(a,b: INTEGER): INTEGER;

FUNCTION min(a,b: INTEGER): INTEGER;

FUNCTION limit(low,high,amt: INTEGER): INTEGER;

FUNCTION querykey(VAR key: CHAR): BOOLEAN;

FUNCTION allowkey(keysallowed: keysettype; scans: INTEGER): CHAR;
  { -1 in scans means wait until key hit any other amount is number of times
    to check for key.  If key is found it is returned as the function, if no
    key is found then a CHR(0) is returned.   }

FUNCTION readchar: CHAR;

PROCEDURE getxy(VAR x,y: INTEGER);

IMPLEMENTATION

VAR
  blankon: BOOLEAN;
  datestr: STRING[80];

  PROCEDURE getdatetime;
  VAR
    year,month,day,dayofweek: WORD;
    s: STRING;
    hour,minute,second,sec100: WORD;
    i: INTEGER;

  BEGIN { getdatetime }
    GetDate(year,month,day,dayofweek);
    CASE dayofweek OF
      0: datestr:='Sunday';
      1: datestr:='Monday';
      2: datestr:='Tuesday';
      3: datestr:='Wednesday';
      4: datestr:='Thursday';
      5: datestr:='Friday';
      6: datestr:='Saturday';
    END; { CASE }
    CASE month OF
      1: datestr:= CONCAT(datestr,' January');
      2: datestr:= CONCAT(datestr,' February');
      3: datestr:= CONCAT(datestr,' March');
      4: datestr:= CONCAT(datestr,' April');
      5: datestr:= CONCAT(datestr,' May');
      6: datestr:= CONCAT(datestr,' June');
      7: datestr:= CONCAT(datestr,' July');
      8: datestr:= CONCAT(datestr,' August');
      9: datestr:= CONCAT(datestr,' September');
     10: datestr:= CONCAT(datestr,' October');
     11: datestr:= CONCAT(datestr,' November');
     12: datestr:= CONCAT(datestr,' December');
    END; { CASE }
    STR(day:2,s);
    datestr:= CONCAT(datestr,' ',s);
    STR(year:4,s);
    datestr:= CONCAT(datestr,' ',s);
    GetTime(hour,minute,second,sec100);
    STR(hour:2,s);
    FOR i:= 1 TO LENGTH(s) DO
      IF s[i]= ' ' THEN
        s[i]:='0';
    datestr:= CONCAT(datestr,' ',s);
    STR(minute:2,s);
    FOR i:= 1 TO LENGTH(s) DO
      IF s[i]= ' ' THEN
        s[i]:='0';
    datestr:= CONCAT(datestr,':',s);
    STR(second:2,s);
    FOR i:= 1 TO LENGTH(s) DO
      IF s[i]= ' ' THEN
        s[i]:='0';
    datestr:= CONCAT(datestr,':',s);
  END; { getdatetime }

  FUNCTION abs(a: INTEGER): INTEGER;
  BEGIN { abs }
    IF a < 0 THEN abs := -a ELSE abs := a;
  END; { abs }

  FUNCTION max(a,b: INTEGER): INTEGER;
  BEGIN { max  }
    IF a > b THEN max := a ELSE max := b;
  END; { max }

  FUNCTION min(a,b: INTEGER): INTEGER;
  BEGIN { min }
    IF a < b THEN min := a ELSE min := b;
  END; {min }

  FUNCTION limit(low,high,amt: INTEGER): INTEGER;
  BEGIN { limit }
    IF amt < low THEN limit := low
    ELSE IF amt > high THEN limit := high
    ELSE limit := amt;
  END; { limit }

  function ReadChar: Char;

  VAR
    ch: CHAR;
    reg: REGISTERS;
  BEGIN
    ch := readkey;
    IF ch = #0 THEN
    BEGIN
      ch:= readkey;
      if ch=CHR(75) then ch:=CHR(left);
      if ch=CHR(77) then ch:=CHR(right);
      if ch=CHR(72) then ch:=CHR(up);
      if ch=CHR(80) then ch:=CHR(down);
      IF NOT blankon THEN
      BEGIN
        IF ch=CHR(hotkey) THEN
        BEGIN
          IF (helpon AND NOT inhelp) THEN INTR(250,reg);
          ch:=CHR(0);
        END; { hotkey }
      END; { NOT blankon }
    END; { ch= 0 prefixed }
     readchar := ch;

  END; { readchar }

  FUNCTION querykey(VAR key: CHAR): BOOLEAN;
  VAR
    keyhit: BOOLEAN;
    reg: registers;
  BEGIN { querykey }
    { check mouse }
    keyhit:= FALSE;
    key:=CHR(0);
      delay(50); { give mickeys time to build up }
                 { and time for keys to buffer }
    IF hasmouse THEN
    BEGIN
      reg.AX:=05;
      reg.BX:=0; { left button }
      INTR($33,reg); { get button status }
      keyhit:=reg.bx<>0;
      IF keyhit THEN
        key:=CHR(return);
      IF NOT keyhit THEN
      BEGIN
        reg.AX:=05;
        reg.BX:=1; { right button }
        INTR($33,reg); { get button status }
        keyhit:=reg.bx<>0;
        IF keyhit THEN
          key:=CHR(esc);
      END;
      IF NOT keyhit THEN
      BEGIN
        reg.AX:=$0B;   { get mouse motion mickeys }
        INTR($33,reg);
        { check mouse motion 25 mickeys to be effective }
        { neg val = up pos down }
        keyhit:= ((reg.DX>25) AND (reg.DX<300))
           OR ((reg.DX>65000) AND (reg.DX<65510));
        IF keyhit THEN
          IF reg.DX >300 THEN
            key:= CHR(up)
          ELSE
            key:= CHR(down);
      { 0.720}
        IF keyhit THEN
        BEGIN
          delay(150); { debounce mouse movement to 6 keys/second }
          reg.AX:=$0B;   { empty mouse mickey count }
         INTR($33,reg);
        END;  { was valid mouse movement }
      END;
    END; { hasmouse }
    keyhit:= keypressed OR keyhit;
    IF keypressed  THEN
      key:= readchar;
    querykey:= keyhit;

  END; { querykey }


  FUNCTION allowkey(keysallowed: keysettype; scans: INTEGER): CHAR;
  { -1 in scans means wait until key hit any other amount is number of times
    to check for key.  If key is found it is returned as the function, if no
    key is found then a CHR(0) is returned.   }

  TYPE
    winrec = RECORD
      state: winstate;
      buffer: POINTER;
    END;
    winrecptr = ^winrec;

  CONST
    timetoblank=300;                      { 1.520 }
    timetomove=5;                         { 0.724 }
    blankattr= lightgray+black*16;
    mmsgattr= black+lightgray*16;
    cmsgattr= lightgray+blue*16;

  VAR
    keyhit: BOOLEAN;
    key: CHAR;
    time: INTEGER;
    ir: INTEGER;
    ohour,omin,osec,osec100: WORD;
    nhour,nmin,nsec,nsec100: WORD;
    timelastmove: INTEGER;
    blankwin: winrecptr;
    msgwin: winrecptr;
    oldwin: winstate;
    x,y: INTEGER;
    attr: INTEGER;
    tscans: INTEGER;

    PROCEDURE openwindow(x1, y1, x2, y2: BYTE;VAR w: winrecptr);
    BEGIN
      NEW(w);
      WITH w^ DO
      BEGIN
        savewin(state);
        window(x1, y1, x2, y2);
        GETMEM(buffer, winsize);
        readwin(buffer^);
      END;
    END;

    PROCEDURE closewindow(VAR w: winrecptr);
    BEGIN
      WITH w^ DO
      BEGIN
        writewin(buffer^);
        FREEMEM(buffer, winsize);
        restorewin(state);
      END;
      DISPOSE(w);
    END;

  BEGIN { allowkey }
    tscans:=scans;
    IF lastmode=mono THEN
      attr:=mmsgattr
    ELSE
      attr:=cmsgattr;
    keyhit:= FALSE;
    blankon:= FALSE;
    gettime(ohour,omin,osec,osec100);
    WHILE (tscans <> 0) AND NOT(keyhit) DO
    BEGIN { WHILE }
      gettime(nhour,nmin,nsec,nsec100);
      IF nmin<omin THEN
        nmin:=nmin+60;
      IF blankon THEN
      BEGIN
        IF timetomove<= ((nmin*60)+nsec)-((omin*60)+osec)THEN
        BEGIN
          REPEAT
            gettime(ohour,omin,osec,osec100);
          UNTIL (osec MOD timetomove)=0; { 0.725 put onto regular boundry }
          unframewin;
          closewindow(msgwin);
          x:=random(24)+1;
          y:=random(15)+1;
          openwindow(x,y,x+45,y+6,msgwin);
          tframewin(blankerstr,
            doubleframe,attr,attr);
          fillwin(#32,attr);
          textattr:=attr;
          getdatetime;
          WriteStr((48-LENGTH(datestr)) DIV 2,2,datestr,attr);
          WriteStr(16,4,'Press any key',attr);
        END; { time to move }

      END; { blankon }
      IF NOT blankon THEN
      BEGIN
        IF timetoblank< ((nmin*60)+nsec)-((omin*60)+osec)THEN
        BEGIN
          blankon:= TRUE;
          REPEAT
            gettime(ohour,omin,osec,osec100);
          UNTIL (osec MOD timetomove)=0; { 0.725 put onto regular boundry }
          openwindow(1,1,80,25,blankwin);
          fillwin(#32,blankattr);
          openwindow(15,8,60,14,msgwin);
          tframewin(blankerstr,
            doubleframe,attr,attr);
          fillwin(#32,attr);
          textattr:=attr;
          getdatetime;
          WriteStr((48-LENGTH(datestr)) DIV 2,2,datestr,attr);
          WriteSTr(16,4,'Press any key',attr);
        END; { start up blanker }
      END; { not blankon }
      IF (tscans <> -1) THEN tscans:= tscans-1;
      keyhit := querykey(key);

      IF keyhit THEN
      BEGIN
	   keyhit:=  ((key IN keysallowed) OR (keysallowed = []));
        gettime(ohour,omin,osec,osec100);
        IF blankon THEN
        BEGIN
          keyhit:= FALSE;
          blankon:= FALSE;
          unframewin;
          closewindow(msgwin);
          closewindow(blankwin);
        END; { turn off blanker }
      END; { keyhit }
    END; { WHILE }
    IF keyhit
    THEN allowkey := key
    ELSE allowkey := CHR(0);
  END; { allowkey }

  FUNCTION anykey: CHAR;
  BEGIN { anykey }
   anykey := allowkey([],-1);
  END; { anykey }

  PROCEDURE getxy(VAR x,y: INTEGER);
  BEGIN { getxy }
    X:= wherex;
    y:= wherey;
  END; { getxy }

BEGIN { SysSup }
  hasmouse:= FALSE;
  helpon:= FALSE;
  inhelp:= FALSE;
  blankon:= FALSE;
  blankerstr:= 'Blanker';
END. { SysSup }