'===========================================================================
' Subject: DIGITAL CLOCK/TIMER               Date: 07-11-97 (12:37)       
' Author:  Michael G. Stewart                Code: QB, QBasic, PDS        
' Origin:  mikegs@juno.com                 Packet: DATETIME.ABC
'===========================================================================
DECLARE SUB showdate ()
DECLARE SUB quit ()
'TIMER.BAS
'DIGITAL CLOCK/TIMER v. 1.0
'Copyright (C) 1997 Arrowhead Corporation
'PUBLIC DOMAIN
'
'If You Use This Program In Your Own Program,
'Give Me (Mike Stewart) Credit.
'
'Have Fun! |:-)
DECLARE SUB setime ()
DECLARE SUB display (hr%, mn%, sc%, mode$, las%)
DECLARE SUB drawwatch ()
DECLARE SUB runwatch ()
DIM SHARED mode
CONST up = 1
CONST down = 0
CLS
SCREEN 12
drawwatch
mode = 1
runwatch

SUB display (hr%, mn%, sc%, mode$, las%)
hra% = CINT((hr% / 10) - .5)
hrb% = hr% - (CINT((hr% / 10) - .5) * 10)
mna% = CINT((mn% / 10) - .5)
mnb% = mn% - (CINT((mn% / 10) - .5) * 10)
sca% = CINT((sc% / 10) - .5)
scb% = sc% - (CINT((sc% / 10) - .5) * 10)
FOR a% = 1 TO 8
 IF a% = 1 THEN l% = hra%: c% = 20
 IF a% = 2 THEN l% = hrb%: c% = 26
 IF a% = 4 THEN l% = mna%: c% = 34
 IF a% = 5 THEN l% = mnb%: c% = 40
 IF a% = 7 THEN l% = sca%: c% = 48
 IF a% = 8 THEN l% = scb%: c% = 54
 IF a% = 3 OR a% = 6 THEN l% = 10
 IF a% = 3 THEN c% = 32
 IF a% = 6 THEN c% = 46
 SELECT CASE l%
  CASE 0
   a$ = "ÜßßßÜ"
   b$ = "Û   Û"
   c$ = "Ü   Ü"
   d$ = "Û   Û"
   e$ = " ßßß "
  CASE 1
   a$ = "    Ü"
   b$ = "    Û"
   c$ = "    Ü"
   d$ = "    Û"
   e$ = "     "
  CASE 2
   a$ = " ßßßÜ"
   b$ = "    Û"
   c$ = "Üßßß "
   d$ = "Û    "
   e$ = " ßßß "
  CASE 3
   a$ = " ßßßÜ"
   b$ = "    Û"
   c$ = " ßßßÜ"
   d$ = "    Û"
   e$ = " ßßß "
  CASE 4
   a$ = "Ü   Ü"
   b$ = "Û   Û"
   c$ = " ßßßÜ"
   d$ = "    Û"
   e$ = "     "
  CASE 5
   a$ = "Üßßß "
   b$ = "Û    "
   c$ = " ßßßÜ"
   d$ = "    Û"
   e$ = " ßßß "
  CASE 6
   a$ = "Üßßß "
   b$ = "Û    "
   c$ = "ÜßßßÜ"
   d$ = "Û   Û"
   e$ = " ßßß "
  CASE 7
   a$ = " ßßßÜ"
   b$ = "    Û"
   c$ = "    Ü"
   d$ = "    Û"
   e$ = "     "
  CASE 8
   a$ = "ÜßßßÜ"
   b$ = "Û   Û"
   c$ = "ÜßßßÜ"
   d$ = "Û   Û"
   e$ = " ßßß "
  CASE 9
   a$ = "ÜßßßÜ"
   b$ = "Û   Û"
   c$ = " ßßßÜ"
   d$ = "    Û"
   e$ = " ßßß "
  CASE 10
   IF las% = 1 THEN
    a$ = " "
    b$ = "Ü"
    c$ = " "
    d$ = "ß"
    e$ = " "
   ELSE
    a$ = " "
    b$ = " "
    c$ = " "
    d$ = " "
    e$ = " "
   END IF
 END SELECT
 LOCATE 12, c%: PRINT a$
 LOCATE 13, c%: PRINT b$
 LOCATE 14, c%: PRINT c$
 LOCATE 15, c%: PRINT d$
 LOCATE 16, c%: PRINT e$
NEXT a%
FOR b% = 1 TO 5
 let$ = MID$(mode$, b%, 1)
 LOCATE b% + 11, 61: PRINT let$
NEXT b%



END SUB

SUB drawwatch
CLS
PAINT (320, 240), 3
CIRCLE (320, 240), 200, 15
PAINT (320, 240), 0, 15
LINE (151, 175)-(489, 256), 15, B
CIRCLE (200, 140), 30, 15
PAINT (200, 140), 8, 15
CIRCLE (440, 140), 30, 15
PAINT (440, 140), 8, 15
CIRCLE (200, 291), 30, 15
PAINT (200, 291), 8, 15
CIRCLE (440, 291), 30, 15
PAINT (440, 291), 8, 15
COLOR 14: LOCATE 8, 30: PRINT "End(1)"
LOCATE 20, 30: PRINT "Mode(2)"
LOCATE 8, 39: PRINT "(3)Start/Stop"
LOCATE 20, 44: PRINT "(4)Reset/Date"
END SUB

SUB quit
CLS
PRINT "TIMER.BAS"
PRINT "DIGITAL CLOCK/TIMER v. 1.0"
PRINT "Copyright (C) 1997 Arrowhead Corporation"
PRINT "PUBLIC DOMAIN"
PRINT
PRINT "If You Use This Program In Your Own Program, "
PRINT "Give Me (Mike Stewart) Credit."
PRINT
PRINT "Good-Bye"
END
END SUB

SUB runwatch
SELECT CASE mode
 CASE 1
  DO
   hr% = VAL(LEFT$(TIME$, 2))
   mn% = VAL(MID$(TIME$, 4, 2))
   sc% = VAL(RIGHT$(TIME$, 2))
   mode$ = "CLOCK"
   display hr%, mn%, sc%, mode$, 1
   kbd$ = ""
   kbd$ = INKEY$
   IF kbd$ = "1" THEN quit
   IF kbd$ = "2" THEN mode = 2: runwatch
   IF kbd$ = "3" THEN BEEP
   IF kbd$ = "4" THEN showdate
  LOOP
 CASE 2
 resets = 1
 display 0, 0, 0, "TIMER", 1
 mode$ = "TIMER"
  DO
   IF resets = 1 THEN
    a% = 0
    b% = 0
    c% = 0
    resets = 0
   END IF
   DO
    kbd$ = ""
    kbd$ = INKEY$
    IF kbd$ = "1" THEN quit
    IF kbd$ = "2" THEN mode = 1: runwatch
    IF kbd$ = "3" THEN EXIT DO
    IF kbd$ = "4" THEN a% = 0: b% = 0: c% = 0: display 0, 0, 0, mode$, 1
   LOOP
   DO
    display a%, b%, c%, mode$, 1
    a$ = TIME$
    b$ = TIME$
    WHILE a$ = b$
     a$ = TIME$
     kbd$ = ""
     kbd$ = INKEY$
     IF kbd$ = "1" THEN quit
     IF kbd$ = "2" THEN mode = 1: runwatch
     IF kbd$ = "3" THEN resets = 1: a$ = ""
     IF kbd$ = "4" THEN start = 1: a$ = ""
    WEND
    IF resets = 1 THEN EXIT DO
    c% = c% + 1
    IF c% = 60 THEN
     c% = 0
     b% = b% + 1
     IF b% = 60 THEN
      b% = 0
      a% = a% + 1
      IF a% = 100 THEN
       BEEP: BEEP
       a% = 0
       b% = 0
       c% = 0
      END IF
     END IF
    END IF
   LOOP
  LOOP
END SELECT
END SUB

SUB setime
CLS : END

END SUB

SUB showdate
a% = VAL(LEFT$(DATE$, 2))
b% = VAL(MID$(DATE$, 4, 2))
c% = VAL(RIGHT$(DATE$, 2))
display a%, b%, c%, "DATE", 0
SLEEP 2
END SUB

'(stat!(i) - meanMi!) ^ 2): NEXT
sdMi! = sdMi! / 10
PRINT sdMi!; "("; 100 * sdMi! / meanMi!; " % )"; : COLOR 7, 0: PRINT
PRINT : PRINT "Normally the most tight test is at 1 %"
PRINT "Press a key to compare deviations with DO LOOP SOLUTION deviations";
SLEEP
FOR k = 0 TO 9
  i = -30000
  c! = TIMER
  DO
    i = i + 1
  LOOP UNTIL i > 30000
  d! = TIMER
stat!(k) = d! - c!
NEXT
COLOR 7, 0: PRINT "DO LOOP TESTVALUES":
FOR i = 0 TO 9: sumL! = sumL! + stat!(i): COLOR 0, 7:
PRINT stat!(i); : COLOR 7, 0: PRINT "", : NEXT:
meanL! = sumL! / 10
PRINT "LOOP MEAN : "; : COLOR 0, 7: PRINT meanL!; : COLOR 7, 0
PRINT "  SD LOOP : "; : COLOR 0, 7:
FOR i = 0 TO 9: sdL! = sdL! + ((stat!(i) - meanL!) ^ 2): NEXT
sdL! = sdL! / 10
PRINT sdL!; "("; 100 * sdL! / meanL!; " % )"; : COLOR 7, 0: PRINT

'In general all timerroutines can at least match up to the deviation
'which the DO LOOP solutions are returning. Furthermore i have noticed
'that the distance of one variation for DO LOOP is most times bigger then
'the single differences for the timers. Even better: it is well known
'that for the do loop solution it makes a great difference if you run
'under plain dos or not, while the timer routines seems not to make
'a difference. Also they should be consistent on different machines,
'a thing which is certainly not so for DO LOOP

'If someone has results that are way out of line then I would appreciate
'some mail, stating if you are using plain dos/ dosbox, and what kind
'of deviations you got..


'Rick(rick@tip.nl)


DEFSTR A-Z
FUNCTION millitimer$
'-----------------------------------------------
'Making use of the toggling of bit 4 of port &h61
'every ~/10000 second..

'To maintain reliability we can not go any closer
'then a ~ 1.18 msec.

'------------------------------------------------

ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&HB9) + CHR$(&HFF) + CHR$(&HFF) 'mov cx,ffff 1/100
ASM = ASM + CHR$(&HBA) + CHR$(&H2) + CHR$(0)     'mov dx,2
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
'timerloop:
ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&H38) + CHR$(&HC4)              'cmp ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF8)              'jnz -8 timerloop
ASM = ASM + CHR$(&H49)                           'dec cx
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF3)              'jnz -13 timerloop
ASM = ASM + CHR$(&H4A)                           'dec dx
ASM = ASM + CHR$(&H75) + CHR$(&HF0)              'jnz -16


'and return to qbasic
ASM = ASM + CHR$(&HCB)                           'retf

millitimer = ASM

END FUNCTION

FUNCTION minitimer
'-----------------------------------------------
'Making use of the toggling of bit 4 of port &h61
'every ~/10000 second..

'To maintain reliability we can not go any smaller
'then aproximataly~ 1.18 msec.

'------------------------------------------------

ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&HB9) + CHR$(&HFF) + CHR$(&HFF) 'mov cx,ffff 1/100
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
'timerloop:
ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&H38) + CHR$(&HC4)              'cmp ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF8)              'jnz -8 timerloop
ASM = ASM + CHR$(&H49)                           'dec cx
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF3)              'jnz -13 timerloop


'and return to qbasic
ASM = ASM + CHR$(&HCB)                           'retf

minitimer = ASM


END FUNCTION

FUNCTION Tenthtimer
'-----------------------------------------------
'Making use of the toggling of bit 4 of port &h61
'every microsecond..

'------------------------------------------------

ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&HB9) + CHR$(&HFF) + CHR$(&HFF) 'mov cx,ffff 1/100
ASM = ASM + CHR$(&HBA) + CHR$(&H11) + CHR$(&H0)  'mov dx,11h  1/100 sec
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
'timerloop:
ASM = ASM + CHR$(&HE4) + CHR$(&H61)              'in al,61
ASM = ASM + CHR$(&H24) + CHR$(&H10)              'and al,10
ASM = ASM + CHR$(&H38) + CHR$(&HC4)              'cmp ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF8)              'jnz -8 timerloop
ASM = ASM + CHR$(&H49)                           'dec cx
ASM = ASM + CHR$(&H88) + CHR$(&HC4)              'mov ah,al
ASM = ASM + CHR$(&H75) + CHR$(&HF3)              'jnz -13 timerloop
ASM = ASM + CHR$(&H4A)                           'dec dx
ASM = ASM + CHR$(&H75) + CHR$(&HF0)              'jnz -16 timerloop
'and return to qbasic
ASM = ASM + CHR$(&HCB)                           'retf

Tenthtimer = ASM
END FUNCTION