Calendar: Difference between revisions

</pre>

=={{header|Forth}}==

<syntaxhighlight lang="forth">

: weekday ( d m y -- u )

over 3 < if swap 12 + swap 1- then

dup 4 / over 100 / - over 400 / + + swap 1+ 13 * 5 / + + 2 - 7 mod ;

: mdays ( m y -- msize mday )

over 12 = if 31 1 2swap weekday negate exit then

2>r 1 2r@ weekday 1 2r> swap 1+ swap weekday over -

7 + 7 mod 28 + swap negate ;

: .week ( msize mday -- msize mday' )

7 0 do dup 0< if 1+ 3 spaces else

2dup > if 1+ dup 2 .r space else 3 spaces then then loop ;

: .3months ( y m -- )

3 0 do ." Mo Tu We Th Fr Sa Su " loop cr

3 over + swap do i over mdays rot loop drop

6 0 do 2rot .week 2 spaces 2rot .week 2 spaces 2rot .week cr loop

2drop 2drop 2drop ;

: cal ( y -- )

30 spaces ." [Snoopy]" cr

32 spaces dup . cr

." January February March" cr

dup 1 .3months

." April May June" cr

dup 4 .3months

." July August September" cr

dup 7 .3months

." October November December" cr

10 .3months ;

1969 cal

</syntaxhighlight>

{{out}}

<pre>

[Snoopy]

1969

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