' ****************
' *** TIME.LST ***
' ****************
'
DEFWRD "a-z"
'
> PROCEDURE set.date
  ' *** input of new date (at current cursor-position)
  LOCAL inputdate$
  REPEAT
    PRINT "date (dd.mm.yy) : ";
    FORM INPUT 8,inputdate$
  UNTIL LEN(inputdate$)=8
  SETTIME TIME$,inputdate$
RETURN
' **********
'
> PROCEDURE set.time
  ' *** input of new time (at current cursor-position)
  ' *** '.' is used as separator !
  ' *** if user presses <Return> immediately, time will not be changed
  LOCAL x$,inputtime$
  REPEAT
    PRINT "time (hh.mm.ss) : ";
    FORM INPUT 8,x$
  UNTIL LEN(x$)=8 OR x$=CHR$(13)
  LET inputtime$=MID$(x$,1,2)+":"+MID$(x$,4,2)+":"+MID$(x$,7,2)
  SETTIME inputtime$,DATE$
RETURN
' **********
'
> PROCEDURE stopwatch
  ' *** 1st call : start stopwatch
  ' *** 2nd call : stop stopwatch
  ' *** global :   STOP.SECONDS#   STOP.H   STOP.M   STOP.S   WATCH.ON!
  LOCAL s#
  IF watch.on!
    stop.watch#=TIMER
    stop.seconds#=(stop.watch#-start.watch#)/200
    stop.h=stop.seconds#/3600
    s#=stop.seconds#-stop.h*3600
    stop.m=s#/60
    stop.s=s#-stop.m*60
    watch.on!=FALSE
  ELSE
    watch.on!=TRUE
    start.watch#=TIMER
  ENDIF
RETURN
' ***
> PROCEDURE print.stopwatch
  ' *** print elapsed time at current cursor-position
  IF stop.h>0
    PRINT stop.h;" h ";stop.m;" m";
  ELSE
    IF stop.m>0
      PRINT stop.m;" m ";stop.s;" s";
    ELSE
      IF stop.seconds#>=10
        PRINT USING "##.# s",stop.seconds#;
      ELSE
        PRINT USING "#.## s",stop.seconds#;
      ENDIF
    ENDIF
  ENDIF
RETURN
' **********
'
> PROCEDURE day.of.week(day.date$,VAR day$)
  ' *** return day of week, determined with Zeller's Congruence
  LOCAL day,mp,month,year,m,h,w,week$,n
  day=VAL(LEFT$(day.date$,2))
  mp=INSTR(day.date$,".")
  month=VAL(MID$(day.date$,mp+1,2))
  year=VAL(RIGHT$(day.date$,4))
  IF month<=2
    m=10+month
    year=year-1
  ELSE
    m=month-2
  ENDIF
  h=year/100
  y=year-100*h
  w=(TRUNC(2.6*m-0.2)+day+y+TRUNC(y/4)+TRUNC(h/4)-2*h) MOD 7
  RESTORE weekdays
  FOR n=0 TO w
    READ day$
  NEXT n
  '
  weekdays:
  DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
RETURN
' **********
'
> PROCEDURE print.date(print.date$)
  ' *** print date as : weekday day month year (e.g. Friday 8 January 1988)
  ' *** uses Procedure Day.of.week
  LOCAL day,year$,m$,mp,m,month$,n
  @day.of.week(print.date$,print.day$)
  day=VAL(LEFT$(print.date$,2))
  year$=RIGHT$(print.date$,4)
  mp=INSTR(print.date$,".")
  m$=MID$(print.date$,mp+1,2)
  m=VAL(m$)
  RESTORE months
  FOR n=1 TO m
    READ month$
  NEXT n
  PRINT print.day$;" ";day;" ";month$;" ";year$;
  '
  months:
  DATA January,February,March,April,May,June,July
  DATA August,September,October,November,December
RETURN
' **********
'
> PROCEDURE date.input(VAR datum$)
  ' *** invoer datum
  ' *** accepteert verschillende formaten, b.v. :
  ' *** 1-6-'88   02-11-88   3.6.88   2/1/88   12 juni 1988   9 aug 88
  ' *** jaartallen 0 - 99 invoeren als YYY (3 cijfers); YY wordt n.l. 19YY
  '
  LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$
  LOCAL n,month!,month,year$,year
  x=CRSCOL
  y=CRSLIN
  ON ERROR GOSUB date.input.error
  '
  date.input:
  ' *** invoer datum
  ok!=TRUE
  FORM INPUT 18,date.input$
  ' *** dag
  day.len=VAL?(date.input$)
  IF day.len>2                         ! vanwege formaat 2.3.88
    IF INSTR(date.input$,".")=2
      day.len=1
    ELSE
      IF INSTR(date.input$,".")=3
        day.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  day$=LEFT$(date.input$,day.len)
  day=VAL(day$)
  IF day>31 OR day<1
    ok!=FALSE
  ENDIF
  ' *** maand
  month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1))
  month.len=VAL?(month.input$)
  IF month.len=0                  ! maand als naam (of afkorting) ingevoerd
    month$=LEFT$(month.input$,3)
    month$=UPPER$(month$)
    month.data:
    DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7
    DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12
    DIM date.input.month$(14),date.input.month(14)
    RESTORE month.data
    FOR n=1 TO 14
      READ date.input.month$(n),date.input.month(n)
    NEXT n
    FOR n=1 TO 14
      IF date.input.month$(n)=month$
        month!=TRUE
        month=date.input.month(n)
      ENDIF
    NEXT n
    ERASE date.input.month$()
    ERASE date.input.month()
    IF NOT month!
      ok!=FALSE
    ENDIF
  ELSE
    month=VAL(month.input$)         ! maand als getal ingevoerd
  ENDIF
  IF month>12 OR month<1
    ok!=FALSE
  ENDIF
  month$=STR$(month)
  IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30
    ok!=FALSE
  ENDIF
  IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31
    ok!=FALSE
  ENDIF
  ' *** jaar
  year$=RIGHT$(date.input$,4)
  IF VAL?(year$)<>4 OR INSTR(year$,".")
    year$=RIGHT$(date.input$,3)
    IF VAL?(year$)<>3 OR INSTR(year$,".")
      year$=RIGHT$(date.input$,2)
      IF VAL?(year$)<>2 OR INSTR(year$,".")
        ok!=FALSE
      ENDIF
      year$="19"+year$                ! jaar YY wordt 19YY
    ENDIF
  ENDIF
  WHILE LEFT$(year$,1)="0"            ! nullen aan begin verwijderen
    year$=RIGHT$(year$,LEN(year$)-1)
  WEND
  year=VAL(year$)
  IF month=2                      ! schrikkeljaar-controle voor maand februari
    IF day>28
      IF (year MOD 400=0) AND day<>29
        ok!=FALSE
      ELSE
        IF year MOD 100=0 AND (year MOD 400<>0)
          ok!=FALSE
        ELSE
          IF (year MOD 4=0) AND day<>29
            ok!=FALSE
          ELSE
            IF (year MOD 4<>0)
              ok!=FALSE
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  ' *** datum
  IF NOT ok!
    PRINT bel$;
    PRINT AT(x,y);STRING$(LEN(date.input$)," ");
    PRINT AT(x,y);"FOUTIEF FORMAAT !!";
    PAUSE 50
    PRINT AT(x,y);STRING$(18," ");
    PRINT AT(x,y);"";
    GOTO date.input
  ENDIF
  datum$=day$+"."+month$+"."+year$
  ON ERROR
RETURN
' ***
> PROCEDURE date.input.error
  ' *** opvang onverwachte error
  ok!=FALSE
  ON ERROR GOSUB date.input.error
  RESUME NEXT
RETURN
' **********
'
> PROCEDURE start.date.input
  ' *** invoer datum bij opstarten
  ' *** accepteert verschillende formaten, b.v. :
  ' *** 1-6-'88   02-11-88   3.6.88   2/1/88   12 juni 1988   9 aug 88
  LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$,n,month!,month,year$,year
  LOCAL new.date$
  PRINT " datum (dag-maand-jaar) : ";
  x=CRSCOL
  y=CRSLIN
  ON ERROR GOSUB start.date.input.error
  '
  start.date.input:
  ' *** invoer datum
  ok!=TRUE
  FORM INPUT 18,date.input$
  ' *** dag
  day.len=VAL?(date.input$)
  IF day.len>2                         ! vanwege formaat 2.3.88
    IF INSTR(date.input$,".")=2
      day.len=1
    ELSE
      IF INSTR(date.input$,".")=3
        day.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  day$=LEFT$(date.input$,day.len)
  day=VAL(day$)
  IF day>31 OR day<1
    ok!=FALSE
  ENDIF
  ' *** maand
  month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1))
  month.len=VAL?(month.input$)
  IF month.len=0                  ! maand als naam (of afkorting) ingevoerd
    month$=LEFT$(month.input$,3)
    month$=UPPER$(month$)
    start.month.data:
    DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7
    DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12
    DIM date.input.month$(14),date.input.month(14)
    RESTORE start.month.data
    FOR n=1 TO 14
      READ date.input.month$(n),date.input.month(n)
    NEXT n
    FOR n=1 TO 14
      IF date.input.month$(n)=month$
        month!=TRUE
        month=date.input.month(n)
      ENDIF
    NEXT n
    ERASE date.input.month$()
    ERASE date.input.month()
    IF NOT month!
      ok!=FALSE
    ENDIF
  ELSE
    month=VAL(month.input$)         ! maand als getal ingevoerd
  ENDIF
  IF month>12 OR month<1
    ok!=FALSE
  ENDIF
  month$=STR$(month)
  IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30
    ok!=FALSE
  ENDIF
  IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31
    ok!=FALSE
  ENDIF
  ' *** jaar
  year$=RIGHT$(date.input$,2)
  IF VAL?(year$)<>2 OR INSTR(year$,".") OR VAL(year$)<88
    ok!=FALSE
  ENDIF
  year=VAL(year$)
  IF month=2                      ! schrikkeljaar-controle voor maand februari
    IF day>28
      IF (year MOD 400=0) AND day<>29
        ok!=FALSE
      ELSE
        IF year MOD 100=0 AND (year MOD 400<>0)
          ok!=FALSE
        ELSE
          IF (year MOD 4=0) AND day<>29
            ok!=FALSE
          ELSE
            IF (year MOD 4<>0)
              ok!=FALSE
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  ' *** datum
  IF NOT ok!
    PRINT bel$;
    PRINT AT(x,y);STRING$(LEN(date.input$)," ");
    PRINT AT(x,y);"FOUTIEF FORMAAT !!";
    PAUSE 50
    PRINT AT(x,y);STRING$(18," ");
    PRINT AT(x,y);"";
    GOTO start.date.input
  ENDIF
  LET new.date$=day$+"."+month$+"."+year$
  SETTIME TIME$,new.date$
  ON ERROR
RETURN
' ***
> PROCEDURE start.date.input.error
  ' *** opvang onverwachte error
  ok!=FALSE
  ON ERROR GOSUB start.date.input.error
  RESUME NEXT
RETURN
' **********
'
> PROCEDURE time.input(VAR tijd$)
  ' *** invoer tijd (seconden eventueel weglaten)
  ' *** accepteert verschillende formaten, b.v. :
  ' *** 12.40.10    1:30:25    20.45
  '
  LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len
  LOCAL minute$,second$,second.input$,second.len
  x=CRSCOL
  y=CRSLIN
  ON ERROR GOSUB time.input.error
  '
  time.input:
  ' *** invoer tijd
  ok!=TRUE
  FORM INPUT 10,time.input$
  ' *** uren
  hour.len=VAL?(time.input$)
  IF hour.len>2                            ! vanwege formaat 12.30.00
    IF INSTR(time.input$,".")=2
      hour.len=1
    ELSE
      IF INSTR(time.input$,".")=3
        hour.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  hour$=LEFT$(time.input$,hour.len)
  IF VAL(hour$)>23
    ok!=FALSE
  ENDIF
  ' *** minuten
  LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1))
  LET minute.len=VAL?(minute.input$)
  IF minute.len>2                            ! vanwege formaat 12.30.00
    IF INSTR(minute.input$,".")=2
      LET minute.len=1
    ELSE
      IF INSTR(minute.input$,".")=3
        LET minute.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  LET minute$=LEFT$(minute.input$,minute.len)
  IF VAL(minute$)>59
    ok!=FALSE
  ENDIF
  ' *** seconden
  IF minute.len>=LEN(minute.input$)-1
    second$="0"
  ELSE
    second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1))
    second$=LEFT$(second.input$,2)
    IF VAL(second$)>59
      ok!=FALSE
    ENDIF
  ENDIF
  ' *** tijd
  IF NOT ok!
    PRINT bel$;
    PRINT AT(x,y);STRING$(LEN(time.input$)," ");
    PRINT AT(x,y);"ONJUIST !!";
    PAUSE 50
    PRINT AT(x,y);STRING$(10," ");
    PRINT AT(x,y);"";
    GOTO time.input
  ENDIF
  tijd$=hour$+":"+minute$+":"+second$
  ON ERROR
RETURN
' ***
> PROCEDURE time.input.error
  ' *** opvang onverwachte error
  ok!=FALSE
  ON ERROR GOSUB time.input.error
  RESUME NEXT
RETURN
' **********
'
> PROCEDURE start.time.input
  ' *** invoer tijd bij opstarten (seconden eventueel weglaten)
  ' *** direct <RETURN> = 00:00:00
  ' *** accepteert verschillende formaten, b.v. :
  ' *** 12.40.10    1:30:25    20.45
  '
  LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len
  LOCAL minute$,second$,second.input$,second.len,new.time$
  PRINT " tijd (uur.min[.sec]) : ";
  x=CRSCOL
  y=CRSLIN
  ON ERROR GOSUB start.time.input.error
  '
  start.time.input:
  ' *** invoer tijd
  ok!=TRUE
  FORM INPUT 10,time.input$
  IF time.input$=""
    LET new.time$="00:00:00"
    GOTO start.time.exit
  ENDIF
  ' *** uren
  hour.len=VAL?(time.input$)
  IF hour.len>2                            ! vanwege formaat 12.30.00
    IF INSTR(time.input$,".")=2
      hour.len=1
    ELSE
      IF INSTR(time.input$,".")=3
        hour.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  hour$=LEFT$(time.input$,hour.len)
  IF VAL(hour$)>23
    ok!=FALSE
  ENDIF
  ' *** minuten
  LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1))
  LET minute.len=VAL?(minute.input$)
  IF minute.len>2                            ! vanwege formaat 12.30.00
    IF INSTR(minute.input$,".")=2
      LET minute.len=1
    ELSE
      IF INSTR(minute.input$,".")=3
        LET minute.len=2
      ELSE
        ok!=FALSE
      ENDIF
    ENDIF
  ENDIF
  LET minute$=LEFT$(minute.input$,minute.len)
  IF VAL(minute$)>59
    ok!=FALSE
  ENDIF
  ' *** seconden
  IF minute.len>=LEN(minute.input$)-1
    second$="0"
  ELSE
    second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1))
    second$=LEFT$(second.input$,2)
    IF VAL(second$)>59
      ok!=FALSE
    ENDIF
  ENDIF
  ' *** tijd
  IF NOT ok!
    PRINT bel$;
    PRINT AT(x,y);STRING$(LEN(time.input$)," ");
    PRINT AT(x,y);"ONJUIST !!";
    PAUSE 50
    PRINT AT(x,y);STRING$(10," ");
    PRINT AT(x,y);"";
    GOTO start.time.input
  ENDIF
  LET new.time$=hour$+":"+minute$+":"+second$
  start.time.exit:
  SETTIME new.time$,DATE$
  ON ERROR
RETURN
' ***
> PROCEDURE start.time.input.error
  ' *** opvang onverwachte error
  ok!=FALSE
  ON ERROR GOSUB start.time.input.error
  RESUME NEXT
RETURN
' **********
'
> PROCEDURE initio.milli.timer
  ' *** speciale timer; kleinste gemeten tijdeenheid = timer.step#
  ' *** afhankelijk van o.a. accessories varieert deze tijdeenheid
  ' *** de maximaal haalbare nauwkeurigheid is minder dan 0.2 milliseconden
  ' *** out : TIMER.STEP#
  LOCAL t1#,t2#,i,k%
  REPEAT
  UNTIL INKEY$=""
  t1#=TIMER
  FOR i=1 TO 20000
    KEYLOOK k%
    EXIT IF k%<>0
  NEXT i
  t2#=TIMER
  timer.step#=(t2#-t1#)/4000000              ! tijdeenheid in seconden
RETURN
' ***
> PROCEDURE milli.timer
  ' *** eerst Procedure initio.milli.timer aanroepen
  ' *** reactietijd voor indrukken van een toets in milliseconden
  ' *** out : MILLI.SEC#
  LOCAL i,k%
  FOR i=1 TO 20000
    KEYLOOK k%
    EXIT IF k%<>0
  NEXT i
  milli.sec#=ROUND(i*timer.step#*1000,1)    ! 1 cijfer achter komma
RETURN
' **********
'
> PROCEDURE time
  ' *** PRINT time at right upper corner (change position if necessary)
  ' *** activate with : EVERY 200 GOSUB time
  ' *** TIME$ is updated every 2 (!) seconds, therefore little trick necessary
  ' *** cursor-position saved and restored
  ' *** uses Standard Global scrn.col.max
  ' *** global :  TIMER$
  LOCAL t$
  t$=TIME$
  IF t$=timer$
    MID$(timer$,8)=SUCC(RIGHT$(timer$))
  ELSE
    timer$=t$
  ENDIF
  PRINT "j";
  PRINT AT(SUB(scrn.col.max,7),1);timer$;
  PRINT "k";
RETURN
' **********
'