Calendar

You are encouraged to You are encouraged to solve this task according to the task description, using any language you may know.

Create a routine that will generate a text calendar for any year. Test the calendar by generating a calendar for the year 1969, on a device of the time. Choose one of the following devices:

A line printer with a width of 132 characters.

An IBM 3278 model 4 terminal (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.



(Ideally, the program will generate well-formatted calendars for any page width from 20 characters up.)

Kudos (κῦδος) for routines that also transition from Julian to Gregorian calendar.

This task is inspired by Real Programmers Don't Use PASCAL by Ed Post, Datamation, volume 29 number 7, July 1983.

THE REAL PROGRAMMER'S NATURAL HABITAT "Taped to the wall is a line-printer Snoopy calender for the year 1969."

For further Kudos see task CALENDAR, where all code is to be in UPPERCASE.

For economy of size, do not actually include Snoopy generation in either the code or the output, instead just output a place-holder.





Related task Five weekends







Translation of: Free Basic

This program uses no external functions but two ASSIST macros (XDECO, XPRNT) to keep the code as short as possible.

* calendar 08/06/2016

CALENDAR CSECT

USING CALENDAR,R13 base register

B 72(R15) skip savearea

DC 17F'0' savearea

STM R14,R12,12(R13) prolog

ST R13,4(R15) "

ST R15,8(R13) "

LR R13,R15 "

L R4,YEAR year

SRDA R4,32 .

D R4,=F'4' year//4

LTR R4,R4 if year//4=0

BNZ LYNOT

L R4,YEAR year

SRDA R4,32 .

D R4,=F'100' year//100

LTR R4,R4 if year//100=0

BNZ LY

L R4,YEAR year

SRDA R4,32 .

D R4,=F'400' if year//400

LTR R4,R4 if year//400=0

BNZ LYNOT

LY MVC ML+2,=H'29' ml(2)=29 leapyear

LYNOT SR R10,R10 ltd1=0

LA R6,1 i=1

LOOPI1 C R6,=F'31' do i=1 to 31

BH ELOOPI1

XDECO R6,XDEC edit i

LA R14,TD1 td1

AR R14,R10 td1+ltd1

MVC 0(3,R14),XDEC+9 sub(td1,ltd1+1,3)=pic(i,3)

LA R10,3(R10) ltd1+3

LA R6,1(R6) i=i+1

B LOOPI1

ELOOPI1 LA R6,1 i=1

LOOPI2 C R6,=F'12' do i=1 to 12

BH ELOOPI2

ST R6,M m=i

MVC D,=F'1' d=1

MVC YY,YEAR yy=year

L R4,M m

C R4,=F'3' if m<3

BNL GE3

L R2,M m

LA R2,12(R2) m+12

ST R2,M m=m+12

L R2,YY yy

BCTR R2,0 yy-1

ST R2,YY yy=yy-1

GE3 L R2,YY yy

LR R1,R2 yy

SRA R1,2 yy/4

AR R2,R1 yy+(yy/4)

L R4,YY yy

SRDA R4,32 .

D R4,=F'100' yy/100

SR R2,R5 yy+(yy/4)-(yy/100)

L R4,YY yy

SRDA R4,32 .

D R4,=F'400' yy/400

AR R2,R5 yy+(yy/4)-(yy/100)+(yy/400)

A R2,D r2=yy+(yy/4)-(yy/100)+(yy/400)+d

LA R5,153 153

M R4,M 153*m

LA R5,8(R5) 153*m+8

D R4,=F'5' (153*m+8)/5

AR R5,R2 ((153*m+8)/5+r2

LA R4,0 .

D R4,=F'7' r4=mod(r5,7) 0=sun 1=mon ... 6=sat

LTR R4,R4 if j=0

BNZ JNE0

LA R4,7 j=7

JNE0 BCTR R4,0 j-1

MH R4,=H'3' j*3

LR R10,R4 j1=j*3

LR R1,R6 i

SLA R1,1 *2

LH R11,ML-2(R1) ml(i)

MH R11,=H'3' j2=ml(i)*3

MVC TD2,BLANK td2=' '

LA R4,TD1 @td1

LR R5,R11 j2

LA R2,TD2 @td2

AR R2,R10 @td2+j1

LR R3,R5 j2

MVCL R2,R4 sub(td2,j1+1,j2)=sub(td1,1,j2)

LR R1,R6 i

MH R1,=H'144' *144

LA R14,DA-144(R1) @da(i)

MVC 0(144,R14),TD2 da(i)=td2

LA R6,1(R6) i=i+1

B LOOPI2

ELOOPI2 L R1,YEAR year

XDECO R1,PG+23 edit year

XPRNT PG,35 print year

MVC WDLINE,BLANK wdline=' '

LA R10,1 lwdline=1

LA R8,1 k=1

LOOPK3 C R8,=F'3' do k=1 to 3

BH ELOOPK3

LA R4,WDLINE @wdline

AR R4,R10 +lwdline

MVC 0(20,R4),WDNA sub(wdline,lwdline+1,20)=wdna

LA R10,20(R10) lwdline=lwdline+20

C R8,=F'3' if k<3

BNL ITERK3

LA R10,2(R10) lwdline=lwdline+2

ITERK3 LA R8,1(R8) k=k+1

B LOOPK3

ELOOPK3 LA R6,1 i=1

LOOPI4 C R6,=F'12' do i=1 to 12 by 3

BH ELOOPI4

MVC MOLINE,BLANK moline=' '

LA R10,6 lmoline=6

LR R8,R6 k=i

LOOPK4 LA R2,2(R6) i+2

CR R8,R2 do k=i to i+2

BH ELOOPK4

LR R1,R8 k

MH R1,=H'10' *10

LA R3,MO-10(R1) mo(k)

LA R4,MOLINE @moline

AR R4,R10 +lmoline

MVC 0(10,R4),0(R3) sub(moline,lmoline+1,10)=mo(k)

LA R10,22(R10) lmoline=lmoline+22

LA R8,1(R8) k=k+1

B LOOPK4

ELOOPK4 XPRNT MOLINE,L'MOLINE print months

XPRNT WDLINE,L'WDLINE print days of week

LA R7,1 j=1

LOOPJ4 C R7,=F'106' do j=1 to 106 by 21

BH ELOOPJ4

MVC PG,BLANK clear buffer

LA R9,PG pgi=0

LR R8,R6 k=i

LOOPK5 LA R2,2(R6) i+2

CR R8,R2 do k=i to i+2

BH ELOOPK5

LR R1,R8 k

MH R1,=H'144' *144

LA R4,DA-144(R1) da(k)

BCTR R4,0 -1

AR R4,R7 +j

MVC 0(21,R9),0(R4) substr(da(k),j,21)

LA R9,22(R9) pgi=pgi+22

LA R8,1(R8) k=k+1

B LOOPK5

ELOOPK5 XPRNT PG,L'PG print buffer

LA R7,21(R7) j=j+21

B LOOPJ4

ELOOPJ4 LA R6,3(R6) i=i+3

B LOOPI4

ELOOPI4 L R13,4(0,R13) epilog

LM R14,R12,12(R13) "

XR R15,R15 "

BR R14 exit

LTORG

YEAR DC F'1969' <==

MO DC CL10' January ',CL10' February ',CL10' March '

DC CL10' April ',CL10' May ',CL10' June '

DC CL10' July ',CL10' August ',CL10'September '

DC CL10' October ',CL10' November ',CL10' December '

ML DC H'31',H'28',H'31',H'30',H'31',H'30'

DC H'31',H'31',H'30',H'31',H'30',H'31'

WDNA DC CL20'Mo Tu We Th Fr Sa Su'

M DS F

D DS F

YY DS F

TD1 DS CL93

TD2 DS CL144

MOLINE DS CL66

WDLINE DS CL66

PG DC CL66' '

XDEC DS CL12

BLANK DC CL144' '

DA DS 12CL144

YREG

END CALENDAR

Output:

2016 January February March Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 6 4 5 6 7 8 9 10 8 9 10 11 12 13 14 7 8 9 10 11 12 13 11 12 13 14 15 16 17 15 16 17 18 19 20 21 14 15 16 17 18 19 20 18 19 20 21 22 23 24 22 23 24 25 26 27 28 21 22 23 24 25 26 27 25 26 27 28 29 30 31 29 28 29 30 31 April May June Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 1 1 2 3 4 5 4 5 6 7 8 9 10 2 3 4 5 6 7 8 6 7 8 9 10 11 12 11 12 13 14 15 16 17 9 10 11 12 13 14 15 13 14 15 16 17 18 19 18 19 20 21 22 23 24 16 17 18 19 20 21 22 20 21 22 23 24 25 26 25 26 27 28 29 30 23 24 25 26 27 28 29 27 28 29 30 30 31 July August September Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 1 2 3 4 5 6 7 1 2 3 4 4 5 6 7 8 9 10 8 9 10 11 12 13 14 5 6 7 8 9 10 11 11 12 13 14 15 16 17 15 16 17 18 19 20 21 12 13 14 15 16 17 18 18 19 20 21 22 23 24 22 23 24 25 26 27 28 19 20 21 22 23 24 25 25 26 27 28 29 30 31 29 30 31 26 27 28 29 30 October November December Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 1 2 3 4 5 6 1 2 3 4 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 31

We first specify a "Printable_Calendar" package (printable_calendar.ads). One can easily override the default names for weekdays and months, see the Calendar_-_for_"real"_programmers#Ada task.

with Ada. Calendar . Formatting ;



package Printable_Calendar is



subtype String20 is String ( 1 .. 20 ) ;

type Month_Rep_Type is array ( Ada. Calendar . Month_Number ) of String20;



type Description is record

Weekday_Rep: String20;

Month_Rep: Month_Rep_Type;

end record ;

-- for internationalization, you only need to define a new description



Default_Description: constant Description :=

( Weekday_Rep =>

"Mo Tu We Th Fr Sa So" ,

Month_Rep =>

( " January " , " February " , " March " ,

" April " , " May " , " June " ,

" July " , " August " , " September " ,

" October " , " November " , " December " ) ) ;



type Calendar ( <> ) is tagged private ;



-- Initialize a calendar for devices with 80- or 132-characters per row

function Init_80 ( Des: Description := Default_Description ) return Calendar;

function Init_132 ( Des: Description := Default_Description ) return Calendar;



-- the following procedures output to standard IO; override if neccessary

procedure New_Line ( Cal: Calendar ) ;

procedure Put_String ( Cal: Calendar; S: String ) ;



-- the following procedures do the real stuff

procedure Print_Line_Centered ( Cal: Calendar'Class; Line: String ) ;

procedure Print ( Cal: Calendar'Class;

Year: Ada. Calendar . Year_Number ;

Year_String: String ) ; -- this is the main Thing



private

type Calendar is tagged record

Columns, Rows, Space_Between_Columns: Positive;

Left_Space: Natural;



Weekday_Rep: String20;

Month_Rep: Month_Rep_Type;

end record ;



end Printable_Calendar;

We continue with the implementation (printable_calendar.ads):

with Ada. Text_IO ;



package body Printable_Calendar is



use Ada. Calendar ;

package F renames Ada. Calendar . Formatting ;



function Days_Per_Month ( Year: Year_Number; Month: Month_Number )

return Day_Number is

begin

case Month is

when 1 | 3 | 5 | 7 | 8 | 10 | 12 => return 31 ;

when 4 | 6 | 9 | 11 => return 30 ;

when 2 =>

if Year mod 4 /= 0 then

return 28 ;

elsif Year mod 100 /= 0 then

return 29 ;

elsif Year mod 400 /= 0 then

return 28 ;

else

return 29 ;

end if ;

end case ;

end Days_Per_Month;



type Full_Month_Rep is array ( 1 .. 6 ) of String20;

function Generate_Printable_Month ( Y: Ada. Calendar . Year_Number ;

M: Ada. Calendar . Month_Number )

return Full_Month_Rep is



X: Full_Month_Rep := ( others => " " ) ;

-- If X=Generate_Printable_Month(2011, 01), the result could be

-- " January ", -- Month_Rep(01)

-- "Mo Tu We Th Fr Sa Su" -- Weekday_Rep

-- " 1 2" -- X(1)

-- " 3 4 5 6 7 8 9" -- X(2)

-- "10 11 12 13 14 15 16" -- X(3)

-- "17 18 19 20 21 22 23" -- X(4)

-- "24 25 26 27 28 29 30" -- X(5)

-- "31 " -- X(6)



Row: Integer range 1 .. 6 := 1 ;

Day_Index: constant array ( F. Day_Name ) of Positive

:= ( 1 , 4 , 7 , 10 , 13 , 16 , 19 ) ;

begin

for I in 1 .. Days_Per_Month ( Y, M ) loop

declare

Weekday: constant F. Day_Name := F. Day_Of_Week ( F. Time_Of ( Y, M, I ) ) ;

Pos: constant Positive := Day_Index ( Weekday ) ;

Cleartext_Name: constant String := Day_Number'Image ( I ) ;

L: constant Positive := Cleartext_Name'Last;

begin

X ( Row ) ( Pos .. Pos + 1 ) := Cleartext_Name ( L- 1 .. L ) ;

if F. "=" ( Weekday, F. Sunday ) then

Row := Row + 1 ;

end if ;

end ;

end loop ;

return X;

end Generate_Printable_Month;





procedure Print ( Cal: Calendar'class;

Year: Ada. Calendar . Year_Number ;

Year_String: String ) is



The_Month: Month_Number := Month_Number'First;



procedure Write_Space ( Length: Natural ) is

begin

for I in 1 .. Length loop

Cal. Put_String ( " " ) ;

end loop ;

end Write_Space;



Year_Rep: array ( Month_Number ) of Full_Month_Rep;



begin

-- print the year

Cal. Print_Line_Centered ( Year_String ) ;



-- generate a printable form for all the months

for Month in Month_Number loop

Year_Rep ( Month ) := Generate_Printable_Month ( Year, Month ) ;

end loop ;



begin

while True loop



-- new line

Cal. New_Line ;



-- write month names

Write_Space ( Cal. Left_Space ) ;

for Month in The_Month .. The_Month +Cal. Columns - 2 loop

Cal. Put_String ( Cal. Month_Rep ( Month ) ) ;

Write_Space ( Cal. Space_Between_Columns ) ;

end loop ;

Cal. Put_String ( Cal. Month_Rep ( The_Month+Cal. Columns - 1 ) ) ;

Cal. New_Line ;



-- write "Mo Tu .. So" - or whatever is defined by Weekday_Rep

Write_Space ( Cal. Left_Space ) ;

for Month in The_Month .. The_Month +Cal. Columns - 2 loop

Cal. Put_String ( Cal. Weekday_Rep ) ;

Write_Space ( Cal. Space_Between_Columns ) ;

end loop ;

Cal. Put_String ( Cal. Weekday_Rep ) ;

Cal. New_Line ;



-- write the dates

for I in 1 .. 6 loop

Write_Space ( Cal. Left_Space ) ;

for Month in The_Month .. The_Month +Cal. Columns - 2 loop

Cal. Put_String ( Year_Rep ( Month ) ( I ) ) ;

Write_Space ( Cal. Space_Between_Columns ) ;

end loop ;

Cal. Put_String ( Year_Rep ( The_Month+Cal. Columns - 1 ) ( I ) ) ;

Cal. New_Line ;

end loop ;



The_Month := The_Month + Cal. Columns ;

-- this will eventually raise Constraint_Error to terminate the loop

end loop ;

exception

when Constraint_Error => null ;

end ;

end Print;



procedure New_Line ( Cal: Calendar ) is

begin

Ada. Text_IO . New_Line ;

end New_Line;



procedure Put_String ( Cal: Calendar; S: String ) is

begin

Ada. Text_IO . Put ( S ) ;

end Put_String;



procedure Print_Line_Centered ( Cal: Calendar'Class; Line: String ) is

Width : constant Positive := Cal. Columns * 20

+ ( Cal. Columns - 1 ) *Cal. Space_Between_Columns

+ Cal. Left_Space ;

begin

if Line'Length >= Width- 1 then

Cal. Put_String ( Line ) ;

Cal. New_Line ;

else

Print_Line_Centered ( Cal, " " & Line & " " ) ;

end if ;

end Print_Line_Centered;



function Init_80 ( Des: Description := Default_Description ) return Calendar is

X: Calendar:=

( Columns => 3 , Rows => 4 , Space_Between_Columns => 4 ,

Left_Space => 1 ,

Weekday_Rep => Des. Weekday_Rep ,

Month_Rep => Des. Month_Rep

) ;

begin

return X;

end Init_80;



function Init_132 ( Des: Description := Default_Description ) return Calendar is

X: Calendar:=

( Columns => 6 , Rows => 2 , Space_Between_Columns => 2 ,

Left_Space => 1 ,

Weekday_Rep => Des. Weekday_Rep ,

Month_Rep => Des. Month_Rep

) ;

begin

return X;

end Init_132;



end Printable_Calendar;

Now, the main program is really simple:

with Printable_Calendar;



procedure Cal is



C: Printable_Calendar. Calendar := Printable_Calendar. Init_80 ;



begin

C. Print_Line_Centered ( "[reserved for Snoopy]" ) ;

C. New_Line ;

C. Print ( 1969 , "Nineteen-Sixty-Nine" ) ;

end Cal;

Here is the output:

[reserved for Snoopy] Nineteen-Sixty-Nine January February March Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So 1 2 3 4 5 1 2 1 2 6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 31 April May June Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So 1 2 3 4 5 6 1 2 3 4 1 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 30 July August September Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So 1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 28 29 30 31 25 26 27 28 29 30 31 29 30 October November December Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So Mo Tu We Th Fr Sa So 1 2 3 4 5 1 2 1 2 3 4 5 6 7 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31



To get a 132-character-wide output, you just have to replace "Init_80" by "Init_132" in the main program.

Works with: ALGOL 68 version Revision 1 - no extensions to language used

#!/usr/local/bin/a68g --script #



PROC print calendar = ( INT year , page width ) VOID : (



[ ] STRING month names = (

"January" , "February" , "March" , "April" , "May" , "June" ,

"July" , "August" , "September" , "October" , "November" , "December" ) ,

weekday names = ( "Su" , "Mo" , "Tu" , "We" , "Th" , "Fr" , "Sa" ) ;

FORMAT weekday fmt = $g , n ( UPB weekday names - LWB weekday names ) ( " " g ) $ ;



# Juggle the calendar format to fit the printer/screen width #

INT day width = UPB weekday names [ 1 ] , day gap = 1 ;

INT month width = ( day width + day gap ) * UPB weekday names - 1 ;

INT month heading lines = 2 ;

INT month lines = ( 31 OVER UPB weekday names + month heading lines + 2 ) ; # +2 for head/tail weeks #

INT year cols = ( page width + 1 ) OVER ( month width + 1 ) ;

INT year rows = ( UPB month names - 1 ) OVER year cols + 1 ;

INT month gap = ( page width - year cols * month width + 1 ) OVER year cols ;

INT year width = year cols * ( month width + month gap ) - month gap ;

INT year lines = year rows * month lines ;



MODE MONTHBOX = [ month lines , month width ] CHAR ;

MODE YEARBOX = [ year lines , year width ] CHAR ;



INT week start = 1 ; # Sunday #



PROC days in month = ( INT year , month ) INT :

CASE month IN 31 ,

IF year MOD 4 EQ 0 AND year MOD 100 NE 0 OR year MOD 400 EQ 0 THEN 29 ELSE 28 FI ,

31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31

ESAC ;



PROC day of week = ( INT year , month , day ) INT : (

# Day of the week by Zeller’s Congruence algorithm from 1887 #

INT y := year , m := month , d := day , c ;

IF m <= 2 THEN m +:= 12 ; y -:= 1 FI ;

c := y OVER 100 ;

y %*:= 100 ;

( d - 1 + ( ( m + 1 ) * 26 ) OVER 10 + y + y OVER 4 + c OVER 4 - 2 * c ) MOD 7

) ;



MODE SIMPLEOUT = UNION ( STRING , [ ] STRING , INT ) ;



PROC cputf = ( REF [ ] CHAR out , FORMAT fmt , SIMPLEOUT argv ) VOID : (

FILE f ; STRING s ; associate ( f , s ) ;

putf ( f , ( fmt , argv ) ) ;

out [ : UPB s ] := s ;

close ( f )

) ;



PROC month repr = ( INT year , month ) MONTHBOX : (

MONTHBOX month box ; FOR line TO UPB month box DO month box [ line , ] := " " * 2 UPB month box OD ;

STRING month name = month names [ month ] ;



# center the title #

cputf ( month box [ 1 , ( month width - UPB month name ) OVER 2 + 1 : ] , $g$ , month name ) ;

cputf ( month box [ 2 , ] , weekday fmt , weekday names ) ;



INT first day := day of week ( year , month , 1 ) ;

FOR day TO days in month ( year , month ) DO

INT line = ( day + first day - week start ) OVER UPB weekday names + month heading lines + 1 ;

INT char = ( ( day + first day - week start ) MOD UPB weekday names ) * ( day width + day gap ) + 1 ;

cputf ( month box [ line , char : char + day width - 1 ] , $g ( - day width ) $ , day )

OD ;

month box

) ;



PROC year repr = ( INT year ) YEARBOX : (

YEARBOX year box ;

FOR line TO UPB year box DO year box [ line , ] := " " * 2 UPB year box OD ;

FOR month row FROM 0 TO year rows - 1 DO

FOR month col FROM 0 TO year cols - 1 DO

INT month = month row * year cols + month col + 1 ;

IF month > UPB month names THEN

done

ELSE

INT month col width = month width + month gap ;

year box [

month row * month lines + 1 : ( month row + 1 ) * month lines ,

month col * month col width + 1 : ( month col + 1 ) * month col width - month gap

] := month repr ( year , month )

FI

OD

OD ;

done : year box

) ;



INT center = ( year cols * ( month width + month gap ) - month gap - 1 ) OVER 2 ;

INT indent = ( page width - year width ) OVER 2 ;



printf ( (

$n ( indent + center - 9 ) k g l$ , "[Insert Snoopy here]" ,

$n ( indent + center - 1 ) k 4d l$ , year , $l$ ,

$n ( indent ) k n ( year width ) ( g ) l$ , year repr ( year )

) )

) ;



main : (

CO inspired by http :// www.ee.ryerson.ca /~ elf / hack / realmen.html

Real Programmers Don't Use PASCAL - Ed Post

Datamation , volume 29 number 7 , July 1983

THE REAL PROGRAMMER'S NATURAL HABITAT

"Taped to the wall is a line-printer Snoopy calender for the year 1969."

CO

INT mankind stepped on the moon = 1969 ,

line printer width = 80 ; # as at 1969! #

print calendar ( mankind stepped on the moon , line printer width )

)

Output:

[Insert Snoopy here] 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

Translation of: Simula

Translation of: C

which is a

This is pretty much the same as the Simula version.

The main differences are that the "for" loop counter in Algol W is a separate variable that only exists during execution of the loop whereas in Simula the loop counter must be declared outside the loop and has its value changed as the loop executes - hence some of the "for" loops have been replaced by "while" loops.

In Algol W, the condition of a "while" loop can be a block and the boolean "and" operator short circuits, which allow us to avoid the goto statements.

Also, the Algol W string type is fixed length, unlike the Simula text type.

BEGIN

INTEGER WIDTH, YEAR;

INTEGER COLS, LEAD, GAP;

STRING(2) ARRAY WDAYS (0::6);

RECORD MONTH ( STRING(9) MNAME; INTEGER DAYS, START_WDAY, AT_POS );

REFERENCE(MONTH) ARRAY MONTHS(0::11);

WIDTH := 80; YEAR := 1969;



BEGIN

WDAYS(0) := "Su"; WDAYS(1) := "Mo"; WDAYS(2) := "Tu";

WDAYS(3) := "We"; WDAYS(4) := "Th"; WDAYS(5) := "Fr"; WDAYS(6) := "Sa";

MONTHS( 0) := MONTH(" January", 31, 0, 0 );

MONTHS( 1) := MONTH(" February", 28, 0, 0 );

MONTHS( 2) := MONTH(" March", 31, 0, 0 );

MONTHS( 3) := MONTH(" April", 30, 0, 0 );

MONTHS( 4) := MONTH(" May", 31, 0, 0 );

MONTHS( 5) := MONTH(" June", 30, 0, 0 );

MONTHS( 6) := MONTH(" July", 31, 0, 0 );

MONTHS( 7) := MONTH(" August", 31, 0, 0 );

MONTHS( 8) := MONTH("September", 30, 0, 0 );

MONTHS( 9) := MONTH(" October", 31, 0, 0 );

MONTHS(10) := MONTH(" November", 30, 0, 0 );

MONTHS(11) := MONTH(" December", 31, 0, 0 )

END;



BEGIN



PROCEDURE SPACE(INTEGER VALUE N);

BEGIN

WHILE N > 0 DO BEGIN

WRITEON(" "); N := N-1;

END

END SPACE;



PROCEDURE INIT_MONTHS;

BEGIN

INTEGER I;



IF YEAR REM 4 = 0 AND YEAR REM 100 NOT = 0 OR YEAR REM 400 = 0 THEN

DAYS(MONTHS(1)) := 29;



YEAR := YEAR-1;

START_WDAY(MONTHS(0))

:= (YEAR * 365 + YEAR DIV 4 - YEAR DIV 100 + YEAR DIV 400 + 1) REM 7;



FOR I := 1 STEP 1 UNTIL 12-1 DO

START_WDAY(MONTHS(I)) :=

(START_WDAY(MONTHS(I-1)) + DAYS(MONTHS(I-1))) REM 7;



COLS := (WIDTH + 2) DIV 22;

WHILE 12 REM COLS NOT = 0 DO

COLS := COLS-1;

GAP := IF COLS - 1 NOT = 0 THEN (WIDTH - 20 * COLS) DIV (COLS - 1) ELSE 0;

IF GAP > 4 THEN

GAP := 4;

LEAD := (WIDTH - (20 + GAP) * COLS + GAP + 1) DIV 2;

YEAR := YEAR+1

END INIT_MONTHS;



PROCEDURE PRINT_ROW(INTEGER VALUE ROW);

BEGIN

INTEGER C, I, FROM, UP_TO;

INTEGER PROCEDURE PREINCREMENT(INTEGER VALUE RESULT I);

BEGIN I := I+1; I

END PREINCREMENT;

INTEGER PROCEDURE POSTINCREMENT(INTEGER VALUE RESULT I);

BEGIN INTEGER PREV_VALUE;

PREV_VALUE := I; I := I+1; PREV_VALUE

END POSTINCREMENT;

FROM := ROW * COLS;

UP_TO := FROM + COLS;

SPACE(LEAD);

FOR C := FROM STEP 1 UNTIL UP_TO-1 DO BEGIN

I := 9 % LENGTH OF MNAME(MONTHS(C)) % ;

SPACE((20 - I) DIV 2);

WRITEON(MNAME(MONTHS(C)));

SPACE(20 - I - (20 - I) DIV 2 + (IF C = UP_TO - 1 THEN 0 ELSE GAP));

END;

WRITE();



SPACE(LEAD);

FOR C := FROM STEP 1 UNTIL UP_TO-1 DO BEGIN

FOR I := 0 STEP 1 UNTIL 7-1 DO BEGIN

WRITEON(WDAYS(I)); IF I NOT = 6 THEN WRITEON(" ")

END;

IF C < UP_TO - 1 THEN

SPACE(GAP)

ELSE

WRITE();

END;

WHILE BEGIN

C := FROM;

WHILE C < UP_TO AND AT_POS(MONTHS(C)) >= DAYS(MONTHS(C)) DO

C := C + 1;



C NOT = UP_TO

END DO BEGIN



SPACE(LEAD);

C := FROM;

WHILE C < UP_TO DO BEGIN

I := 0;

WHILE I < START_WDAY(MONTHS(C)) DO BEGIN

I := I + 1;

SPACE(3)

END;

WHILE POSTINCREMENT(I) < 7 AND AT_POS(MONTHS(C)) < DAYS(MONTHS(C)) DO BEGIN

WRITEON(I_W := 2, S_W := 0, PREINCREMENT(AT_POS(MONTHS(C))));

IF I < 7 OR C < UP_TO - 1 THEN

SPACE(1)

END;

WHILE POSTINCREMENT(I) <= 7 AND C < UP_TO-1 DO

SPACE(3);

IF C < UP_TO - 1 THEN

SPACE(GAP - 1);

START_WDAY(MONTHS(C)) := 0;

C := C + 1

END;

WRITE();

END;

WRITE()

END PRINT_ROW;



PROCEDURE PRINT_YEAR;

BEGIN

INTEGER ROW, STRLEN, Y;

STRLEN := 1;

Y := YEAR;

WHILE Y > 9 DO BEGIN Y := Y DIV 10; STRLEN := STRLEN + 1 END;

SPACE((WIDTH - STRLEN) DIV 2);

WRITEON(I_W := 1, YEAR);

WRITE(); WRITE();

WHILE ROW * COLS < 12 DO BEGIN

PRINT_ROW(ROW);

ROW := ROW+1

END

END PRINT_YEAR;



INIT_MONTHS;

PRINT_YEAR

END

END.

Output:

1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

Calendar ( Yr ) {

LastDay := [ ] , Day := [ ]

Titles =

( ltrim

______January_________________February_________________March_______

_______April____________________May____________________June________

________July___________________August_________________September_____

______October_________________November________________December______

)

StringSplit , title , titles , `n

Res := "________________________________" Yr "`r`n"



loop 4 { ; 4 Vertical Sections

Day [ 1 ] := Yr SubStr ( "0" A_Index * 3 - 2 , - 1 ) 01

Day [ 2 ] := Yr SubStr ( "0" A_Index * 3 - 1 , - 1 ) 01

Day [ 3 ] := Yr SubStr ( "0" A_Index * 3 , - 1 ) 01

Res .= "`r`n" title %A_Index% "`r`nSu Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa"

loop , 6 { ; 6 Weeks max per month

Week := A_Index , Res .= "`r`n"

loop , 21 { ; 3 weeks times 7 days

Mon := Ceil ( A_Index / 7 ) , ThisWD := Mod ( A_Index - 1 , 7 ) + 1

FormatTime , WD , % Day [ Mon ] , WDay

FormatTime , dd , % Day [ Mon ] , dd

if ( WD > ThisWD ) {

Res .= "__ "

continue

}

dd := ( ( Week > 3 ) && dd < 10 ) ? "__" : dd , Res .= dd " " , LastDay [ Mon ] := Day [ Mon ] , Day [ Mon ] += 1 , Days

Res .= ( ( wd = 7 ) && A_Index < 21 ) ? "___" : ""

FormatTime , dd , % Day [ Mon ] , dd

}

}

Res .= "`r`n"

}

StringReplace , Res , Res , _ , %A_Space% , all

Res := RegExReplace ( Res , "`am)(^|\s)\K0" , " " )

return res

}

Gui , font , s8 , COURIER

Gui , add , edit , vYr w40 r1 Limit4 Number , 1969

Gui , add , edit , vEdit2 w580 r38

Gui , Add , Button , Default Hidden gSubmit

Gui , show



Submit :

Gui , Submit , NoHide

GuiControl ,, Edit2 , % Calendar ( Yr )

return



GuiEscape :

GuiClose :

ExitApp

return

1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30



#include <Date.au3>



; Set the count of characters in each line, minimum is 20 - one month.

Global $iPrintSize = 132



; Set the count of months, you want to print side by side. With "0" it calculates automatically.

; The number will corrected, if it not allowed to print in an rectangle.

; If your print size is to small for given count, it will set back to automatically calculation.

Global $iSideBySide = 3



; Set the count of spaces between months.

Global $iSpace = 4



_CreateCalendar ( 1969 )





Func _CreateCalendar ( $_iYear )

Local $aMon [ 12 ] = [ ' January ' , ' February ' , ' March ' , _

' April ' , ' May ' , ' June ' , _

' July ' , ' August ' , ' September ' , _

' October ' , ' November ' , ' December ' ]

Local $sHead = 'Mo Tu We Th Fr Sa Su'

Local $aDaysInMonth [ 12 ] = [ 31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 ]

If _DateIsLeapYear ( $_iYear ) Then $aDaysInMonth [ 1 ] = 29



; == assign date in weekday table for the whole year

Local $aAllDaysInMonth [ 6 ] [ 7 ] [ 12 ] ; [ lines ][ weekdays ][ months ]

Local $iDay = 1 , $iShift

For $i = 1 To 12

$iShift = _DateToDayOfWeekISO ( $_iYear , $i , 1 ) - 1

For $j = 0 To 5

For $k = $iShift To 6

$aAllDaysInMonth [ $j ] [ $k ] [ $i - 1 ] = $iDay

$iDay += 1

If $iDay > $aDaysInMonth [ $i - 1 ] Then ExitLoop ( 2 )

Next

$iShift = 0

Next

$iDay = 1

Next



; == check given side by side count, calculate if needed

If $iSideBySide > 0 Then

If $iPrintSize < ( $iSideBySide * ( 20 + $iSpace ) - $iSpace ) Then $iSideBySide = 0

EndIf

Switch $iSideBySide

Case 0

$iSideBySide = Int ( $iPrintSize / ( 20 + $iSpace ) )

If $iPrintSize < 20 Then Return _PrintLine ( 'Escape: Size Error' )

If $iPrintSize < ( 20 + $iSpace ) Then $iSideBySide = 1

Case 5

$iSideBySide = 4

Case 7 To 11

$iSideBySide = 6

EndSwitch



; == create space string

Local $sSpace = ''

For $i = 1 To $iSpace

$sSpace &= ' '

Next



; == print header

_PrintLine ( @LF )

_PrintLine ( '[ here is Snoopy ]' , @LF )

_PrintLine ( StringRegExpReplace ( $_iYear , '(\d)(\d)(\d)(\d)' , '$1 $2 $3 $4' ) , @LF )



; == create data for each line, in dependence to count of months in one line

Local $sLine , $iRight , $sTmp1 , $sTmp2

For $n = 0 To 12 / $iSideBySide - 1

$sTmp1 = ''

$sTmp2 = ''

For $z = 0 To $iSideBySide - 1

$sTmp1 &= $aMon [ $iSideBySide * $n + $z ] & $sSpace

$sTmp2 &= $sHead & $sSpace

Next

_PrintLine ( StringTrimRight ( $sTmp1 , $iSpace ) )

_PrintLine ( StringTrimRight ( $sTmp2 , $iSpace ) )

For $j = 0 To 5

$sLine = ''

For $i = 1 To $iSideBySide

For $k = 0 To 6

$iRight = 3

If $k = 0 Then $iRight = 2

$sLine &= StringRight ( ' ' & $aAllDaysInMonth [ $j ] [ $k ] [ $iSideBySide * $n + $i - 1 ] , $iRight )

Next

If $i < $iSideBySide Then $sLine &= $sSpace

Next

_PrintLine ( $sLine )

Next

Next

EndFunc ;==>_CreateCalendar



Func _PrintLine ( $_sLine , $_sLF = '' )

Local $iLen = StringLen ( $_sLine )

Local $sSpace = '' , $sLeft = ''

For $i = 1 To $iPrintSize - 1

$sSpace &= ' '

Next

If $iLen < $iPrintSize Then $sLeft = StringLeft ( $sSpace , Int ( ( $iPrintSize - $iLen ) / 2 ) )

ConsoleWrite ( $sLeft & $_sLine & $_sLF & @LF )

EndFunc ;==>_PrintLine



Examples:Outputs:

Output

[ here is Snoopy ] 1 9 6 9 January February March Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 1 2 1 2 6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 31 April May June Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 6 1 2 3 4 1 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 30 July August September Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 28 29 30 31 25 26 27 28 29 30 31 29 30 October November December Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 1 2 1 2 3 4 5 6 7 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31

--BugFix (talk) 00:40, 15 November 2013 (UTC)





Works with Gnu awk version 3.1.5 and with BusyBox v1.20.0.git awk

To change the output width, change the value assigned to variable pagewide



#!/bin/gawk -f

BEGIN {

wkdays = "Su Mo Tu We Th Fr Sa"

pagewide = 80

blank= " "

for ( i= 1 ; i < pagewide; i ++ ) blank = blank " "

# month name accessed as substr(month,num*10,10)

# where num is number of month, 1-12

month= " January February March April "

month= month " May June July August "

month= month " September October November December "

# table of days per month accessed as substr(days,2*month,2)

days = " 312831303130313130313031"

line1 = ""

line2 = ""

line3 = ""

line4 = ""

line5 = ""

line6 = ""

line7 = ""

line8 = ""

# print " year: " year " starts on: " dow(year)

}

function center ( text, half ) {

half = ( pagewide - length ( text ) ) / 2

return substr ( blank, 1 ,half ) text substr ( blank, 1 ,half )

}

function min ( a,b ) {

if ( a < b ) return a

else return b

}

function makewk ( fst,lst,day, i,wstring ) {

wstring= ""

for ( i= 1 ;i < day;i ++ ) wstring=wstring " "

for ( i=fst;i <= lst;i ++ ) wstring=wstring sprintf ( "%2d " ,i )

return substr ( wstring " " , 1 , 20 )

}

function dow ( year, y ) {

y=year

y= ( y * 365 + int ( y / 4 ) - int ( y / 100 ) + int ( y / 400 ) + 1 ) % 7

# leap year adjustment

leap = 0

if ( year % 4 == 0 ) leap = 1

if ( year % 100 == 0 ) leap = 0

if ( year % 400 == 0 ) leap = 1

y = y - leap

if ( y == - 1 ) y= 6

if ( y == 0 ) y= 7

return ( y )

}

function prmonth ( nmonth, newdow,monsize ) {

line1 = line1 " " ( substr ( month, 10 * nmonth, 10 ) ) " "

line2 = line2 ( wkdays ) " "

line3 = line3 ( makewk ( 1 , 8 - newdow,newdow ) ) " "

line4 = line4 ( makewk ( 9 - newdow, 15 - newdow, 1 ) ) " "

line5 = line5 ( makewk ( 16 - newdow, 22 - newdow, 1 ) ) " "

line6 = line6 ( makewk ( 23 - newdow, 29 - newdow, 1 ) ) " "

line7 = line7 ( makewk ( 30 - newdow,min ( monsize, 36 - newdow ) , 1 ) ) " "

line8 = line8 ( makewk ( 37 - newdow,monsize, 1 ) ) " "

if ( length ( line3 ) + 22 > pagewide ) {

print center ( line1 )

print center ( line2 )

print center ( line3 )

print center ( line4 )

print center ( line5 )

print center ( line6 )

print center ( line7 )

print center ( line8 )

line1 = ""

line2 = ""

line3 = ""

line4 = ""

line5 = ""

line6 = ""

line7 = ""

line8 = ""

}

}

/ q / {

exit }

{

monsize= substr ( days, 2 * 1 , 2 )

newdow=dow ( $1 )

print center ( "[ picture of Snoopy goes here ]" )

print center ( sprintf ( "%d" , $1 ) )

# January - December

for ( i= 1 ; i < 13 ; i ++ ) {

prmonth ( i,newdow,monsize )

newdow= ( monsize + newdow ) % 7

if ( newdow == 0 ) newdow = 7

monsize= substr ( days, 2 + 2 * i, 2 )

if ( leap == 1 && monsize == 28 ) monsize = 29

}

}







Output:

[ picture of Snoopy goes here ] 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

Choosing 132 character output.

DECLARE month$ [ ] = { "January" , "February" , "March" , "April" , "May" , "June" , "July" , "August" , "September" , "October" , "November" , "December" }

DECLARE month [ ] = { 31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 }

year$ = "1969"

' Leap year

INCR month [ 1 ] , IIF ( MOD ( VAL ( year$ ) , 4 ) = 0 OR MOD ( VAL ( year$ ) , 100 ) = 0 AND MOD ( VAL ( year$ ) , 400 ) <> 0 , 1 , 0 )

PRINT ALIGN$ ( "[SNOOPY HERE]" , 132 , 2 )

PRINT ALIGN$ ( year$, 132 , 2 )

FOR nr = 0 TO 11

row = 3

GOTOXY 1 + ( nr %6 ) * 22 , row+ ( nr/ 6 ) * 9

PRINT ALIGN$ ( month$ [ nr ] , 21 , 2 ) ;

INCR row

GOTOXY 1 + ( nr %6 ) * 22 , row+ ( nr/ 6 ) * 9

PRINT ALIGN$ ( "Mo Tu We Th Fr Sa Su" , 21 , 2 ) ;

INCR row

' Each day

FOR day = 1 TO month [ nr ]

' Zeller

J = VAL ( LEFT $ ( year$, 2 ) )

K = VAL ( MID $ ( year$, 3 , 2 ) )

m = nr+ 1

IF nr < 2 THEN

INCR m, 12

DECR K

END IF

h = ( day + ( ( m+ 1 ) * 26 ) / 10 + K + ( K/ 4 ) + ( J/ 4 ) + 5 *J )

daynr = MOD ( h, 7 ) - 2

IF daynr < 0 THEN INCR daynr, 7

IF daynr = 0 AND day > 1 THEN INCR row

GOTOXY 1 + ( nr %6 ) * 22 +daynr* 3 , row+ ( nr/ 6 ) * 9

PRINT day;

NEXT

NEXT

Output:

[SNOOPY HERE] 1969 January February March April May June Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1 6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 31 30 July August September October November December Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su 1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7 7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14 14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21 21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31

::Calender Task from Rosetta Code Wiki

::Batch File Implementation



@ echo off

setlocal enabledelayedexpansion



% == Set a valid year [will not be validated] == %

set y=1969



% == Set the variables for months (feb_l=the normal 28 days) == %

set jan_l=31 & set apr_l=30

set mar_l=31 & set jun_l=30

set may_l=31 & set sep_l=30

set jul_l=31 & set nov_l=30

set aug_l=31 & set feb_l=28

set oct_l=31

set dec_l=31



% == Compute day for first day of the year == %

set /a d= ( y/4+y ) - ( y/100-y/400 )



% == Check if that year is a leap year == %

set /a "op1=y %% 4 ","op2=y %% 1 00","op3=y %% 4 00"

if not " % op1 % "=="0" ( goto : no_leap)

if not " % op2 % "=="0" ( goto : yes_leap)

if not " % op3 % "=="0" ( goto : no_leap)

: yes_leap

% == Ooops... Leap year. Change feb_l to 29. == %

set feb_l=29

set /a d-=1

: no_leap



% == Compute weekday of the first day... == %

set /a d % % =7



% == Generate everything that's inside the calendar == %

for %% a in ( jan feb mar apr may jun jul aug sep oct nov dec ) do (

set %% a =

set chars_added=0

for /l %% b in ( 1,1, ! d !) do ( set " %% a = ! %% a ! " & set /a chars_added+=3 )

for /l %% c in ( 1,1, ! %%a_l !) do (

if %% c lss 10 ( set " %% a = ! %% a ! %% c " ) else ( set " %% a = ! %% a !%% c " )

set /a chars_added+=3

)

for /l %% d in (! chars_added ! ,1,124 ) do set " %% a = ! %% a ! "

set /a d= ^( d+ % % a_l ^) %% 7

)



% == Display the calendar == %

cls

echo .

echo . [SNOOPY]

echo .

echo . YEAR = % y %

echo .

echo . January February March

echo . Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa

echo . % jan:~0,20 % % feb:~0,20 % % mar:~0,20 %

echo . % jan:~21,20 % % feb:~21,20 % % mar:~21,20 %

echo . % jan:~42,20 % % feb:~42,20 % % mar:~42,20 %

echo . % jan:~63,20 % % feb:~63,20 % % mar:~63,20 %

echo . % jan:~84,20 % % feb:~84,20 % % mar:~84,20 %

echo . % jan:~105 % % feb:~105 % % mar:~105 %

echo .

echo . April May June

echo . Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa

echo . % apr:~0,20 % % may:~0,20 % % jun:~0,20 %

echo . % apr:~21,20 % % may:~21,20 % % jun:~21,20 %

echo . % apr:~42,20 % % may:~42,20 % % jun:~42,20 %

echo . % apr:~63,20 % % may:~63,20 % % jun:~63,20 %

echo . % apr:~84,20 % % may:~84,20 % % jun:~84,20 %

echo . % apr:~105 % % may:~105 % % jun:~105 %

echo .

echo . July August September

echo . Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa

echo . % jul:~0,20 % % aug:~0,20 % % sep:~0,20 %

echo . % jul:~21,20 % % aug:~21,20 % % sep:~21,20 %

echo . % jul:~42,20 % % aug:~42,20 % % sep:~42,20 %

echo . % jul:~63,20 % % aug:~63,20 % % sep:~63,20 %

echo . % jul:~84,20 % % aug:~84,20 % % sep:~84,20 %

echo . % jul:~105 % % aug:~105 % % sep:~105 %

echo .

echo . October November December

echo . Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa

echo . % oct:~0,20 % % nov:~0,20 % % dec:~0,20 %

echo . % oct:~21,20 % % nov:~21,20 % % dec:~21,20 %

echo . % oct:~42,20 % % nov:~42,20 % % dec:~42,20 %

echo . % oct:~63,20 % % nov:~63,20 % % dec:~63,20 %

echo . % oct:~84,20 % % nov:~84,20 % % dec:~84,20 %

echo . % oct:~105 % % nov:~105 % % dec:~105 %

echo .

pause

endlocal

Output:

[SNOOPY] YEAR = 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30 Press any key to continue . . .

Works with: BBC BASIC for Windows

The day and month names are in the language for which the PC is configured.

INSTALL @lib$+"DATELIB"

VDU 23,22,640;570;8,15,16,128



year% = 1969

PRINT TAB(38); year%

DIM dom%(2), mjd%(2), dim%(2)



FOR day% = 1 TO 7

days$ += LEFT$(FN_date$(FN_mjd(day%, 1, 1905), "ddd"), 2) + " "

NEXT



FOR month% = 1 TO 10 STEP 3

PRINT

FOR col% = 0 TO 2

mjd%(col%) = FN_mjd(1, month% + col%, year%)

month$ = FN_date$(mjd%(col%), "MMMM")

PRINT TAB(col%*24 + 16 - LEN(month$)/2) month$;

NEXT

FOR col% = 0 TO 2

PRINT TAB(col%*24 + 6) days$;

dim%(col%) = FN_dim(month% + col%, year%)

NEXT

dom%() = 1

col% = 0

REPEAT

dow% = FN_dow(mjd%(col%))

IF dom%(col%)<=dim%(col%) THEN

PRINT TAB(col%*24 + dow%*3 + 6); dom%(col%);

dom%(col%) += 1

mjd%(col%) += 1

ENDIF

IF dow%=6 OR dom%(col%)>dim%(col%) col% = (col% + 1) MOD 3

UNTIL dom%(0)>dim%(0) AND dom%(1)>dim%(1) AND dom%(2)>dim%(2)

PRINT

NEXT



Output:

1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

This is quite closely based on the C sample, although the centering calculation has been adjusted to fix an off-by-one error, and the months have been made a constant height, regardless of how much space they require, to try and produce a more balanced layout.

The year is read from stdin, and the width is specified by the first value on the stack (set to 80 - "P" - in the current implementation).

"P"00p&>:::4%!\"d"%*\45*:*%!+!!65*+31p:1-:::"I"5**\4/+\"d"/-\45*:*/+1+7%:0v

J!F?M!A M!J J!A!S O!N D!SaFrThWeTuMoSuvp01:_1#!-#%:#\>#+6<v-2g1+1g01p1p01:<

January February March April >:45**00g\-\1-:v:<<6>+7%:10g2+:38*\`|

May June July August v02-1:+4*-4\`\4:/_$:^^:/*2+92+2:g00$$$<

September October November December>p:45*+10g*\--2/00g4-2/>:#,1#*-#8\#4_$v

>20g>:#,1#*-#8\#4_$6"$S" v. .vp040\$_4#!8#\*#-,#1>#:<+5g03g01:,,:+55<0.p03<

^_v#:-1$_v#!:,*84,g1+1,< < ^ >::4%9*40g:8`!#v_$$$1+v^+g02_#v$#,$#+5<^_v#`\<

-#8\#4_$7>1-:2*64*+:1g>^ ^ ^,g+2/4\+p04+1:<>1#\-#<:66+\^ >>$10g30g>:#,1#*

> > $$55+,6>>40p:10g30g>:#,1#*-#8\#4_$>\:2*:1+1g2-50p1g640g-7*1+\-7v [email protected],<6

2:+g01$_55+,^ > > > > #^>#g>#0>#2_v v*2!!\%+55:\/+55:**`0\!`g05:::\< >2-^^

->:> >#^>#<>#<^#!:-1g04$$ < < < < < >4+8*+\:!!2*4+8*+,,48*,1+\1-:>#^_$$1+\1

With arbitrary display width (>= 20 though) and auto spacing.

#include <stdio.h>

#include <stdlib.h>

#include <string.h>



int width = 80 , year = 1969 ;

int cols , lead , gap ;



const char * wdays [ ] = { "Su" , "Mo" , "Tu" , "We" , "Th" , "Fr" , "Sa" } ;

struct months {

const char * name ;

int days , start_wday , at ;

} months [ 12 ] = {

{ "January" , 31 , 0 , 0 } ,

{ "February" , 28 , 0 , 0 } ,

{ "March" , 31 , 0 , 0 } ,

{ "April" , 30 , 0 , 0 } ,

{ "May" , 31 , 0 , 0 } ,

{ "June" , 30 , 0 , 0 } ,

{ "July" , 31 , 0 , 0 } ,

{ "August" , 31 , 0 , 0 } ,

{ "September" , 30 , 0 , 0 } ,

{ "October" , 31 , 0 , 0 } ,

{ "November" , 30 , 0 , 0 } ,

{ "December" , 31 , 0 , 0 }

} ;



void space ( int n ) { while ( n -- > 0 ) putchar ( ' ' ) ; }



void init_months ( )

{

int i ;



if ( ( ! ( year % 4 ) && ( year % 100 ) ) || ! ( year % 400 ) )

months [ 1 ] . days = 29 ;



year --;

months [ 0 ] . start_wday

= ( year * 365 + year / 4 - year / 100 + year / 400 + 1 ) % 7 ;



for ( i = 1 ; i < 12 ; i ++ )

months [ i ] . start_wday =

( months [ i - 1 ] . start_wday + months [ i - 1 ] . days ) % 7 ;



cols = ( width + 2 ) / 22 ;

while ( 12 % cols ) cols --;

gap = cols - 1 ? ( width - 20 * cols ) / ( cols - 1 ) : 0 ;

if ( gap > 4 ) gap = 4 ;

lead = ( width - ( 20 + gap ) * cols + gap + 1 ) / 2 ;

year ++;

}



void print_row ( int row )

{

int c , i , from = row * cols , to = from + cols ;

space ( lead ) ;

for ( c = from ; c < to ; c ++ ) {

i = strlen ( months [ c ] . name ) ;

space ( ( 20 - i ) / 2 ) ;

printf ( "%s" , months [ c ] . name ) ;

space ( 20 - i - ( 20 - i ) / 2 + ( ( c == to - 1 ) ? 0 : gap ) ) ;

}

putchar ( '

' ) ;



space ( lead ) ;

for ( c = from ; c < to ; c ++ ) {

for ( i = 0 ; i < 7 ; i ++ )

printf ( "%s%s" , wdays [ i ] , i == 6 ? "" : " " ) ;

if ( c < to - 1 ) space ( gap ) ;

else putchar ( '

' ) ;

}



while ( 1 ) {

for ( c = from ; c < to ; c ++ )

if ( months [ c ] . at < months [ c ] . days ) break ;

if ( c == to ) break ;



space ( lead ) ;

for ( c = from ; c < to ; c ++ ) {

for ( i = 0 ; i < months [ c ] . start_wday ; i ++ ) space ( 3 ) ;

while ( i ++ < 7 && months [ c ] . at < months [ c ] . days ) {

printf ( "%2d" , ++ months [ c ] . at ) ;

if ( i < 7 || c < to - 1 ) putchar ( ' ' ) ;

}

while ( i ++ <= 7 && c < to - 1 ) space ( 3 ) ;

if ( c < to - 1 ) space ( gap - 1 ) ;

months [ c ] . start_wday = 0 ;

}

putchar ( '

' ) ;

}

putchar ( '

' ) ;

}



void print_year ( )

{

int row ;

char buf [ 32 ] ;

sprintf ( buf , "%d" , year ) ;

space ( ( width - strlen ( buf ) ) / 2 ) ;

printf ( "%s



" , buf ) ;

for ( row = 0 ; row * cols < 12 ; row ++ )

print_row ( row ) ;

}



int main ( int c , char ** v )

{

int i , year_set = 0 ;

for ( i = 1 ; i < c ; i ++ ) {

if ( ! strcmp ( v [ i ] , "-w" ) ) {

if ( ++ i == c || ( width = atoi ( v [ i ] ) ) < 20 )

goto bail ;

} else if ( ! year_set ) {

if ( ! sscanf ( v [ i ] , "%d" , & year ) || year <= 0 )

year = 1969 ;

year_set = 1 ;

} else

goto bail ;

}



init_months ( ) ;

print_year ( ) ;

return 0 ;



bail : fprintf ( stderr , "bad args

Usage: %s year [-w width (>= 20)]

" , v [ 0 ] ) ;

exit ( 1 ) ;

}

An attempt to abuse the DateTime class for all static information. In the event that the number of days and months changes, so long as the DateTime class is updated accordingly, this should still print properly. It also abuses iterators to allow for a concise month printing method, but with the ability to still print x months per line.





using System ;

using System.Collections.Generic ;

using System.Linq ;

using System.Text ;



namespace CalendarStuff

{



class Program

{

static void Main ( string [ ] args )

{

Console . WindowHeight = 46 ;

Console . Write ( buildMonths ( new DateTime ( 1969 , 1 , 1 ) ) ) ;

Console . Read ( ) ;

}

private static string buildMonths ( DateTime date )

{

StringBuilder sb = new StringBuilder ( ) ;

sb . AppendLine ( center ( "[Snoop]" , 24 * 3 ) ) ;

sb . AppendLine ( ) ;

sb . AppendLine ( center ( date . Year . ToString ( ) , 24 * 3 ) ) ;



List < DateTime > dts = new List < DateTime > ( ) ;

while ( true )

{

dts . Add ( date ) ;

if ( date . Year != ( ( date = date . AddMonths ( 1 ) ) . Year ) )

{

break ;

}

}

var jd = dts . Select ( a => buildMonth ( a ) . GetEnumerator ( ) ) . ToArray ( ) ;



int sCur = 0 ;

while ( sCur < dts . Count )

{

sb . AppendLine ( ) ;

int curMonth = 0 ;

var j = jd . Where ( a => curMonth ++ >= sCur && curMonth - 1 < sCur + 3 ) . ToArray ( ) ; //grab the next 3

sCur += j . Length ;

bool breakOut = false ;

while ( ! breakOut )

{

int inj = 1 ;

foreach ( var cd in j )

{

if ( cd . MoveNext ( ) )

{

sb . Append ( ( cd . Current . Length == 21 ? cd . Current : cd . Current . PadRight ( 21 , ' ' ) ) + " " ) ;

}

else

{

sb . Append ( "" . PadRight ( 21 , ' ' ) + " " ) ;

breakOut = true ;

}

if ( inj ++ % 3 == 0 ) sb . AppendLine ( ) ;

}

}



}

return sb . ToString ( ) ;

}





private static IEnumerable < string > buildMonth ( DateTime date )

{

yield return center ( date . ToString ( "MMMM" ) , 7 * 3 ) ;

var j = DateTime . DaysInMonth ( date . Year , date . Month ) ;

yield return Enum . GetNames ( typeof ( DayOfWeek ) ) . Aggregate ( "" , ( current, result ) => current + ( result . Substring ( 0 , 2 ) . ToUpper ( ) + " " ) ) ;

string cur = "" ;

int total = 0 ;



foreach ( var day in Enumerable . Range ( - ( ( int ) date . DayOfWeek ) ,j + ( int ) date . DayOfWeek ) )

{

cur += ( day < 0 ? " " : ( ( day < 9 ? " " : "" ) + ( day + 1 ) ) ) + " " ;

if ( total ++ > 0 && ( total ) % 7 == 0 )

{

yield return cur ;

cur = "" ;

}

}

yield return cur ;

}

private static string center ( string s, int len )

{

return ( s . PadLeft ( ( len - s . Length ) / 2 + s . Length , ' ' ) . PadRight ( ( len ) , ' ' ) ) ;

}

}

}







#include <windows.h>

#include <iostream>



//--------------------------------------------------------------------------------------------------

using namespace std ;





//--------------------------------------------------------------------------------------------------

class calender

{

public :

void drawCalender ( int y )

{

year = y ;

for ( int i = 0 ; i < 12 ; i ++ )

firstdays [ i ] = getfirstday ( i ) ;



isleapyear ( ) ;

build ( ) ;

}



private :

void isleapyear ( )

{

isleap = false ;



if ( ! ( year % 4 ) )

{

if ( year % 100 ) isleap = true ;

else if ( ! ( year % 400 ) ) isleap = true ;

}

}



int getfirstday ( int m )

{

int y = year ;



int f = y + 1 + 3 * m - 1 ;

m ++ ;

if ( m < 3 ) y -- ;

else f - = int ( .4 * m + 2.3 ) ;



f + = int ( y / 4 ) - int ( ( y / 100 + 1 ) * 0.75 ) ;

f % = 7 ;



return f ;

}



void build ( )

{

int days [ ] = { 31 , isleap ? 29 : 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 } ;

int lc = 0 , lco = 0 , ystr = 7 , start = 2 , fd = 0 , m = 0 ;

HANDLE h = GetStdHandle ( STD_OUTPUT_HANDLE ) ;

COORD pos = { 0 , ystr } ;

draw ( ) ;



for ( int i = 0 ; i < 4 ; i ++ )

{

for ( int j = 0 ; j < 3 ; j ++ )

{

int d = firstdays [ fd ++ ] , dm = days [ m ++ ] ;

pos. X = d * 3 + start ;

SetConsoleCursorPosition ( h, pos ) ;



for ( int dd = 0 ; dd < dm ; dd ++ )

{

if ( dd < 9 ) cout << 0 << dd + 1 << " " ;

else cout << dd + 1 << " " ;



pos. X + = 3 ;

if ( pos. X - start > 20 )

{

pos. X = start ; pos. Y ++ ;

SetConsoleCursorPosition ( h, pos ) ;

}

}



start + = 23 ;

pos. X = start ; pos. Y = ystr ;

SetConsoleCursorPosition ( h, pos ) ;

}

ystr + = 9 ; start = 2 ;

pos. Y = ystr ;

}

}



void draw ( )

{

system ( "cls" ) ;

cout << "+--------------------------------------------------------------------+" << endl ;

cout << "| [SNOOPY] |" << endl ;

cout << "| |" << endl ;

cout << "| == " << year << " == |" << endl ;

cout << "+----------------------+----------------------+----------------------+" << endl ;

cout << "| JANUARY | FEBRUARY | MARCH |" << endl ;

cout << "| SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "+----------------------+----------------------+----------------------+" << endl ;

cout << "| APRIL | MAY | JUNE |" << endl ;

cout << "| SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "+----------------------+----------------------+----------------------+" << endl ;

cout << "| JULY | AUGUST | SEPTEMBER |" << endl ;

cout << "| SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "+----------------------+----------------------+----------------------+" << endl ;

cout << "| OCTOBER | NOVEMBER | DECEMBER |" << endl ;

cout << "| SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "| | | |" << endl ;

cout << "+----------------------+----------------------+----------------------+" << endl ;

}



int firstdays [ 12 ] , year ;

bool isleap ;

} ;

//--------------------------------------------------------------------------------------------------

int main ( int argc, char * argv [ ] )

{

int y ;

calender cal ;



while ( true )

{

system ( "cls" ) ;

cout << "Enter the year( yyyy ) --- ( 0 to quit ): " ;

cin >> y ;

if ( ! y ) return 0 ;



cal. drawCalender ( y ) ;

cout << endl << endl << endl << endl << endl << endl << endl << endl ;



system ( "pause" ) ;

}

return 0 ;

}

//--------------------------------------------------------------------------------------------------



Output:

+--------------------------------------------------------------------+ | [SNOOPY] | | | | == 1969 == | +----------------------+----------------------+----------------------+ | JANUARY | FEBRUARY | MARCH | | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | | 01 02 03 04 | 01 | 01 | | 05 06 07 08 09 10 11 | 02 03 04 05 06 07 08 | 02 03 04 05 06 07 08 | | 12 13 14 15 16 17 18 | 09 10 11 12 13 14 15 | 09 10 11 12 13 14 15 | | 19 20 21 22 23 24 25 | 16 17 18 19 20 21 22 | 16 17 18 19 20 21 22 | | 26 27 28 29 30 31 | 23 24 25 26 27 28 | 23 24 25 26 27 28 29 | | | | 30 31 | +----------------------+----------------------+----------------------+ | APRIL | MAY | JUNE | | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | | 01 02 03 04 05 | 01 02 03 | 01 02 03 04 05 06 07 | | 06 07 08 09 10 11 12 | 04 05 06 07 08 09 10 | 08 09 10 11 12 13 14 | | 13 14 15 16 17 18 19 | 11 12 13 14 15 16 17 | 15 16 17 18 19 20 21 | | 20 21 22 23 24 25 26 | 18 19 20 21 22 23 24 | 22 23 24 25 26 27 28 | | 27 28 29 30 | 25 26 27 28 29 30 31 | 29 30 | | | | | +----------------------+----------------------+----------------------+ | JULY | AUGUST | SEPTEMBER | | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | | 01 02 03 04 05 | 01 02 | 01 02 03 04 05 06 | | 06 07 08 09 10 11 12 | 03 04 05 06 07 08 09 | 07 08 09 10 11 12 13 | | 13 14 15 16 17 18 19 | 10 11 12 13 14 15 16 | 14 15 16 17 18 19 20 | | 20 21 22 23 24 25 26 | 17 18 19 20 21 22 23 | 21 22 23 24 25 26 27 | | 27 28 29 30 31 | 24 25 26 27 28 29 30 | 28 29 30 | | | 31 | | +----------------------+----------------------+----------------------+ | OCTOBER | NOVEMBER | DECEMBER | | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | SU MO TU WE TH FR SA | | 01 02 03 04 | 01 | 01 02 03 04 05 06 | | 05 06 07 08 09 10 11 | 02 03 04 05 06 07 08 | 07 08 09 10 11 12 13 | | 12 13 14 15 16 17 18 | 09 10 11 12 13 14 15 | 14 15 16 17 18 19 20 | | 19 20 21 22 23 24 25 | 16 17 18 19 20 21 22 | 21 22 23 24 25 26 27 | | 26 27 28 29 30 31 | 23 24 25 26 27 28 29 | 28 29 30 31 | | | 30 | | +----------------------+----------------------+----------------------+

the program calls subroutine DATE2DOW to convert any YYYY-MM-DD to Day of Week (1=Sunday). the group names WS-CFGN and WS-CFGW may be moved to WS-CFG to use narrow or wide print line size respectively.



IDENTIFICATION DIVISION .

PROGRAM-ID . CALEND .

ENVIRONMENT DIVISION .

INPUT-OUTPUT SECTION .

DATA DIVISION .



WORKING-STORAGE SECTION .

01 WS-DAY-NAMES-DEF .

03 FILLER PIC X ( 09 ) VALUE 'SUNDAY ' .

03 FILLER PIC X ( 09 ) VALUE 'MONDAY ' .

03 FILLER PIC X ( 09 ) VALUE 'TUESDAY ' .

03 FILLER PIC X ( 09 ) VALUE 'WEDNESDAY' .

03 FILLER PIC X ( 09 ) VALUE 'THURSDAY ' .

03 FILLER PIC X ( 09 ) VALUE 'FRIDAY ' .

03 FILLER PIC X ( 09 ) VALUE 'SATURDAY ' .

01 FILLER REDEFINES WS-DAY-NAMES-DEF .

03 WS-DAY-NAME PIC X ( 09 ) OCCURS 07 TIMES .



01 WS-MTH-INFO-DEF .

03 FILLER PIC X ( 11 ) VALUE 'JANUARY 31' .

03 FILLER PIC X ( 11 ) VALUE 'FEBRUARY 28' .

03 FILLER PIC X ( 11 ) VALUE 'MARCH 31' .

03 FILLER PIC X ( 11 ) VALUE 'APRIL 30' .

03 FILLER PIC X ( 11 ) VALUE 'MAY 31' .

03 FILLER PIC X ( 11 ) VALUE 'JUNE 30' .

03 FILLER PIC X ( 11 ) VALUE 'JULY 31' .

03 FILLER PIC X ( 11 ) VALUE 'AUGUST 31' .

03 FILLER PIC X ( 11 ) VALUE 'SEPTEMBER30' .

03 FILLER PIC X ( 11 ) VALUE 'OCTOBER 31' .

03 FILLER PIC X ( 11 ) VALUE 'NOVEMBER 30' .

03 FILLER PIC X ( 11 ) VALUE 'DECEMBER 31' .

01 FILLER REDEFINES WS-MTH-INFO-DEF .

03 WS-MTH-INFO- TABLE OCCURS 12 TIMES .

05 WS-MTH-INFO-NAME PIC X ( 09 ) .

05 WS-MTH-INFO-DAYS PIC 9 ( 02 ) .



01 WS-MTH- AREA .

03 WS-MTH-DD PIC S99 .

03 WS-DAY1 PIC 9 .

03 WS-DAYS PIC 99 .

03 WS-DD PIC 9 .

03 WS-WK PIC 9 .

03 WS-MM PIC 99 .

03 WS-QQ PIC 99 .



03 WS-MTH-MONTH OCCURS 12 TIMES .

05 WS-MTH-WEEK OCCURS 6 TIMES .

07 WS-DAY-FLD OCCURS 7 TIMES .

09 WS- DAY PIC ZZ .

01 INPDATE- RECORD .

05 INPD-YEAR PIC 9 ( 04 ) .

05 FILLER PIC X ( 01 ) .

05 INPD-MONTH PIC 9 ( 02 ) .

05 FILLER PIC X ( 01 ) .

05 INPD- DAY PIC 9 ( 02 ) .

01 WMS-DOW PIC 9 ( 01 ) .

01 WS-PRT PIC X ( 132 ) .

01 WS-COL PIC 9 ( 03 ) VALUE 0 .

01 WS-PP PIC 9 ( 03 ) VALUE 0 .

01 WS-CFGN .

03 FILLER PIC 9 ( 03 ) VALUE 80 .

03 FILLER PIC 9 ( 02 ) VALUE 5 .

03 FILLER PIC 9 ( 01 ) VALUE 1 .

03 FILLER PIC 9 ( 02 ) VALUE 5 .

03 FILLER PIC 9 ( 01 ) VALUE 2 .

01 WS-CFGW .

03 FILLER PIC 9 ( 03 ) VALUE 120 .

03 FILLER PIC 9 ( 02 ) VALUE 10 .

03 FILLER PIC 9 ( 01 ) VALUE 2 .

03 FILLER PIC 9 ( 02 ) VALUE 10 .

03 FILLER PIC 9 ( 01 ) VALUE 3 .

01 WS-CFG .

03 WS-LS PIC 9 ( 03 ) VALUE 120 .

03 WS-LMAR PIC 9 ( 02 ) VALUE 10 .

03 WS-SPBD PIC 9 ( 01 ) VALUE 2 .

03 WS-SPBC PIC 9 ( 02 ) VALUE 10 .

03 WS-DNMW PIC 9 ( 01 ) VALUE 3 .

PROCEDURE DIVISION .

MOVE '1969-01-01' TO INPDATE- RECORD

MOVE WS-CFGN TO WS-CFG

IF ( FUNCTION MOD ( INPD-YEAR , 400 ) = 0

OR ( FUNCTION MOD ( INPD-YEAR , 4 ) = 0

AND

FUNCTION MOD ( INPD-YEAR , 100 ) NOT = 0 ) )

MOVE 29 TO WS-MTH-INFO-DAYS ( 02 )

ELSE

MOVE 28 TO WS-MTH-INFO-DAYS ( 02 )

END- IF



PERFORM VARYING WS-MM FROM 1 BY + 1

UNTIL WS-MM > 12

MOVE WS-MM TO INPD-MONTH

CALL 'DATE2DOW' USING INPDATE- RECORD , WMS-DOW

COMPUTE WS-MTH-DD = 1 - WMS-DOW

COMPUTE WS-DAYS = WS-MTH-INFO-DAYS ( INPD-MONTH )

PERFORM VARYING WS-WK FROM 1 BY + 1

UNTIL WS-WK > 6

PERFORM VARYING WS-DD FROM 1 BY + 1

UNTIL WS-DD > 7

COMPUTE WS-MTH-DD = WS-MTH-DD + 1

IF ( WS-MTH-DD < 1 )

OR ( WS-MTH-DD > WS-DAYS )

MOVE 0 TO WS- DAY ( WS-MM , WS-WK , WS-DD )

ELSE

MOVE WS-MTH-DD TO WS- DAY ( WS-MM , WS-WK , WS-DD )

END- IF

END- PERFORM

END- PERFORM

END- PERFORM



COMPUTE WS-MM = 0

PERFORM VARYING WS-QQ FROM 1 BY + 1

UNTIL WS-QQ > 4



INITIALIZE WS-PRT

COMPUTE WS-PP = 1

PERFORM VARYING WS-COL FROM 1 BY + 1

UNTIL WS-COL > 3

COMPUTE WS-MM = 3 * ( WS-QQ - 1 ) + WS-COL



IF WS-COL = 1

COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW

ELSE

COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW

END- IF

MOVE WS-MTH-INFO-NAME ( WS-MM )

TO WS-PRT ( WS-PP: 9 )

COMPUTE WS-PP

= WS-PP + ( 2 * 7 + WS-SPBD * 6 + WS-SPBD - 1 )

- 4

MOVE INPD-YEAR TO WS-PRT ( WS-PP: 4 )

COMPUTE WS-PP = WS-PP + 4

END- PERFORM

DISPLAY WS-PRT ( 1 :WS-LS )



INITIALIZE WS-PRT

COMPUTE WS-PP = 1

PERFORM VARYING WS-COL FROM 1 BY + 1

UNTIL WS-COL > 3

COMPUTE WS-MM = 3 * ( WS-QQ - 1 ) + WS-COL



IF WS-COL = 1

COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW

ELSE

COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW

END- IF

PERFORM VARYING WS-DD FROM 1 BY + 1

UNTIL WS-DD > 7

IF WS-DD > 1

COMPUTE WS-PP = WS-PP + WS-SPBD + 2 - WS-DNMW

END- IF

MOVE WS-DAY-NAME ( WS-DD ) ( 1 :WS-DNMW )

TO WS-PRT ( WS-PP:WS-DNMW )

COMPUTE WS-PP = WS-PP + WS-DNMW

END- PERFORM

END- PERFORM

DISPLAY WS-PRT ( 1 :WS-LS )



PERFORM VARYING WS-WK FROM 1 BY + 1

UNTIL WS-WK > 6

INITIALIZE WS-PRT

COMPUTE WS-PP = 1

PERFORM VARYING WS-COL FROM 1 BY + 1

UNTIL WS-COL > 3

COMPUTE WS-MM = 3 * ( WS-QQ - 1 ) + WS-COL



IF WS-COL = 1

COMPUTE WS-PP = WS-PP + WS-LMAR

ELSE

COMPUTE WS-PP = WS-PP + WS-SPBC

END- IF

PERFORM VARYING WS-DD FROM 1 BY + 1

UNTIL WS-DD > 7

IF WS-DD > 1

COMPUTE WS-PP = WS-PP + WS-SPBD

END- IF

MOVE WS- DAY ( WS-MM , WS-WK , WS-DD )

TO WS-PRT ( WS-PP: 2 )

COMPUTE WS-PP = WS-PP + 2

END- PERFORM

END- PERFORM

DISPLAY WS-PRT ( 1 :WS-LS )

END- PERFORM

DISPLAY ' '

END- PERFORM

GOBACK

.

END PROGRAM CALEND .

IDENTIFICATION DIVISION .

PROGRAM-ID . DATE2DOW .

ENVIRONMENT DIVISION .

DATA DIVISION .

WORKING-STORAGE SECTION .

01 WMS-WORK- AREA .

03 WMS-YEAR PIC 9 ( 04 ) .

03 WMS-MONTH PIC 9 ( 02 ) .

03 WMS-CSYS PIC 9 ( 01 ) VALUE 1 .

03 WMS- SUM pic 9 ( 04 ) .

LINKAGE SECTION .

01 INPDATE- RECORD .

05 INPD-YEAR PIC 9 ( 04 ) .

05 FILLER PIC X ( 01 ) .

05 INPD-MONTH PIC 9 ( 02 ) .

05 FILLER PIC X ( 01 ) .

05 INPD- DAY PIC 9 ( 02 ) .

01 WMS-DOW PIC 9 ( 01 ) .

PROCEDURE DIVISION USING INPDATE- RECORD , WMS-DOW .

1010 -CONVERT-DATE-TO-DOW .

IF INPD-MONTH < 3

COMPUTE WMS-MONTH = INPD-MONTH + 12

COMPUTE WMS-YEAR = INPD-YEAR - 1

ELSE

COMPUTE WMS-MONTH = INPD-MONTH

COMPUTE WMS-YEAR = INPD-YEAR

END- IF

COMPUTE WMS- SUM =

( INPD- DAY + 2 * WMS-MONTH + WMS-YEAR

+ FUNCTION INTEGER ( 6 * ( WMS-MONTH + 1 ) / 10 )

+ FUNCTION INTEGER ( WMS-YEAR / 4 )

- FUNCTION INTEGER ( WMS-YEAR / 100 )

+ FUNCTION INTEGER ( WMS-YEAR / 400 )

+ WMS-CSYS )

COMPUTE WMS-DOW = FUNCTION MOD ( WMS- SUM , 7 ) + 1

GOBACK

.

END PROGRAM DATE2DOW .



Output (based on 80 character wide display)

JANUARY 1969 FEBRUARY 1969 MARCH 1969 SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 APRIL 1969 MAY 1969 JUNE 1969 SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 JULY 1969 AUGUST 1969 SEPTEMBER 1969 SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 OCTOBER 1969 NOVEMBER 1969 DECEMBER 1969 SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

Depends on quicklisp.

( ql : quickload ' ( date-calc ) )



( defparameter *day-row* "Su Mo Tu We Th Fr Sa" )

( defparameter *calendar-margin* 3 )



( defun month-to-word ( month )

"Translate a MONTH from 1 to 12 into its word representation."

( svref # ( "January" "February" "March" "April"

"May" "June" "July" "August"

"September" "October" "November" "December" )

( 1 - month ) ) )



( defun month-strings ( year month )

"Collect all of the strings that make up a calendar for a given

MONTH and YEAR."

` ( , ( date-calc : center ( month-to-word month ) ( length *day-row* ) )

, *day-row*

;; We can assume that a month calendar will always fit into a 7 by 6 block

;; of values. This makes it easy to format the resulting strings.

, @ ( let ( ( days ( make- array ( * 7 6 ) : initial-element nil ) ) )

( loop : for i : from ( date-calc : day-of-week year month 1 )

: for day : from 1 : to ( date-calc : days-in-month year month )

: do ( setf ( aref days i ) day ) )

( loop : for i : from 0 : to 5

: collect

( format nil "~{~:[ ~;~2,d~]~^ ~}"

( loop : for day : across ( subseq days ( * i 7 ) ( + 7 ( * i 7 ) ) )

: append ( if day ( list day day ) ( list day ) ) ) ) ) ) ) )



( defun calc-columns ( characters margin-size )

"Calculate the number of columns given the number of CHARACTERS per

column and the MARGIN-SIZE between them."

( multiple-value-bind ( cols excess )

( truncate characters ( + margin-size ( length *day-row* ) ) )

( incf excess margin-size )

( if ( >= excess ( length *day-row* ) )

( 1 + cols )

cols ) ) )



( defun take ( n list )

"Take the first N elements of a LIST."

( loop : repeat n : for x : in list : collect x ) )



( defun drop ( n list )

"Drop the first N elements of a LIST."

( cond ( ( or ( <= n 0 ) ( null list ) ) list )

( t ( drop ( 1 - n ) ( cdr list ) ) ) ) )



( defun chunks-of ( n list )

"Split the LIST into chunks of size N."

( assert ( > n 0 ) )

( loop : for x := list : then ( drop n x )

: while x

: collect ( take n x ) ) )



( defun print-calendar ( year & key ( characters 80 ) ( margin-size 3 ) )

"Print out the calendar for a given YEAR, optionally specifying

a width limit in CHARACTERS and MARGIN-SIZE between months."

( assert ( >= characters ( length *day-row* ) ) )

( assert ( >= margin-size 0 ) )

( let * ( ( calendars ( loop : for month : from 1 : to 12

: collect ( month-strings year month ) ) )

( column-count ( calc-columns characters margin-size ) )

( total-size ( + ( * column-count ( length *day-row* ) )

( * ( 1 - column-count ) margin-size ) ) )

( format-string ( concatenate 'string

"~{~a~^~" ( write-to-string margin-size ) ", [email protected] ~}~%" ) ) )

( format t "~a~%~a~%~%"

( date-calc : center "[Snoopy]" total-size )

( date-calc : center ( write-to-string year ) total-size ) )

( loop : for row : in ( chunks-of column-count calendars )

: do ( apply ' mapcar

( lambda ( & rest heads )

( format t format-string heads ) )

row ) ) ) )

Output:

CL-USER> (print-calendar 1969) [Snoopy] 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 6 7 8 9 10 11 12 4 5 6 7 8 9 10 1 2 3 4 5 6 7 13 14 15 16 17 18 19 11 12 13 14 15 16 17 8 9 10 11 12 13 14 20 21 22 23 24 25 26 18 19 20 21 22 23 24 15 16 17 18 19 20 21 27 28 29 30 25 26 27 28 29 30 31 22 23 24 25 26 27 28 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30 NIL

import std. stdio , std. datetime , std. string , std. conv ;



void printCalendar ( in uint year , in uint nCols )

in {

assert ( nCols > 0 && nCols <= 12 ) ;

} body {

immutable rows = 12 / nCols + ( 12 % nCols != 0 ) ;

auto date = Date ( year , 1 , 1 ) ;

int offs = date. dayOfWeek ;

const months = "January February March April May June

July August September October November December" . split ;



string [ 8 ] [ 12 ] mons ;

foreach ( immutable m ; 0 .. 12 ) {

mons [ m ] [ 0 ] = months [ m ] . center ( 21 ) ;

mons [ m ] [ 1 ] = " Su Mo Tu We Th Fr Sa" ;

immutable dim = date. daysInMonth ;

foreach ( immutable d ; 1 .. 43 ) {

immutable day = d > offs && d <= offs + dim ;

immutable str = day ? format ( " %2s" , d - offs ) : " " ;

mons [ m ] [ 2 + ( d - 1 ) / 7 ] ~= str ;

}

offs = ( offs + dim ) % 7 ;

date. add ! "months" ( 1 ) ;

}



"[Snoopy Picture]" . center ( nCols * 24 + 4 ) . writeln ;

writeln ( year. text . center ( nCols * 24 + 4 ) , "

" ) ;

foreach ( immutable r ; 0 .. rows ) {

string [ 8 ] s ;

foreach ( immutable c ; 0 .. nCols ) {

if ( r * nCols + c > 11 )

break ;

foreach ( immutable i , line ; mons [ r * nCols + c ] )

s [ i ] ~= format ( " %s" , line ) ;

}

writefln ( "%-(%s

%)

" , s ) ;

}

}



void main ( ) {

printCalendar ( 1969 , 3 ) ;

}

[Snoopy Picture] 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

let getCalendar year =

let day_of_week month year =

let t = [ | 0 ; 3 ; 2 ; 5 ; 0 ; 3 ; 5 ; 1 ; 4 ; 6 ; 2 ; 4 | ]

let y = if month < 3 then year - 1 else year

let m = month

let d = 1

( y + y / 4 - y / 100 + y / 400 + t. [ m - 1 ] + d ) % 7

//0 = Sunday, 1 = Monday, ...



let last_day_of_month month year =

match month with

| 2 -> if ( 0 = year % 4 && ( 0 = year % 400 || 0 <> year % 100 ) ) then 29 else 28

| 4 | 6 | 9 | 11 -> 30

| _ -> 31



let get_month_calendar year month =

let min ( x: int , y: int ) = if x < y then x else y

let ld = last_day_of_month month year

let dw = 7 - ( day_of_week month year )

[ | [ | 1 .. dw | ] ;

[ |dw + 1 .. dw + 7 | ] ;

[ |dw + 8 .. dw + 14 | ] ;

[ |dw + 15 .. dw + 21 | ] ;

[ |dw + 22 .. min ( ld, dw + 28 ) | ] ;

[ |min ( ld + 1 , dw + 29 ) .. ld | ] | ]



let sb_fold ( f:System. Text . StringBuilder -> 'a -> System.Text.StringBuilder) (sb:System.Text.StringBuilder) (xs:' a array ) =

for x in xs do ( f sb x ) |> ignore

sb



let sb_append ( text: string ) ( sb:System. Text . StringBuilder ) = sb. Append ( text )



let sb_appendln sb = sb |> sb_append "

" |> ignore



let sb_fold_in_range a b f sb = [ |a.. b | ] |> sb_fold f sb |> ignore



let mask_builder mask = Printf . StringFormat < string -> string > ( mask )

let center n ( s: string ) =

let l = ( n - s. Length ) / 2 + s. Length

let f n s = sprintf ( mask_builder ( "%" + ( n. ToString ( ) ) + "s" ) ) s

( f l s ) + ( f ( n - l ) "" )

let left n ( s: string ) = sprintf ( mask_builder ( "%-" + ( n. ToString ( ) ) + "s" ) ) s

let right n ( s: string ) = sprintf ( mask_builder ( "%" + ( n. ToString ( ) ) + "s" ) ) s



let array2string xs =

let ys = xs |> Array . map ( fun x -> sprintf "%2d " x )

let sb = ys |> sb_fold ( fun sb y -> sb. Append ( y ) ) ( new System. Text . StringBuilder ( ) )

sb. ToString ( )



let xsss =

let m = get_month_calendar year

[ | 1 .. 12 | ] |> Array . map ( fun i -> m i )



let months = [ | "January" ; "February" ; "March" ; "April" ; "May" ; "June" ; "July" ; "August" ; "September" ; "October" ; "November" ; "December" | ]



let sb = new System. Text . StringBuilder ( )

sb |> sb_append "

" |> sb_append ( center 74 ( year. ToString ( ) ) ) |> sb_appendln

for i in 0 .. 3 .. 9 do

sb |> sb_appendln

sb |> sb_fold_in_range i ( i + 2 ) ( fun sb i -> sb |> sb_append ( center 21 months. [ i ] ) |> sb_append " " )

sb |> sb_appendln

sb |> sb_fold_in_range i ( i + 2 ) ( fun sb i -> sb |> sb_append "Su Mo Tu We Th Fr Sa " |> sb_append " " )

sb |> sb_appendln

sb |> sb_fold_in_range i ( i + 2 ) ( fun sb i -> sb |> sb_append ( right 21 ( array2string ( xsss. [ i ] . [ 0 ] ) ) ) |> sb_append " " )

sb |> sb_appendln

for j = 1 to 5 do

sb |> sb_fold_in_range i ( i + 2 ) ( fun sb i -> sb |> sb_append ( left 21 ( array2string ( xsss. [ i ] . [ j ] ) ) ) |> sb_append " " )

sb |> sb_appendln

sb. ToString ( )



let printCalendar year = getCalendar year

Output:

> printCalendar 1969;; val it : string = " 1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30 "

USING: arrays calendar.format grouping io.streams.string kernel

math.ranges prettyprint sequences sequences.interleaved ;

IN: rosetta-code.calendar



: calendar ( year -- )

12 [1,b] [ 2array [ month. ] with-string-writer ] with map

3 <groups> [ " " <interleaved> ] map 5 " " <repetition>

<interleaved> simple-table. ;



: calendar-demo ( -- ) 1969 calendar ;



MAIN: calendar-demo

Output:

January 1969 February 1969 March 1969 Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April 1969 May 1969 June 1969 Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July 1969 August 1969 September 1969 Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October 1969 November 1969 December 1969 Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

Already having a routine to produce a calendar simplified matters. However, it added to each row of days a row of annotations for those days (Xmas, etc. and also +2hh and -2hh for the days with two half-hour changes in length due to daylight saving: NZ also had daylight saving with changes of one half-hour) which meant that the field allowance was always four. With the annotations abandoned, this could be reduced to three, and, the first day column on a line does not need a leading space. Since the method employed variables for the layout, it could easily be twiddled to have three months per line (thus fitting into a line length of 80) or six (using most of a line length of 132) and so it became a matter of pulling together the needed routines from various places.



MODULE DATEGNASH !Assorted vexations. Time and calendar games, with local flavourings added.



TYPE DateBag !Pack three parts into one.

INTEGER DAY,MONTH,YEAR !The usual suspects.

END TYPE DateBag !Simple enough.



CHARACTER * 9 MONTHNAME ( 12 ) ,DAYNAME ( 0 : 6 ) !Re-interpretations.

PARAMETER ( MONTHNAME = ( / "January" , "February" , "March" , "April" ,

1 "May" , "June" , "July" , "August" , "September" , "October" , "November" ,

2 "December" / ) )

PARAMETER ( DAYNAME = ( / "Sunday" , "Monday" , "Tuesday" , "Wednesday" ,

1 "Thursday" , "Friday" , "Saturday" / ) ) !Index this array with DayNum mod 7.

CHARACTER * 3 MTHNAME ( 12 ) !The standard abbreviations.

PARAMETER ( MTHNAME = ( / "JAN" , "FEB" , "MAR" , "APR" , "MAY" , "JUN" ,

1 "JUL" , "AUG" , "SEP" , "OCT" , "NOV" , "DEC" / ) )



INTEGER * 4 JDAYSHIFT !INTEGER*2 just isn't enough.

PARAMETER ( JDAYSHIFT = 2415020 ) !Thus shall 31/12/1899 give 0, a Sunday, via DAYNUM.

CONTAINS

INTEGER FUNCTION LSTNB ( TEXT ) !Sigh. Last Not Blank.

Concocted yet again by R.N.McLean (whom God preserve) December MM.

Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!

Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces.

Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.

Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.

Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.

Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.

Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!

Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.

CHARACTER * ( * ) , INTENT ( IN ) :: TEXT !The bumf. If there must be copy-in, at least there need not be copy back.

INTEGER L !The length of the bumf.

L = LEN ( TEXT ) !So, what is it?

1 IF ( L. LE .0 ) GO TO 2 !Are we there yet?

IF ( ICHAR ( TEXT ( L : L ) ) . GT . ICHAR ( " " ) ) GO TO 2 !Control chars are regarded as spaces also.

L = L - 1 !Step back one.

GO TO 1 !And try again.

2 LSTNB = L !The last non-blank, possibly zero.

RETURN !Unsafe to use LSTNB as a variable.

END FUNCTION LSTNB !Compilers can bungle it.

CHARACTER * 2 FUNCTION I2FMT ( N ) !These are all the same.

INTEGER * 4 N !But, the compiler doesn't offer generalisations.

IF ( N. LT .0 ) THEN !Negative numbers cop a sign.

IF ( N. LT . - 9 ) THEN !But there's not much room left.

I2FMT = "-!" !So this means 'overflow'.

ELSE !Otherwise, room for one negative digit.

I2FMT = "-" // CHAR ( ICHAR ( "0" ) - N ) !Thus. Presume adjacent character codes, etc.

END IF !So much for negative numbers.

ELSE IF ( N. LT .10 ) THEN !Single digit positive?

I2FMT = " " // CHAR ( ICHAR ( "0" ) + N ) !Yes. This.

ELSE IF ( N. LT .100 ) THEN !Two digit positive?

I2FMT = CHAR ( N / 10 + ICHAR ( "0" ) ) !Yes.

1 // CHAR ( MOD ( N, 10 ) + ICHAR ( "0" ) ) !These.

ELSE !Otherwise,

I2FMT = "+!" !Positive overflow.

END IF !So much for that.

END FUNCTION I2FMT !No WRITE and FORMAT unlimbering.

CHARACTER * 8 FUNCTION I8FMT ( N ) !Oh for proper strings.

INTEGER * 4 N

CHARACTER * 8 HIC

WRITE ( HIC, 1 ) N

1 FORMAT ( I8 )

I8FMT = HIC

END FUNCTION I8FMT



SUBROUTINE SAY ( OUT ,TEXT ) !Gutted version that maintains no file logging output, etc.

INTEGER OUT

CHARACTER * ( * ) TEXT

WRITE ( 6 , 1 ) TEXT ( 1 : LSTNB ( TEXT ) )

1 FORMAT ( A )

END SUBROUTINE SAY



INTEGER * 4 FUNCTION DAYNUM ( YY,M,D ) !Computes (JDayN - JDayShift), not JDayN.

C Conversion from a Gregorian calendar date to a Julian day number, JDayN.

C Valid for any Gregorian calendar date producing a Julian day number

C greater than zero, though remember that the Gregorian calendar

C was not used before y1582m10d15 and often, not after that either.

C thus in England (et al) when Wednesday 2'nd September 1752 (Julian style)

C was followed by Thursday the 14'th, occasioning the Eleven Day riots

C because creditors demanded a full month's payment instead of 19/30'ths.

C The zero of the Julian day number corresponds to the first of January

C 4713BC on the *Julian* calendar's naming scheme, as extended backwards

C with current usage into epochs when it did not exist: the proleptic Julian calendar.

c This function employs the naming scheme of the *Gregorian* calendar,

c and if extended backwards into epochs when it did not exist (thus the

c proleptic Gregorian calendar) it would compute a zero for y-4713m11d24 *if*

c it is supposed there was a year zero between 1BC and 1AD (as is convenient

c for modern mathematics and astronomers and their simple calculations), *but*

c 1BC immediately preceeds 1AD without any year zero in between (and is a leap year)

c thus the adjustment below so that the date is y-4714m11d24 or 4714BCm11d24,

c not that this name was in use at the time...

c Although the Julian calendar (introduced by himself in what we would call 45BC,

c which was what the Romans occasionally called 709AUC) was provoked by the

c "years of confusion" resulting from arbitrary application of the rules

c for the existing Roman calendar, other confusions remain unresolved,

c so precise dating remains uncertain despite apparently precise specifications

c (and much later, Dennis the Short chose wrongly for the birth of Christ)

c and the Roman practice of inclusive reckoning meant that every four years

c was interpreted as every third (by our exclusive reckoning) so that the

c leap years were not as we now interpret them. This was resolved by Augustus

c but exactly when (and what date name is assigned) and whose writings used

c which system at the time of writing is a matter of more confusion,

c and this has continued for centuries.

C Accordingly, although an algorithm may give a regular sequence of date names,

c that does not mean that those date names were used at the time even if the

c calendar existed then, because the interpretation of the algorithm varied.

c This in turn means that a date given as being on the Julian calendar

c prior to about 10AD is not as definite as it may appear and its alignment

c with the astronomical day number is uncertain even though the calculation

c is quite definite.

c

C Computationally, year 1 is preceded by year 0, in a smooth progression.

C But there was never a year zero despite what astronomers like to say,

C so the formula's year 0 corresponds to 1BC, year -1 to 2BC, and so on back.

C Thus y-4713 in this counting would be 4714BC on the Gregorian calendar,

C were it to have existed then which it didn't.

C To conform to the civil usage, the incoming YY, presumed a proper BC (negative)

C and AD (positive) year is converted into the computational counting sequence, Y,

C and used in the formula. If a YY = 0 is (improperly) offered, it will manifest

C as 1AD. Thus YY = -4714 will lead to calculations with Y = -4713.

C Thus, 1BC is a leap year on the proleptic Gregorian calendar.

C For their convenience, astronomers decreed that a day starts at noon, so that

C in Europe, observations through the night all have the same day number.

C The current Western civil calendar however has the day starting just after midnight

C and that day's number lasts until the following midnight.

C

C There is no constraint on the values of D, which is just added as it stands.

C This means that if D = 0, the daynumber will be that of the last day of the

C previous month. Likewise, M = 0 or M = 13 will wrap around so that Y,M + 1,0

C will give the last day of month M (whatever its length) as one day before

C the first day of the next month.

C

C Example: Y = 1970, M = 1, D = 1; JDAYN = 2440588, a Thursday but MOD(2440588,7) = 3.

C and with the adjustment JDAYSHIFT, DAYNUM = 25568; mod 7 = 4 and DAYNAME(4) = "Thursday".

C The Julian Day number 2440588.0 is for NOON that Thursday, 2440588.5 is twelve hours later.

C And Julian Day number 2440587.625 is for three a.m. Thursday.

C

C DAYNUM and MUNYAD are the infamous routines of H. F. Fliegel and T.C. van Flandern,

C presented in Communications of the ACM, Vol. 11, No. 10 (October, 1968).

Carefully typed in again by R.N.McLean (whom God preserve) December XXMMIIX.

C Though I remain puzzled as to why they used I,J,K for Y,M,D,

C given that the variables were named in the INTEGER statement anyway.

INTEGER * 4 JDAYN !Without rebasing, this won't fit in INTEGER*2.

INTEGER YY,Y,M,MM,D !NB! Full year number, so 1970, not 70.

Caution: integer division in Fortran does not produce fractional results.

C The fractional part is discarded so that 4/3 gives 1 and -4/3 gives -1.

C Thus 4/3 might be Trunc(4/3) or 4 div 3 in other languages. Beware of negative numbers!

Y = YY !I can fiddle this copy without damaging the original's value.

IF ( Y. LT .1 ) Y = Y + 1 !Thus YY = -2=2BC, -1=1BC, +1=1AD, ... becomes Y = -1, 0, 1, ...

MM = ( M - 14 ) / 12 !Calculate once. Note that this is integer division, truncating.

JDAYN = D - 32075 !This is the proper astronomer's Julian Day Number.

a + 1461 * ( Y + 4800 + MM ) / 4

b + 367 * ( M - 2 - MM * 12 ) / 12

c - 3 * ( ( Y + 4900 + MM ) / 100 ) / 4

DAYNUM = JDAYN - JDAYSHIFT !Thus, *NOT* the actual *Julian* Day Number.

END FUNCTION DAYNUM !But one such that Mod(n,7) gives day names.



Could compute the day of the year somewhat as follows...

c DN:=D + (61*Month + (Month div 8)) div 2 - 30

c + if Month > 2 then FebLength - 30 else 0;



TYPE ( DATEBAG ) FUNCTION MUNYAD ( DAYNUM ) !Oh for palindromic programming!

Conversion from a Julian day number to a Gregorian calendar date. See JDAYN/DAYNUM.

INTEGER * 4 DAYNUM,JDAYN !Without rebasing, this won't fit in INTEGER*2.

INTEGER Y,M,D,L,N !Y will be a full year number: 1950 not 50.

JDAYN = DAYNUM + JDAYSHIFT !Revert to a proper Julian day number.

L = JDAYN + 68569 !Further machinations of H. F. Fliegel and T.C. van Flandern.

N = 4 * L / 146097

L = L - ( 146097 * N + 3 ) / 4

Y = 4000 * ( L + 1 ) / 1461001

L = L - 1461 * Y / 4 + 31

M = 80 * L / 2447

D = L - 2447 * M / 80

L = M / 11

M = M + 2 - 12 * L

Y = 100 * ( N - 49 ) + Y + L

IF ( Y. LT .1 ) Y = Y - 1 !The other side of conformity to BC/AD, as in DAYNUM.

MUNYAD % YEAR = Y !Now place for the world to see.

MUNYAD % MONTH = M

MUNYAD % DAY = D

END FUNCTION MUNYAD !A year has 365.2421988 days...



INTEGER FUNCTION PMOD ( N,M ) !Remainder, mod M; always positive even if N is negative.

c For date calculations, the MOD function is expected to yield positive remainders,

c in line with the idea that MOD(a,b) = MOD(a ± b,b) as is involved in shifting the zero

c of the daynumber count by a multiple of seven when considering the day of the week.

c For this reason, the zero day was chosen to be 31/12/1899, a Sunday, so that all

c day numbers would be positive. But, there was generation at Reefton in 1886.

c For some computers, the positive interpretation is implemented, for others, not.

c In the case MOD(N,M) = N - Truncate(N/M)*M, MOD(-6,7) = -6 even though MOD(1,7) = 1.

INTEGER N,M !The numbers. M presumed positive.

PMOD = MOD ( MOD ( N,M ) + M,M ) !Double do does de deed.

END FUNCTION PMOD !Simple enough.



SUBROUTINE CALENDAR ( Y1,Y2,COLUMNS ) !Print a calendar, with holiday annotations.

Careful with the MOD function. MOD(-6,7) may be negative on some systems, positive on others. Thus, PMOD.

INTEGER Y1,Y2,YEAR !Ah yes. Year stuff.

INTEGER M,M1,M2,MONTH !And within each year are the months.

INTEGER * 4 DN1,DN2,DN,D !But days are handled via day numbers.

INTEGER W,G !Layout: width and gap.

INTEGER L,LINE !Vertical layout.

INTEGER COL,COLUMNS,COLWIDTH !Horizontal layout.

INTEGER CODE !Days are not all alike.

CHARACTER * 200 STRIPE ( 6 ) ,SPECIAL ( 6 ) ,MLINE,DLINE !Scratchpads.

IF ( Y1. LE .0 ) CALL SAY ( MSG, "Despite the insinuations of "

1 // "astronomers seduced by the ease of their arithmetic, "

2 // "there is no year zero. 1AD is preceded by 1BC, "

3 // "corresponding to year -1, 2BC to year -2, etc." )

IF ( Y1. LT .1582 ) CALL SAY ( MSG, "This Gregorian calendar"

1 // " scheme did not exist prior to 1582." )

c COLUMNS = 4 !Number of months across the page.

c W = 4 !Width of a day's field.

c G = 3 !Added gap between month columns.

W = 3 !Abandon the annotation of the day's class, so just a space and two digits.

G = 1 !Set the gap to one.

COLWIDTH = 7 * W + G !Seven days to a week, plus a gap.

Y : DO YEAR = Y1,Y2 !Step through the years.

CALL SAY ( MSG, "" ) !Space out between each year's schedule.

IF ( YEAR. EQ .0 ) THEN !This year number is improper.

CALL SAY ( MSG, "There is no year zero." ) !Declare correctness.

CYCLE Y !Skip this year.

END IF !Otherwise, no evasions.

MLINE = "" !Prepare a field..

L = ( COLUMNS * COLWIDTH - G - 8 ) / 2 !Find the centre.

IF ( YEAR. GT .0 ) THEN !Ordinary Anno Domine years?

MLINE ( L : ) = I8FMT ( YEAR ) !Yes. Place the year number.

ELSE !Otherwise, we're in BC.

MLINE ( L - 1 : ) = I8FMT ( - YEAR ) // "BC" !There is no year zero.

END IF !So much for year games.

CALL SAY ( MSG,MLINE ) !Splot the year.

DO MONTH = 1 , 12 ,COLUMNS !Step through the months of this YEAR.

M1 = MONTH !The first of this lot.

M2 = MIN ( 12 ,M1 + COLUMNS - 1 ) !The last.

MLINE = "" !Scrub the month names.

DLINE = "" !Wipe the day names in case COLUMNS does not divide 12.

STRIPE = "" !Scrub the day table.

SPECIAL = "" !And the associated special day remarks.

c L0 = W - 1 !Locate the first day number's first column.

L0 = 1 !Cram: no space in front of the Sunday day-of-the-month.

DO M = M1,M2 !Work through the months.

L = ( COLWIDTH - G - LSTNB ( MONTHNAME ( M ) ) ) / 2 - 1 !Centre the month name.

MLINE ( L0 + L : ) = MONTHNAME ( M ) !Splot.

DO D = 0 , 6 !Prepare this month's day name heading.

L = L0 + ( 3 - W ) + D * W !Locate its first column.

DLINE ( L : L + 2 ) = DAYNAME ( D ) ( 1 : W - 1 ) !Squish.

END DO !On to the next day.

DN1 = DAYNUM ( YEAR,M, 1 ) !Day number of the first day of the month.

DN2 = DAYNUM ( YEAR,M + 1 , 0 ) !Thus the last, without annoyance.

COL = MOD ( PMOD ( DN1, 7 ) + 7 , 7 ) !What day of the week is the first day?

LINE = 1 !Whichever it is, it is on the first line.

D = 1 !Day of the month, not number of the day.

DO DN = DN1,DN2 !Step through the day numbers of this month.

L = L0 + COL * W !Finger the starting column.

STRIPE ( LINE ) ( L : L + 1 ) = I2FMT ( D ) !Place the two-digit day number.

D = D + 1 !Advance to the next day of the current month

COL = COL + 1 !So, one more day along in the week.

IF ( COL. GT .6 ) THEN !A fresh week is needed?

LINE = LINE + 1 !Yes.

COL = 0 !Start the new week.

END IF !So much for the end of a week.

END DO !On to the next day of this month.

L0 = L0 + 7 * W + G !Locate the start column of the next month's column.

END DO !On to the next month in this layer.

CALL SAY ( MSG,MLINE ) !Name the months.

C CALL SAY(MSG,"") !Set off.

CALL SAY ( MSG,DLINE ) !Give the day name headings.

DO LINE = 1 , 6 !Now roll the day number table.

IF ( STRIPE ( LINE ) . NE . "" ) THEN !Perhaps there was no use of the sixth line.

CALL SAY ( MSG,STRIPE ( LINE ) ) !Ah well. Show the day numbers.

END IF !So much for that week line.

END DO !On to the next week line.

END DO !On to the next batch of months of the YEAR.

END DO Y !On to the next YEAR.

CALL SAY ( MSG, "" ) !Take a breath.

END SUBROUTINE CALENDAR !Enough of this.

END MODULE DATEGNASH !An ad-hoc assemblage.



PROGRAM SHOW1968 !Put it to the test.

USE DATEGNASH

INTEGER NCOL

DO NCOL = 1 , 6

CALL CALENDAR ( 1969 , 1969 ,NCOL )

END DO

END



Selected output, lacking alas the outbursts from Snoopy: three months /line

1969 January February March Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 30 31 April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28 27 28 29 30 25 26 27 28 29 30 31 29 30 July August September Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 5 1 2 1 2 3 4 5 6 6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 31 October November December Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 2 3 4 5 6 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30

And with six...

1969 January February March April May June Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa 1 2 3 4 1 1 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7 5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14 12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21 19 20 21 22