Calendar - for "REAL" programmers: Difference between revisions
→{{header|Icon}} and {{header|Unicon}}: Add FORTRAN
(Mathematica's functions are case-sensitive) |
(→{{header|Icon}} and {{header|Unicon}}: Add FORTRAN) |
||
Line 637:
].</lang>
=={{header|Fortran}}==
Alas, the header "FORTRAN" is not recognised - REAL programmers were absent that day? Even upon the apperance of lower case, I have preferred to use shouting for programme source, and normal upper/lower case for commentary. Aside from petty details such as 1 and l being nowhere as distinct as 1 and L, this allows the two sorts of blather to be identifiably different without ratiocination as the hours drag past. Further, the names of variables can easily be distinguished from the same word in discussion, as in ... the text in TEXT will be printed as the subtitle to the text in TITLE ... Anyway, in the spirit of old, herewith the source without tedious commentary:
<lang FORTRAN>
MODULE DATEGNASH
TYPE DATEBAG
INTEGER DAY,MONTH,YEAR
END TYPE DATEBAG
CHARACTER*9 MONTHNAME(12),DAYNAME(0:6)
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"/))
INTEGER*4 JDAYSHIFT
PARAMETER (JDAYSHIFT = 2415020)
CONTAINS
INTEGER FUNCTION LSTNB(TEXT)
CHARACTER*(*),INTENT(IN):: TEXT
INTEGER L
L = LEN(TEXT)
1 IF (L.LE.0) GO TO 2
IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2
L = L - 1
GO TO 1
2 LSTNB = L
RETURN
END FUNCTION LSTNB
CHARACTER*2 FUNCTION I2FMT(N)
INTEGER*4 N
IF (N.LT.0) THEN
IF (N.LT.-9) THEN
I2FMT = "-!"
ELSE
I2FMT = "-"//CHAR(ICHAR("0") - N)
END IF
ELSE IF (N.LT.10) THEN
I2FMT = " " //CHAR(ICHAR("0") + N)
ELSE IF (N.LT.100) THEN
I2FMT = CHAR(N/10 + ICHAR("0"))
1 //CHAR(MOD(N,10) + ICHAR("0"))
ELSE
I2FMT = "+!"
END IF
END FUNCTION I2FMT
CHARACTER*8 FUNCTION I8FMT(N)
INTEGER*4 N
CHARACTER*8 HIC
WRITE (HIC,1) N
1 FORMAT (I8)
I8FMT = HIC
END FUNCTION I8FMT
SUBROUTINE SAY(OUT,TEXT)
INTEGER OUT
CHARACTER*(*) TEXT
WRITE (6,1) TEXT(1:LSTNB(TEXT))
1 FORMAT (A)
END SUBROUTINE SAY
INTEGER*4 FUNCTION DAYNUM(YY,M,D)
INTEGER*4 JDAYN
INTEGER YY,Y,M,MM,D
Y = YY
IF (Y.LT.1) Y = Y + 1
MM = (M - 14)/12
JDAYN = D - 32075
A + 1461*(Y + 4800 + MM)/4
B + 367*(M - 2 - MM*12)/12
C - 3*((Y + 4900 + MM)/100)/4
DAYNUM = JDAYN - JDAYSHIFT
END FUNCTION DAYNUM
TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM)
INTEGER*4 DAYNUM,JDAYN
INTEGER Y,M,D,L,N
JDAYN = DAYNUM + JDAYSHIFT
L = JDAYN + 68569
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
MUNYAD%YEAR = Y
MUNYAD%MONTH = M
MUNYAD%DAY = D
END FUNCTION MUNYAD
INTEGER FUNCTION PMOD(N,M)
INTEGER N,M
PMOD = MOD(MOD(N,M) + M,M)
END FUNCTION PMOD
SUBROUTINE CALENDAR(Y1,Y2,COLUMNS)
INTEGER Y1,Y2,YEAR
INTEGER M,M1,M2,MONTH
INTEGER*4 DN1,DN2,DN,D
INTEGER W,G
INTEGER L,LINE
INTEGER COL,COLUMNS,COLWIDTH
CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE
W = 3
G = 1
COLWIDTH = 7*W + G
Y:DO YEAR = Y1,Y2
CALL SAY(MSG,"")
IF (YEAR.EQ.0) THEN
CALL SAY(MSG,"THERE IS NO YEAR ZERO.")
CYCLE Y
END IF
MLINE = ""
L = (COLUMNS*COLWIDTH - G - 8)/2
IF (YEAR.GT.0) THEN
MLINE(L:) = I8FMT(YEAR)
ELSE
MLINE(L - 1:) = I8FMT(-YEAR)//"BC"
END IF
CALL SAY(MSG,MLINE)
DO MONTH = 1,12,COLUMNS
M1 = MONTH
M2 = MIN(12,M1 + COLUMNS - 1)
MLINE = ""
DLINE = ""
STRIPE = ""
SPECIAL = ""
L0 = 1
DO M = M1,M2
L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1
MLINE(L0 + L:) = MONTHNAME(M)
DO D = 0,6
L = L0 + (3 - W) + D*W
DLINE(L:L + 2) = DAYNAME(D)(1:W - 1)
END DO
DN1 = DAYNUM(YEAR,M,1)
DN2 = DAYNUM(YEAR,M + 1,0)
COL = MOD(PMOD(DN1,7) + 7,7)
LINE = 1
D = 1
DO DN = DN1,DN2
L = L0 + COL*W
STRIPE(LINE)(L:L + 1) = I2FMT(D)
D = D + 1
COL = COL + 1
IF (COL.GT.6) THEN
LINE = LINE + 1
COL = 0
END IF
END DO
L0 = L0 + 7*W + G
END DO
CALL SAY(MSG,MLINE)
CALL SAY(MSG,DLINE)
DO LINE = 1,6
IF (STRIPE(LINE).NE."") THEN
CALL SAY(MSG,STRIPE(LINE))
END IF
END DO
END DO
END DO Y
CALL SAY(MSG,"")
END SUBROUTINE CALENDAR
END MODULE DATEGNASH
PROGRAM SHOW1968
USE DATEGNASH
INTEGER NCOL
DO NCOL = 1,6
CALL CALENDAR(1969,1969,NCOL)
END DO
END
</lang>
And for output, the wide form:
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 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30
30 31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
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 5 1 2 1 2 3 4 5 6 1 2 3 4 1 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 5 6 7 8 9 10 11 2 3 4 5 6 7 8 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 12 13 14 15 16 17 18 9 10 11 12 13 14 15 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 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
31 30
As before, with a leading space for layout here.
Actual lineprinters offer the opportunity of overprinting lines, so with underlines (and for overlines, an underline on the previous line) the appearance can be improved. Vertical bars can also be used, and more advanced lineprinters (IBM1403 etc. using the "TN" chain) or dot-matrix printers also supplied "corner" glyphs so that boxes would not have leaks.
=={{header|Icon}} and {{header|Unicon}}==
Icon and Unicon don't lend themselves to ''REAL'' programming in the sense of this task easily. And initially this task was marked ''omit'' because the primary declarations, reserved words, and the name of the ''main'' procedure are all in lowercase. However, getting in the spirit of the task real programmers do not give up and a number of solutions are possible:
| |||