This program generates a calendar of a given month and year. It was written in an era with no PDA's and cell phones.
YEAR : year
MONTH : month
XEQ "CALENDR" enter "YEAR" and "MONTH" R/S
The leftmost day is Sunday.
Use up/down arrows to view different weeks.
Press any key to go back to VARMENU.
Contents of x, y, z and t stack registers are destroyed.
R00 : loop counter
R01 : current day
R02 : day of the first Sunday in the display
R03 : number of days in the month
Flag 99 : non-interactive mode
YEAR : year
MONTH : month
V1.00 February 12, 1989
00 { 313-BYTE PRGM } ;
01 LBL "CALENDR" ;
02 MVAR "YEAR" ;
03 MVAR "MONTH" ;
04 LBL 00 ;
05 VARMENU "CALENDR" ;
06 FC? 99 ;
07 STOP ;
08 EXITALL ;
09 XEQ I ; Get day of week of day 0
10 1 ;
11 + ;
12 7 ;
13 MOD ; day of week of day 1
14 1 ;
15 X<>Y ;
16 - ; first day of week ( <= 1 )
17 STO 02 ;
18 XEQ D ; number of days in the month
19 STO 03 ;
20 LBL 02 ;Make calendar
21 CLA ; clear Alpha register
22 RCL 02 ; day to start
23 STO 01 ;
24 XEQ A ; make first week
25 |-"LF" ; append "linefeed"
;(key stroke = ALPHA ENTER DOWN PUNC DOWN LF)
26 XEQ A ; make second week
27 AVIEW ; show alpha register
28 GETKEY ; wait for key input
29 18 ;
30 X=Y? ; up arrow
31 GTO B ; go backward
32 CLX ;
33 23 ;
34 X=Y? ; down arrow
35 GTO F ; go forward
36 VIEW "MONTH" ;
37 GTO 00 ; go back to var menu
38 LBL B ;Backward
39 14 ;
40 STO- 02 ; start 14 days earlier
41 RCL 02 ;
42 -5 ;
43 X<=Y? ; if 1st day >= -5, remake calend
44 GTO 02 ; else move back forward
45 LBL F ;Forward
46 14 ;
47 STO+ 02 ; advance 14 days
48 RCL 02 ;
49 RCL 03 ;
50 X>=Y? ; if first day <= last day of mnt
51 GTO 02 ; remake calendar
52 GTO B ; else move back 14 days
;
53 LBL A ;Fill alpha register for a week
; input R1: first day of week
; R3: last day of month
; output:Alpha register
; R1: current day
54 7 ;
55 STO 00 ; loop counter
56 LBL 12 ; do for R0 = 7, 1, -1
57 RCL 03 ;
58 RCL 01 ;
59 X>Y? ; if day > max day then
60 +/- ; negate to suppress display
61 9 ;
62 X<>Y ;
63 X<=Y? ; if day < 9 then
64 |-" " ; append one blank
;(key stroke= ALPHA ENTER ABCDE blank)
65 X>0? ; if day > 0 then
66 AIP ; append day to alpha reg
67 X<=0? ; if day <= 0 then
68 |-" " ; append one blank
69 |-" " ; append another blank
70 1 ;
71 STO+ 01 ; increment day
72 DSE 00 ; enddo R0
73 GTO 12 ;
74 RTN ;
;
75 LBL D ;Number of days in month
; input :"YEAR", "MONTH"
; output:X-reg=# of days in month
76 2 ;
77 RCL "MONTH" ;
78 X=Y? ; if February,
79 GTO 22 ; branch to 22
80 8 ; else
81 X<>Y ; odd(even) months have 31 days
82 X>=Y? ; if month is < (>=) 8.
83 DSE ST X ; (this will not skip)
;(key stroke = PGM.FCN down DSE . ST X)
84 2 ;
85 MOD ;
86 30 ;
87 + ;
88 RTN ;
89 LBL 22 ; Feburary
90 RCL "YEAR" ;
91 ENTER ;
92 ENTER ;
93 ENTER ;
94 4 ;
95 MOD ;
96 X/=0? ; if not multiple of 4,
97 GTO 28 ; it is not a leap year
98 CLX ;
99 100 ;
100 MOD ;
101 X/=0? ; if not multiple of 100,
102 GTO 29 ; it is leap year
103 CLX ;
104 400 ;
105 MOD ; if mulitiple of 400,
106 X=0? ; it is leap year
107 GTO 29 ;
108 LBL 28 ; Not leap year:
109 28 ; return 28 days
110 RTN ;
111 LBL 29 ; Leap year:
112 29 ; return 29 days
113 RTN ;
;
114 LBL I ;Day of the week of the 0-th day
; input :"YEAR","MONTH"
; output:X-reg=day of week of the
; 0-th day.
; 0=Sun,..6=Sat
; DOW of 1st day is X+1
115 RCL "YEAR" ;
116 RCL "MONTH" ;
117 3 ;
118 X>Y? ; if month <3 then
119 DSE ST Z ; decrement year
120 RCL ST Z ;
121 400 ;
122 MOD ; Use mod(year,400)
123 ENTER ; advance 1 day every year
124 ENTER ;
125 ENTER ;
126 100 ;
127 BASE/ ; no leap year every 100 years
128 - ;
129 X<>Y ;
130 4 ;
131 BASE/ ; leap year every 4 years
132 + ;
133 RCL "MONTH" ; 3 -> 0, 4 -> 1,... 12 -> 9
134 9 ; 1 -> 10, 2 -> 11
135 + ;
136 12 ;
137 MOD ;
138 2.6 ; TY's method to get the
139 x ; offset for the month
140 2.4 ;
141 + ;
142 IP ;
143 + ;
144 END ;
Programmed by Taku Yamanaka, February 12, 1989.