51 lines
1.7 KiB
Text
51 lines
1.7 KiB
Text
calendar: procedure (year) options (main);
|
|
declare year character (4) varying;
|
|
declare (a, b, c) (0:5,0:6) character (3);
|
|
declare name_month(12) static character (9) varying initial (
|
|
'JANUARY', 'FEBRUARY', 'MARCH', 'APRIL', 'MAY', 'JUNE',
|
|
'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER');
|
|
declare i fixed;
|
|
declare (mm, mmp1, mmp2) pic '99';
|
|
|
|
put edit (center('CALENDAR FOR ' || YEAR, 67)) (a);
|
|
put skip (2);
|
|
|
|
do mm = 1 to 12 by 3;
|
|
mmp1 = mm + 1; mmp2 = mm + 2;
|
|
call prepare_month('01' || mm || YEAR, a);
|
|
call prepare_month('01' || mmp1 || YEAR, b);
|
|
call prepare_month('01' || mmp2 || YEAR, c);
|
|
|
|
put skip edit (center(name_month(mm), 23),
|
|
center(name_month(mmp1), 23),
|
|
center(name_month(mmp2), 23) ) (a);
|
|
put skip edit ((3)' M T W T F S S ') (a);
|
|
do i = 0 to 5;
|
|
put skip edit (a(i,*), b(i,*), c(i,*)) (7 a, x(2));
|
|
end;
|
|
end;
|
|
|
|
prepare_month: procedure (start, month);
|
|
declare month(0:5,0:6) character (3);
|
|
declare start character (8);
|
|
declare i pic 'ZZ9';
|
|
declare offset fixed;
|
|
declare (j, day) fixed binary (31);
|
|
declare (this_month, next_month, k) fixed binary;
|
|
|
|
day = days(start, 'DDMMYYYY');
|
|
offset = weekday(day) - 1;
|
|
if offset = 0 then offset = 7;
|
|
month = '';
|
|
do j = day by 1;
|
|
this_month = substr(daystodate(j, 'DDMMYYYY'), 3, 2);
|
|
next_month = substr(daystodate(j+1, 'DDMMYYYY'), 3, 2);
|
|
if this_month^= next_month then leave;
|
|
end;
|
|
i = 1;
|
|
do k = offset-1 to offset+j-day-1;
|
|
month(k/7, mod(k,7)) = i; i = i + 1;
|
|
end;
|
|
end prepare_month;
|
|
|
|
end calendar;
|