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