Calendar

Gallery

Source Code

   1 REM "CALENDAR"
  10 FAST 
  20 DIM D$(7,10)
  30 DIM M$(12,9)
  40 DIM L(12)
  49 REM --INITIALIZE VARIABLES      AND ARRAYS--
  50 REM 
  51 LET P1=1
  60 LET P2=7
  70 LET I$="SUNDAY,MONDAY,TUESDAY,WEDNESDAY,"
  80 LET I$=I$+"THURSDAY,FRIDAY,SATURDAY,"
  90 LET I$=I$+"JANUARY,31,FEBRUARY,28,MARCH,31,"
 100 LET I$=I$+"APRIL,30,MAY,31,JUNE,30,JULY,31,"
 110 LET I$=I$+"AUGUST,31,SEPTEMBER,30,OCTOBER,31,"
 120 LET I$=I$+"NOVEMBER,30,DECEMBER,31,"
 130 FOR I=1 TO 7
 140 GOSUB 1000
 150 LET D$(I)=R$
 160 LET D$(I,10)=CHR$ (LEN R$)
 170 NEXT I
 180 FOR I=1 TO 12
 190 GOSUB 1000
 200 LET M$(I)=R$
 210 LET M$(I,9)=CHR$ (LEN R$)
 220 GOSUB 1000
 230 LET L(I)=VAL (R$)
 240 NEXT I
 249 REM --ASK FOR,ACCEPT,AND                 CHECK INPUT--
 250 SLOW 
 260 CLS 
 270 PRINT AT 0,7;"PERPETUAL CALENDAR"
 280 PRINT AT 1,0;"TYPE IN DATE IN ANY YEAR"
 290 PRINT "AFTER 1800 AND BEFORE 2400;"
 300 PRINT "THEN PRESS <ENTER>."
 310 PRINT AT 5,0;"USE THIS FORMAT:"
 320 PRINT AT 7,0;"12,22,1984"
 330 PRINT AT 9,0;"DATE? ";
 340 INPUT I$
 350 PRINT I$
 360 LET I$=I$+","
 370 LET P1=1
 380 LET P2=2
 390 GOSUB 1000
 400 LET M=VAL R$
 410 IF M<1 OR M>12 THEN GOTO        260
 420 GOSUB 1000
 430 LET D=VAL R$
 440 GOSUB 1000
 450 LET Y=VAL R$
 460 FAST 
 470 CLS 
 480 LET L(2)=28+((Y=INT (Y/4)*4 AND Y<>INT (Y/100)*100) OR Y=2000)
 490 IF D<1 OR D>L(M) OR Y<1801 OR Y>2399 THEN GOTO 250
 495 REM 
 496 REM ***********************
 498 REM --COMPUTE WHAT DAY THE            DATE FALLS ON (DOW)-
 499 REM ***********************
 500 IF M<3 THEN LET Y=Y-1
 510 IF M<3 THEN LET M=M+12
 520 LET FOM=INT (Y*1.25)+(Y<1900)+(Y>2000)*INT ((Y-2000)/100)+INT ((M-2)*2.59)
 530 LET DOW=FOM+D-INT ((FOM+D-1)/7)*7
 537 REM 
 538 REM ***********************
 539 REM --FOM IS DAY THAT FIRST           OF MONTH M FALLS ON--
 540 REM ***********************
 541 REM 
 542 LET FOM=FOM-INT (FOM/7)*7+1
 550 IF M>12 THEN LET Y=Y+1
 560 IF M>12 THEN LET M=M-12
 565 REM 
 566 REM ***********************
 567 REM --PRINT DAY OF WEEK AND         TOP OF CALENDAR PAGE--
 568 REM ***********************
 569 REM 
 570 PRINT M$(M,1 TO CODE M$(M,9));" ";D;", ";Y;", IS A"
 580 PRINT D$(DOW,1 TO CODE D$(DOW,10));"."
 590 PRINT AT 4,(25-CODE M$(M,9))/2;M$(M,1 TO CODE M$(M,9));" ";Y
 600 PRINT AT 6,2;
 610 FOR I=1 TO 7
 620 PRINT D$(I,1 TO 3);" ";
 630 NEXT I
 640 PRINT 
 650 LET VP=8
 660 LET HP=(FOM-1)*4+2
 670 FOR I=1 TO L(M)
 680 LET P$=STR$ (I)
 690 IF I<>D THEN GOTO 730
 700 FOR J=1 TO LEN P$
 710 LET P$(J)=CHR$ (CODE P$(J)+128)
 720 NEXT J
 730 PRINT AT VP,HP+(I<10);P$
 740 LET HP=HP+4
 750 IF HP>=30 THEN LET VP=VP+2
 760 IF HP>=30 THEN LET HP=2
 770 NEXT I
 780 SLOW 
 781 REM 
 782 REM **********************
 783 REM -- ANOTHER DATE OR STOP
 784 REM **********************
 785 PRINT AT 19,0;"\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''"
 790 PRINT AT 20,3;"PRESS <Q> TO QUIT OR ANY";AT 21,0;"OTHER KEY TO TRY ANOTHER DATE."
 800 LET K$=INKEY$
 810 IF K$="" THEN GOTO 800
 820 IF K$<>"Q" THEN GOTO 260
 830 STOP 
1000 IF I$(P2)="," THEN GOTO 1030
1010 LET P2=P2+1
1020 GOTO 1000
1030 LET R$=I$(P1 TO P2-1)
1040 LET P2=P2+2
1050 LET P1=P2-1
1060 RETURN 
1800 STOP 
2000 SAVE "CALENDA%R"
3000 GOTO 10