*** CALENDR2.prg
*
*  (c) CTS, MRI 1990
*
*=-  Print a calendar for the current month
*
*      an array will be used to hold the days of the month.  It will
*      be 42 elements in size to compensate for the potential of any
*      calendar covering 6 partial weeks.  The calendar's form is:
*
*                   Sun Mon Tue Wed Thu Fri Sat
*         week 1     xx  xx  xx  xx  xx  xx  xx
*         week 2     xx  xx  xx  xx  xx  xx  xx
*         week 3     xx  xx  xx  xx  xx  xx  xx
*         week 4     xx  xx  xx  xx  xx  xx  xx
*         week 5     xx  xx  xx  xx  xx  xx  xx
*         week 6     xx  xx  xx  xx  xx  xx  xx
*
*     the first and last week may have several spaces blank
*
*=-
DECL x[42,1]
mTALK=SET("TALK")='ON'
SET TALK OFF
y=1
*
*=-  Fill array with spaces
*
DO WHILE y<43
    x[y,1]=SPACE(2)
    y=y+1
ENDDO
*
*=-  Get first day of month
*
xSTDAY=DATE()-DAY(DATE())+1
*
*=-  Get the first subscript element to use for fill the array
*
y=DOW(xSTDAY)
*
*=- used for filling the subscript of the month
*
xMONTH=MONTH(DATE())
DO WHILE .T.
  IF MONTH(xSTDAY)=xMONTH
    x[y,1]=STR(DAY(xSTDAY),2)
    y=y+1
    xSTDAY=xSTDAY+1
  ELSE
    EXIT
  ENDIF
ENDDO
*
*=- Print the calendar
*
@1,12 SAY TRAN(CMONTH(DATE()),"@R X X X X X X X X X")
@2,22 SAY YEAR(DATE())
@3,5 to 11,33
@4,6 SAY 'Sun Mon Tue Wen Thu Fri Sat'
a=1
y=5
z=7
b=1
DO WHILE A<43
    *=- Print 7 subscripts (a row of any week)
    DO WHILE B<8
        @y,z SAY x[a,1]
        a=a+1
        b=b+1
        z=z+4
    ENDDO
    b=1
    y=y+1
    z=7
ENDDO
IF mTALK
  SET TALK ON
ENDIF
RETURN
*** End of CALENDR2.prg
*