10REM >CALENDA 20REM v1.0E 02/98 Check PROCchoose c odes 30*FX6,13 40F%=TRUE :YR%=1998 50PROCinit :ON ERROR PROCerr 60MODE135 :PROCoff :PROCyear 70Day%=FNperams(yr%) :ea%=FNeaster(yr %) 80PROCload :PROCreminders 90IFHIMEM=&8000: F%=FALSE :MODE131 100PROCoff :PROCprintCal :GOTO60 110: 120DEF PROCyear :W%=-1 :REM Easter ini t 130PROCdh(0,3,CHR$134+CHR$157+CHR$132+ "CALENDAR / NOTEBOOK (3*A4) "+CHR$156) 140 PRINTTAB(7,6);CHR$134;"Years 1800 to 3000" 150PROCdh(8,8,CHR$(131)+"Year ? "+STR$ (YR%)) 160yr%=VALFNinput(17,8): IFyr%=0yr%=YR % 170YR%=yr%: IFyr%<1800 OR yr%>3000 VDU 7,7 :GOTO 160 180ENDPROC 190: 200DEF FNinput(x%,y%) :LOCALyr$ :yr$=" " 210REPEAT :G%=GET :IFG%=13 UNTILTRUE : =yr$ 220IFG%=127 AND LENyr$>0: yr$=LEFT$(yr $,LENyr$-1) 230IFG%<>127 AND LENyr$<4 yr$=yr$+CHR$ G% 240FOR n=0 TO 1: PRINTTAB(x%,y%+n)yr$; SPC4 :NEXT 250UNTIL 0 260: 270DEF PROCdh(x,y,word$) 280FOR n=0 TO 1 :PRINTTAB(x,y+n)CHR$14 1;word$ :NEXT 290ENDPROC 300: 310DEF PROCprintCal :IFF%VDU21 320FOR M%=1 TO 12 STEP 2 330 IF M%=1 OR M%=5 OR M%=9 PROCchoose 340 IFprt%=2 VDU 27,71 :REM D/S 350 PRINT"`"SPC(10);M$(M%);" ";yr%;TA B(36)"`"; 360 IFprt%=2 VDU 27,45,0 :REM U/L off 370 PRINTTAB(42); 380 IFprt%=2 VDU 27,45,1 :REM U/L on 390 PRINT"`"SPC(10);M$(M%+1);" ";yr%; TAB(78)"`" 400 IFprt%=2 VDU 27,72 :REM D/S off 410 PROCdates(M%) 420 FOR N%=1 TO 31 430 IFprt%=2AND INSTR(D$(N%,0),"SU ")>0 VDU 27,71 :REM D/S 440 PRINT D$(N%,0); 450 IFprt%=2 VDU 27,45,0,27,72 :RE M U/L & D/S off 460 PRINT TAB(42); 470 IFprt%=2 VDU 27,45,1 :REM U/L on 480 IFprt%=2 AND INSTR(D$(N%,1),"S U")>0 VDU 27,71 :REM D/S 490 PRINT D$(N%,1) 500 IFprt%=2 VDU 27,72 :REM D/S o ff 510 NEXT :PRINT :IF prt%=2PRINT'''''' ' 520NEXT 530IF prt%=2 PROCdly(3): VDU 27,64 :*F X3 540*FX21 550VDU6 :PRINT"<KEY>":IFGET 560ENDPROC 570: 580DEF PROCchoose :prt%=3:*FX3 590IFF%VDU6 600PRINT'M$(M%)" to "M$(M%+3)" ";yr%;" : Print <Yes/key>?"':*FX21 610IFF%VDU21 620IF(GETAND223)<>ASC"Y":ENDPROC 630prt%=2:PROCprtchk:*FX3,10 640VDU 27,56 :REM paper out o ff 650VDU 27,65,10 :REM L/Feed n/72 660VDU 27,50 :REM Enable L/Fe ed (REM Line if not IBM mode) 670VDU 27,69 :REM Emph 680VDU 27,45,1 :REM U/L on 690ENDPROC 700: 710DEF PROCdates(month%) :LOCAL exit% :*FX3 720IFF%VDU6 730PRINT"Wait! "; :exit%=FALSE :colm%= 0 740REPEAT :IFcolm%=1 exit%=TRUE 750 date%=1 760 REPEAT :VDU ASC"-" 770 T$=LEFT$(STRING$(2-LENSTR$(date% )," ")+STR$(date%)+" "+MID$("M T W T F S SU",((Day%-1)*2)+1,2)+FNmonthly(date%,D ay%)+FNholls(month%,date%,Day%)+FNevent( month%+colm%,date%),36) 780 D$(date%,colm%) = T$+STRING$(36- LENT$," ")+"`" 790 date%=date%+1 :Day%=Day%+1 :IF D ay%=8 Day%=1 800 UNTIL (date%-1) = D(month%+colm%) 810 IF D(month%+colm%)<31 FOR N% = D(month%+colm%)+1 TO 31 :D$(N%,colm%)="` "+STRING$(35," ")+"`" :NEXT 820 colm%=1 830UNTIL exit% :PRINT :IFF%VDU21 840IF prt%=2: *FX3,10 850ENDPROC 860: 870 REM month,date,day 880DEF FNholls(m%,t%,d%) 890IF m%+colm%=Ea% AND t%=ea% :W%=0 := " Easter." 900IF W%>=0 W%=W%+1 910IF W%=49 :=" WhitSun." :REM 49 days after easter sunday 920IF m%+colm%=5 AND t%<8 AND d%=1 := " MayDay." :REM 1st Mon 930IF m%+colm%=5 AND t%>24 AND d%=1 := " Spring." :REM Last Mon 940IF m%+colm%=8 AND t%>24 AND d%=1 := " Summer." :REM Last Mon 950IF m%+colm%=3 AND t%>23 AND t%<31 A ND d%=7 :=" BST." :REM Last Sun before 31st 960IF m%+colm%=10 AND t%>23 AND t%<31 AND d%=7 :=" GMT." :REM Last Sun before 31st 970="" 980: 990DEF PROCinit :LOCAL I : name$="CALN OTE" 1000prt%=3 :new%=FALSE 1010DIM M$(12), D(12) ,D$(31,1), d$(12, 9), e$(12,9) 1020FOR I=0 TO 12:FOR g%=1 TO 9:d$(I,g% )="..":NEXT :NEXT 1030S$="JANFEBMARAPRMAYJUNJULAUGSEPOCTN OVDEC" 1040W$="MONTUEWEDTHUFRISATSUN" 1050RESTORE 1060FOR I=1 TO 12 :READ M$(I),D(I) :NEX T :D(0)=28 1070ENDPROC 1080: 1090 DATA January,31,February,28,March, 31,April,30,May,31,June,30,July,31,Augus t,31,September,30,October,31,November,30 ,December,31 1100: 1110DEF PROCdefaultRems :LOCAL I,m$,n$, m% 1120 RESTORE 1290 :m%=1 1130REPEAT :READ m$,n$ 1140IFm$<>"-1" d$(0,m%)=m$ :e$(0,m%)=n$ 1150 m%=m%+1 1160UNTIL m$="-1" 1170: 1180 RESTORE 1350 1190FOR I=1 TO 12 1200READ m$,n$ :m%=1 1210 REPEAT :READ m$,n$ 1220IFm$<>"-1" d$(I,m%)=m$ :e$(I,m%)=n$ 1230 m%=m%+1 1240 UNTIL m$="-1" 1250NEXT 1260ENDPROC 1270: 1280REM Date or Day, event. DATE REP EATED EVERY MONTH, DAY EVERY WEEK 1290DATA 2, Pension., SAT, Papers., -1, "" 1300: 1310REM Data format: Num, Month, Date,E vent., -1,"" MONTH SELECTED ITEMS 1320REM If month needs more Data lines, ONLY terminate last line with -1,"" 1330REM Month MUST remain in Upper case ! 1340: 1350 DATA 1 ,JAN, 1,New Year, -1,"" 1360 DATA 2 ,FEB, 14,Valentines., -1,"" 1370 DATA 3 ,MAR, 9,Mothers., 17,St.Pat ricks., -1,"" 1380 DATA 4 ,APR, 30,Water., -1,"" 1390 DATA 5 ,MAY, 30,Water., -1,"" 1400 DATA 6 ,JUN, 15,Fathers day., 21,L ongest day., 30,Water., -1,"" 1410 DATA 7 ,JUL, 31,T/V., -1,"" 1420 DATA 8 ,AUG, 29,Freds B/D., -1,"" 1430 DATA 9 ,SEP, 30,Water., -1,"" 1440 DATA 10,OCT, 7,Vera B/D., 23,Ella B/D., 31,Hallowe'en. Water., -1,"" 1450 DATA 11,NOV, 2,All Soul's Night., 5,Guy Fawkes., 30,Water., -1,"" 1460 DATA 12,DEC, 25,Christmas., -1,"" 1470: 1480REM month,date 1490DEF FNevent(m%,t%) :LOCALi%,i$ :i$= "" 1500FOR i%=1 TO 9 1510IF d$(m%,i%)=STR$(t%) i$=" "+e$(m%, i%) 1520NEXT 1530=i$ 1540: 1550REM date,day = 1 Mon - 7 Su n 1560DEF FNmonthly(t%,d%): LOCALa$,b$,i% : a$="": b$="" 1570FOR i%=1 TO 9 1580IF d$(0,i%)=MID$(W$,(d%-1)*3+1,3) a $=" "+e$(0,i%) 1590IF d$(0,i%)=STR$(t%) b$=" "+e$(0,i% ) 1600NEXT 1610=a$+b$ 1620: 1630DEF FNperams(yr%) :REM d%=Day of we ek, 1 Mon - 7 SUN 1640d%=(((yr%-1800)*365+(yr%-1800)DIV4) -(yr% DIV100-yr% DIV400-14)+3)MOD7 1650D(2)=28 :IF ((yr% DIV 4)*4=yr%) D(2 )=29 :d%=(d%+6)MOD7 :REM leap year 1660=d% 1670: 1680DEF FNeaster(Y%):LOCAL A,B,C,D,E,F, G,H,J,K,L,Q,month,day 1690B=Y% DIV 100 1700C=Y% MOD 100 1710A=(5*B+C) MOD 19 1720D=(3*B+75) DIV 4 1730E=(3*B+75) MOD 4 1740F=(8*B+88) DIV 25 1750H=(19*A+D-F) MOD 30 1760G=(A+11*H) DIV 319 1770J=(60*(5-E)+C) DIV 4 1780K=(60*(5-E)+C) MOD 4 1790L=(2*J-K-H+G) MOD 7 1800month=(H-G+L+110) DIV 30 1810Q=(H-G+L+110) MOD 30 1820day=(Q+5-month) MOD 32 1830Ea%=month 1840=day 1850: 1860DEF PROCprtchk:LOCALh%:h%=ADVAL(-4) :IFFNprton(h%):ENDPROC 1870PRINT 1880REPEAT:*FX15 1890PRINT" Enable Printer!";:VDU7 :PROC dly(2):PRINTSTRING$(15,CHR$127):VDU11 1900UNTILFNprton(h%) 1910ENDPROC 1920: 1930DEF FNprton(h%) 1940VDU2,1,0,1,0,1,0,1,0,1,0,1,0,3 :PRO Cdly(2) 1950=(ADVAL(-4)=h%) 1960: 1970DEF PROCdly(d%):TIME=0:REPEAT:UNTIL TIME>d%*100:ENDPROC 1980: 1990DEFPROCreminders:LOCAL N%,I%,g%,t%, D$,M$,P$,d$,n$,o$,t$ 2000M$="": new%=FALSE 2010CLS: PROCdh(1,2,CHR$135+CHR$157+CHR $132+" EDIT CALENDAR REMINDERS <Yes/No>? "+CHR$156) 2020REPEAT:o$=CHR$(GETAND223):UNTILINST R("YN",o$)>0 2030IFo$="N"AND new% PROCsave 2040IFo$="N":CLS: ENDPROC 2050PRINT'''"(S)elect Month for reminde rs;"''"(E)very Week/Month reminders;"''" Choose <S/E>?"; 2060REPEAT:o$=CHR$(GETAND223):UNTILINST R("SE",o$)>0 2070V%=VPOS+3 2080IFo$="E" g%=0 ELSE PRINTTAB(3,V%)"M ONTH REQ'D. <1-12>? "SPC5:VDU31,24,V%: I NPUT""g% :IFg%<1 ORg%>12 :GOTO 2080 2090REPEAT: IFo$="S"M$=MID$(S$,((g%-1)* 3)+1,3) 2100CLS: IF o$="E"PROCdh(0,0,CHR$135+CH R$157+CHR$132+"DAY IN EVERY WEEK, DATE E VERY MONTH "):ELSE PROCdh(0,0,CHR$135+CH R$157+CHR$132+" ("+M$(g%)+") Year "+STR$ (yr%)+" "+CHR$156) 2110 PRINT'" Item : When : Reminders"' STRING$(39,"-") 2120 FOR N%=1 TO9: PRINTSPC4;N%") : "; d$(g%,N%);TAB(14)": ";e$(g%,N%):NEXT 2130V%=VPOS: P$="<Z/X>month. ": IFo$="E "P$="" 2140PRINTTAB(0,V%+1)P$"<Rtn>exit. <Item >No. ?";: OSCLI"FX21": t$=GET$: I%=VAL(t $) 2150IFo$="S"AND INSTR("Zz",t$)>0 g%=g%- 1 :IFg%<1 g%=1: GOTO 2140 2160IFo$="S"AND INSTR("Xx",t$)>0 g%=g%+ 1 :IFg%>12 g%=12: GOTO 2140 2170IF INSTR("ZzXx",t$)>0 UNTIL0 2180IF I%=0 UNTIL TRUE :GOTO 2010 2190PRINTTAB(0,V%+1); 2200IF o$="S" t%=19: PRINT"<Rtn> Date i n ("M$") <1-";D(g%);"> ? .."; 2210IF o$="E" t%=8 :PRINT"<Rtn> Date or Day <MON-SUN>? ..."; 2220PRINTSPC10: VDU31,29,V%+1 :INPUT""D $ 2230IFD$=""GOTO 2270 2240d%=VALD$: IF d%>0 AND d%<=D(g%) d$( g%,I%)=STR$d% :GOTO 2270 2250IFLEND$>2d$="":FORN=1TO3:d$=d$+CHR$ (ASC(MID$(D$,N,1))AND223):NEXT:PROCcheck 2260IF d$(g%,I%)=""UNTIL0 2270PRINTTAB(0,V%+3)"<* to DEL>"''"<Rtn > Reminder ?"STRING$(t%,"-") :VDU31,16,V %+5 :INPUT""t$ 2280IFt$="*"e$(g%,I%)="":t$="": new%=TR UE 2290IFt$>""e$(g%,I%)=LEFT$(t$,t%): new% =TRUE 2300UNTIL0 2310ENDPROC 2320: 2330DEFPROCcheck:FORN=0TO6:IF MID$(W$,N *3+1,3)=d$: d$(g%,I%)=d$ 2340NEXT:ENDPROC 2350: 2360DEFPROCload :LOCALg%,I 2370ch%=OPENIN(name$) :IFch%=0PROCdefau ltRems:ENDPROC 2380FOR I=0 TO 12 2390FOR g%=1 TO 9 2400INPUT# ch%,d$(I,g%),e$(I,g%) 2410NEXT :NEXT :CLOSE# ch% 2420ENDPROC 2430: 2440DEFPROCsave :LOCALg%,I,ac$, A%,Y% 2450ac$="RW":IF(USR(&FFDA)AND&FF)=4 ac$ ="" 2460ch%=OPENIN(name$):CLOSE#ch%: IFch%> 0:OSCLI"ACC."+name$+" "+ac$ 2470ch%=OPENOUT(name$) 2480FOR I=0 TO 12 2490FOR g%=1 TO 9 2500PRINT# ch%,d$(I,g%),e$(I,g%) 2510NEXT :NEXT :CLOSE# ch% :new%=FALSE 2520ENDPROC 2530: 2540DEF PROCoff:VDU23,1,0;0;0;0;:ENDPRO C 2550DEF PROCon:VDU23,1,1;0;0;0;:ENDPROC 2560: 2570DEF PROCerr :LOCALp$: CLOSE#0 :IFpr t%=2VDU1,27,1,64 2580*FX3 2590*FX15 2600VDU6,23,1,1;0;0;0; :CLS 2610IFERR<>17CLS:REPORT:PRINT" at line ";ERL 2620IFnew%PRINT'"SAVE NEW DATA <Yes/key >?";:IFCHR$(GETAND223)="Y":PROCsave 2630PRINT''"FINISHED <Yes/Key>?";:IFCHR $(GETAND223)<>"Y":ENDPROC 2640PRINT''"FIN!" 2650END