.enable quiet,substitution,lowercase .disable suffix,prefix,octal .; .; CALNDR.COM .; .; A Program written entirely in IND .; to generate a calender on VT100,VT200 terminals .; .; Tony Euser .; 568 Booth Street .; PMRL/EMR-Canada .; 613-990-0440 ; .SETF IFLAG .PARSE "-" DA MONTH YEAR .1: .IF MONTH EQ "JAN" .OR .IF MONTH EQ "Jan" .SETN MAX 31 .IF MONTH EQ "FEB" .OR .IF MONTH EQ "Feb" .SETN MAX 28 .IF MONTH EQ "MAR" .OR .IF MONTH EQ "Mar" .SETN MAX 31 .IF MONTH EQ "APR" .OR .IF MONTH EQ "Apr" .SETN MAX 30 .IF MONTH EQ "MAY" .OR .IF MONTH EQ "May" .SETN MAX 31 .IF MONTH EQ "JUN" .OR .IF MONTH EQ "Jun" .SETN MAX 30 .IF MONTH EQ "JUL" .OR .IF MONTH EQ "Jul" .SETN MAX 31 .IF MONTH EQ "AUG" .OR .IF MONTH EQ "Aug" .SETN MAX 31 .IF MONTH EQ "SEP" .OR .IF MONTH EQ "Sep" .SETN MAX 30 .IF MONTH EQ "OCT" .OR .IF MONTH EQ "Oct" .SETN MAX 31 .IF MONTH EQ "NOV" .OR .IF MONTH EQ "Nov" .SETN MAX 30 .IF MONTH EQ "DEC" .OR .IF MONTH EQ "Dec" .SETN MAX 31 .;Let's calculate the day of the week for the 1st day of each month .IF MONTH EQ "JAN" .OR .IF MONTH EQ "Jan" .SETN M 1 .IF MONTH EQ "FEB" .OR .IF MONTH EQ "Feb" .SETN M 2 .IF MONTH EQ "MAR" .OR .IF MONTH EQ "Mar" .SETN M 3 .IF MONTH EQ "APR" .OR .IF MONTH EQ "Apr" .SETN M 4 .IF MONTH EQ "MAY" .OR .IF MONTH EQ "May" .SETN M 5 .IF MONTH EQ "JUN" .OR .IF MONTH EQ "Jun" .SETN M 6 .IF MONTH EQ "JUL" .OR .IF MONTH EQ "Jul" .SETN M 7 .IF MONTH EQ "AUG" .OR .IF MONTH EQ "Aug" .SETN M 8 .IF MONTH EQ "SEP" .OR .IF MONTH EQ "Sep" .SETN M 9 .IF MONTH EQ "OCT" .OR .IF MONTH EQ "Oct" .SETN M 10 .IF MONTH EQ "NOV" .OR .IF MONTH EQ "Nov" .SETN M 11 .IF MONTH EQ "DEC" .OR .IF MONTH EQ "Dec" .SETN M 12 .SETN DATE 'DA' .SETN YE 'YEAR' .;================================================================== .;algorithm to test for leap years .;remember,IND returns only integer values .SETN LY YE*10./4. .SETN LDY LY/10. .SETN TEST LY-(LDY*10.) .IF TEST EQ 0. .AND .IF MAX EQ 28. .SETN MAX 29. .;================================================================= .SETN FDAT 1 .SETN BCOL 4. .IFT IFLAG .SETN BCOL 54. .SETN MAXCOL 29. .IFT IFLAG .SETN MAXCOL 79. .SETN COLH 2. .IFT IFLAG .SETN COLH 52. .SETN MCOL 12. .IFT IFLAG .SETN MCOL 62. .;================================================================= .;Now let's calculate which day of the week the first of each month .;falls on .IF YE GE 85 .GOTO 2 .SETN YE YE+100. .2: .SETN M1 M+1 .SETN M2 (10./M1+7.)/10. .SETN M3 YE-M2 .SETN M4 M1+(12.*M2) .SETN N ((M4*306.)/10.)+(365.*M3)+((25.*M3)/100.)+FDAT .SETN M6 N/7. .SETN W N-(M6*7) .SETN X 8. .SETN Y BCOL+(W*4.) .;================================================================= .SETN DAY 1 .SETS YEARR "19"+YEAR ;[3;'MCOL'H'MONTH'. 'YEARR' ;(0 ;[5;'COLH'Hlqqqwqqqwqqqwqqqwqqqwqqqwqqqk ;[6;'COLH'HxSUNxMONxTUExWEDxTHUxFRIxSATx ;[7;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[8;'COLH'Hx x x x x x x x ;[9;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[10;'COLH'Hx x x x x x x x ;[11;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[12;'COLH'Hx x x x x x x x ;[13;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[14;'COLH'Hx x x x x x x x ;[15;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[16;'COLH'Hx x x x x x x x ;[17;'COLH'Htqqqnqqqnqqqnqqqnqqqnqqqnqqqu ;[18;'COLH'Hx x x x x x x x ;[19;'COLH'Hmqqqvqqqvqqqvqqqvqqqvqqqvqqqj(B .DISABLE LOWERCASE .10: .TESTFILE 'DAY''YE'.'MONTH' .IF NE 1 .GOTO 11 .SETN Y1 Y-1 ;['X';'Y1'H* .11: .IF DAY EQ DATE .AND .IF MONTH EQ [4.:6.] ;['X';'Y'H ;['X';'Y'H'DAY' .IF DAY GE MAX .GOTO 20 .SETN Y Y+4 .IF Y GT MAXCOL .SETN X X+2 .IF Y GT MAXCOL .SETN Y BCOL .INC DAY .GOTO 10 .20: .IFT IFLAG .GOTO 60 .DISABLE LOWERCASE .22: .ASKS YESNO Would you like to preview another month? .ONERR .GOTO 22 .IF YESNO EQ "N" .GOTO 60 .25: .ASKS NUDAT Enter the month and year [MMM-YY] (use hyphen) eg.Jun-86 : .TEST NUDAT "-" .IF =0 .GOTO 25 .ENABLE LOWERCASE .PARSE NUDAT "-" MONTH YEAR .SETT IFLAG .GOTO 1 .60: ; .exit