Category : Databases and related files
Archive   : PORTCLDR.ZIP
Filename : CALSHOW.CLA
SHOW_CALNDAR PROCEDURE(INFIL",INHLP")
CALENDAR SCREEN WINDOW(23,44),PRE(CAL),HUE(14,1)
OMIT('**-END-**') Rows 2 thru 23
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º þþþþþþþþþþþþþþ º
ÇÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄĶ
º SUN ³ MON ³ TUE ³ WED ³ THU ³ FRI ³ SAT º
ºþþþ<#³ ³ ³ ³ ³ ³ º
ºþþþþþ³ ³ ³ ³ ³ ³ º
ÇÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄĶ
º ³ ³ ³ ³ ³ ³ º
º ³ ³ ³ ³ ³ ³ º
ÇÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄĶ
º ³ ³ ³ ³ ³ ³ º
º ³ ³ ³ ³ ³ ³ º
ÇÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄĶ
º ³ ³ ³ ³ ³ ³ º
º ³ ³ ³ ³ ³ ³ º
ÇÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄĶ
º ³ ³ ³ ³ ³ ³ º
º ³ ³ ³ ³ ³ ³ º
ÇÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄĶ
º ³ ³ ³ ³ ³ ³ º
º ³ ³ ³ ³ ³ ³ º
ÈÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍͼ
**-END-**
ROW(1,44) PAINT(1,1),TRN
ROW(23,3) PAINT(1,41),HUE(8,0),TRN
ROW(2,44) PAINT(22,1),HUE(8,0),TRN
ROW(23,1) PAINT(1,2),TRN
ROW(1,1) STRING('ÉÍ{41}»')
ROW(2,1) STRING('º<0{41}>º')
ROW(3,1) STRING('ÇÄ{5}ÂÄ{5}ÂÄ{5}ÂÄ{5}ÂÄ{5}ÂÄ{5}ÂÄ{5}¶')
ROW(4,1) REPEAT(3)
STRING('º<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>' |
& '³<0{5}>º') .
ROW(7,1) REPEAT(5),EVERY(3)
STRING('ÇÄ{5}ÅÄ{5}ÅÄ{5}ÅÄ{5}ÅÄ{5}ÅÄ{5}ÅÄ{5}¶') .
ROW(8,1) REPEAT(5),EVERY(3)
STRING('º<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>' |
& '³<0{5}>º') .
ROW(9,1) REPEAT(5),EVERY(3)
STRING('º<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>³<0{5}>' |
& '³<0{5}>º') .
ROW(22,1) STRING('ÈÍ{5}ÏÍ{5}ÏÍ{5}ÏÍ{5}ÏÍ{5}ÏÍ{5}ÏÍ{5}¼')
ROW(4,3) STRING('SUN')
COL(9) STRING('MON')
COL(15) STRING('TUE')
COL(21) STRING('WED')
COL(27) STRING('THU')
COL(33) STRING('FRI')
COL(39) STRING('SAT')
MONTHNAME ROW(2,16) STRING(14)
REPEAT(6,7),EVERY(3,6),INDEX(INDEX)
ROW(5,2) POINT(2,5),USE(?INDEX),HLP('CALENDAR'),SEL(0,7),REQ
DAY COL(5) STRING(@N_2B)
LN1 COL(2) STRING(3)
AM ROW(6,2) STRING(5)
. .
DATE LONG !SELECTED DATE
MONTH LONG !SELECTED MONTH
DAY LONG !SELECTED DAY
YEAR LONG !SELECTED YEAR
MONTH_YEAR STRING(14) !SELECTED MONTH AND YEAR
MONTH_NAMES GROUP !NAMES OF THE MONTHS
STRING('JANUARY FEBRUARY MARCH APRIL ')
STRING('MAY JUNE JULY AUGUST ')
STRING('SEPTEMBEROCTOBER NOVEMBER DECEMBER ')
.
MONTH_NAME STRING(9),DIM(12),OVER(MONTH_NAMES) !ARRAY OF MONTH NAMES
TRNSFORM_TBL GROUP !THIS TABLE TRANSFORMS
STRING('<01,07,13,19,25,31,37>') ! COLUMN WITHIN ROW
STRING('<02,08,14,20,26,32,38>') ! SEQUENCE
STRING('<03,09,15,21,27,33,39>') ! INTO
STRING('<04,10,16,22,28,34,40>') ! ROW WITHIN COLUMN
STRING('<05,11,17,23,29,35,41>') ! SEQUENCE
STRING('<06,12,18,24,30,36,42>') !
. !
TRANSFORM BYTE,DIM(42)OVER(TRNSFORM_TBL) !REDECLARE AS A BYTE ARRAY
INDEX BYTE !REPEAT INDEX
SAVE_INDEX BYTE !SAVE AREA FOR REPEAT INDEX
BASE_COL LONG !LAST COLUMN OF LAST MONTH
BASE_DATE LONG !LAST DAY OF LAST MONTH
I BYTE !SUBSCRIPT USED FOR DAY
LAST_DAY BYTE !LAST CALENDAR DAY OF MONTH
CODE
IF NOT INFIL"
APPOINTS" = 'CALENDAR'
ELSE
APPOINTS" = INFIL"
.
IF INHLP" THEN HELP('CALENDAR').
! IF NOT OMITTED(2) THEN HELP('CALENDAR').
OPEN(APPOINTS)
IF ERROR() THEN CREATE(APPOINTS).
DATE = TODAY() !SELECT TODAY'S DATE
MONTH = MONTH(DATE) !SELECT TODAY'S MONTH
DAY = DAY(DATE) !SELECT TODAY'S DAY
YEAR = YEAR(DATE) !SELECT TODAY'S YEAR
INDEX = TRANSFORM[(DATE-DAY+1) % 7 + DAY] !SET REPEAT INDEX
OPEN(CALENDAR) !SHOW THE CALENDAR
LOOP !LOOP UNTIL CTRL-ESC KEY
SAVE_INDEX = INDEX !SAVE REPEAT INDEX
CAL:MONTHNAME = CENTER(CLIP(MONTH_NAME[MONTH])&' '&YEAR,14)!SET MONTH AND YEAR
BASE_DATE = DATE(MONTH,1,YEAR) - 1 !SET BASE DATE
BASE_COL = (BASE_DATE + 1) % 7 !SET BASE COLUMN
LAST_DAY = DAY(DATE(MONTH+1,1,YEAR) -1) !GET LAST DAY OF MONTH
LOOP I = 1 TO BASE_COL !CLEAR LEADING UNUSED BOXES
INDEX = TRANSFORM[I] ! FOR THE MONTH DISPLAYED
CAL:DAY = '' ! CLEAR SCREEN VARIABLE
CAL:AM = '' ! "
CAL:LN1= '' ! "
.
LOOP I = (LAST_DAY + BASE_COL + 1) TO (42) !CLEAR TRAILING UNUSED BOXES
INDEX = TRANSFORM[I] ! FOR THE MONTH DISPLAYED
CAL:DAY = '' ! CLEAR SCREEN VARIABLE
CAL:AM = '' ! "
CAL:LN1= '' ! "
.
LOOP I = 1 TO LAST_DAY !LOOP FOR EACH DAY OF MONTH
INDEX = TRANSFORM[I + BASE_COL] !SET REPEAT INDEX TO TODAY
CAL:DAY = I !SHOW THE DAY OF THE MONTH
APP:DATE = BASE_DATE + I !SET THE DATE FOR THIS DAY
CAL:AM = '' !CLEAR SCREEN VARIABLE
CAL:LN1= '' !
GET(APPOINTS,APP:DATE_KEY) !READ THE APPOINTMENT RECORD
IF ~ERROR() !IF THERE IS A RECORD
DO SHOWDAY
. .
INDEX = SAVE_INDEX !RESTORE REPEAT INDEX
LOOP
ALERT !CLEAR ALL ALERT KEYS
ALERT(CTRL_HOME) !CTRL-HOME RESETS CALENDAR
ALERT(CTRL_ESC) !CTRL-ESC TERMINATES CALENDAR
ALERT(ESC_KEY)
ALERT(CTRL_E)
ACCEPT !GET AN ALERTED KEY STROKE
CASE KEYCODE() !JUMP TO THE KEYSTROKE
OF ENTER_KEY !DAY WAS SELECTED
T#=GET_APPOINTS(DATE(MONTH,CAL:DAY,YEAR)) ! GET APPOINTMENTS
IF T#
BREAK
ELSE
DO SHOWDAY
CYCLE ! DO NOT REDISPLAY CALENDAR
.
OF CTRL_E
APP:DATE = DATE(MONTH,CAL:DAY,YEAR) !SET THE RECORD KEY
GET(APPOINTS,APP:DATE_KEY) !READ THE RECORD
IF ERROR() THEN CYCLE. ! GET APPOINTMENTS
DELETE(APPOINTS) !DELETE RECORD
CAL:AM = ''
CAL:LN1= ''
CYCLE
OF CTRL_ESC OROF ESC_KEY !RETURN ON Ctrl-Esc KEY
IF INHLP" THEN HELP(INHLP").
! IF NOT OMITTED(2) THEN HELP(INHLP").
CLOSE(APPOINTS)
RETURN
OF PGUP_KEY !LAST MONTH ON PgUp kEY
MONTH-=1
OF PGDN_KEY !NEXT MONTH ON PgDn KEY
MONTH+=1
OF CTRL_PGUP !LAST YEAR ON Ctrl-PgUp KEY
YEAR-=1
OF CTRL_PGDN !NEXT YEAR ON Ctrl-PgDn KEY
YEAR+=1
OF CTRL_HOME !TODAY ON Ctrl-Home KEY
DATE = TODAY() !SELECT TODAY'S DATE
MONTH = MONTH(DATE) !SELECT TODAY'S MONTH
DAY = DAY(DATE) !SELECT TODAY'S DAY
YEAR = YEAR(DATE) !SELECT TODAY'S YEAR
INDEX = TRANSFORM[(DATE-DAY+1) % 7 + DAY]!SET REPEAT INDEX TO TODAY
.
IF MONTH < 1 THEN YEAR-=1;MONTH=12. !CORRECT MONTH UNDERFLOW
IF MONTH > 12 THEN YEAR+=1;MONTH=1. !CORRECT MONTH OVERFLOW
BREAK !REDISPLAY THE CALANDER
. .
SHOWDAY ROUTINE
IF APP:NOTES AND APP:AM AND APP:PM
CAL:AM = ' N*B'
ELSIF APP:NOTES AND APP:AM AND NOT APP:PM
CAL:AM = ' N*a'
ELSIF APP:NOTES AND APP:PM AND NOT APP:AM
CAL:AM = ' N*p'
ELSIF NOT APP:NOTES AND APP:PM AND APP:AM
CAL:AM = ' *B'
ELSIF NOT APP:NOTES AND APP:PM AND NOT APP:AM
CAL:AM = ' *p'
ELSIF NOT APP:NOTES AND APP:AM AND NOT APP:PM
CAL:AM = ' *a'
.
CASE APP:SIGN
OF 1
CAL:LN1 = ''
OF 2
CAL:LN1 = ''
OF 3
CAL:LN1 = ''
OF 4
CAL:LN1 = ' '
.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/