Category : BASIC Source Code
Archive   : CHRONOS.ZIP
Filename : CALC.TBI

calc:
SCREEN 0
CLEAR
DEFDBL A-Z
DIM DYNAMIC ENTEST$(7),CLOR%(11),FMT$(5),CLDISP$(13),CLDISPC%(13)
GOSUB 41000
500 REM setup default values
GREGMONTH#=VAL(LEFT$(DATE$,2))
GREGYEAR#=VAL(RIGHT$(DATE$,4))
BASEMONTH#=GREGMONTH#
BASEDAY#=VAL(MID$(DATE$,4,2))
BASEYEAR#=GREGYEAR#
BASEHOUR#=VAL(LEFT$(TIME$,2))
BASEMIN#=VAL(MID$(TIME$,4,2))
BASESEC#=VAL(RIGHT$(TIME$,2))
gosub setupcolor
FMT$(1)="##"
FMT$(2)="####"
FMT$(3)="##,###"
FMT$(4)="##,###,###"
FMT$(5)="#,###,###,###"
CLTOP%=13
CLLAST%=0
GOSUB 20000
GOSUB 21000
GOSUB 22000
GOSUB 33000 :REM display first calendar
GOSUB 32500 :REM calc & show BASE day name
GOTO 30100
10000 REM calculator
10100 REM cycle & recycle calculator entry collection
GOSUB 18000 :REM collect a calculator entry
IF CLDIR%=5 THEN LOCATE 20,62 : PRINT " ";:RETURN
IF CLUSE1$="" THEN CLUSE$=" "+RIGHT$(CLUSE$,1)
ON (CLLAST%+1) GOTO 10500,10500,10800,11100,11400
10500 REM add
CLUM#=CLUM#+(CLDAY#*86400#)+(CLHOUR#*3600)+(CLMIN#*60#)+CLSEC#
GOSUB 19300 :REM show tape
GOTO 11800
10800 REM subtract
CLUM#=CLUM#-((CLDAY#*86400#)+(CLHOUR#*3600)+(CLMIN#*60#)+CLSEC#)
GOSUB 19300 :REM show tape
GOTO 11800
11100 REM divide
IF CLDAY#=0# THEN CLUSE$="ERR: Zero-Divide ":GOSUB 19300:GOTO 11915
CLUM#=FIX(CLUM#/CLDAY#)
CLUSE$=RIGHT$(" "+STR$(CLDAY#)+RIGHT$(CLUSE$,1),17)
GOSUB 19300 :REM show tape
GOTO 11800
11400 REM multiply
CLUM#=FIX(CLUM#*CLDAY#)
CLUSE$=RIGHT$(" "+STR$(CLDAY#)+RIGHT$(CLUSE$,1),17)
GOSUB 19300 :REM show tape
GOTO 11800
11800 REM combine last direction branches
CLLAST%=CLDIR%
IF CLDIR%<>0 THEN GOTO 10100
IF CLUM#<0 THEN CLNEG%=1 ELSE CLNEG%=0
IF ABS(CLUM#)>86399913600# THEN CLUSE$="ERR: Overflow ":GOSUB 19300 : GOTO 11915
CLUM#=ABS(CLUM#)
CLDAY#=FIX(CLUM#/86400#)
CLUM#=CLUM#-(CLDAY#*86400#)
CLHOUR#=FIX(CLUM#/3600#)
CLUM#=CLUM#-(CLHOUR#*3600#)
CLMIN#=FIX(CLUM#/60#)
CLUM#=CLUM#-(CLMIN#*60#)
CLSEC#=CLUM#
CLUSE$=" "+STR$(CLDAY#)+CHR$(250)+RIGHT$(STR$(100#+CLHOUR#),2)+":"+RIGHT$(STR$(100#+CLMIN#),2)+":"+RIGHT$(STR$(100#+CLSEC#),2)
CLUSE$=RIGHT$(CLUSE$,16)
IF CLNEG%=1 THEN CLUSE$=CHR$(174)+RIGHT$(CLUSE$,15)+CHR$(175) ELSE CLUSE$=CLUSE$+" "
GOSUB 19300 :REM show tape
11915 REM branch in for error recovery
CLNEG%=0
CLUSE$="ßßßßßßßßßßßßßßßßß"
GOSUB 19300
CLUM#=(1-1)
GOTO 10100
18000 REM collect & parse a calculator entry CR0 =0 +1 -2 /3 *4 ESC5
IF CLR%=1 THEN COLOR CLOR%(10)
LOCATE 20,63 : PRINT " ";
LOCATE 20,63,1,0,7
CLUSE1$=""
18100 REM cycle & recycle key get
CL$=INKEY$ : IF CL$="" THEN GOTO 18100
CL%=INSTR(CLTEST$,CL$)
ON CL% GOTO 18170,18180,18190,18200,18210,18220,18230,19000,19000,19000,19000,19000,19000,19000,19000,19000,19000,19000,18900
SOUND 50,3
GOTO 18100
18170 CLDIR%=0 : GOTO 18300 :REM cr
18180 CLDIR%=0 : GOTO 18300 :REM =
18190 CLDIR%=1 : GOTO 18300 :REM +
18200 CLDIR%=2 : GOTO 18300 :REM -
18210 CLDIR%=3 : GOTO 18300 :REM /
18220 CLDIR%=4 : GOTO 18300 :REM *
18230 CLDIR%=5 : GOTO 18300 :REM esc
18300 REM function key pressed - parse & return
CLUSE$=CLUSE1$
CLUSE$=CLUSE$+"...."
CLUSE%=INSTR(CLUSE$,".") : CL$=LEFT$(CLUSE$,CLUSE%-1)
CLUSE$=RIGHT$(CLUSE$,LEN(CLUSE$)-(LEN(CL$)+1)) : CLDAY#=VAL(CL$)
CLUSE%=INSTR(CLUSE$,".") : CL$=LEFT$(CLUSE$,CLUSE%-1)
CLUSE$=RIGHT$(CLUSE$,LEN(CLUSE$)-(LEN(CL$)+1)) : CLHOUR#=VAL(CL$)
CLUSE%=INSTR(CLUSE$,".") : CL$=LEFT$(CLUSE$,CLUSE%-1)
CLUSE$=RIGHT$(CLUSE$,LEN(CLUSE$)-(LEN(CL$)+1)) : CLMIN#=VAL(CL$)
CLUSE%=INSTR(CLUSE$,".") : CL$=LEFT$(CLUSE$,CLUSE%-1)
CLUSE$=RIGHT$(CLUSE$,LEN(CLUSE$)-(LEN(CL$)+1)) : CLSEC#=VAL(CL$)
IF CLDAY#>99999# THEN CLDAY#=99999#
IF CLHOUR#>23# THEN CLHOUR#=23#
IF CLMIN#>59# THEN CLMIN#=59#
IF CLSEC#>59# THEN CLSEC#=59#
CLUSE$=" "+STR$(CLDAY#)+CHR$(250)
CLUSE$=CLUSE$+RIGHT$(STR$(100#+CLHOUR#),2)+":"
CLUSE$=CLUSE$+RIGHT$(STR$(100#+CLMIN#),2)+":"
CLUSE$=CLUSE$+RIGHT$(STR$(100#+CLSEC#),2)
CLUSE$=RIGHT$(CLUSE$,16)
CLUSE$=CLUSE$+MID$("=+-"+CHR$(246)+"x ",CLDIR%+1,1)
RETURN
18900 REM backspace character pressed
IF CLUSE1$="" THEN SOUND 50,3 : GOTO 18100
IF LEN(CLUSE1$)=1 THEN GOTO 18000
CLUSE1$=LEFT$(CLUSE1$,LEN(CLUSE1$)-1)
LOCATE 20,(63+LEN(CLUSE1$)) : PRINT " ";
LOCATE 20,(63+LEN(CLUSE1$))
GOTO 18100
19000 REM valid character process
IF LEN(CLUSE1$)=14 THEN SOUND 50,3 : GOTO 18100
CLUSE1$=CLUSE1$+CL$
PRINT CL$;
GOTO 18100
19300 REM update calculator display
IF CLNEG%=1 THEN CLDISPC%(CLTOP%)=CLOR%(11) ELSE CLDISPC%(CLTOP%)=CLOR%(10)
CLDISP$(CLTOP%)=CLUSE$
CLDISP%=CLTOP%
IF CLTOP%=13 THEN CLTOP%=1 ELSE CLTOP%=CLTOP%+1
FOR C%=13 TO 1 STEP (-1)
LOCATE 5+C%,62
IF CLR%=1 THEN COLOR CLDISPC%(CLDISP%)
PRINT CLDISP$(CLDISP%);
IF CLDISP%=1 THEN CLDISP%=13 ELSE CLDISP%=CLDISP%-1
NEXT
RETURN
20000 REM show borders
CLS:IF CLR%=1 THEN COLOR CLOR%(1)
PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
PRINT "º º"
PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
PRINT "º ³ º ³ º º"
PRINT "ÇÄÄÄÄÂÄÄÄÄÂÄÄÁÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄ×ÄÄÄÄÂÄÄÄÄÂÄÄÁÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄĶ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º"
PRINT "º ³ ³ ³ º ³ ³ ³ º º"
PRINT "ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄ×ÄÄÄÄÅÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄĶ º"
PRINT "º ³ ³ ³ º ³ ³ ³ º º"
PRINT "ÌÍÍÍÍÏÑÍÍÍÏÍÍÍÍÍÍÏÍÑÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÏÍÍÍÍÏÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍ͹ º"
PRINT "º ³ ³ º º º"
PRINT "º ÃÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄĶ º º"
PRINT "º ³ ³ º º º"
PRINT "ÌÍÍÍÑÍÏÍÍÍÍÍÍÍÑÍÍÍÍÏÍÍÍÍÍÍÍÍÍ͹ ÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ º º"
PRINT "º ³ ³ º ³ ³ ³ ³ ³ ³ º º"
PRINT "º ÃÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ ³ ³ ³ ³ ³ ³ º º"
PRINT "º ³ ³ º ³ ³ ³ ³ ³ ³ º º"
PRINT "º ÃÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ ³ ³ ³ ³ ³ ³ º º"
PRINT "º ³ ³ º ³ ³ ³ ³ ³ ³ º º"
PRINT "º ÃÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ ³ ³ ³ ³ ³ ³ º ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º"
PRINT "º ³ ³ º ³ ³ ³ ³ ³ ³ º º"
PRINT "ÌÍÍÍÏÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
PRINT "º º"
PRINT "º º";:LOCATE 24,1
PRINT "º º";:LOCATE 25,1
PRINT "º º";:LOCATE 1,1
RETURN
21000 REM screen text
IF CLR%=1 THEN COLOR CLOR%(2)
LOCATE 2,4 : PRINT " Calculator - Copyright 1987 Frederick Volking ";
IF CLR%=1 THEN COLOR CLOR%(3)
LOCATE 22,11 : PRINT "<";CHR$(26);CHR$(25);CHR$(27);CHR$(24);"> ";
LOCATE 22,45 : PRINT "";
LOCATE 23,11 : PRINT "";
LOCATE 23,45 : PRINT "";
LOCATE 24,11 : PRINT "";
LOCATE 24,45 : PRINT "";
LOCATE 25,45 : PRINT "";
IF CLR%=1 THEN COLOR CLOR%(4)
LOCATE 4,16 : PRINT "Day:";
LOCATE 4,46 : PRINT "Day:";
LOCATE 6,3 : PRINT "Mn";
LOCATE 6,8 : PRINT "Dy";
LOCATE 6,13 : PRINT "Year";
LOCATE 6,23 : PRINT "Time";
LOCATE 6,33 : PRINT "Mn";
LOCATE 6,38 : PRINT "Dy";
LOCATE 6,43 : PRINT "Year";
LOCATE 6,53 : PRINT "Time";
LOCATE 10,12 : PRINT "Days";
LOCATE 10,22 : PRINT "hh mm ss";
LOCATE 11,33 : PRINT "Month:";
LOCATE 11,42 : PRINT "Year:";
LOCATE 12,33 : PRINT "Sun Mon Tue Wed Thu Fri Sat";
LOCATE 14,7 : PRINT "Days";
LOCATE 16,7 : PRINT "Hours";
LOCATE 18,7 : PRINT "Minutes";
LOCATE 20,7 : PRINT "Seconds";
IF CLR%=1 THEN COLOR CLOR%(5)
LOCATE 4,6 : PRINT "BASE"
LOCATE 4,35 : PRINT "TARGET";
LOCATE 4,65 : PRINT "CALCULATOR";
LOCATE 11,3 : PRINT "MOD";
LOCATE 16,3 : PRINT "S";
LOCATE 17,3 : PRINT "U";
LOCATE 18,3 : PRINT "M";
LOCATE 10,37 : PRINT "GREGORIAN CALENDAR";
IF CLR%=1 THEN COLOR CLOR%(6)
LOCATE 22,3 : PRINT "Action:";
LOCATE 22,35 : PRINT "Function:";
IF CLR%=1 THEN COLOR CLOR%(7)
LOCATE 22,48 : PRINT "alculator";
LOCATE 23,14 : PRINT "rase fields";
LOCATE 23,48 : PRINT "ase to target = sum & mod";
LOCATE 24,16 : PRINT "ape";
LOCATE 25,48 : PRINT "um + base = target & mod";
LOCATE 24,48 : PRINT "od + base = target";
IF CLR%=1 THEN COLOR CLOR%(0)
LOCATE 8,22 : PRINT ":";
LOCATE 8,25 : PRINT ":";
LOCATE 8,52 : PRINT ":";
LOCATE 8,55 : PRINT ":";
LOCATE 12,24 : PRINT ":";
LOCATE 12,27 : PRINT ":";
RETURN
22000 REM show all variables
IF CLR%=1 THEN COLOR CLOR%(0)
LOCATE 8,3 : PRINT RIGHT$(STR$(BASEMONTH#+10000),2);
LOCATE 8,8 : PRINT RIGHT$(STR$(BASEDAY#+10000),2);
LOCATE 8,13 : PRINT RIGHT$(STR$(BASEYEAR#+10000),4);
LOCATE 8,20 : PRINT RIGHT$(STR$(BASEHOUR#+10000),2);
LOCATE 8,23 : PRINT RIGHT$(STR$(BASEMIN#+10000),2);
LOCATE 8,26 : PRINT RIGHT$(STR$(BASESEC#+10000),2);
LOCATE 8,33 : PRINT RIGHT$(STR$(TARGMONTH#+10000),2);
LOCATE 8,38 : PRINT RIGHT$(STR$(TARGDAY#+10000),2);
LOCATE 8,43 : PRINT RIGHT$(STR$(TARGYEAR#+10000),4);
LOCATE 8,50 : PRINT RIGHT$(STR$(TARGHOUR#+10000),2);
LOCATE 8,53 : PRINT RIGHT$(STR$(TARGMIN#+10000),2);
LOCATE 8,56 : PRINT RIGHT$(STR$(TARGSEC#+10000),2);
LOCATE 12,9 : IF MODDAY#>99999999# THEN PRINT "Overflow "; ELSE PRINT USING FMT$(4);MODDAY#;
LOCATE 12,22 : PRINT RIGHT$(STR$(MODHOUR#+10000),2);
LOCATE 12,25 : PRINT RIGHT$(STR$(MODMIN#+10000),2);
LOCATE 12,28 : PRINT RIGHT$(STR$(MODSEC#+10000),2);
LOCATE 14,17 : IF SUMDAY#>9999999999# THEN PRINT "Overflow "; ELSE PRINT USING FMT$(5);SUMDAY#;
LOCATE 16,17 : IF SUMHOUR#>9999999999# THEN PRINT "Overflow "; ELSE PRINT USING FMT$(5);SUMHOUR#;
LOCATE 18,17 : IF SUMMIN#>9999999999# THEN PRINT "Overflow "; ELSE PRINT USING FMT$(5);SUMMIN#;
LOCATE 20,17 : IF SUMSEC#>9999999999# THEN PRINT "Overflow "; ELSE PRINT USING FMT$(5);SUMSEC#;
LOCATE 11,39 : PRINT RIGHT$(STR$(GREGMONTH#+10000),2);
LOCATE 11,47 : PRINT RIGHT$(STR$(GREGYEAR#+10000),4);
IF CLR%=1 THEN COLOR CLOR%(8)
LOCATE 4,21 : PRINT BASEDAY$;
LOCATE 4,51 : PRINT TARGDAY$;
RETURN
23000 REM calc base to target is sum & mod
GOSUB 24800 :REM verify base D&T
GOSUB 24900 :REM verify targ D&T
MODDAY#=TARGJ#-BASEJ#
BASET#=(BASEHOUR#*3600)+(BASEMIN#*60)+BASESEC#
TARGT#=(TARGHOUR#*3600)+(TARGMIN#*60)+TARGSEC#
MODT#=TARGT#-BASET#
IF MODT#<0 THEN MODDAY#=MODDAY#-1 : MODT#=MODT#+86400#
IF (TARGT#+(TARGJ#*86400#))<(BASET#+(BASEJ#*86400#)) THEN GOTO 23400
MODHOUR#=FIX(MODT#/3600#)
MODT#=MODT#-(MODHOUR#*3600#)
MODMIN#=FIX(MODT#/60#)
MODSEC#=MODT#-(MODMIN#*60#)
SUMDAY#=MODDAY#
SUMHOUR#=MODHOUR#+(SUMDAY#*24#)
SUMMIN#=MODMIN#+(SUMHOUR#*60#)
SUMSEC#=MODSEC#+(SUMMIN#*60#)
GOSUB 22000
RETURN
23400 REM error - target less than base
LOCATE 25,3
IF CLR%=1 THEN COLOR CLOR%(9)+16
PRINT "Base must occur BEFORE Target! ";
MODDAY#=0 : MODHOUR#=0 : MODMIN#=0 : MODSEC#=0
SUMDAY#=0 : SUMHOUR#=0 : SUMMIN#=0 : SUMSEC#=0
GOSUB 22000
LOCATE 25,38,1,0,7
23470 K$=INKEY$ : IF K$="" THEN GOTO 23470
LOCATE 25,3
PRINT " ";
RETURN
24800 REM verify base D&T
IF BASEYEAR#<1 THEN BASEYEAR#=1
JD#=BASEDAY# : JM#=BASEMONTH# : JY#=BASEYEAR# : GOSUB 39000
BASEJ#=JJ# : GOSUB 39300 : BASEDAY$=JDN$ : GOSUB 39100
BASEDAY#=JD# : BASEMONTH#=JM# : BASEYEAR#=JY#
IF BASEHOUR#>23 THEN BASEHOUR#=23
IF BASEMIN#>59 THEN BASEMIN#=59
IF BASESEC#>59 THEN BASESEC#=59
RETURN
24900 REM verify target D&T
IF TARGYEAR#<1 THEN TARGYEAR#=1
JD#=TARGDAY# : JM#=TARGMONTH# : JY#=TARGYEAR# : GOSUB 39000
TARGJ#=JJ# : GOSUB 39300 : TARGDAY$=JDN$ : GOSUB 39100
TARGDAY#=JD# : TARGMONTH#=JM# : TARGYEAR#=JY#
IF TARGHOUR#>23 THEN TARGHOUR#=23
IF TARGMIN#>59 THEN TARGMIN#=59
IF TARGSEC#>59 THEN TARGSEC#=59
RETURN
25000 REM add sum to base for target
GOSUB 24800 :REM verify base D&T
TARGSEC#=BASESEC#+SUMSEC#
TARGMIN#=BASEMIN#+SUMMIN#
TARGHOUR#=BASEHOUR#+SUMHOUR#
TARGJ#=BASEJ#
H#=FIX(TARGSEC#/60#)
TARGSEC#=TARGSEC#-(H#*60#)
TARGMIN#=TARGMIN#+H#
H#=FIX(TARGMIN#/60#)
TARGMIN#=TARGMIN#-(H#*60#)
TARGHOUR#=TARGHOUR#+H#
H#=FIX(TARGHOUR#/24#)
TARGHOUR#=TARGHOUR#-(H#*24#)
TARGJ#=TARGJ#+H#+SUMDAY#
JJ#=TARGJ# : GOSUB 39100
TARGMONTH#=JM# : TARGDAY#=JD# : TARGYEAR#=JY#
MODDAY#=TARGJ#-BASEJ#
BASET#=(BASEHOUR#*3600)+(BASEMIN#*60)+BASESEC#
TARGT#=(TARGHOUR#*3600)+(TARGMIN#*60)+TARGSEC#
MODT#=TARGT#-BASET#
IF MODT#<0 THEN MODDAY#=MODDAY#-1 : MODT#=MODT#+86400#
MODHOUR#=FIX(MODT#/3600#)
MODT#=MODT#-(MODHOUR#*3600#)
MODMIN#=FIX(MODT#/60#)
MODSEC#=MODT#-(MODMIN#*60#)
GOSUB 22000
RETURN
27000 REM add mod to base for target
GOSUB 24800 :REM verify base D&T
TARGJ#=BASEJ#+MODDAY#
TARGT#=(BASEHOUR#*3600)+(BASEMIN#*60)+BASESEC#
TARGT#=TARGT#+(MODHOUR#*3600)+(MODMIN#*60)+MODSEC#
IF TARGT#=>86400# THEN TARGT#=TARGT#-86400# : TARGJ#=TARGJ#+1
JJ#=TARGJ# : GOSUB 39300 : TARGDAY$=JDN$
GOSUB 39100 : TARGMONTH#=JM# : TARGDAY#=JD# : TARGYEAR#=JY#
TARGHOUR#=FIX(TARGT#/3600#)
TARGT#=TARGT#-(TARGHOUR#*3600#)
TARGMIN#=FIX(TARGT#/60#)
TARGSEC#=TARGT#-(TARGMIN#*60#)
GOSUB 22000
RETURN
30100 REM collect BASEMONTH
ENSTAT$="08030251" : ENDFLT$=STR$(BASEMONTH#)
GOSUB 40000 : BASEMONTH#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32500
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30100
ON ENWAY% GOTO 30100,31300,30100,30200,32100,31300
30200 REM collect BASEDAY
ENSTAT$="08080251" : ENDFLT$=STR$(BASEDAY#)
GOSUB 40000 : BASEDAY#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32500
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30200
ON ENWAY% GOTO 30200,31300,30100,30300,32100,31300
30300 REM collect BASEYEAR
ENSTAT$="08130451" : ENDFLT$=STR$(BASEYEAR#)
GOSUB 40000 : BASEYEAR#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32500
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30300
ON ENWAY% GOTO 30300,31300,30200,30400,32100,31300
30400 REM collect BASEHOUR
ENSTAT$="08200251" : ENDFLT$=STR$(BASEHOUR#)
GOSUB 40000 : BASEHOUR#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30400
ON ENWAY% GOTO 30400,31400,30300,30500,32100,31300
30500 REM collect BASEMINUTE
ENSTAT$="08230251" : ENDFLT$=STR$(BASEMIN#)
GOSUB 40000 : BASEMIN#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30500
ON ENWAY% GOTO 30500,31400,30400,30600,32100,31300
30600 REM collect BASESECOND
ENSTAT$="08260251" : ENDFLT$=STR$(BASESEC#)
GOSUB 40000 : BASESEC#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30600
ON ENWAY% GOTO 30600,31500,30500,30700,32100,31300
30700 REM collect TARGETMONTH
ENSTAT$="08330251" : ENDFLT$=STR$(TARGMONTH#)
GOSUB 40000 : TARGMONTH#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32600
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30700
ON ENWAY% GOTO 30700,31600,30600,30800,31700,32100
30800 REM collect TARGETDAY
ENSTAT$="08380251" : ENDFLT$=STR$(TARGDAY#)
GOSUB 40000 : TARGDAY#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32600
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30800
ON ENWAY% GOTO 30800,32100,30700,30900,31700,32100
30900 REM collect TARGETYEAR
ENSTAT$="08430451" : ENDFLT$=STR$(TARGYEAR#)
GOSUB 40000 : TARGYEAR#=VAL(ENRETURN$)
IF ENPASS%>0 THEN GOSUB 32600
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 30900
ON ENWAY% GOTO 30900,32100,30800,31000,31700,32100
31000 REM collect TARGETHOUR
ENSTAT$="08500251" : ENDFLT$=STR$(TARGHOUR#)
GOSUB 40000 : TARGHOUR#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31000
ON ENWAY% GOTO 31000,32200,30900,31100,31700,32100
31100 REM collect TARGETMINUTE
ENSTAT$="08530251" : ENDFLT$=STR$(TARGMIN#)
GOSUB 40000 : TARGMIN#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31100
ON ENWAY% GOTO 31100,32200,31000,31200,31700,32100
31200 REM collect TARGETSECOND
ENSTAT$="08560251" : ENDFLT$=STR$(TARGSEC#)
GOSUB 40000 : TARGSEC#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31200
ON ENWAY% GOTO 31200,32200,31100,31200,31700,32100
31300 REM collect MODDAY
ENSTAT$="12090851" : ENDFLT$=STR$(MODDAY#)
LOCATE 12,9 : PRINT " ";
GOSUB 40000 : MODDAY#=VAL(ENRETURN$)
LOCATE 12,9 : PRINT USING FMT$(4);MODDAY#;
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31300
ON ENWAY% GOTO 30200,31700,30100,31400,30100,31700
31400 REM collect MODHOUR
ENSTAT$="12220251" : ENDFLT$=STR$(MODHOUR#)
GOSUB 40000 : MODHOUR#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31400
ON ENWAY% GOTO 30400,31700,31300,31500,30100,31700
31500 REM collect MODMINUTE
ENSTAT$="12250251" : ENDFLT$=STR$(MODMIN#)
GOSUB 40000 : MODMIN#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31500
ON ENWAY% GOTO 30500,31700,31400,31600,30100,31700
31600 REM collect MODSECOND
ENSTAT$="12280251" : ENDFLT$=STR$(MODSEC#)
GOSUB 40000 : MODSEC#=VAL(ENRETURN$)
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31600
ON ENWAY% GOTO 30600,31700,31500,32100,30100,31700
31700 REM collect SUMDAY
ENSTAT$="14171051" : ENDFLT$=STR$(SUMDAY#)
LOCATE 14,17 : PRINT " ";
GOSUB 40000 : SUMDAY#=VAL(ENRETURN$)
LOCATE 14,17 : PRINT USING FMT$(5);SUMDAY#;
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31700
ON ENWAY% GOTO 31300,31800,30200,31400,31300,30700
31800 REM collect SUMHOUR
ENSTAT$="16171051" : ENDFLT$=STR$(SUMHOUR#)
LOCATE 16,17 : PRINT " ";
GOSUB 40000 : SUMHOUR#=VAL(ENRETURN$)
LOCATE 16,17 : PRINT USING FMT$(5);SUMHOUR#;
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31800
ON ENWAY% GOTO 31700,31900,30200,31400,31300,30700
31900 REM collect SUMMINUTE
ENSTAT$="18171051" : ENDFLT$=STR$(SUMMIN#)
LOCATE 18,17 : PRINT " ";
GOSUB 40000 : SUMMIN#=VAL(ENRETURN$)
LOCATE 18,17 : PRINT USING FMT$(5);SUMMIN#;
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 31900
ON ENWAY% GOTO 31800,32000,30200,30100,31300,30700
32000 REM collect SUMSECOND
ENSTAT$="20171051" : ENDFLT$=STR$(SUMSEC#)
LOCATE 20,17 : PRINT " ";
GOSUB 40000 : SUMSEC#=VAL(ENRETURN$)
LOCATE 20,17 : PRINT USING FMT$(5);SUMSEC#;
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 32000
ON ENWAY% GOTO 31900,30100,30200,30100,31300,30700
32100 REM collect GREGMONTH
ENSTAT$="11390251" : ENDFLT$=STR$(GREGMONTH#)
GOSUB 40000 : GREGMONTH#=VAL(ENRETURN$)
IF GREGMONTH#<1 THEN GREGMONTH#=1 : GOSUB 32195
IF GREGMONTH#>12 THEN GREGMONTH#=12 : GOSUB 32195
IF ENPASS%>0 THEN GOSUB 33000 : GOTO 32100
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 32100
ON ENWAY% GOTO 30800,31600,31600,32200,30700,30100
GOTO 32200
32195 LOCATE 11,39 : PRINT USING FMT$(1);GREGMONTH#; : RETURN
32200 REM collect GREGYEAR
ENSTAT$="11470451" : ENDFLT$=STR$(GREGYEAR#)
GOSUB 40000 : GREGYEAR#=VAL(ENRETURN$)
IF GREGYEAR#<1 THEN GREGYEAR#=1 : GOSUB 32295
IF ENPASS%>0 THEN GOSUB 33000 : GOTO 32200
IF ENWAY%>6 THEN ON (ENWAY%-6) GOSUB 65000,58000,10000,23000,25000,27000:GOTO 32200
ON ENWAY% GOTO 30900,31600,32100,31000,30700,30100
GOTO 30100
32295 LOCATE 11,47 : PRINT USING FMT$(2);GREGYEAR#; : RETURN
32500 REM calc & show new day name - BASE
IF CLR%=1 THEN COLOR CLOR%(8)
JD#=BASEDAY# : JM#=BASEMONTH# : JY#=BASEYEAR# : GOSUB 39000
GOSUB 39300 : LOCATE 4,21 : PRINT JDN$;
IF CLR%=1 THEN COLOR CLOR%(0)
RETURN
32600 REM calc & show new day name - TARGET
IF CLR%=1 THEN COLOR CLOR%(8)
JD#=TARGDAY# : JM#=TARGMONTH# : JY#=TARGYEAR# : GOSUB 39000
GOSUB 39300 : LOCATE 4,51 : PRINT JDN$;
IF CLR%=1 THEN COLOR CLOR%(0)
RETURN
33000 REM show a calendar month
LOCATE 11,52 : IF CLR%=1 THEN COLOR (CLOR%(8)-1)
PRINT MID$("January February March April May June July August SeptemberOctober November December ",((GREGMONTH#-1)*9)+1,9);
JM#=GREGMONTH#
JD#=1
JY#=GREGYEAR#
GOSUB 39000
GOSUB 39300
IF JDN%=7 THEN GREGHOLD#=JJ#-8 ELSE GREGHOLD#=JJ#-(15-(7-JDN%))
IF CLR%=1 THEN COLOR CLOR%(8)
FOR C%=14 TO 20
FOR B%=0 TO 24 STEP 4
LOCATE C%,B%+34
GREGHOLD#=GREGHOLD#+1
JJ#=GREGHOLD#
GOSUB 39100
IF CLR%=0 THEN GOTO 33170
IF JM#=GREGMONTH# THEN COLOR (CLOR%(8)-1) ELSE COLOR CLOR%(8)
33170 PRINT USING FMT$(1);JD#;
NEXT
NEXT
IF CLR%=1 THEN COLOR CLOR%(0)
RETURN
39000 REM input Month,Day,Year - return Julian
IF JM#>2# THEN
JM#=JM#-3#
ELSE
JM#=JM#+9#
JY#=JY#-1#
END IF
J2#=FIX(JY#/100#)
J1#=JY#-100#*J2#
JJ#=FIX((146097#*J2#)/4#)+FIX((1461#*J1#)/4#)+FIX((153#*JM#+2#)/5#)+JD#+1721119#
RETURN
39100 REM input Julian - return Month,Day,Year
JJ#=JJ#-1721119#
JY#=FIX((4#*JJ#-1#)/146097#)
JJ#=4#*JJ#-1#-146097#*JY#
JD#=FIX(JJ#/4#)
JJ#=FIX((4#*JD#+3#)/1461#)
JD#=4#*JD#+3#-1461#*JJ#
JD#=FIX((JD#+4#)/4#)
JM#=FIX((5#*JD#-3#)/153#)
JD#=5#*JD#-3#-153#*JM#
JD#=FIX((JD#+5#)/5#)
JY#=100#*JY#+JJ#
IF JM#<10# THEN
JM#=JM#+3#
ELSE
JM#=JM#-9#
JY#=JY#+1#
END IF
RETURN
39300 REM input Julian - Return name of day of week
JDN%=((JJ#-(FIX(JJ#/7)*7))+1)
JDN$=MID$( _
"Monday Tuesday WednesdayThursday Friday Saturday Sunday ", _
JDN%*9-8,9)
RETURN
40000 REM enput routine begins
ENROW% =VAL(MID$(ENSTAT$,1,2))
ENCOL% =VAL(MID$(ENSTAT$,3,2))
ENLEN% =VAL(MID$(ENSTAT$,5,2))
ENTEST%=VAL(MID$(ENSTAT$,7,1))
ENKIND%=VAL(MID$(ENSTAT$,8,1))
IF CLR%=1 THEN COLOR CLOR%(0)
40100 REM start & restart
LOCATE ENROW%,ENCOL%,0,0,7
IF ENKIND%=0 THEN PRINT (LEFT$(ENDFLT$+STRING$(ENLEN%,249),ENLEN%)); ELSE PRINT (RIGHT$(STR$(VAL(ENDFLT$)+10000000000#),ENLEN%));
ENPASS%=0
ENRETURN$=""
40200 REM cycle & recycle character collection
LOCATE ENROW%,(ENCOL%+ENPASS%),1,0,7
ENCHAR$=""
WHILE ENCHAR$=""
ENCHAR$=INKEY$
WEND
K%=ASC(ENCHAR$) : IF K%>96 AND K%<123 THEN ENCHAR$=CHR$(K%-32)
IF INSTR(ENTEST$(ENTEST%),ENCHAR$)>0 THEN GOTO 40300
IF LEN(ENCHAR$)=2 THEN ON INT((INSTR(ENTESTER2$,ENCHAR$)+1)/2) GOTO 40510,40520,40530,40540,40550,40560
ON INSTR(ENTESTER1$,ENCHAR$) GOTO 40580,40590,40600,40620,40630,40640,40650,40800
SOUND 50,3 : GOTO 40200
40300 REM valid character - process
IF ENPASS%>0 THEN GOTO 40400
PRINT STRING$(ENLEN%,249);
LOCATE ENROW%,ENCOL%,1,0,7
40400 REM skip field erase
ENPASS%=ENPASS%+1
PRINT ENCHAR$;
ENRETURN$=ENRETURN$+ENCHAR$
IF ENPASS%=ENLEN% THEN ENWAY%=0 : GOTO 40900
GOTO 40200
40500 REM branch control for special key pressed
40510 ENWAY%=1 : GOTO 40900 :REM up
40520 ENWAY%=2 : GOTO 40900 :REM down
40530 ENWAY%=3 : GOTO 40900 :REM left
40540 ENWAY%=4 : GOTO 40900 :REM rght
40550 ENWAY%=5 : GOTO 40900 :REM PgUp
40560 ENWAY%=6 : GOTO 40900 :REM PgDn
40580 ENWAY%=7 : GOTO 40900 :REM ESC
40590 ENWAY%=8 : GOTO 40900 :REM rase
40600 ENWAY%=9 : GOTO 40900 :REM alculator
40620 ENWAY%=10: GOTO 40900 :REM ase to target
40630 ENWAY%=11: GOTO 40900 :REM um
40640 ENWAY%=12: GOTO 40900 :REM od
40650 ENWAY%=0 : GOTO 40900 :REM CR
40800 REM backspace character pressed :REM BkSp
IF ENPASS%<2 THEN GOTO 40100 :REM start/restart
ENPASS%=ENPASS%-1
LOCATE ENROW%,ENCOL%+ENPASS%,0,0,7
PRINT CHR$(249);
ENRETURN$=LEFT$(ENRETURN$,ENPASS%)
GOTO 40200
40900 REM field exit - finish subroutine
IF ENPASS%<1 THEN ENRETURN$=ENDFLT$
IF ENKIND%=1 THEN ENRETURN$=RIGHT$(SPACE$(ENLEN%)+STR$(VAL(ENRETURN$)),ENLEN%)
LOCATE ENROW%,ENCOL%,0,0,7
IF ENKIND%=0 THEN PRINT (LEFT$(ENRETURN$+STRING$(ENLEN%,249),ENLEN%)); ELSE PRINT (RIGHT$(STR$(VAL(ENRETURN$)+10000000000#),ENLEN%));
RETURN
41000 REM establish test strings required by enput routine
ENTESTER2$= CHR$(0)+"H"+CHR$(0)+"P"+CHR$(0)+"K"+CHR$(0)+"M"
ENTESTER2$=ENTESTER2$+CHR$(0)+"I"+CHR$(0)+"Q"
ENTESTER1$=CHR$(27)+"ECBSM"+CHR$(13)+CHR$(8)
ENTEST$(5)="0123456789"
CLTEST$=CHR$(13)+"=+-/*"+CHR$(27)+"1234567890."+CHR$(8)
RETURN
58000 REM erase all fields
BASEDAY$=" "
BASEMONTH#=0
BASEDAY#=0
BASEYEAR#=0
BASEHOUR#=0
BASEMIN#=0
BASESEC#=0
TARGETDAY$=" "
TARGMONTH#=0
TARGDAY#=0
TARGYEAR#=0
TARGHOUR#=0
TARGMIN#=0
TARGSEC#=0
MODDAY#=0
MODHOUR#=0
MODMIN#=0
MODSEC#=0
SUMDAY#=0
SUMHOUR#=0
SUMMIN#=0
SUMSEC#=0
GREGMONTH#=1
GREGYEAR#=1
GOSUB 22000
GOSUB 33000
FOR C%=1 TO 13
LOCATE 5+C%,62
PRINT " ";
CLDISP$(C%)=""
NEXT
LOCATE 20,62
PRINT " ";
RETURN
65000 REM exit requested
CLS
erase ENTEST$,CLOR%,FMT$,CLDISP$,CLDISPC%
goto start