`CALENDAR VERSION 1.0 "Perpetual Calendar with notes"

RUN /CALL:CALENDAR

variable sp1month=5,  sp1week=9, sp1dow=2, sp1ndow=0, sp1dom=0  | variable (str) sp1name="Memorial Day"
variable sp2month=11, sp2week=0, sp2dow=5, sp2ndow=4, sp2dom=0  | variable (str) sp2name="Thanksgiving Day"
variable sp3month=12, sp3week=0, sp3dow=0, sp3ndow=0, sp3dom=25 | variable (str) sp3name="Christmas Day"
variable sp4month=2,   sp4week=0, sp4dow=0, sp4ndow=0, sp4dom=2  | variable (str) sp4name="Groundhog Day"
variable sp5month=10, sp5week=0, sp5dow=2, sp5ndow=2, sp5dom=0 | variable (str) sp5name="Columbus Day"
variable nsp=5

macro sphere
 `me sphere %1 month=%2 week=%3 dow=%4 ndow=%5 dom=%6 lastweek=%7
 if {sp%1month}<>%2 then exit
 if {sp%1dow}<>0 then if {sp%1dow}<>%4 then exit
 if {sp%1dom}<>0 then if {sp%1dom}<>%6 then exit
 if {sp%1week}<>0 then if {sp%1week}<>9 then if {sp%1week}<>%3 then exit
 if {sp%1week}=9 then if %7=0 then exit
 if {sp%1ndow}<>0 then if {sp%1ndow}<>%5 then exit
 special:=sp%1name
/

macro special `month, week, dow, ndow, dom, lastwk
 variable (str) special
 .sphere (nsp,1) 1, %1,%2,%3,%4,%5,%6
/

macro scanday
 idow:=idow+1
 if %1<1 then exit
 variable spcolor_%1=0
 ndow{idow}:=ndow{idow}+1
 .special {m},{iweek},{idow},{ndow{idow}},%1,{lastweek}
 if "{special}"<>"" then spcolor_%1:=7
/

macro scanweek
 if %1>%2 then exit
 iweek:=iweek+1
 lastweek:=0
 if {iweek}={nweeks} then lastweek:=1
 variable idow=0
 .scanday (7,1) %1,%2
/

macro scanmonth
 .resetmonth
 .scanweek (6,7) {day1}, {days}
/

macro resetmonth
 variable iweek=0
 variable lastweek=0
 variable nweeks=4
 macro t
  variable ndow{%%91}=0
 //
 .t (7,1) 1 
 if {days}>28 then nweeks:=5
 if {day1}>6 then nweeks:=6
/

macro month
 .scanmonth
 template montht "{month}-{y}" /size:large /gap:9
  "S"/cen/color=4|"M"/cen|"T"/cen|"W"/cen|"T"/cen|"F"/cen|"S"/cen
  expand week (6,7) {day1}, {days}
  break
  "Prior month" exit priormonth | "Next Month" exit nextmonth
  exit
 //
 .resetmonth
 exit montht
/

macro week
 variable idow=0
 set n=7
 if %1>%2 then set n=0 else set iweek={iweek} plus 1
 set lastweek=0
 if {iweek}={nweeks} then set lastweek=1
 set c=4
 %3
 expand day ({n},1) %1, %2
 " "
/

macro day
 set idow={idow} plus 1
 set s="%1"
 if %1<1 then set s=" ", note=""
 if %1>%2 then set s="", note=""
 if "{note}"<>"" then set ndow{idow}={ndow{idow}} plus 1
 variable rcolor=99
 set note=".note {y},{m},%1,{iweek},{idow},{ndow{idow}},{lastweek} /persist:refresh"
 if vexist note_{m}_%1_color then set rcolor={note_{m}_%1_color}
 if %1>0 then if {spcolor_%1}<>0 then set rcolor={spcolor_%1}
 if {rcolor}<>99 then set note="{note} /bg:{color{rcolor}}"
 "{s}" {note} /color:{c} /cen /bold |
 set c=0
/

variable (str) note

macro note `%1: year; %2: month; %3: day; %4: iweek; %5: idow; %6: ndow; %7: lastweek
 iweek:=0
 macro t
  ndow%%91:=0
 //
 .t (7,1) 1
 .special %2,%4,%5,%6,%3,%7
 if not vexist note_%2_%3_A then variable (str) note_%2_%3_A
 if not vexist note_%2_%3_B then variable (str) note_%2_%3_B
 if not vexist note_%2_%3_C then variable (str) note_%2_%3_C
 if not vexist note_%1_%2_%3_A then variable (str) note_%1_%2_%3_A
 if not vexist note_%1_%2_%3_B then variable (str) note_%1_%2_%3_B
 if not vexist note_%1_%2_%3_C then variable (str) note_%1_%2_%3_C
 template notet "Note on %2/%3" /gap:0 /pos:rigbotadj /bg:FFFFFF
  " {special}"
  "   Every year:"  
  break
  "   "|note_%2_%3_A /WID:25 |"   "
  |note_%2_%3_B
  |note_%2_%3_C
  break
  "   This year only:"
  "   "|note_%1_%2_%3_A /WID:25 |"   "
  |note_%1_%2_%3_B
  |note_%1_%2_%3_C
  break line
  "" /WID:7 | "Color:" |,
   "" /bg:{color0} radio rcolor |,
   "" /bg:{color1} radio rcolor |,
   "" /bg:{color2} radio rcolor |,
   "" /bg:{color3} radio rcolor |,
   "" /bg:{color4} radio rcolor |,
   "" /bg:{color5} radio rcolor |,
   "" /bg:{color6} radio rcolor
  break
  "Accept" exit /start
  "Delete" exit
 //
 if "{special}"="" then if vexist note_%2_%3_Color then rcolor:=note_%2_%3_Color
 if {rcolor}>6 then rcolor:=0
 .notet
 if "{special}"="" then variable note_%2_%3_Color={rcolor}
 `me {templok}
 if {templok}<>28 then exit
 `clear (note_%1_%2_%3_*) variables
 clear (note_%2_%3_*) variables
/

variable (str) color0="14", 
                   color1="AAAAFF",
                   color2="2", 
                   color3="3",
                   color4="4",
                   color5="5",
                   color6="6",
                   color7="FF5544"

macro priormonth
 mo:=mo-1 | if {mo}<1 then mo:=12 |  yr:=yr-1 | y:=yr
 m:=mo
 .days
 day1:=day1-35+days
 if {day1}<-5 then day1:=day1+7
/

macro nextmonth
 mo:=mo+1 | if {mo}>12 then mo:=1 | yr:=yr+1 | y:=yr
 exit advancemonth
/

macro advancemonth
 m:=m+1 | if {m}>12 then m:=1 | y:=y+1
 day1:=day1+28-days
 if {day1}<-5 then day1:=day1+7
/

macro days
 imo:=m*2-1
 month:=item(imo,months)
 imo:=imo+1
 days:=item(imo,months)
/

macro doyear
 `if "{noscan}"<>"" then .scanyear
 .days
 if {m}=2 then days:=days+leap
 if {mo}={m} then exit month 
 exit advancemonth
/

macro skipyear
 day1:=day1-1-leap
 if {day1}<-5 then day1:=day1+7
 y:=y+1
/

macro isdiv
 if {trunc(y/%1)*%1}<>{y} then j:=0 else j:=1
/

macro maybleap
 .isdiv 4
 leap:=0
 if {j}=0 then exit
 .isdiv 100 | if {j}<>0 then .isdiv 400 | if {j}=0 then exit
 leap:=1
/

macro calendar1
 .maybleap
 if {y}<{yr} then .skipyear else .doyear 
 if {templok}=0 then exit ask
 exit calendar1
/

variable j, n, days, leap, c, imo, prior
variable (str) s, month, months
set months="January 31, February 28, March 31,
April 30, May 31, June 30,
July 31, August 31, September 30,
October 31, November 30, December 31"
variable y0=1583, day0=-5
variable yr:{y0}:9999, mo:1:12

macro ask
 template ask1 "Perpetual Calendar" /size:large
  "Year" yr /dec:0
  "Month" mo /dec:0
  break line
  "OK","E_xit" exit /start
 //
 .ask1
 variable m=1, y={y0}, day1={day0}
 if {templok}<>0 then .calendar1
 write (variables) ^calendarnotes.dat /name:note_*
/
if fexist ^calendarnotes.dat then run ^calendarnotes.dat /call /quiet
yr:=left(4,date) |  mo:=left(2,slice(6,date))
end calendar.ask