8-Bit Software Online Conversion
Desk Diary - Listing
1REM >Calendar3
10REM Program Calendar
20REM Version B1.0
30REM Author Barry Thorpe
40REM BEEBUG December 1988
50REM Program subject to copyright
51REM Modified by Douglas Ambrose Mar
ch 1996 to give two
52REM weeks beginning on Sunday per A
4 page and including the
53REM phases of the moon. Printing st
ops at the end of each
54REM sheet until a fresh sheet has b
een inserted and a key
55REM pressed. The original numbering
is preserved and the
56REM lines introducing the modificat
ions do not end in zero.
57REM Phases of the moon are calculat
ed and stored in a file
58REM PMOON. It is assumed that the f
ile DATES exists.
59REM Entries in DATES must be of the
form day/month/detail,
60REM each on a new line, and there m
ust be an entry (dummy
61REM if necessary) for January and f
or a fictitious date
62REM following 31 December.
70:
100MODE7:PROCinit:ON ERROR GOTO210
110REMREPEAT
120RESTORE 190
130opt%=FNmenu("CALENDAR PRINTER",nite
ms%,maxlen%)
140IF opt%=1 THEN PROCdeskcal
150IF opt%=2 THEN PROCcheckfile
160REMUNTIL opt%=3
170REMMODE7:*FX4
175CLOSE#0:VDU14
180END
190DATA Desk calendar,Check date file,
Quit
200:
210CLOSE#0:VDU1,27,64,3:CLS:*FX15
215REM *FX15,0 flushes all buffers, *F
X15,1 flushes current input buffer.
220REMIF ERR=17 THEN GOTO110 ELSE REPO
RT:PRINT" in line ";ERL:END
221ON ERROR OFF:VDU3:VDU14:REPORT:PRIN
T" in line ";ERL:END
230:
999DEF FNN="DIARY"
1000DEF PROCinit
1010dy$=" ":mn$=dy$:rec$=STRING$(100,"
"):line$=rec$:rec$="":line$=""
1020DIM month$(12),daysinmonth%(12),day
$(6),mstart%(12),daynum%(12)
1030pagelen%=66:width%=132:margin%=6
1040REMS$=" ":U$=S$+STRING$(70,"`"):
dot$=S$+STRING$(70,".")
1045S$=" ":U$=S$+STRING$(70,"`"):dot
$=S$+STRING$(70,"=")
1050DIM insert$(10),errmess$(5),dayabbr
$(31)
1060errmess$(1)="day out of range":errm
ess$(2)="month out of range":errmess$(3)
="year out of range":errmess$(4)="printe
r not connected":errmess$(5)="File not f
ound"
1070RESTORE 1130
1080FOR N%=1 TO 12
1090READ month$(N%),daysinmonth%(N%)
1100daynum%(N%)=daynum%(N%-1)+daysinmon
th%(N%)
1110NEXT
1120FOR N%=0TO 6:READ day$(N%):NEXT
1130DATA JANUARY,31,FEBRUARY,28,MARCH,3
1,APRIL,30,MAY,31,JUNE,30
1140DATA JULY,31,AUGUST,31,SEPTEMBER,30
,OCTOBER,31,NOVEMBER,30,DECEMBER,31
1150DATA Saturday,Sunday,Monday,Tuesday
,Wednesday,Thursday,Friday
1160filechecked=FALSE:nitems%=3:maxlen%
=20
1170ENDPROC
1180:
1190DEF FNzeller(D%,M%,Y%)
1200K%=(60+(100/M%))DIV100:X%=365
1210F%=X%*Y%+D%+31*(M%-1)-INT(.4*M%+2.3
)*(1-K%)
1220F%=F%+(Y%-K%)DIV4-INT(.75*(Y%-K%)DI
V100+1)+700
1230=F%MOD 7
1240:
1250DEF FNleap(y%)
1260IF y% MOD 400=0 THEN =TRUE
1270IF y% MOD 4=0 AND y% MOD 100<>0 THE
N =TRUE
1280=FALSE
1290:
1300DEF FNyday(m%,d%)
1310IF m%=1 THEN =d%
1320LOCAL C%:tdays%=0
1330FOR C%=1 TO m%-1
1340tdays%=tdays%+daysinmonth%(C%)
1350NEXT
1360=tdays%+d%
1370:
1380DEF PROCtestbuffer
1390REMREPEAT:*FX21,3
1400probe1%=ADVAL(-4):VDU2,1,0,1,0,3:pr
obe2%=ADVAL(-4)
1410printerconnected=probe1%=probe2%
1413CLS:VDU14
1414PRINT"PRINTER ON?":C$=GET$
1415GOTO 1445
1420IF NOT printerconnected THEN CLS:PR
INT TAB(8,10)CHR$129 CHR$136"Please conn
ect printer"''TAB(8)"Press Return to go
on":REPEAT UNTIL GET=13
1430REMUNTIL printerconnected
1440REMVDU2,1,27,1,64,3
1445IF C$="Y" VDU2,1,27,1,64,3,15
1450ENDPROC
1460:
1470DEF PROCcentre(S$)
1480PRINTTAB((39-LENS$)DIV2)S$
1490ENDPROC
1500:
1510DEF FNmenu(T$,N%,L%)
1520LOCAL Y%,B$,S%:S%=3:VDU23,1,0;0;0;0
;:VDU26:CLS
1530FOR Y%=0 TO 1:PROCcentre(CHR$134+CH
R$157+CHR$132+CHR$141+T$+" "+CHR$156):
NEXT:PRINT
1540FOR Y%=1 TO N%:PRINTTAB(0,S%*Y%+1)
1550READ B$:PROCcentre(CHR$156+CHR$156+
CHR$134+LEFT$(B$+STRING$(L%," "),L%)+CHR
$156):NEXT
1560PRINTTAB(0,24)CHR$132CHR$157CHR$135
"Use up/down cursors: then Return"SPC2CH
R$156;:*FX4 1
1570Y%=1:L%=(34-L%)/2:PRINTTAB(L%,S%*Y%
+2)CHR$129CHR$157
1580REPEAT:REPEAT UNTIL GET:PRINTTAB(L%
,S%*Y%+2)CHR$156CHR$156:Y%=(Y%-INKEY-42+
INKEY-58+N%-1)MODN%+1:PRINTTAB(L%,S%*Y%+
2)CHR$129CHR$157:UNTIL INKEY-74:*FX4
1590VDU23,1,1;0;0;0;:=Y%
1600:
1610DEF PROCerror(n%)
1620L%=LEN(errmess$(n%))
1630PRINT'TAB((39-L%)DIV2)CHR$129CHR$13
6;errmess$(n%)
1640TIME=0:REPEAT UNTIL TIME>200
1650PRINTTAB((39-L%)DIV2,VPOS-1)SPC(L%+
2)
1660mistake=TRUE
1670ENDPROC
1680:
1690DEF PROCrepeat
1700CLS:PRINTTAB(5,10)CHR$135CHR$157CHR
$129"Repeat this routine Y/N "CHR$156;
1710REPEAT:A$=GET$
1720UNTIL INSTR("YNyn",A$)>0
1730norepeat=(INSTR("Nn",A$)>0)
1740ENDPROC
1750:
1760DEF PROCdeskcal
1770PROCtestbuffer
1780REMREPEAT
1790CLS:FORY%=0TO1:PROCcentre(CHR$134+C
HR$157+CHR$132+CHR$141+"DESK CALENDAR
"+CHR$156):NEXT
1800VDU28,0,24,39,3
1810PRINT''CHR$134;"Enter year required
: ";
1820REPEAT:mistake=FALSE
1830INPUTTAB(22,2)SPC6;TAB(22,2) year%
1840IF year%<1752 OR year%>4000 THEN PR
OCerror(3)
1850UNTIL NOT mistake
1860PRINT''CHR$131;"Enter number of fir
st month: ";
1870REPEAT:mistake=FALSE
1880INPUTTAB(30,5)" "TAB(30,5) startmo
nth%
1890IF startmonth%<1 OR startmonth%>12
THEN PROCerror(2)
1900UNTIL NOT mistake
1910PRINT''CHR$134;"Enter number of mon
ths: ";
1920REPEAT:mistake=FALSE
1930INPUTTAB(25,8)" "TAB(25,8) nm%
1940IF nm%>12 THEN PROCerror(2)
1950UNTIL NOT mistake
1955startmonth%=startmonth%-1:IF startm
onth%=0 startmonth%=12
1960month%=startmonth%:IF FNleap(year%)
THEN daysinmonth%(2)=29
1965IF startmonth%=12 year%=year%-1
1970day%=FNzeller(1,startmonth%,year%)
1980REMPROConepersheet
1985CLS:PROCmoon:PROConepersheet
1990REMVDU26,12:PROCrepeat
1995VDU26,12
2000daysinmonth%(2)=28
2010REMUNTIL norepeat
2020ENDPROC
2030:
2040DEF PROConepersheet
2042REM rday%, rmonth% - date for entry
from file DATES
2044REM month%=startmonth%; nm%=number
of months
2046REM day%=day of week, 0 (Saturday)
to 6 (Friday); dy%=day of month
2048REM bhd%=date of bankholiday; bhm%=
month of bank holiday
2050PROCcalc`hols(year%)
2055PRINT"Calculating holidays":GOTO 20
95
2060PRINT''CHR$131;"Is the text file DA
TES available?";
2070REPEAT:A$=GET$:UNTIL INSTR("YyNn",A
$):inserts=INSTR("Yy",A$)>0
2080IF inserts AND NOT filechecked THEN
PRINT'CHR$129 "File not checked: OK? ";
:REPEAT:A$=GET$:UNTIL INSTR("YNyn",A$):I
F INSTR("Nn",A$) THEN ENDPROC
2090IF inserts THEN X=OPENUP"DATES":REP
EAT PROCgetdaterec:UNTIL rmonth%>=month%
2095inserts=TRUE:X=OPENUP"DATES":REPEAT
PROCgetdaterec:UNTIL rmonth%>=month%
2096file%=OPENUP"PMOON":REPEAT PROCread
moon:UNTIL mmonth%=month%
2100IF month%=1 THEN I%=0 ELSE PROCfind
startofhols
2105REM I% is the number, 1 to 9 of ban
kholiday
2110PROCnextbankholiday
2112PROCdiscard
2115IF startmonth%=12 REPEAT PROCgetdat
erec:UNTIL rmonth%=month%
2116PROCcalc`hols(year%):IF month%=1 TH
EN I%=0 ELSE PROCfindstartofhols
2118PROCnextbankholiday
2119REPEAT:PROCreadmoon:UNTIL mmonth%=m
onth%
2120REMVDU2,1,27,1,69
2130FOR m%=1 TO nm%
2140REMT%=39-LEN(month$(month%))DIV2:PR
INT SPC(T%);month$(month%)" ";year%'
2145PROCprintmonth
2150FOR dy%=1 TO daysinmonth%(month%)
2160PRINT SPC(margin%);LEFT$(day$(day%)
,3);SPC(2+(dy%>9));dy%;SPC(2);
2170IF bhd%=dy% AND bhm%=month% THEN PR
INT bh$;:PROCnextbankholiday
2180IF inserts THEN PROCinsertrec ELSE
PRINT
2182PROCinsertmoon
2185PRINT:B%=B%+1
2190REMPRINT U$
2195IF day%=1 PRINT dot$ ELSE PRINT U$
2200day%=day%+1:IF day%=7 THEN day%=0
2207IF B%=14 A=GET:B%=0:PROCprintmonth
2210NEXT dy%
2220REML1%=pagelen%-(daysinmonth%(month
%)*2+2)
2230REMFOR K%=1 TO L1%:PRINT:NEXT
2240month%=month%+1:IF month%=13 THEN m
onth%=1:year%=year%+1:PROCcalc`hols(year
%):I%=0:PROCnextbankholiday
2250NEXT m%
2255PROCgather
2260REMIF inserts THEN CLOSE#X
2265CLOSE#X:VDU 1,27,1,64,3
2270daysinmonth%(2)=28
2280ENDPROC
2290:
2300DEF PROCgetdaterec
2310rec$="":A%=BGET#X:IF A%=ASC"|" THEN
CLOSE#X:inserts=FALSE:ENDPROC
2320REPEAT
2330rec$=rec$+CHR$(A%):A%=BGET#X
2340UNTIL A%=13
2350line$=rec$
2360slash%=INSTR(rec$,"/"):IF slash%=0
THEN rec$="":ENDPROC
2370rday%=VAL(LEFT$(rec$,slash%-1)):ms%
=slash%+1:slash%=INSTR(rec$,"/",ms%):IF
slash%=0 THEN rec$="":ENDPROC
2380rmonth%=VAL(MID$(rec$,ms%,slash%-ms
%)):rec$=MID$(rec$,slash%+1)
2390ENDPROC
2400:
2401DEF PROCprintmonth
2402T%=39-LEN(month$(month%))DIV2:PRINT
SPC(T%);month$(month%)" ";year%
2403ENDPROC
2404
2410DEF PROCinsertrec
2420IF dy%=rday% AND month%=rmonth% THE
N VDU1,27,1,70,1,15:PRINT " ";LEFT$(rec$
,70):VDU1,18,1,27,1,69:PROCgetdaterec:EN
DPROC
2430PRINT
2440ENDPROC
2450:
2460DEF PROCfindeasterin(X)
2470A=X-19*INT(X/19):B=INT(X/100)
2480C=X-100*B:D=INT(B/4)
2490E=B-4*D:G=INT((8*B+13)/25)
2500F=19*A+B-D-G+15:Z1=INT(F/30)
2510H=F-30*Z1:M=INT((A+11*H)/319)
2520I=INT(C/4):K=C-4*I
2530Q=2*E+2*I-K-H+M+32
2540Z2=INT(Q/7):L=Q-7*Z2
2550R=H-M+L+90:M%=R/25
2560Z3=INT((H-M+L+M%+19)/32)
2570D%=H-M+L+M%+19-32*Z3
2580ENDPROC
2590:
2600DEF PROCcalc`hols(Y%)
2610daysinmonth%(2)=28-FNleap(Y%)
2620LOCAL m%,M%,d%,D%
2630d%=FNzeller(1,1,Y%)
2640IF d%>1 THEN dy$="1" ELSE dy$=STR$(
3-d%)
2650insert$(1)="0"+dy$+"01Bank Holiday"
2660PROCfindeasterin(Y%)
2670insert$(3)=RIGHT$("0"+STR$(D%),2)+"
0"+STR$(M%)+"Easter Day"
2680m%=M%:d%=D%-2:IF d%<1 THEN d%=d%+31
:m%=M%-1
2690insert$(2)=RIGHT$("0"+STR$(d%),2)+"
0"+STR$(m%)+"Good Friday - b.h."
2700m%=M%:d%=D%+1:IF d%>31 THEN d%=1:m%
=m%+1
2710insert$(4)=RIGHT$("0"+STR$(d%),2)+"
0"+STR$(m%)+"Bank Holiday"
2720d%=FNzeller(1,5,Y%):C%=1
2730IF d%<>2 THEN REPEAT:d%=d%+1:C%=C%+
1:d%=ABS(d%<7)*d%:UNTIL d%=2
2740insert$(5)="0"+STR$(C%)+"05Bank Hol
iday"
2750d%=FNzeller(31,5,Y%):C%=31
2760IF d%<>2 THEN REPEAT:d%=d%-1:C%=C%-
1:d%=ABS(d%<0)*7+d%:UNTIL d%=2
2770insert$(6)=STR$(C%)+"05Bank Holiday
"
2780d%=FNzeller(31,8,Y%):C%=31
2790IF d%<>2 THEN REPEAT:d%=d%-1:C%=C%-
1:d%=ABS(d%<0)*7+d%:UNTIL d%=2
2800insert$(7)=STR$(C%)+"08Bank Holiday
"
2810d%=FNzeller(25,12,Y%):C%=1
2820insert$(8)="2512Christmas Day"
2830d%=FNzeller(26,12,Y%)
2840IF d%>2 THEN insert$(9)="2612Bank H
oliday" ELSE insert$(9)=STR$(26+2-d%)+"1
2Bank Holiday"
2850ENDPROC
2860:
2870DEF PROCnextbankholiday
2880I%=I%+1
2890bhd%=VAL(LEFT$(insert$(I%),2))
2900bhm%=VAL(MID$(insert$(I%),3,2))
2910bh$=" "+MID$(insert$(I%),5)
2920ENDPROC
2930:
2940DEF PROCfindstartofhols
2950I%=0:REPEAT:I%=I%+1:UNTIL VAL(MID$(
insert$(I%),3,2))>=month%
2960I%=I%-1
2970ENDPROC
2980:
2990DEF PROCcheckfile
3000CLS:inserts=TRUE:pyd%=0
3010errcount%=0:numentries%=0
3020X=OPENUP"DATES"
3030IF X=0 THEN PROCerror(5):ENDPROC
3040PRINT"ERRORS IN DATES"'
3050PROCgetdaterec
3060REPEAT
3070numentries%=numentries%+1
3080IF rec$="" THEN errcount%=errcount%
+1:PRINT;numentries% SPC(3) line$ ELSE P
ROCchecksequence
3090IF error THEN errcount%=errcount%+1
:PRINT;numentries% SPC(3) line$ " >> out
of sequence"
3100pyd%=yd%
3110PROCgetdaterec
3120UNTIL NOT inserts
3130PRINT';errcount%;" errors detected"
3135filechecked=(errcount%=0)
3150ENDPROC
3160:
3170DEF PROCchecksequence
3180error=FALSE
3190IF rmonth%<1 OR rmonth%>12 THEN err
or=TRUE:ENDPROC
3200IF rday%<1 OR rday%>daysinmonth%(rm
onth%) THEN error=TRUE:ENDPROC
3210yd%=FNyday(rmonth%,rday%)
3220IF yd%<=pyd% THEN error=TRUE
3230REM unless, of course, the calendar
crosses the new year
3240ENDPROC
3250
3260DEF PROCdiscard
3270B%=0:PRINT"Discarding preceding mon
th"
3280FOR dy%=1 TO daysinmonth%(month%)
3290PRINT SPC(margin%);LEFT$(day$(day%)
,3);SPC(2+(dy%>9));dy%;SPC(2);
3300IF bhd%=dy% AND bhm%=month% THEN PR
INT bh$;:PROCnextbankholiday
3310IF inserts THEN PROCinsertrec ELSE
PRINT
3315PROCinsertmoon
3320PRINT::B%=B%+1
3330IF day%=1 OR day%=6 PRINT dot$ ELSE
PRINT U$
3340day%=day%+1:IF day%=7 THEN day%=0
3350D%=daysinmonth%(month%)
3360REMIF D%-dy%<=14 AND day%=1 AND B%>
8 PRINT "Now we start":B%=0:A=GET
3370IF D%-dy%<=6 AND day%=1 PRINT "Now
we start: insert paper":B%=0:A=GET
3380IF C$="Y" AND B%=0 VDU2,1,27,1,69
3390IF dy%<daysinmonth%(month%) AND B%=
0 PROCprintmonth
3400NEXT dy%:month%=month%+1:IF month%=
13 month%=1:year%=year%+1
3410IF startmonth%=12 pointer%=0:PTR#X=
pointer%
3420ENDPROC
3430
3440DEF PROCgather
3450IF month%=13 PROCgetdaterec:month%=
1:year%=year%+1:PROCcalc`hols(year%):I%=
0:PROCnextbankholiday:X=OPENUP"DATES":PR
OCgetdaterec
3460PROCprintmonth
3470FOR dy%=1 TO 7
3480PRINT SPC(margin%);LEFT$(day$(day%)
,3);SPC(2+(dy%>9));dy%;SPC(2);
3490IF bhd%=dy% AND bhm%=month%-1 THEN
PRINT bh$;:PROCnextbankholiday
3500IF inserts THEN PROCinsertrec ELSE
PRINT
3505PROCinsertmoon
3510PRINT
3520IF day%=1 OR day%=6 PRINT dot$ ELSE
PRINT U$
3530day%=day%+1:IF day%=7 day%=0
3540IF day%=1 A=GET:ENDPROC
3550NEXT dy%
3560ENDPROC
3570
4000DEF PROCmoon
4005PRINT"Calculating phases of the moo
n"
4010DIM phase$(4)
4020phase$(1)="new moon":phase$(2)="fir
st quarter"
4030phase$(3)="full moon":phase$(4)="la
st quarter"
4040file%=OPENOUT"PMOON"
4050tzone=0
4060IM%=startmonth%:ID%=1:IY%=year%
4070timzon=-tzone/24
4080N%=INT(12.37*(IY%-1900+(IM%-.5)/12)
)
4090nphase%=2
4100PROCjulday(IM%,ID%,IY%)
4110J1%=JD%
4120PROCflmoon(N%,nphase%)
4130N%=INT(N%+(J1%-JD%)/28)
4140FOR J%=1 TO 7*(nm%+1)
4150PROCflmoon(N%,nphase%)
4160ifrac%=INT((24*(frac+timzon))+.5)
4170IF ifrac%<0 JD%=JD%-1:ifrac%=ifrac%
+24
4180IF ifrac%>=12 JD%=JD%+1:ifrac%=ifra
c%-12 ELSE ifrac%=ifrac%+12
4190PROCcaldat(JD%)
4200REM PRINT OD%,OM%,ifrac%,phase$(n
phase%+1)
4210PRINT#file%, OD%,OM%,ifrac%,phase$(
nphase%+1)
4220IF nphase%=3 nphase%=0:N%=N%+1 ELSE
nphase%=nphase%+1
4230NEXT J%
4240CLOSE#file%
4250ENDPROC
4260
4270DEF PROCflmoon(N%,nphase%)
4280C=N%+nphase%/4
4290T=C/1236.85
4300T2=T^2
4310AQ=359.2242+29.105366*C
4320AM=306.0253+385.816918*C+.01073*T2
4330JD%=2415020+28*N%+7*nphase%
4340xtra=.75933+1.53058868*C+(.0001178-
1.55E-7*T)*T2
4350IF nphase%=0 OR nphase%=2 xtra=xtra
+(.1734-.000393*T)*SIN(RAD(AQ))-.4068*SI
N(RAD(AM))
4360IF nphase%=1 OR nphase%=3 xtra=xtra
+(.1721-.0004*T)*SIN(RAD(AQ))-.628*SIN(R
AD(AM))
4370IF xtra>=0 I%=INT(xtra) ELSE I%=INT
(xtra-1)
4380JD%=JD%+I%
4390frac=xtra-I%
4400ENDPROC
4410
4420DEF PROCjulday(MM%,ID%,IY%)
4430igreg%=588829
4440IF IY%<0 IY%=IY%+1
4450IF MM%>2 JY%=IY%:JM%=MM%+1:ELSE JY%
=IY%-1:JM%=MM%+13
4460JD%=INT(365.25*JY%)+INT(30.6001*JM%
)+ID%+1720995
4470IF ID%+31*(MM%+12*IY%)>=igreg% JA%=
INT(.01*JY%):JD%=JD%+2-JA%+INT(.25*JA%)
4480ENDPROC
4490
4500DEF PROCcaldat(JD%)
4510igreg%=2299161
4520IF JD%>=igreg% jalpha%=INT(((JD%-18
67216)-.25)/36524.25): JA%=JD%+1+jalpha%
-INT(.25*jalpha%) ELSE JA%=JD%
4530JB%=JA%+1524
4540JC%=INT(6680+((JB%-2439870)-122.1)/
365.25)
4550JD%=365*JC%+INT(.25*JC%)
4560JE%=INT((JB%-JD%)/30.6001)
4570OD%=JB%-JD%-INT(30.6001*JE%)
4580OM%=JE%-1
4590IF OM%>12 OM%=OM%-12
4600OY%=JC%-4715
4610IF OM%>2 OY%=OY%-1
4620IF OY%<=0 OY%=OY%-1
4630ENDPROC
4640
4650DEF PROCreadmoon
4660INPUT#file%,mday%,mmonth%,ifrac%,ph
ase$
4670ENDPROC
4680
4690DEF PROCinsertmoon
4700IF dy%=mday% AND month%=mmonth% THE
N VDU1,27,1,70,1,15:PRINT phase$:VDU1,18
,1,27,1,69:PROCreadmoon:ENDPROC
4710PRINT:ENDPROC