File: CALNDR.FC of Tape: Sources/Focal/fc3

(.FC,.FO Focal format converted to 'WRITE' listing) 

---

C-PS/8 FOCAL, 1971

01.01 C     CALNDR FROM 'PROGRAMMING LANGUAGES' COPYRIGHT 1970               
01.02 C     BY DIGITAL EQUIPMENT CORPORATION                                        
01.03 C     LAST CHANGE: 8/30/71                                                    
01.04 
01.05 C     GIVEN THE MONTH/DATE/YEAR, THE "PERPETUAL                                 
01.06 C CALENDAR" WILL TYPE THE DAY OF THE WEEK.                                      
01.07 
01.30 A "WHAT IS THE DATE?  (MM/DD/YYYY) ",M,K,C,!
01.32 I (M-13) 1.35;T "IN ORDER TO MAKE ROOM FOR THE MONTHS, THERE "
01.33 T "WERE NO DAYS!"!!;G 1.3
01.35 I (K-32) 1.4;T "MONTHS WITH",%3,K," DAYS DON'T EXIST IN",%4
01.36 T " THE YEAR",C,"!"!!;G 1.3
01.40 S C=C/100;S D=FITR(.1+100*(C-FITR(C)));S C=FITR(C)
01.50 S M=M-2;I (M) 5.4,5.4;G 5.5

05.40 S M=M+12;S D=D-1;I (-D) 5.5,5.5;S D=99;S C=C-1
05.50 S X=FITR<FITR[2.6*M-.2]+K+D+FITR[D/4]+FITR(C/4)-2*C>
05.60 I (X-6) 5.7,5.7;S X=X-7;G 5.6
05.70 T !"THE DAY IS ";D 6.1
05.90 T !!;G 1.3

06.10 I (X) 6.26,6.2;I (X-2) 6.21,6.22,6.15
06.15 I (X-4) 6.23,6.24;I (X-6) 6.25,6.26
06.20 T "SUNDAY
06.21 T "MONDAY
06.22 T "TUESDAY
06.23 T "WEDNESDAY
06.24 T "THURSDAY
06.25 T "FRIDAY";I (FABS(K-13)),6.3;
06.26 T "SATURDAY
06.30 T " THE 13TH!!"

---