home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / basic / egbas.lbr / CAL.BZS / CAL.BAS
Encoding:
BASIC Source File  |  1988-01-24  |  4.3 KB  |  122 lines
  1. 0 REM 02-02-85 <-- last backup
  2. 10 PRINT CHR$(26)
  3. 20 PRINT"Eric Gans"
  4. 30 PRINT"French Department UCLA"
  5. 40 PRINT"Los Angeles, CA 90024"
  6. 50 PRINT"02/02/85"
  7. 60 PRINT
  8. 70 REM written by Eric Gans 6/24/84
  9. 80 DEFINT A-Z
  10. 90 REM calendar pgm
  11. 100 PRINT TAB(7)STRING$(52,42)
  12. 110 PRINT TAB(7)"*"TAB(30)"CAL"TAB(58)"*"
  13. 120 PRINT TAB(7)"*  This program gives the day of the week for any  *"
  14. 130 PRINT TAB(7)"* date. It also displays/prints a calendar for any *"
  15. 140 PRINT TAB(7)"* month or for an entire year.                     *"
  16. 150 PRINT TAB(7)STRING$(52,42)
  17. 160 PRINT
  18. 170 DIM CM(12),M$(12)
  19. 180 DATA 0,3,3,6,1,4,6,2,5,0,3,5
  20. 190 FOR I=1 TO 12:READ CM(I):NEXT
  21. 200 DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
  22. 210 FOR I=0 TO 6:READ D$(I):NEXT
  23. 220 DATA January,February,March,April,May,June,July,August,September
  24. 230 DATA October,November,December
  25. 240 FOR I=1 TO 12:READ M$(I):NEXT
  26. 250 INPUT "Year";Y
  27. 260 IF Y=0 THEN END
  28. 270 PRINT"Print year calendar (y/n)?"
  29. 280 E$=INPUT$(1):IF E$<>"y" AND E$<>"n" THEN 280
  30. 290 NY=Y-1
  31. 300 DAYJ=(1+NY+NY\4-NY\100+NY\400)MOD 7:DAYJ=(7+DAYJ)MOD 7
  32. 310 IF E$="y" THEN 750
  33. 320 INPUT "Month";M
  34. 330 IF M<1 OR M>12 THEN PRINT CHR$(7);:GOTO 320
  35. 340 LM=28+(CM((M+1)MOD 13)-CM(M)+7)MOD 7
  36. 350 IF M=12 OR (M=2 AND Y MOD 4=0 AND NOT(Y MOD 100=0 AND Y MOD 400<>0)) THEN LM=LM+1
  37. 360 DAYM=(DAYJ+CM(M))MOD 7
  38. 370 IF Y MOD 4=0 AND M>2 AND NOT(Y MOD 100=0 AND Y MOD 400<>0) THEN DAYM=DAYM+1
  39. 380 INPUT "Day (0 for calendar)";D
  40. 390 IF D=0 THEN 450
  41. 400 IF D<1 OR D>LM THEN PRINT CHR$(7);:GOTO 380
  42. 410 DW=(DAYM+D-1)MOD 7
  43. 420 PRINT"Day of week is: "D$(DW)
  44. 430 PRINT:PRINT"See calendar (y or n)? ";
  45. 440 E$=INPUT$(1):IF E$="n" GOTO 460 ELSE IF E$<>"y" GOTO 440
  46. 450 GOSUB 510
  47. 460 PRINT:PRINT"More (y or n)?"
  48. 470 PRINT
  49. 480 E$=INPUT$(1)
  50. 490 IF E$="y" GOTO 250 ELSE IF E$<>"n" GOTO 480
  51. 500 END
  52. 510 REM print cal
  53. 520 PRINT"To print out, ready printer, type any key -->";
  54. 530 E$=INPUT$(1)
  55. 540 PRINT:PRINT
  56. 550 LPRINT:LPRINT
  57. 560 PRINT TAB(25)CHR$(27)"B3"M$(M)" "Y;CHR$(27)"C3"CHR$(8)CHR$(32)
  58. 570 LPRINT TAB(32)CHR$(27)"C "M$(M)" "Y;CHR$(27)"D"
  59. 580 PRINT
  60. 590 LPRINT:LPRINT
  61. 600 PRINT TAB(10);
  62. 610 LPRINT TAB(17);
  63. 620 FOR I=0 TO 6:LPRINT USING"\ \";D$(I);:PRINT USING"\ \";D$(I);:LPRINT"    ";:PRINT"    ";:NEXT:PRINT:LPRINT:LPRINT
  64. 630 PRINT"    ";
  65. 640 LPRINT TAB(12);
  66. 650 PRINT SPACE$(7*((DAYM)MOD 7));
  67. 660 LPRINT SPACE$(7*((DAYM)MOD 7));
  68. 670 FOR I=1 TO LM
  69. 680 PRINT USING"#######";I;
  70. 690 LPRINT USING"#######";I;
  71. 700 IF (DAYM+I)MOD 7=0 THEN PRINT:PRINT"    ";:LPRINT:LPRINT:LPRINT TAB(12);
  72. 710 NEXT
  73. 720 PRINT
  74. 730 LPRINT
  75. 740 RETURN
  76. 750 REM adapted 10/13/84
  77. 760 PRINT"To print, ready printer; type any key --->";:E$=INPUT$(1)
  78. 770 REM prints year calendar
  79. 780 D$=CHR$(27)+"B3"+"S  M  T  W  T  F  S"+CHR$(27)+"C3"
  80. 790 DP$=CHR$(27)+"C"+"S  M  T  W  T  F  S"+CHR$(27)+"D"
  81. 800 PRINT:PRINT
  82. 810 PRINT TAB(33)Y" CALENDAR"
  83. 820 LPRINT TAB(35)CHR$(31)Y;CHR$(30)
  84. 830 FOR M=1 TO 6
  85. 840 LM=28+(CM((M+1)MOD 13)-CM(M)+7)MOD 7
  86. 850 LM2=28+(CM((M+7)MOD 13)-CM(M+6)+7)MOD 7
  87. 860 IF (M=2 AND Y MOD 4=0 AND NOT(Y MOD 100=0 AND Y MOD 400<>0)) THEN LM=LM+1
  88. 870 IF M=6 THEN LM2=LM2+1
  89. 880 DAYM=(DAYJ+CM(M))MOD 7:DAYM2 =(DAYJ+CM(M+6))MOD 7
  90. 890 IF Y MOD 4=0 AND M>2 AND NOT(Y MOD 100=0 AND Y MOD 400<>0) THEN DAYM=DAYM+1
  91. 900 IF Y MOD 4=0  AND NOT(Y MOD 100=0 AND Y MOD 400<>0) THEN DAYM2=DAYM2+1
  92. 910 J=1
  93. 920 REM print cal
  94. 930 PRINT:PRINT TAB(20)M$(M);TAB(55)M$(M+6)
  95. 940 LPRINT:LPRINT TAB(20)M$(M);TAB(55)M$(M+6)
  96. 950 PRINT:PRINT TAB(14)D$;TAB(53)D$
  97. 960 LPRINT:LPRINT TAB(14)DP$;TAB(53)DP$
  98. 970 PRINT SPACE$(11+3*((DAYM)MOD 7));
  99. 980 LPRINT SPACE$(11+3*((DAYM)MOD 7));
  100. 990 FOR I=1 TO LM
  101. 1000 PRINT USING"###";I;
  102. 1010 LPRINT USING"###";I;
  103. 1020 IF (DAYM+I)MOD 7=0 OR I=LM THEN GOSUB 1100
  104. 1030 NEXT
  105. 1040 GOSUB 1100:IF LM=28 AND DAYM=0 THEN GOSUB 1100
  106. 1050 NEXT M
  107. 1060 PRINT:PRINT:LPRINT:LPRINT
  108. 1070 PRINT"More (y/n)?"
  109. 1080 Y$=INPUT$(1):IF Y$="n" THEN END ELSE IF Y$<>"y" THEN 1080
  110. 1090 GOTO 250
  111. 1100 REM month+6
  112. 1110 IF J>LM2 THEN RETURN
  113. 1120 IF J=1 THEN PRINT TAB(47+3*((DAYM2)MOD 7)); ELSE PRINT TAB(47);
  114. 1130 IF J=1 THEN LPRINT TAB(47+3*((DAYM2)MOD 7)); ELSE LPRINT TAB(47);
  115. 1140 PRINT USING"###";J;
  116. 1150 LPRINT USING"###";J;
  117. 1160 J=J+1
  118. 1170 IF (DAYM2+J-1)MOD 7=0 OR J>LM2 THEN PRINT:LPRINT:PRINT SPC(11);:LPRINT SPC(11);:RETURN
  119. 1180 GOTO 1140
  120. ";J;
  121. 1160 J=J+1
  122. 1170 IF