main.bas

#RetroDevStudio.MetaData.BASIC:2049,BASIC V2,uppercase,10,10

# TODOS:
# - BUG: https://archive.org/details/transactor-magazines-v7-i04/page/n79/mode/1up
# - PET INPUT BUG (USE CONT AS WORKAROUND)

# NOTES:
# - EXPANDED VIC20 START ADDRESS: 4097
# - PET BASIC START ADDRESS: 1025
# - C64 BASIC START ADDRESS: 2049
# - C128 BASIC START ADDRESS: 7169

1000 REM ---------------------------
1010 REM --- CONFIG.GLOBAL VARS. ---
1020 REM ---------------------------
1030 CF$="CBMCAL-CONF":REM CONFIG.FILE
1040 DE=8:REM DISK DEVICE NR. (8,9,..)
1050 DD$="0":REM DISK DRV. NR. (0 OR 1)
1060 YE=2024:REM YEAR
1070 MO=4:REM MONTH (1 TO 12)
1080 REM --------------------------
1090 REM --- OTHER GLOBAL VARS. ---
1100 REM --------------------------
1110 DIM DW(11):REM FOR WEEKDAY-BY-DATE
1120 DIM WD$(6):REM THE WEEKDAYS
1130 DIM MD(11):REM NON-LEAP MONTH DAYS
1140 DIM DT$(7):REM DAY DATES'TITLES
1150 DIM DH(7):REM DAY DATES'HOURS
1160 DIM DM(7):REM DAY DATES'MINUTES
1170 DIM DF(7):REM DAY DATES'F.DAY FLAG
1180 DIM ME(31):REM HAS DAY ENTRY/-IES?
1190 I=0:J=0:K=0:REM COUNTERS
1200 B0=0:B1=0:B2=0:REM NUMBER BUFFERS
1210 E0=0:E1=0:E2=0:E0$="":REM DISK ERR.
1220 B0$="":B1$="":REM STRING BUFFERS
1230 IN$="":REM FOR USER INPUT
1240 CO$="":REM STORES A USER COMMAND
1250 DA=0:REM DAY (0 <=> NO DATE SET)
1260 ET$="":REM CALENDAR ENTRY'S TITLE
1270 HO=0:REM HOURS OF CALENDAR ENTRY
1280 MI=0:REM MINUTES OF CALENDAR ENTRY
1290 FL=0:REM FULL DAY FLAG OF C.ENTRY
1300 WD=0:REM INDEX INTO WD$
1310 EE=0:REM INDICATE ERROR TO CALLER
1320 REM ------------------------
1330 REM --- INIT "CONSTANTS" ---
1340 REM ------------------------
1350 RL=144:REM RECORD LENGTH
1360 CN=2:REM CONF.FILE & CHANNEL NR.
1370 RN=3:REM REL.FILE & CHANNEL NR.
1380 RC=31:REM RECORD COUNT PER FILE
1390 Z$=CHR$(0):REM READ BYTE HELPER
1391 R$=CHR$(13)
1400 FOR I=0TO11:READ DW(I):NEXT I
1410 FOR I=0TO6:READ WD$(I):NEXT I
1420 FOR I=0TO11:READ MD(I):NEXT I
1430 REM ------------------------------
1440 REM --- OPEN DISK CMD. CHANNEL ---
1450 REM ------------------------------
1460 OPEN15,DE,15
1470 REM ------------------------
1480 REM --- TRY TO INIT.DISK ---
1490 REM ------------------------
1500 GOSUB1620:REM IGNORING ERR.FLAG!
1510 REM --------------------
1520 REM --- JUMP TO MAIN ---
1530 REM --------------------
1540 GOTO7250
1550 REM -------------------
1560 REM --- SUBROUTINES ---
1570 REM -------------------
1580 REM ******************************
1590 REM *** INITIALIZE DISK. SETS  ***
1600 REM *** ERROR FLAG EE AND LOGS ***
1610 REM ******************************
1620 EE=0:PRINT#15,"I"DD$
1630 GOSUB6240:REM READS DISK ERROR
1640 IF E0=0THEN1670:REM OK-RETURN
1650 EE=-1
1660 PRINT"FAILED TO INITIALIZE DISK!"
1670 RETURN
1680 REM ******************************
1690 REM *** GET REL.FILE N. TO B1$ ***
1700 REM ******************************
1710 B1$=RIGHT$(STR$(YE),4)
1720 B0=MO:B0$="0":GOSUB5290
1730 B1$=B1$+"-"+B0$
1740 RETURN
1750 REM ******************************
1760 REM *** CREATE NEW REL. WITH   ***
1770 REM *** NAME IN B1$. ASSUMES   ***
1780 REM *** FILE NOT EXIST., YET.  ***
1790 REM *** SETS ERROR FLAG EE.    ***
1800 REM ******************************
1810 OPEN RN,DE,RN,DD$+":"+B1$+",L,"+CHR$(RL)
1820 GOSUB6240:REM READS DISK ERROR
1830 IF E0<>0THEN1960:REM ERR.-RETURN
1840 REM ASSUMES RC TO BE BELOW 256:
1850 PRINT#15,"P"CHR$(96+RN)CHR$(RC)Z$CHR$(RL);
1860 GOSUB6240:REM READS DISK ERROR
1870 IF E0<>50THEN1960
1880 PRINT# RN,CHR$(255);:REM IS EMPTY
1890 GOSUB6240:REM READS DISK ERROR
1900 IF E0<>0THEN1960
1910 REM RE-POSITION TO AVOID BUG:
1920 PRINT#15,"P"CHR$(96+RN)CHR$(RC)Z$CHR$(RL);
1930 GOSUB6240:REM READS DISK ERROR
1940 IF E0<>0THEN1960:REM ERR.-RETURN
1950 EE=0:GOTO 1980:REM OK-RETURN
1960 PRINT"ERROR: NEW REL.FILE!";E0
1970 EE=-1:REM ERROR OCCURRED!
1980 CLOSE RN
1990 RETURN
2000 REM **************************
2010 REM *** TRY READ CONF.FILE ***
2020 REM **************************
2030 OPEN CN,DE,CN,DD$+":"+CF$+",S,R"
2070 GOSUB6240
2080 IF E0=62THEN2130:REM NOT FOUND,OK
2090 IF E0=0THEN2120
2100 PRINT"ERROR: READ CONF.FILE!";E0
2110 GOTO 2130:REM RETURNS ON ERROR
2120 INPUT# CN,DE,DD$,YE,MO
2130 CLOSE CN:RETURN
2140 REM ******************************
2150 REM *** B1$ REL. EXISTS? => B0 ***
2160 REM *** SETS ERROR FLAG EE     ***
2170 REM ******************************
2180 OPEN RN,DE,RN,DD$+":"+B1$
2190 GOSUB6240:REM READS DISK ERROR
2200 IF E0<>0 THEN2220
2210 EE=0:B0=-1:CLOSE RN:RETURN
2220 IF E0<>62 THEN2240
2230 EE=0:B0=0:CLOSE RN:RETURN
2240 PRINT"ERROR: OPEN REL.FILE!";E0
2250 EE=1:CLOSE RN:RETURN
2260 REM ******************************
2270 REM *** (OVER-)WRITE DAY REC.  ***
2280 REM *** ASSUMES REL.EXISTS AND ***
2290 REM *** B1$ HOLDS FILENAME AND ***
2300 REM *** DT$()&DH()&DM()&DF()   ***
2310 REM *** ARE SET TO FOR CUR.DAY ***
2320 REM *** AND ALREADY ORDERED!   ***
2330 REM ******************************
2340 IF E0<>0 THEN2790:REM ERR.-RETURN
2350 B0$="":REM TO HOLD BYTES TO WRITE
2360 FOR I=0TO7:REM FOR EACH SLOT/ENTRY
2370 IF DT$(I)<>"" THEN2440:REM EMPTY?
2390 REM IS EMPTY
2400 FOR J=0TO17
2410 B0$=B0$+CHR$(255)
2420 NEXT J
2430 GOTO2630
2440 J=0
2460 IF DF(I) THEN2490:REM ALL-DAY?
2480 J=60*DH(I)+DM(I):GOTO2510:REM H:M
2490 J=256*128:REM ALL-DAY CAL.ENTRY
2510 B2=INT(J/256):B1=J-256*B2
2520 IF B2=0 THEN B2=255:REM ENCODES 0
2530 IF B1=0 THEN B1=255:REM ENCODES 0
2540 B0$=B0$+DT$(I)
2550 K=LEN(DT$(I))
2560 IF K=16THEN2600
2570 FOR J=K TO15
2580 B0$=B0$+" ":REM FILL WITH SPACES
2590 NEXT J
2600 B0$=B0$+CHR$(B1)+CHR$(B2)
2610 GOTO2630
2620 I=7:EE=-1:REM GRACEFUL ERR.EXIT
2630 NEXT I
2640 OPEN RN,DE,RN,DD$+":"+B1$+",L,"+CHR$(RL)
2650 GOSUB6240:REM READS DISK ERROR
2660 IF E0<>0THEN2790:REM ERR.-RETURN
2670 REM ASSUMING 1<=DA<=31
2680 PRINT#15,"P"CHR$(96+RN)CHR$(DA)Z$CHR$(1);
2690 GOSUB6240:REM READS DISK ERROR
2700 IF E0<>0THEN2790:REM ERR.-RETURN
2710 PRINT# RN,B0$;:REM WRITES RECORD
2720 GOSUB6240:REM READS DISK ERROR
2730 IF E0<>0THEN2790:REM ERR.-RETURN
2740 REM RE-POSITION TO AVOID BUG:
2750 PRINT#15,"P"CHR$(96+RN)CHR$(DA)Z$CHR$(1);
2760 GOSUB6240:REM READS DISK ERROR
2770 IF E0<>0 THEN2790:REM ERR.-RETURN
2780 EE=0:GOTO2810:REM OK-RETURN
2790 PRINT"ERROR: WRITE TO REL.FILE!";E0
2800 EE=-1:REM ERROR OCCURRED!
2810 CLOSE RN:RETURN
2820 REM ******************************
2830 REM *** (OVER-)WRITE CAL.ENTRY ***
2840 REM ******************************
2850 GOSUB1710:REM REL.NAME TO B1$
2860 GOSUB2180:REM DOES REL.FILE EXIST?
2870 IF EE<>0THEN2930:REM ALR.PRINTED
2880 IF B0 THEN2920
2900 GOSUB1810:REM CREATE REL.FILE
2910 IF EE<>0THEN2930:REM ALR.PRINTED
2920 GOSUB2340:REM (OVER-)WR. DAY REC.
2930 RETURN:REM ALR.PRINTED,IF ERR.OCC.
2940 REM ******************************
2950 REM *** (OVER-)WRITE CONF.FILE ***
2960 REM ******************************
2970 OPEN CN,DE,CN,"@"+DD$+":"+CF$+",S,W"
2980 REM (OLD-1541-BUG IS NO PROBLEM,
2981 REM AS LONG AS DEVICE NR.IS USED)
3010 GOSUB6240
3020 IF E0=0THEN3050
3030 PRINT"ERROR: WRITE CONF.FILE!";E0
3040 GOTO3090:REM RETURNS ON ERROR
3050 PRINT# CN,DE;R$;DD$;R$;YE;R$;MO;R$;
3090 CLOSE CN:RETURN
3100 REM ******************************
3110 REM *** LEAP YEAR YES/NO TO B2 ***
3120 REM ******************************
3130 IF YE/100<>INT(YE/100) GOTO3160
3140 IF YE/400=INT(YE/400) GOTO3170
3150 B2=0:RETURN:REM NOT A LEAP YEAR
3160 IF YE/4<>INT(YE/4) GOTO3150
3170 B2=1:RETURN:REM IT IS A LEAP YEAR
3180 REM ******************************
3190 REM *** INPUT POS.OR 0 INTEGER ***
3200 REM ******************************
3210 PRINT B0$;:IN$="":INPUT IN$
3220 IF0<LEN(IN$) THEN3250
3230 PRINT"PLEASE ENTER A NUMBER."
3240 GOTO3210:REM TRY AGAIN..
3250 B0=VAL(IN$)
3260 IF0<=B0 THEN3290
3270 PRINT"NUMBER IS LESS THAN ZERO."
3280 GOTO3210:REM TRY AGAIN..
3290 IF B0=INT(B0) THEN3320
3300 PRINT"NUMBER IS NOT AN INTEGER."
3310 GOTO3210:REM TRY AGAIN..
3320 RETURN
3330 REM ****************************
3340 REM *** INPUT CALENDAR ENTRY ***
3350 REM ****************************
3360 HO=0:MI=0:REM NOT NECESSARY..
3370 FL=-1:REM TRUE BY DEFAULT
3380 INPUT"ALL DAY (Y/N)";IN$
3390 IF IN$="Y" THEN 3490
3400 FL=0:REM HAS A SPECIFIC TIME SET
3410 B0$="HOURS":GOSUB3210:HO=B0
3420 IF HO<=23THEN3450
3430 PRINT"INVALID HOURS ENTERED."
3440 GOTO3410:REM TRY AGAIN..
3450 B0$="MINUTES":GOSUB3210:MI=B0
3460 IF MI<=59THEN3490
3470 PRINT"INVALID MINUTES ENTERED."
3480 GOTO3450:REM TRY AGAIN..
3490 IN$="":INPUT"TITLE";IN$
3500 B0=LEN(IN$):IF0<B0 THEN3530
3510 PRINT"PLEASE ENTER A TITLE."
3520 GOTO3490:REM TRY AGAIN..
3530 IF B0<=16 THEN3560
3540 PRINT"TITLE TOO LONG (MAX. LENGTH IS 16)."
3550 GOTO3490:REM TRY AGAIN..
3560 ET$=IN$
3570 RETURN
3580 REM ***********************
3590 REM *** REMOVE AN ENTRY ***
3600 REM ***********************
3610 IF DA>0THEN3619
3611 PRINT"PLEASE SET A DATE, FIRST."
3612 GOTO3760:REM JUST RETURNS
3619 IF LEN(IN$)=2THEN3640
3620 PRINT"INVALID INPUT FORMAT."
3630 GOTO3760:REM JUST RETURNS
3640 I=VAL(RIGHT$(IN$,1))
3650 IF 1<=I AND I<=8THEN3671
3660 PRINT"INVALID INPUT NUMBER."
3670 GOTO3760:REM JUST RETURNS
3671 I=I-1
3672 IF DT$(I)<>"" THEN3675
3673 PRINT"SLOT IS ALREADY EMPTY."
3674 GOTO3760:REM JUST RETURNS
3675 ET$=DT$(I):FL=DF(I):HO=DH(I):MI=DM(I)
3676 GOSUB5360:REM PRINTS CAL.ENTRY
3680 INPUT"REALLY ERASE (Y/N)";IN$
3690 IF IN$="Y" THEN3720
3700 PRINT"SKIPPED ERASING OF ENTRY."
3710 GOTO3760:REM JUST RETURNS
3720 DT$(I)=""
3730 DH(I)=0:DM(I)=0:DF(I)=-1
3740 GOSUB7070:REM SORT ENTRIES IN MEM.
3750 GOSUB2850:REM (OVER-)WRITES DAY
3760 RETURN
3770 REM ******************************
3780 REM *** TRY TO ADD/OVERWRITE   ***
3790 REM *** ENTRY IN MEMORY. => B0 ***
3800 REM ******************************
3810 J=-1:REM INDEX TO OVERWRITE
3820 IF FL THEN3890
3830 FOR I=0TO7:REM FIND EXISTING HO:MI
3840 IF DF(I) OR DT$(I)="" OR DH(I)<>HO OR DM(I)<>MI THEN3870
3850 J=I:REM REMEMBER INDEX TO OVERWR.
3860 I=7:REM DONE
3870 NEXT I
3880 IF0<=J THEN3960
3890 FOR I=0TO7:REM FIND EMPTY
3900 IF DT$(I)<>"" THEN3930
3910 J=I:REM REMEMBER FIRST EMPTY SLOT
3920 I=7:REM DONE
3930 NEXT I
3940 IF0<=J THEN3960
3950 PRINT"NO FREE SLOT FOUND!":B0=0:RETURN
3960 DT$(J)=ET$:DH(J)=HO:DM(J)=MI:DF(J)=FL
3970 B0=-1:RETURN:REM SUCCESS
3980 REM *****************************
3990 REM *** TRY TO INPUT AND      ***
4000 REM *** (OVER-)WRITE AN ENTRY ***
4010 REM *****************************
4020 IF DA>0THEN4050
4030 PRINT"PLEASE SET A DATE, FIRST."
4040 GOTO4150:REM RETURNS W/O SET DATE
4050 GOSUB3360:REM INPUT CAL.ENTRY
4060 GOSUB5360:REM PRINTS CAL.ENTRY
4070 INPUT"REALLY (OVER-)WRITE (Y/N)";IN$
4080 IF IN$="Y" THEN 4110
4090 PRINT"SKIPPED WRITING TO FILE."
4100 GOTO4150
4110 GOSUB3810:REM ADD/OVERWR. IN MEM.
4120 IF NOT B0 THEN4150:REM ALR.LOGGED
4130 GOSUB7070:REM SORT ENTRIES IN MEM.
4140 GOSUB2850:REM (OVER-)WRITES DAY
4150 RETURN
4160 REM ******************************
4170 REM *** FILL ME().IF EXISTING, ***
4180 REM *** FILL FROM MONTH FILE.  ***
4190 REM ******************************
4200 EE=0
4210 FOR I=1TO31
4220 ME(I-1)=0:REM DEFAULT: NO ENTRIES
4230 NEXT I
4240 GOSUB1710:REM REL.NAME TO B1$
4250 GOSUB2180:REM DOES REL.FILE EXIST?
4260 IF EE<>0THEN4510:REM ALR.PRINTED
4270 IF NOT B0 THEN4510
4280 REM FILE *DOES* EXIST
4290 REM *** FILL ME() FROM EX.FILE ***
4300 OPEN RN,DE,RN,DD$+":"+B1$+",L,"+CHR$(RL)
4310 GOSUB6240:REM READS DISK ERROR
4320 IF E0<>0THEN4440:REM ERR.-RETURN
4330 FOR I=1TO31
4340 PRINT#15,"P"CHR$(96+RN)CHR$(I)Z$CHR$(1);
4350 GOSUB6240:REM READS DISK ERROR
4360 IF E0<>0THEN4440:REM ERR.-RETURN
4370 GET# RN,B1$
4380 GOSUB6240:REM READS DISK ERROR
4390 IF E0<>0THEN4440:REM ERR.-RETURN
4400 IF B1$<>CHR$(255)THEN ME(I-1)=-1
4410 PRINT#15,"P"CHR$(96+RN)CHR$(I)Z$CHR$(1);
4420 GOSUB6240:REM READS DISK ERROR
4430 IF E0=0THEN4450
4440 EE=-1:I=31:REM GRACEFUL ERR.-EXIT
4450 NEXT I
4460 IF EE THEN4490
4470 GOTO4500
4480 EE=-1
4490 PRINT"ERROR: READ FROM REL.FILE!";E0
4500 CLOSE RN
4510 RETURN
4520 REM *****************************
4530 REM *** LOAD DAY FROM FILE.   ***
4540 REM *** FILE MUST EXIST.      ***
4550 REM *** B1$ MUST HOLD NAME    ***
4560 REM *** DAY ARRAYS MUST ALR.  ***
4570 REM *** BE SET TO EMPTY.      ***
4580 REM *** DA MUST BE SET.       ***
4590 REM *****************************
4600 OPEN RN,DE,RN,DD$+":"+B1$+",L,"+CHR$(RL)
4610 GOSUB6240:REM READS DISK ERROR
4620 IF E0<>0THEN5040:REM ERR.-RETURN
4630 PRINT#15,"P"CHR$(96+RN)CHR$(DA)Z$CHR$(1);
4640 GOSUB6240:REM READS DISK ERROR
4650 IF E0<>0THEN5040:REM ERR.-RETURN
4660 FOR I=0TO7
4670 B0$=""
4680 GET# RN,B1$
4690 IF B1$<>CHR$(255)THEN4780
4710 IF (ST AND 64)=0THEN4740
4730 I=7:GOTO4970:REM END OF RECORD
4740 FOR J=1TO17:REM REPOS. INSTEAD?
4750 GET# RN,B1$
4760 NEXT J
4770 GOTO4970
4780 B0$=B1$
4800 FOR J=1TO15:REM REST OF TITLE
4810 GET# RN,B1$:B0$=B0$+B1$
4820 NEXT J
4830 GET# RN,B1$:REM LOW B.
4840 B1=ASC(B1$+Z$):IF B1=255THEN B1=0
4850 GET# RN,B1$:REM HIG.B.
4860 B2=ASC(B1$+Z$):IF B2=255THEN B2=0
4870 GOSUB6240:REM READS DISK ERROR
4880 IF E0<>0THEN4960:REM ERR.-RETURN
4890 DF(I)=-1
4900 IF B2 AND128THEN4940:REM ALL-DAY
4920 DF(I)=0:J=256*B2+B1
4930 DH(I)=INT(J/60):DM(I)=J-60*DH(I)
4940 DT$(I)=B0$
4950 GOTO4970
4960 I=7:EE=-1:REM GRACEFUL ERR.EXIT
4970 NEXT I
4980 IF EE THEN5040:REM ERR.-RETURN
4990 REM RE-POSITION TO AVOID BUG:
5000 PRINT#15,"P"CHR$(96+RN)CHR$(DA)Z$CHR$(1);
5010 GOSUB6240:REM READS DISK ERROR
5020 IF E0<>0THEN5040:REM ERR.-RETURN
5030 EE=0:GOTO5060:REM OK-RETURN
5040 PRINT"ERROR: READ FROM REL.FILE!";E0
5050 EE=-1:REM ERROR OCCURRED!
5060 CLOSE RN:RETURN
5070 REM ******************************
5080 REM *** TRY LOAD DAY FR. FILE  ***
5090 REM *** PREPARES EMPTY DAY, IF ***
5100 REM *** NO REL.FILE FOUND.     ***
5110 REM ******************************
5120 FOR I=0TO7
5130 DT$(I)="":REM INDICATES EMPTY ENT.
5140 DH(I)=0
5150 DM(I)=0
5160 DF(I)=-1:REM ALWAYS SET,IF EMPTY.
5170 NEXT I
5180 GOSUB1710:REM REL.NAME TO B1$
5190 GOSUB2180:REM DOES REL.FILE EXIST?
5200 IF EE<>0THEN5240:REM ALR.PRINTED
5210 IF NOT B0 THEN5240
5220 REM FILE *DOES* EXIST
5230 GOSUB4600:REM ACTUALLY LOAD.
5240 RETURN
5250 REM ******************************
5260 REM *** POS.INT.B0 2 2-DIG.B0$ ***
5270 REM *** B0$ MUST HOLD PLACEH.  ***
5280 REM ******************************
5290 IF B0<10THEN5310
5300 B0$=RIGHT$(STR$(B0),2):RETURN
5310 B0$=B0$+RIGHT$(STR$(B0),1):RETURN
5320 REM ******************************
5330 REM *** PRINT CAL.ENTRY,IF NOT ***
5340 REM *** EMPTY                  ***
5350 REM ******************************
5360 IF ET$="" THEN5440:REM EMPTY?
5370 PRINT" ";
5380 IF FL THEN5420
5390 B0=HO:B0$="0":GOSUB5290:PRINT B0$+":";
5400 B0=MI:B0$="0":GOSUB5290:PRINT B0$;
5410 GOTO5430
5420 PRINT"--:--";:REM ALL-DAY ENTRY
5430 PRINT" ";ET$
5440 RETURN
5450 REM *****************
5460 REM *** PRINT DAY ***
5470 REM *****************
5480 PRINT"":PRINT" ";
5490 PRINT WD$(WD);", ";
5500 PRINT RIGHT$(STR$(YE),4);
5510 PRINT"/";
5520 B0=MO:B0$="0":GOSUB5290:PRINT B0$;
5530 PRINT"/";
5540 B0=DA:B0$="0":GOSUB5290:PRINT B0$
5550 PRINT""
5560 FOR I=0TO7
5570 FL=DF(I):HO=DH(I):MI=DM(I)
5580 ET$=DT$(I)
5590 IF ET$="" THEN5610
5600 PRINT" ";RIGHT$(STR$(I+1),1);")";
5610 GOSUB5360:REM PRINTS CAL.ENTRY
5620 NEXT I
5630 IF DT$(0)<>"" THEN PRINT""
5640 RETURN
5650 REM *******************
5660 REM *** PRINT MONTH ***
5670 REM *******************
5680 PRINT"":PRINT" ";
5690 PRINT RIGHT$(STR$(YE),4);
5700 PRINT"/";
5710 B0=MO:B0$="0":GOSUB5290:PRINT B0$
5720 PRINT""
5730 REM TITLE ROW (THE WEEKDAYS):
5740 PRINT " ";
5750 FOR I=0TO5
5760 PRINT WD$(I);"  ";
5770 NEXT I
5780 PRINT WD$(6)
5790 REM 1ST (MAYBE INCOMPL.) DAY ROW:
5800 FOR I=0TO6
5810 IF I>=WD THEN5830
5820 PRINT "   ";:GOTO5870
5830 B0=I-WD+1:B0$=" ":GOSUB5290:PRINT" "B0$;
5840 IF ME(B0-1) THEN5860
5850 PRINT" ";:GOTO5870:REM NO ENTRY
5860 PRINT"*";:REM HAS ENTRY/-IES
5870 NEXT I
5880 PRINT
5890 REM FOLLOWING (COMPLETE) DAY ROWS:
5900 B0=I-WD+1
5910 B1=MD(MO-1)
5920 IF MO<>2THEN5960:REM NO FEBRUARY
5930 GOSUB3130:REM IS A LEAP YEAR?
5940 IF B2=0THEN5960:REM NO LEAP YEAR
5950 B1=B1+1:REM 29 DAYS IN FEBRUARY
5960 J=0
5970 FOR I=B0 TO B1
5980 B0=I:B0$=" ":GOSUB5290:PRINT" "B0$;
5990 IF ME(I-1) THEN6010
6000 PRINT" ";:GOTO6020:REM NO ENTRY
6010 PRINT"*";:REM HAS ENTRY/-IES
6020 J=J+1
6030 IF J<7THEN6060
6040 PRINT""
6050 J=0
6060 NEXT I
6070 PRINT"":PRINT""
6080 RETURN
6090 REM *****************************
6100 REM *** FILL WD BY YE,MO & DA ***
6110 REM *****************************
6120 B0=YE
6130 IF MO<3 THEN B0=B0-1
6140 WD=B0+INT(B0/4)
6150 WD=WD-INT(B0/100)
6160 WD=WD+INT(B0/400)
6170 WD=WD+DW(MO-1)+DA
6180 WD=WD-INT(WD/7)*7
6190 WD=WD+6:WD=WD-INT(WD/7)*7
6200 RETURN
6210 REM ******************************
6220 REM *** READ DISK ERR. CHANNEL ***
6230 REM ******************************
6240 INPUT#15,E0,E0$,E1,E2:RETURN
6250 REM ******************************
6260 REM *** MONTH FROM INPUT CMD.  ***
6270 REM *** OR JUST A RELOAD&PRINT ***
6280 REM ******************************
6290 B0=LEN(IN$)
6300 IF B0=1THEN6420
6310 IF B0=7THEN6360
6320 IF B0<>2AND B0<>3THEN6490
6330 REM MONTH (ONLY) FROM INPUT:
6340 MO=VAL(MID$(IN$,2,2)):GOTO6400
6350 REM *** YEAR & MONTH FROM INP. ***
6360 YE=VAL(MID$(IN$,2,4))
6370 IF YE<=0THEN6490
6380 IF YE<>INT(YE) THEN6490
6390 MO=VAL(MID$(IN$,6,2))
6400 IF MO<1OR12<MO THEN6490
6410 REM *** MONTH FROM YE AND MO ***
6420 DA=1
6430 GOSUB6120:REM FILLS WD
6440 GOSUB4200:REM FILLS ME()
6450 DA=0:REM INDICATES: NO DATE
6460 GOSUB5680:REM PRINTS MONTH
6470 GOTO6500:REM OK-RETURN
6480 REM ERROR-RETURN
6490 PRINT"INVALID YEAR/MONTH ENTERED."
6500 RETURN
6510 REM ***************************
6520 REM *** DAY FROM INPUT CMD. ***
6530 REM ***************************
6540 B0=LEN(IN$)
6550 IF DA<>0AND B0=1THEN6740
6560 IF2<=B0 THEN6590:REM 2 OR 3
6570 PRINT"NO DAY NR. ENTERED."
6580 GOTO6770:REM JUST RETURN
6590 B0=INT(VAL(MID$(IN$,2,2)))
6600 IF1<=B0 THEN6630
6610 PRINT"INVALID DAY NR. ENTERED."
6620 GOTO6770:REM JUST RETURN
6630 B1=MD(MO-1):REM NO-LEAP YEAR DAYS
6640 IF MO<>2THEN6680:REM NO FEBRUARY
6650 GOSUB3130:REM IS A LEAP YEAR?
6660 IF B2=0 THEN6680:REM NO LEAP YEAR
6670 B1=B1+1:REM 29 DAYS IN FEBRUARY
6680 IF B0<=B1 THEN6720
6690 PRINT"INVALID, MONTH HAS LESS DAYS."
6700 GOTO6770:REM JUST RETURN
6710 REM *** DAY FROM B0, FILL DA ***
6720 DA=B0
6730 REM *** DAY FROM DA ***
6740 GOSUB6120:REM SETS WD TO INDEX
6750 GOSUB5120:REM TRIES TO LOAD DAY
6760 GOSUB5480:REM PRINTS DAY
6770 RETURN
6780 REM ******************************
6790 REM *** COMPARE THE 2 ENTRIES  ***
6800 REM *** WITH INDICES B0 & B1.  ***
6810 REM *** PUTS RESULT IN B0      ***
6820 REM ******************************
6830 IF DT$(B0)="" THEN6890
6840 REM X IS NO EMPTY ENTRY:
6850 IF DT$(B1)<>"" THEN6910
6860 REM X IS NOT,BUT Y IS EMPTY ENTRY:
6870 B0=-1:RETURN:REM X FIRST
6880 REM X IS AN EMPTY ENTRY:
6890 B0=(DT$(B1)=""):RETURN
6900 REM NEITHER X NOR Y ARE EMPTY:
6910 IF DF(B0) THEN6990
6920 IF DF(B1) THEN6960
6930 REM BOTH ARE NO ALL-DAY ENTRIES:
6940 B0=60*DH(B0)+DM(B0)<=60*DH(B1)+DM(B1)
6950 RETURN
6960 B0=0:REM X IS NOT ALL-DAY, Y IS
6970 RETURN
6980 REM X IS ALL-DAY
6990 IF DF(B1) THEN7030
7000 B0=-1:REM X IS ALL-DAY, Y IS NOT
7010 RETURN
7020 REM BOTH ARE ALL-DAY ENTRIES:
7030 B0=DT$(B0)<=DT$(B1):RETURN
7040 REM ****************************
7050 REM *** SORT ENTRIES IN MEM. ***
7060 REM ****************************
7070 K=7:REM ENTRY COUNT LESS ONE
7080 J=0:REM DID-SWAP INDICATOR
7090 FOR I=0TO K-1:REM K MUST BE >=0
7100 B0=I:B1=I+1:GOSUB6830:REM COMPARES
7110 IF B0 THEN7180
7120 REM SWAP I AND I+1 IN-PLACE:
7130 B0$=DT$(I):DT$(I)=DT$(I+1):DT$(I+1)=B0$
7140 B2=DH(I):DH(I)=DH(I+1):DH(I+1)=B2
7150 B2=DM(I):DM(I)=DM(I+1):DM(I+1)=B2
7160 B2=DF(I):DF(I)=DF(I+1):DF(I+1)=B2
7170 J=-1:REM INDICATES HAPPENED SWAP
7180 NEXT I
7190 K=K-1
7200 IF J AND0<=K THEN7080
7201 RETURN
7202 REM ***********************
7203 REM *** PRINT HELP TEXT *** 
7204 REM ***********************
7205 PRINT""
7206 PRINT"M...    SELECT, LOAD AND PRINT MONTH"
7207 PRINT"M202411 <- YEAR AND MONTH."
7208 PRINT"M11     <- MONTH OF CURRENT YEAR."
7209 PRINT"M       <- CURRENT MONTH (RELOAD)."
7210 PRINT"D...    SELECT, LOAD AND PRINT DAY"
7211 PRINT"D30     <- DAY OF CURRENT MONTH."
7212 PRINT"D       <- CURRENT DAY (RELOAD)."
7213 PRINT"W       CREATE OR UPDATE AN ENTRY."
7214 PRINT"E...    ERASE AN ENTRY BY ITS NR."
7215 PRINT""
7216 PRINT"I       INITIALIZE DISK."
7217 PRINT"C       WRITE CONFIG FILE TO DISK"
7218 PRINT"        - HOLDS DEVICE NR., DISK NR.,"
7219 PRINT"          YEAR AND MONTH."
7220 PRINT"        - (RE-)LOADED AT START-UP."
7221 PRINT"B       CLEAR THE SCREEN."
7222 PRINT"Q       EXIT APPLICATION."
7245 PRINT""
7246 RETURN
7247 REM --------------------
7248 REM --- MAIN ROUTINE ---
7249 REM -------------------
7250 PRINT""
7255 PRINT" CBMCAL (C)2024 MARCEL TIMM, RHINODEVEL"
7260 GOSUB2030:REM TRY READ CONF.FILE
7270 GOSUB6420:REM CALC.MONTH DATA
7275 PRINT"PRESS H FOR HELP.":PRINT""
7280 IN$="":INPUT"";IN$:REM READS CMD.
7290 CO$=LEFT$(IN$,1):REM GETS COMMAND
7300 IF CO$<>"M" THEN7320
7310 GOSUB6290:GOTO7280
7320 IF CO$<>"D" THEN7340
7330 GOSUB6540:GOTO7280
7340 IF CO$<>"C" THEN7360
7350 GOSUB2970:GOTO7280
7360 IF CO$<>"W" THEN7380
7370 GOSUB4020:GOTO7280
7380 IF CO$<>"E" THEN7400
7390 GOSUB3610:GOTO7280
7400 IF CO$<>"I" THEN7415
7410 GOSUB1620:GOTO7280
7415 IF CO$<>"B" THEN7418
7417 PRINT"";:GOTO7280
7418 IF CO$<>"H" THEN7420
7419 GOSUB7205:GOTO7280
7420 IF CO$<>"Q" THEN7440
7430 GOTO7480:REM GOES TO EXIT CODE
7440 PRINT"UNKNOWN COMMAND (PRESS H FOR HELP)."
7445 GOTO7280:REM BACK TO USR.CMD.READ
7450 REM >>>>>>>>><<<<<<<<
7460 REM >>> EXIT CODE <<<
7470 REM >>>>>>>>><<<<<<<<
7480 CLOSE15:END
7490 REM ------------
7500 REM --- DATA ---
7510 REM ------------
7520 REM FOR WEEKDAY-BY-DATE CALC.:
7530 DATA0,3,2,5,0,3,5,1,4,6,2,4
7540 REM FOR WEEKDAY ITERATION:
7550 DATA MO,TU,WE,TH,FR,SA,SU
7560 REM DAYS OF MONTH (NON-LEAP YEAR)
7570 DATA31,28,31,30,31,30,31,31,30,31,30,31