[= 	Test Calendar

	grarls -png 720x800 calendar.grs 2019 4 EXAMPLES:/hols_2020_uk.txt

Parameters :-

Number year - full 4 digit year ( if 0 then the system will pick up current year )
Number keyday - weekday 1 to 7 for a week to be in the year ( if 0 then no week numbers shown )
Text hols - name of holiday file ( if missing no holidays will be shown )

    The UK holidays are not totally predictable so will need a separate
file for each year.



=]



TPen WeekNumPen = Pen { colour -> {70, 70, 70} };	[= light grey pen =]
TFont MainFont = Font { size -> 18 };
TBrush NatHolBrush = Brush { colour -> {80, 80, 80} };	[= very light grey brush =]


[= define types for the notable dates table =]
Type TNoteClass = ( National = "N", Personal = "P" );
Type TNoteDates = { TNoteClass class, Number month, Number dom };
Type TNoteArray = TNoteDates[];



Number YearHeight = 0;		[= height of the year title =]
Number DateWidth = 0;		[= width of individual date field =]
Number DateHeight = 0;		[= height the ste norma text =]
Number MonthWidth = 0;		[= width of a single month =]
Number MonthGutter = 0;		[= horizonal space between months =]
Number MonthHeight = 0;		[= Total height of month - month name, day names and data =]

Logical DoWeekNums = False;	[= Print absolute week numbers =]
Number AbsRow;			[= absolute row number =]
Number FirstTagRow, LastTagRow;	[= first and last rows to tag with week number =]
Number WeekNum = 0;		[= current week number =]

TNoteArray Notables;

Program(Number year = 0, Number keyday = 0, Text hols = Null )

	Logical ok;

    Begin

	[= set up the page canvas layout variables =]
	ok := Setup(MainFont, Canvas);
	If Not ok Then
		Return;
	EndIf;

	[= if the year is zero then get the current year form the system =]
	If year == 0 Then
		year := GetYear(Now());
	EndIf;

	[= set up the week number tagging =]
	ok := SetupWeekNums(year, keyday);
	If Not ok Then
		Return;
	EndIf;

	[= read in the notable dates =]
	Notables := ReadNotableDates(hols);

[=
	[= testing the reading of the date file =]
	If Notables <> Null Then
		Output Notables;
	EndIf;
=]
		
	[= can now draw the calendar =]
	Calendar(year) => MainFont;

	
    End;

Shape Calendar(Number year)

	Number month;
	Point corner;

    Begin

	[= write the year title =]
	YearTitle(year) => WeekNumPen;
	AbsRow := 0;
	WeekNum := 1;
	[= go through all the months =]
	For month From 1 To 12 Do

		corner := CalcCorner(month);

		OneMonth(year, month) => corner;
	EndFor;

    End;



Function Point CalcCorner(Number month)
	Point res;
	Number mont;
    Begin

	res.x := ( month - 1 ) Mod 3;
	res.y := ( month - 1 ) // 3;
	res.x := res.x * ( MonthWidth + MonthGutter ) + MonthGutter;
	res.y := res.y * MonthHeight + YearHeight;

	Return res;

    End;

Shape OneMonth(Number year, Number month)

	Number fistcol, monlen, dofm, dofw, row;
	Number centre;
	Point offset;
	Time date;
	Text str;
	TNoteClass noteclass;
	TFont namefont = Font {weight -> 75 };
    Begin

	monlen := MonthLen(year, month);
	[=Output year, month, monlen;=]

	centre := DateWidth * 5;

	[= if not starting on Monday need to skip forweard one row =]
	If GetWeekday(MakeDate(year, month, 1)) <> 1 Then
		AbsRow += 1;
	EndIf;

	date := MakeDate(year, month, 1);
	dofw := GetWeekday(date) - 1;
	[= get the month name =]
	str := Format(date, "N19d");
	TextBlock(str, halign -> Centre) =>  { centre , 0}, namefont;
	row := 1;
	DayTitles() => { 0, row * DateHeight};
	row += 1;
	[= go through the whole month =]
	For dofm From 1 To monlen Do		


		[= see if need to write week number =]
		If AbsRow >= FirstTagRow And AbsRow <= LastTagRow And ( dofw == 0 Or dofm == 1 ) Then
			offset.x := -DateWidth // 2;
			offset.y := row * DateHeight;
			str := Format(WeekNum, "I2r");
			TextBlock(str, halign -> Right) => offset, WeekNumPen;
		EndIf;

		str := Format(dofm, "I2r");
		offset.x := dofw * DateWidth * 3 // 2 + DateWidth;
		offset.y := row * DateHeight;

		noteclass := GetNotable(month, dofm);

		Select noteclass From

		    Case National Do
			Rectangle(-(DateWidth + 3), DateHeight, Filled)
					=> { offset.x + 1, offset.y }, NatHolBrush;

		    Case Personal Do
			Rectangle(-(DateWidth + 3), DateHeight) => { offset.x + 1, offset.y };

		EndSelect;

		TextBlock(str, halign -> Right) => offset;

		If dofw < 6 Then
			dofw += 1;
		Else
			dofw := 0;
			row += 1;
			[=  increment absolute week - if we wrote it =]
			If AbsRow >= FirstTagRow And AbsRow <= LastTagRow Then
				WeekNum += 1;
			EndIf;
			AbsRow += 1;
		EndIf;

	EndFor;

	

    End;



Function Logical Setup(TFont font, TCanvas canvas)

	Text str;
	Point textsize;
	Number dow;
    Begin
	[= format the widest =]
	str := Format(22, "I2r");
	textsize := TextSize(str, font);
	[=Output "Text Size", textsize;=]
	DateWidth := textsize.x;
	[= ensure is even - round up =]
	If ( DateWidth Mod 2 ) == 1 Then
		DateWidth += 1;
	EndIf;
	DateHeight := textsize.y;
	[= 7 * fieldwidth + 6 * halfwidth =]
	MonthWidth := DateWidth * 10;	
	[= space split between 2 gutter and 2 halfwidth margins =]
	MonthGutter := ( canvas.width - 3 * MonthWidth ) // 4;


	[= temp =]
	MonthHeight := 9 * DateHeight;


	Return True;

      OnError
	Output Status;
	Return False;
    End;


[=		DAY TITLES
		----------
	    Draw the line of day titles. "Mo", "Tu" etc.
=]
Shape DayTitles()

	Time date = '2000-01-01';
	Number day, dow, centre;
	Text dayname;
	TFont dayfont = Font { underline -> True };

    Begin

	For day From 1 To 7 Do

		dow := GetWeekday(date);
		dayname := Format(date, "W2d");
		centre := ( dow - 1) * 3 * DateWidth // 2 + DateWidth // 2;
		TextBlock(dayname, halign -> Centre) => { centre , 0}, dayfont;
	
		date := AddDays(date, 1);

	EndFor;

    End;



[=		YEAR TITLE
		----------
	    Write the year number at the top.
=]

Shape YearTitle(Number year)
	Number yheight = Font.size * 8;
	TFont yearfont;
	Text yearstr;
    Begin

	[= create the year font =]
	yearfont := Font { size -> yheight, typeface -> "Hobo Hollow", weight -> 75};	

	[= write the year =]
	yearstr := Format(year);

	[=Output yearstr;=]

	TextBlock(yearstr, halign -> Centre) => { Canvas.width // 2  , 0 }, yearfont;

	[= set the offset for the heading =]
	YearHeight := yheight + Font.size;


    End;


[========	LOCAL FUNCTION		========]


[=		GET NOTABLE
		-----------
	    See if date on list - not wery efficient.
=]
Function TNoteClass GetNotable(Number month, Number dom)

    Begin

	[= if theree was no natable date file return null =]
	If Notables == Null Then
		Return Null;
	EndIf;
	Over Notables As entry Do

		If entry.month == month And entry.dom == dom Then
			[=Output "Found";=]
			Return entry.class;
		EndIf;

	EndOver;

	[= not found, so explicitly retutrn null =]
	Return Null;

    End;



[=		MONTH LEN
		---------
	    Calculate the lenght of the specified month.
=]
Function Number MonthLen(Number year, Number month)

    Begin
	Select month From
	    Case 1, 3, 5, 7,8, 10, 12 Do
		[= long months =]
		Return 31;

	    Case 4, 6, 9, 11 Do
		[= short month =]
		Return 30;

	    Case 2 Do
		[= February - special case =]
		[= simple version - FIX LATER =]
		If year Mod 4 == 0 Then
			Return 29;
		Else
			Return 28;
		EndIf;

	EndSelect;

	Return 0;	[= should never reach here =]
	
    End;

[=		READ NOTABLE DATES
		------------------
	    Resd the array of notrable dates. If erro just
	return null.
=]
Function TNoteArray ReadNotableDates(Text hols)
    Begin

	If hols == Null Then
		Return Null;
	EndIf;
	Return ReadData(hols);


      OnError
	Return Null;
	
    End;

[=		SETUP WEEK NUMS
		---------------
	    Set up the week numbers.
=]
Function Logical SetupWeekNums(Number year, Number keyday)
	Number dow, totalrows, yearlength, month, prepad;
    Begin
	[= general check - ignore unless valid =]
	If keyday == Null Or keyday < 1 Or keyday > 7 Then
		[= use 0 as supression value =]
		FirstTagRow := 0;
		LastTagRow := 0;
		Return True;
	EndIf;

	[= get the year length - Jan 1st to next Jan 1st =]
	yearlength := DiffDays(MakeDate(year, 1, 1), MakeDate(year+1, 1,1 ));
	[= work out the total number of weeks ( inc. part weeks ) =]
	prepad := GetWeekday(MakeDate(year, 1, 1 )) - 1;
	totalrows := ( ( prepad + yearlength - 1 ) // 7 ) + 1;
	[= allow for intermonth gaps =]
	For month From 2 To 12 Do
		[= unless staer on monday there will be a gap =]
		If GetWeekday(MakeDate(year, month, 1)) <> 1 Then
			totalrows += 1;
		EndIf;
	EndFor;

	[= check 1st Jan =]
	dow := GetWeekday(MakeDate(year, 1, 1 ));
	[= see if quilifies =]
	If dow <= keyday Then
		FirstTagRow := 1;
	Else
		FirstTagRow := 2;
	EndIf;

	[= check 31st Dec =]
	dow := GetWeekday(MakeDate(year, 12, 31 ));
	[= see if qualifies =]
	If dow >= keyday Then
		[= tag the last row =]
		LastTagRow := totalrows;
	Else
		[= don't tag last row =]
		LastTagRow := totalrows - 1;
	EndIf;

	[=Output totalrows, FirstTagRow, LastTagRow;=]

	Return True;

      OnError
	[= just in case - bad year etc. =]
	Return False;

    End;