Calendar - for "REAL" programmers: Difference between revisions

=={{header|REXX}}==

This is essentially the same REXX program as for the CALENDAR task, but written entirely

<br>in uppercase. Indeed, it could be written without any Latin (or any language) letters

<br>of any kind for the REXX program's variables.

<br><br>The other REXX program made use of lowercase letters for determining the minimum length of

<br>any of the options (from the command line), and a few stupid tricks were used to accomplish this.

<br>[Note: the command line may also be all uppercase.]

<br>In any case, both versions of the programs' output are identical (but the second REXX program

<br>sure as heck looks it was beat with an ugly stick ─── and pardon the strong language).

<lang rexx>

/*REXX PROGRAM TO SHOW ANY YEAR'S (MONTHLY) CALENDAR (WITH/WITHOUT GRID)*/

@ABC=

DO J=0 TO 255;_=D2C(J);IF DATATYPE(_,'L') THEN @ABC=@ABC||_;END

@ABCU=@ABC; UPPER @ABCU

DAYS_='SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY'

MONTHS_='JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER'

DAYS=; MONTHS=

DO J=1 FOR 7

_=LOWER(WORD(DAYS_,J))

DAYS=DAYS TRANSLATE(LEFT(_,1))SUBSTR(_,2)

END

DO J=1 FOR 12

_=LOWER(WORD(MONTHS_,J))

MONTHS=MONTHS TRANSLATE(LEFT(_,1))SUBSTR(_,2)

END

CALFILL=' '; MC=12; _='1 3 1234567890' "FB"X

PARSE VAR _ GRID CALSPACES # CHK . CV_ DAYS.1 DAYS.2 DAYS.3 DAYSN SD SW

_=0; PARSE VAR _ COLS 1 JD 1 LOWERCASE 1 MAXKALPUTS 1 NARROW 1,

NARROWER 1 NARROWEST 1 SHORT 1 SHORTER 1 SHORTEST 1,

SMALL 1 SMALLER 1 SMALLEST 1 UPPERCASE

PARSE ARG MM '/' DD "/" YYYY _ '(' OPS; UOPS=OPS

IF _\=='' | \IS#(MM) | \IS#(DD) | \IS#(YYYY) THEN CALL ERX 86

@CALMONTHS ='CALMON' || LOWER('THS')

@CALSPACES ='CALSP' || LOWER('ACES')

@DEPTH ='DEP' || LOWER('TH')

@GRIDS ='GRID' || LOWER('S')

@LOWERCASE ='LOW' || LOWER('ERCASE')

@NARROW ='NAR' || LOWER('ROW')

@NARROWER ='NARROWER'

@NARROWEST ='NARROWES' || LOWER('T')

@SHORT ='SHOR' || LOWER('T')

@SHORTER ='SHORTER'

@SHORTEST ='SHORTES' || LOWER('T')

@UPPERCASE ='UPP' || LOWER('ERCASE')

@WIDTH ='WID' || LOWER('TH')

DO WHILE OPS\==''; OPS=STRIP(OPS,'L'); PARSE VAR OPS _1 2 1 _ . 1 _O OPS

UPPER _

SELECT

WHEN ABB(@CALMONTHS) THEN MC=NAI()

WHEN ABB(@CALSPACES) THEN CALSPACES=NAI()

WHEN ABB(@DEPTH) THEN SD=NAI()

WHEN ABBN(@GRIDS) THEN GRID=NO()

WHEN ABBN(@LOWERCASE) THEN LOWERCASE=NO()

WHEN ABBN(@NARROW) THEN NARROW=NO()

WHEN ABBN(@NARROWER) THEN NARROWER=NO()

WHEN ABBN(@NARROWEST) THEN NARROWEST=NO()

WHEN ABBN(@SHORT) THEN SHORT=NO()

WHEN ABBN(@SHORTER) THEN SHORTER=NO()

WHEN ABBN(@SHORTEST) THEN SHORTEST=NO()

WHEN ABBN(@SMALL) THEN SMALL=NO()

WHEN ABBN(@SMALLER) THEN SMALLER=NO()

WHEN ABBN(@SMALLEST) THEN SMALLEST=NO()

WHEN ABBN(@UPPERCASE) THEN UPPERCASE=NO()

WHEN ABB(@WIDTH) THEN SW=NAI()

OTHERWISE NOP

END /*SELECT*/

END /*DO WHILE OPTS\== ...*/

MC=INT(MC,'MONTHSCALENDER'); IF MC>0 THEN CAL=1

DAYS=' 'DAYS; MONTHS=' 'MONTHS

CYYYY=RIGHT(DATE(),4); HYY=LEFT(CYYYY,2); LYY=RIGHT(CYYYY,2)

DY.=31; _=30; PARSE VAR _ DY.4 1 DY.6 1 DY.9 1 DY.11; DY.2=28+LY(YYYY)

YY=RIGHT(YYYY,2); SD=P(SD 43); SW=P(SW 80); CW=10; CINDENT=1; CALWIDTH=76

IF SMALL THEN DO; NARROW=1 ; SHORT=1 ; END

IF SMALLER THEN DO; NARROWER=1 ; SHORTER=1 ; END

IF SMALLEST THEN DO; NARROWEST=1; SHORTEST=1; END

IF SHORTEST THEN SHORTER=1

IF SHORTER THEN SHORT =1

IF NARROW THEN DO; CW=9; CINDENT=3; CALWIDTH=69; END

IF NARROWER THEN DO; CW=4; CINDENT=1; CALWIDTH=34; END

IF NARROWEST THEN DO; CW=2; CINDENT=1; CALWIDTH=20; END

CV_=CALWIDTH+CALSPACES+2

CALFILL=LEFT(COPIES(CALFILL,CW),CW)

DO J=1 FOR 7; _=WORD(DAYS,J)

DO JW=1 FOR 3; _D=STRIP(SUBSTR(_,CW*JW-CW+1,CW))

IF JW=1 THEN _D=CENTRE(_D,CW+1)

ELSE _D=LEFT(_D,CW+1)

DAYS.JW=DAYS.JW||_D

END /*JW*/

__=DAYSN

IF NARROWER THEN DAYSN=__||CENTRE(LEFT(_,3),5)

IF NARROWEST THEN DAYSN=__||CENTER(LEFT(_,2),3)

END /*J*/

_YYYY=YYYY; CALPUTS=0; CV=1; _MM=MM+0; MONTH=WORD(MONTHS,MM)

DY.2=28+LY(_YYYY); DIM=DY._MM; _DD=01; DOW=DOW(_MM,_DD,_YYYY); $DD=DD+0

/*─────────────────────────────NOW: THE BUSINESS OF THE BUILDING THE CAL*/

CALL CALGEN

DO _J=2 TO MC

IF CV_\=='' THEN DO

CV=CV+CV_

IF CV+CV_>=SW THEN DO; CV=1; CALL CALPUT

CALL FCALPUTS;CALL CALPB

END

ELSE CALPUTS=0

END

ELSE DO;CALL CALPB;CALL CALPUT;CALL FCALPUTS;END

_MM=_MM+1; IF _MM==13 THEN DO; _MM=1; _YYYY=_YYYY+1; END

MONTH=WORD(MONTHS,_MM); DY.2=28+LY(_YYYY); DIM=DY._MM

DOW=DOW(_MM,_DD,_YYYY); $DD=0; CALL CALGEN

END /*_J*/

CALL FCALPUTS

RETURN _

/*─────────────────────────────CALGEN SUBROUTINE────────────────────────*/

CALGEN: CELLX=;CELLJ=;CELLM=;CALCELLS=0;CALLINE=0

CALL CALPUT

CALL CALPUTL COPIES('─',CALWIDTH),"┌┐"; CALL CALHD

CALL CALPUTL MONTH ' ' _YYYY ; CALL CALHD

IF NARROWEST | NARROWER THEN CALL CALPUTL DAYSN

ELSE DO JW=1 FOR 3

IF SPACE(DAYS.JW)\=='' THEN CALL CALPUTL DAYS.JW

END

CALFT=1; CALFB=0

DO JF=1 FOR DOW-1; CALL CELLDRAW CALFILL,CALFILL; END

DO JY=1 FOR DIM; CALL CELLDRAW JY; END

CALFB=1

DO 7; CALL CELLDRAW CALFILL,CALFILL; END

IF SD>32 & \SHORTER THEN CALL CALPUT

RETURN

/*─────────────────────────────CELLDRAW SUBROUTINE──────────────────────*/

CELLDRAW: PARSE ARG ZZ,CDDOY;ZZ=RIGHT(ZZ,2);CALCELLS=CALCELLS+1

IF CALCELLS>7 THEN DO

CALLINE=CALLINE+1

CELLX=SUBSTR(CELLX,2)

CELLJ=SUBSTR(CELLJ,2)

CELLM=SUBSTR(CELLM,2)

CELLB=TRANSLATE(CELLX,,")(─-"#)

IF CALLINE==1 THEN CALL CX

CALL CALCSM; CALL CALPUTL CELLX; CALL CALCSJ; CALL CX

CELLX=; CELLJ=; CELLM=; CALCELLS=1

END

CDDOY=RIGHT(CDDOY,CW); CELLM=CELLM'│'CENTER('',CW)

CELLX=CELLX'│'CENTRE(ZZ,CW); CELLJ=CELLJ'│'CENTER('',CW)

RETURN

/*═════════════════════════════GENERAL 1-LINE SUBS══════════════════════*/

ABB:ARG ABBU;PARSE ARG ABB;RETURN ABBREV(ABBU,_,ABBL(ABB))

ABBL:RETURN VERIFY(ARG(1)LEFT(@ABC,1),@ABC,'M')-1

ABBN:PARSE ARG ABBN;RETURN ABB(ABBN)|ABB('NO'ABBN)

CALCSJ:IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;IF SD>24&\SHORT THEN CALL CALPUTL CELLJ; RETURN

CALCSM:IF SD>24&\SHORT THEN CALL CALPUTL CELLM;IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;RETURN

CALHD:IF SD>24&\SHORTER THEN CALL CALPUTL;IF SD>32&\SHORTEST THEN CALL CALPUTL;RETURN

CALPB:IF \GRID&SHORTEST THEN CALL PUT CHK;RETURN

CALPUT:CALPUTS=CALPUTS+1;MAXKALPUTS=MAX(MAXKALPUTS,CALPUTS);IF SYMBOL('CT.'CALPUTS)\=='VAR' THEN CT.CALPUTS=;CT.CALPUTS=OVERLAY(ARG(1),CT.CALPUTS,CV);RETURN

CALPUTL:CALL CALPUT COPIES(' ',CINDENT)LEFT(ARG(2)"│",1)CENTER(ARG(1),CALWIDTH)||RIGHT('│'ARG(2),1);RETURN

CX:CX_='├┤';CX=COPIES(COPIES('─',CW)'┼',7);IF CALFT THEN DO;CX=TRANSLATE(CX,'┬',"┼");CALFT=0;END;IF CALFB THEN DO;CX=TRANSLATE(CX,'┴',"┼");CX_='└┘';CALFB=0;END;CALL CALPUTL CX,CX_;RETURN

DOW:PROCEDURE;ARG M,D,Y;IF M<3 THEN DO;M=M+12;Y=Y-1;END;YL=LEFT(Y,2);YR=RIGHT(Y,2);W=(D+(M+1)*26%10+YR+YR%4+YL%4+5*YL)//7;IF W==0 THEN W=7;RETURN W

ER:PARSE ARG _1,_2;CALL '$ERR' "14"P(_1) P(WORD(_1,2) !FID(1)) _2;IF _1<0 THEN RETURN _1;EXIT RESULT

ERR:CALL ER '-'ARG(1),ARG(2);RETURN ''

ERX:CALL ER '-'ARG(1),ARG(2);EXIT ''

FCALPUTS: DO J=1 FOR MAXKALPUTS;CALL PUT CT.J;END;CT.=;MAXKALPUTS=0;CALPUTS=0;RETURN

INT:INT=NUMX(ARG(1),ARG(2));IF \ISINT(INT) THEN CALL ERX 92,ARG(1) ARG(2);RETURN INT/1

IS#:RETURN VERIFY(ARG(1),#)==0

ISINT:RETURN DATATYPE(ARG(1),'W')

LOWER:RETURN TRANSLATE(ARG(1),@ABC,@ABCU)

LY:ARG _;IF LENGTH(_)==2 THEN _=HYY||_;LY=_//4==0;IF LY==0 THEN RETURN 0;LY=((_//100\==0)|_//400==0);RETURN LY

NA:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);PARSE VAR OPS NA OPS;IF NA=='' THEN CALL ERX 35,_O;RETURN NA

NAI:RETURN INT(NA(),_O)

NAN:RETURN NUMX(NA(),_O)

NO:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);RETURN LEFT(_,2)\=='NO'

NUM:PROCEDURE;PARSE ARG X .,F,Q;IF X=='' THEN RETURN X;IF DATATYPE(X,'N') THEN RETURN X/1;X=SPACE(TRANSLATE(X,,','),0);IF DATATYPE(X,'N') THEN RETURN X/1;RETURN NUMNOT()

NUMNOT:IF Q==1 THEN RETURN X;IF Q=='' THEN CALL ER 53,X F;CALL ERX 53,X F

NUMX:RETURN NUM(ARG(1),ARG(2),1)

P:RETURN WORD(ARG(1),1)

PUT:_=ARG(1);_=TRANSLATE(_,,'_'CHK);IF \GRID THEN _=UNGRID(_);IF LOWERCASE THEN _=LOWER(_);IF UPPERCASE THEN UPPER _;IF SHORTEST&_=' ' THEN RETURN;CALL TELL _;RETURN

TELL:SAY ARG(1);RETURN

UNGRID:RETURN TRANSLATE(ARG(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")

</lang>

Output when using the input of: <tt> 1/1/1969 (noGrid shortest narrowest)

<pre style="height:40ex;overflow:scroll">

«Snoopy "picture" here»

January 1969 February 1969 March 1969

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

5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8

12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15

19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22

26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29

30 31

April 1969 May 1969 June 1969

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 3 1 2 3 4 5 6 7

6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14

13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21

20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28

27 28 29 30 25 26 27 28 29 30 31 29 30

July 1969 August 1969 September 1969

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

6 7 8 9 10 11 12 3 4 5 6 7 8 9 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

20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27

27 28 29 30 31 24 25 26 27 28 29 30 28 29 30

31

October 1969 November 1969 December 1969

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 2 3 4 5 6

5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13

12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20

19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27

26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31

30

</pre>