10REM >DyWkTst
20REM by Steven Flintham
30REM
40REM Monday 19th January 1997
50REM Tuesday 20th January 1997
60:
70MODE 7:PROCcursor`off
80PROCdisable
90PROCinit
100REPEAT
110choice%=FNmenu
120IF choice%=1 THEN PROCexample
130IF choice%=2 THEN PROCtest
140UNTIL choice%=3
150MODE 7
160PROCenable
170END
180:
190DEF PROCdisable
200*FX229,1
210*FX4,1
220ENDPROC
230:
240DEF PROCenable
250*FX229
260*FX4
270ENDPROC
280:
290DEF PROCcursor`off
300VDU 23,1,0;0;0;0;
310ENDPROC
320:
330DEF PROCcursor`on
340VDU 23,1,1;0;0;0;
350ENDPROC
360:
370DEF PROCinit
380LOCAL read%
390DIM dim%(12),dow$(6),month$(12),cum
ulative`dim%(12)
400ON ERROR IF ERR=17 THEN PROCdisable
:PROCcursor`off:GOTO 100 ELSE MODE 7:REP
ORT:PRINT " at line ";ERL:PROCenable:END
410PROCtitle
420RESTORE
430FOR read%=1 TO 12:READ dim%(read%):
NEXT
440FOR read%=0 TO 6:READ dow$(read%):N
EXT
450FOR read%=1 TO 12:READ month$(read%
):NEXT
460FOR read%=1 TO 12:READ cumulative`d
im%(read%):NEXT
470ENDPROC
480:
490DATA 31,28,31,30,31,30,31,31,30,31,
30,31
500DATA Sunday,Monday,Tuesday,Wednesda
y,Thursday,Friday,Saturday
510DATA January,February,March,April,M
ay,June,July,August,September,October,No
vember,December
520DATA 0,31,59,90,120,151,181,212,243
,273,304,334
530:
540DEF PROCtitle
550VDU 26,12
560PRINTTAB(5);CHR$141;CHR$132;CHR$157
;CHR$135;"Day of the week tester ";CHR$
156
570PRINTTAB(5);CHR$141;CHR$132;CHR$157
;CHR$135;"Day of the week tester ";CHR$
156
580PRINTTAB(7);CHR$131;"(C) Steven Fli
ntham 1998"
590VDU 28,0,24,39,4
600ENDPROC
610:
620DEF FNmenu
630LOCAL key%
640CLS
650PRINT "1) Worked example"
660PRINT "2) Test"
670PRINT "3) Quit"
680PRINT'"Your choice?";CHR$131;
690*FX21
700REPEAT
710key%=GET-48
720UNTIL key%>=1 AND key%<=3
730PRINT ;key%
740=key%
750:
760DEF PROCexample
770LOCAL date$,base`day%,last`two%,Q%,
R%,Q2%,doomsday%,text$,special`day%,spec
ial`day$,day$
780CLS
790PRINT "Enter the date to use for th
e example inthe form DD/MM/YYYY, or pres
s RETURN forthe main menu."
800PRINT'"Date:";CHR$131;
810date$=FNinput(0,10,"0123456789/")
820IF date$="" THEN ENDPROC
830IF NOT FNvalid`date(date$) THEN REP
EAT:PRINT''"Sorry, that is an invalid da
te."''"Date:";CHR$131;:date$=FNinput(0,1
0,"0123456789/"):UNTIL FNvalid`date(date
$) OR date$=""
840IF date$="" THEN ENDPROC
850CLS
860PRINT CHR$132;CHR$157;CHR$131;"Doom
sday ";CHR$156'
870IF year%<=1999 THEN base`day%=3 ELS
E base`day%=2
880last`two%=year% MOD 100:last`two$=R
IGHT$(STR$(year%),2)
890Q%=last`two% DIV 12:R%=last`two% MO
D 12:Q2%=R% DIV 4
900doomsday%=(base`day%+Q%+R%+Q2%) MOD
7
910IF doomsday%<>FNdoomsday(year%) THE
N PRINT "The program cannot handle the y
ear ";year%;";please report the bug."':P
ROCenable:PROCcursor`on:END
920text$="The last two digits of the y
ear are "+last`two$+". "+last`two$+"/12=
"+STR$(last`two% DIV 12)+" remainder "+S
TR$(last`two% MOD 12)+", so Q="+STR$(Q%)
+" and R="+STR$(R%)+". "
930text$=text$+"R/4="+STR$(R% DIV 4)+"
remainder "+STR$(R% MOD 4)+", so Q2="+S
TR$(Q2%)+". "
940text$=text$+"For "+LEFT$(STR$(year%
),2)+"xx years, the Doomsday is "+dow$(b
ase`day%)+" + Q + R + Q2, i.e. "+dow$(ba
se`day%)+"+"+STR$(Q%+R%+Q2%)+", which is
"+dow$(doomsday%)+"."
950PROCpretty`print(text$,135,TRUE)
960PRINT'CHR$132;CHR$157;CHR$131;"Day
of the week ";CHR$156'
970special`day%=FNspecial`day(month%,y
ear%)
980special`day$=month$(month%)+" "+STR
$(special`day%)+FNrd(special`day%)
990text$=special`day$+" falls on Dooms
day"
1000IF day%=special`day% THEN text$=tex
t$+", so it's a "+dow$(doomsday%)+"."
1010IF day%<special`day% THEN text$=tex
t$+". "+month$(month%)+" "+STR$(day%+7)+
FNrd(day%+7)+" falls on the same day of
the week as "+month$(month%)+" "+STR$(da
y%)+FNrd(day%)+", so work with that as i
t falls after the special day. "
1020IF day%<special`day% THEN day%=day%
+7:PROCpretty`print(text$,135,TRUE):PRIN
T
1030day$=month$(month%)+" "+STR$(day%)+
FNrd(day%)
1040IF day%>special`day% THEN text$=day
$+" is "+STR$(day%-special`day%)+" day"+
FNs(day%-special`day%)+" after "+special
`day$+", so it falls on "+dow$(doomsday%
)+"+"+STR$(day%-special`day%)+", i.e. "+
dow$((doomsday%+day%-special`day%) MOD 7
)+"."
1050PROCpretty`print(text$,135,TRUE)
1060PRINT'"Press SPACE to continue...";
1070*FX21
1080REPEAT UNTIL GET=32
1090ENDPROC
1100:
1110DEF FNinput(min%,max%,allow$)
1120LOCAL string$,key$
1130string$=""
1140PRINT STRING$(max%,".");STRING$(max
%,CHR$8);
1150PROCcursor`on
1160*FX21
1170REPEAT
1180REPEAT
1190key$=GET$
1200UNTIL (INSTR(allow$,key$)<>0 AND LE
N(string$)<max%) OR (LEN(string$)>0 AND
key$=CHR$127) OR (LEN(string$)>=min% AND
key$=CHR$13)
1210IF INSTR(allow$,key$)<>0 THEN PRINT
;key$;:string$=string$+key$
1220IF key$=CHR$127 THEN VDU 8,ASC".",8
:string$=LEFT$(string$,LEN(string$)-1)
1230UNTIL key$=CHR$13
1240PROCcursor`off
1250=string$
1260:
1270REM This returns the day, month and
year in day%, month% and year% if it
1280REM returns TRUE.
1290DEF FNvalid`date(date$)
1300LOCAL first%,last%
1310first%=INSTR(date$,"/")
1320IF first%=0 THEN =FALSE
1330last%=INSTR(date$,"/",first%+1)
1340IF last%=0 THEN =FALSE
1350day%=VAL(LEFT$(date$,first%-1))
1360month%=VAL(MID$(date$,first%+1,last
%-first%-1))
1370year%=VAL(MID$(date$,last%+1))
1380IF year%<100 THEN year%=year%+1900
1390IF year%<1900 OR year%>=2100 THEN =
FALSE
1400IF month%<1 OR month%>12 THEN =FALS
E
1410IF day%<1 OR day%>FNdays`in`month(m
onth%,year%) THEN =FALSE
1420=TRUE
1430:
1440DEF FNdays`in`month(month%,year%)
1450IF NOT FNleap`year(year%) THEN =dim
%(month%)
1460IF month%=2 THEN =29 ELSE =dim%(mon
th%)
1470:
1480DEF FNleap`year(year%)
1490IF (year% MOD 4)<>0 THEN =FALSE
1500IF (year% MOD 100)=0 AND (year% MOD
400)<>0 THEN =FALSE
1510=TRUE
1520:
1530REM N%=TRUE means go onto a new lin
e afterwards
1540DEF PROCpretty`print(T$,C%,N%)
1550REPEAT
1560IF LEN(T$)<40 THEN PRINT CHR$(C%);T
$;SPC((39-LEN(T$))*-N%);:T$="" ELSE A%=I
NSTR(T$," ",41):A%=A%+(A%=0)*-40:REPEAT:
A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRINT CH
R$(C%);LEFT$(T$,A%-1);SPC(40-A%);:T$=MID
$(T$,A%+1)
1570UNTIL T$=""
1580ENDPROC
1590:
1600DEF FNdoomsday(year%)
1610IF FNleap`year(year%) THEN =FNdow(2
9,2,year%) ELSE =FNdow(28,2,year%)
1620:
1630REM This only works for 1900-2099 i
nclusive
1640DEF FNdow(day%,month%,year%)
1650=(FNday`num(day%,month%,year%) MOD
7)
1660:
1670REM This only works for 1900-2099 i
nclusive
1680DEF FNday`num(day%,month%,year%)
1690LOCAL day`num%
1700day`num%=day%+FNcumulative`diy(year
%-1)+cumulative`dim%(month%)
1710IF month%>2 AND FNleap`year(year%)
THEN day`num%=day`num%+1
1720=day`num%
1730:
1740REM This only works for 1899-2099 i
nclusive
1750DEF FNcumulative`diy(year%)
1760LOCAL leap`years%
1770leap`years%=(year%-1900) DIV 4
1780=365*(year%-1899-leap`years%)+366*l
eap`years%
1790:
1800DEF FNspecial`day(month%,year%)
1810IF month%>=4 AND (month% MOD 2)=0 T
HEN =month%
1820IF month%=3 THEN =0
1830IF month%=5 THEN =9
1840IF month%=9 THEN =5
1850IF month%=7 THEN =11
1860IF month%=11 THEN =7
1870IF month%=1 AND FNleap`year(year%)
THEN =4
1880IF month%=2 AND FNleap`year(year%)
THEN =1
1890IF month%=1 THEN =3
1900IF month%=2 THEN =0
1910END
1920:
1930DEF FNrd(day%)
1940IF day%=1 OR day%=21 OR day%=31 THE
N ="st"
1950IF day%=2 OR day%=22 THEN ="nd"
1960IF day%=3 OR day%=23 THEN ="rd"
1970="th"
1980:
1990DEF FNs(num%)
2000IF num%=1 THEN ="" ELSE ="s"
2010:
2020DEF PROCtest
2030LOCAL first%,last%,correct%,min`tim
e%,max`time%,total`time%,question%,year%
,month%,day%,key$,time%,dow%,correct`dow
%
2040CLS
2050PRINT "The test is on a range of ye
ars. You canpress ESCAPE at any point to
return to"'"the menu."
2060REM MUST *FX229,1 ON EXIT
2070*FX229
2080REPEAT
2090PRINT'"First year (1900-2099):";CHR
$131;
2100first%=VAL(FNinput(4,4,"0123456789"
))
2110IF first%<1900 OR first%>2099 THEN
PRINT''"Sorry, that is an invalid year."
2120UNTIL first%>=1900 AND first%<=2099
2130PRINT
2140REPEAT
2150PRINT'"Last year (";STR$(first%);"-
2099):";CHR$131;
2160last%=VAL(FNinput(4,4,"0123456789")
)
2170IF last%<1900 OR last%>2099 OR last
%<first% THEN PRINT''"Sorry, that is an
invalid year."
2180UNTIL last%>=1900 AND last%<=2099 A
ND last%>=first%
2190correct%=0
2200min`time%=1E6:max`time%=-1:total`ti
me%=0
2210FOR question%=1 TO 10
2220CLS
2230PRINT "Question ";question%;" of 10
:"
2240IF first%=last% THEN year%=first% E
LSE year%=first%-1+RND(last%-first%+1)
2250month%=RND(12)
2260IF FNleap`year(year%) AND month%=2
THEN day%=RND(29) ELSE day%=RND(dim%(mon
th%))
2270PRINT'"What day of the week is ";RI
GHT$("00"+STR$(day%),2);"/";RIGHT$("00"+
STR$(month%),2);"/";STR$(year%);"?"
2280PRINT'"Q) Sunday"'"W) Monday"'"E) T
uesday"'"R) Wednesday"'"T) Thursday"'"Y)
Friday"'"U) Saturday"
2290PRINT'"Your answer?";CHR$131;
2300TIME=0
2310*FX21
2320REPEAT
2330key$=CHR$(GET AND &DF)
2340UNTIL INSTR("QWERTYU",key$)<>0
2350time%=TIME
2360IF time%<min`time% THEN min`time%=t
ime%
2370IF time%>max`time% THEN max`time%=t
ime%
2380total`time%=total`time%+time%
2390dow%=INSTR("QWERTYU",key$)-1
2400PRINT dow$(dow%)
2410correct`dow%=FNdow(day%,month%,year
%)
2420IF dow%=correct`dow% THEN PRINT'"Co
rrect!":correct%=correct%+1 ELSE PRINT'"
Incorrect - it's ";dow$(correct`dow%);".
"
2430TIME=0:REPEAT UNTIL TIME>=100
2440NEXT
2450*FX229,1
2460CLS
2470PRINT "You got ";correct%;" questio
n";FNs(correct%);" right out of 10."
2480PRINT'"Quickest answer:";CHR$131;mi
n`time%/100;"s"
2490PRINT "Slowest answer:";CHR$131;max
`time%/100;"s"
2500PRINT "Average answer time:";CHR$13
1;(total`time%/10)/100;"s"
2510PRINT'"Press SPACE to continue..."
2520*FX21
2530REPEAT UNTIL GET=32
2540ENDPROC
2550:
2560REM Crude test code
2570PROCinit
2580N%=1
2590FOR Y%=1900 TO 2099
2600PRINT Y%
2610FOR M%=1 TO 12
2620Z%=FNdays`in`month(M%,Y%)
2630FOR D%=1 TO Z%
2640IF N%<>FNday`num(D%,M%,Y%) THEN VDU
7:PRINT D%,M%,Y%:END
2650N%=N%+1
2660NEXT
2670NEXT
2680NEXT
2690PRINT "OK!"
2700END