'===========================================================================
' Subject: TSR-CLOCK                          Date: 10-31-95 (00:00)       
'  Author: Thomas Gohel                       Code: PB                     
'  Origin: alt.lang.basic                   Packet: PB.ABC
'===========================================================================
'> Is there a way to have the ON TIMER() loop use a value less than 1 second?
'> I was hoping for 16 times a second.  Otherwise, how can I specify
'> the ON UEVENT to look for INT 1 (I believe that's the interrupt that is
'> called 18.2 times a second--timer tick)?

'Here is a source for a INT1C clock. The routine is called 18.2 times in a
'second:

'*************************************************************************
'
'  demonstration for a little TSR-clock with PowerBASIC 3.0/3.2
'
'  copyright by Thomas Gohel, GERMANY
'
'*************************************************************************

$COMPILE EXE "PBCLOCK.EXE"
$OPTION CNTLBREAK OFF

CLS
TSRClock "ON"                              ' Clock on
SHELL
TSRClock "OFF"                             ' Clock off
END

SUB TSRClock(Action$) public

        SELECT CASE Action$
            CASE "ON", "EIN", "+"
                NewIntVektorSeg?? = CODESEG(Time)
                NewIntVektorOff?? = CODEPTR(Time)
                ! call GetOldInterruptVektor
                ! call SetNewInterruptVektor
            CASE "OFF", "AUS", "-"
                ! call SetOldInterruptVektor
            CASE ELSE
                PRINT "illegal function call!"
        END SELECT
        EXIT SUB

        Time:

        ! push  ax
        ! push  bx
        ! push  cx
        ! push  dx
        ! push  si
        ! push  di
        ! push  bp
        ! push  ds
        ! push  es

        ! mov   ax, &hb800               ;Set the Video-RAM
        ! mov   es, ax
        ! mov   bx, 142                  ;Set the position
        ! mov   al, &h04
        ! out &h70, al
        ! in    al, &h71
        ! call WriteTime
        ! call WriteHyphen
        ! mov   al, &h02
        ! out &h70, al
        ! in    al, &h71
        ! call WriteTime
        ! call WriteHyphen
        ! mov   al, &h00
        ! out &h70, al
        ! in    al, &h71
        ! call WriteTime
        ! pop   es
        ! pop   ds
        ! pop   bp
        ! pop   di
        ! pop   si
        ! pop   dx
        ! pop   cx
        ! pop   bx
        ! pop   ax
        ! jmp dword OldTimerProcedure    ; jump old handler (incl. IRET)

        WriteTime:
        ! mov   ah, al
        ! mov   cl, 4
        ! shr   ah, cl
        ! mov   ch, ah
        ! shl   ch, cl
        ! sub   al, ch
        ! add   ah, 48
        ! add   al, 48
        ! mov   cl, 11                    ;set color
        ! mov   es:[bx], ah
        ! inc   bx
        ! mov   es:[bx], cl
        ! inc   bx
        ! mov   es:[bx], al
        ! inc   bx
        ! mov   es:[bx], cl
        ! inc   bx
        ! retn

        WriteHyphen:
        ! mov   ah, 58
        ! mov   es:[bx], ah
        ! inc   bx
        ! mov   es:[bx], cl
        ! inc   bx
        ! retn

        SetNewInterruptVektor:
        ! push ds
        ! mov  ah, &h25
        ! mov  al, &h1C
        ! mov  dx, NewIntVektorOff??
        ! mov  ds, NewIntVektorSeg??
        ! int  &h21
        ! pop  ds
        ! retn

        SetOldInterruptVektor:
        ! push ds
        ! mov  ah, &h25
        ! mov  al, &h1C
        ! mov  dx, OldTimerProcedure[00]
        ! mov  ds, OldTimerProcedure[02]
        ! int  &h21
        ! pop  ds
        ! retn

        GetOldInterruptVektor:
        ! push ds
        ! mov ah, &h35
        ! mov al, &h1C
        ! int &h21
        ! pop ds
        ! mov OldTimerProcedure[02], es
        ! mov OldTimerProcedure[00], bx
        ! retn

        OldTimerProcedure:                ' old Int1C-pointer
        ! dd 0
END SUB