home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib23a.dsk / FEBRUARY.1985 / PERPETUAL.CAL.bas < prev   
BASIC Source File  |  2023-02-26  |  4KB  |  112 lines
  1. 10  REM  **********************
  2. 20  REM  *   PERPETUAL.CAL    *
  3. 30  REM  *  BY  NEIL SPINDEL  *
  4. 40  REM  * COPYRIGHT (C) 1985 *
  5. 50  REM  * BY MICROSPARC, INC *
  6. 60  REM  * CONCORD, MA  01742 *
  7. 70  REM  **********************
  8. 80  DIM M$(12): DIM DY$(7): DIM NM(12): DIM Y%(12,6,7)
  9. 90  TEXT : HOME : VTAB 5: HTAB 13: PRINT "PERPETUAL CALENDAR": HTAB 14: PRINT "BY  NEIL SPINDEL": PRINT 
  10. 100  PRINT "** COPYRIGHT 1985 BY MICROSPARC, INC. **": PRINT 
  11. 110  VTAB 10: CALL  -958: INPUT "YEAR: ";Y$:Y =  INT( VAL(Y$))
  12. 120  IF Y <1753  THEN  PRINT "YEAR MUST FOLLOW GREGORIAN CALENDAR.": FOR PAUSE = 1 TO 2000: NEXT : GOTO 110
  13. 130  VTAB 12: CALL  -958: INPUT "START MONTH (1-12): ";J$:J =  INT( VAL(J$)): IF J <1  OR J >12  THEN 130
  14. 140  VTAB 14: CALL  -958: INPUT "HOW MANY MONTHS (1-12): ";FJ$:FJ =  INT( VAL(FJ$)): IF FJ <1  OR FJ >12  THEN 140
  15. 150 FJ = J +FJ: HOME 
  16. 160  PRINT "MAKE SURE THAT THE FORM FEED ON YOUR": PRINT "PRINTER IS SET TO STOP AT THE": PRINT "PERFORATED LINES.": PRINT "PRESS ANY KEY TO BEGIN PRINTING"
  17. 170  GET Z$: PRINT 
  18. 180  VTAB 22: HTAB 5: INVERSE : PRINT "CALCULATING DATES FOR ";Y: NORMAL 
  19. 190  FOR Z1 = 0 TO 12: FOR Z2 = 0 TO 6: FOR Z3 = 0 TO 7:Y%(Z1,Z2,Z3) = 0: NEXT : NEXT : NEXT 
  20. 200  GOSUB 500: GOSUB 560: GOSUB 650
  21. 210  VTAB 22: CALL  -958
  22. 220  PRINT  CHR$(4)"PR#1": PRINT  CHR$(9);"80N"
  23. 230  IF J = FJ  THEN  PRINT  CHR$(4)"PR#0": TEXT : HOME : END 
  24. 240  IF J = 13  THEN Y = Y +1:J = 1:FJ = FJ -12: RESTORE : PRINT  CHR$(4)"PR#0": GOTO 180
  25. 250 Y$ =  STR$(Y)
  26. 260 TB = (80 - LEN(Y$))/2: GOSUB 1090: PRINT Y
  27. 270  PRINT :TB = ((80 - LEN(M$(J)))/2): GOSUB 1090: PRINT M$(J)
  28. 280  PRINT 
  29. 290  GOSUB 880
  30. 300  PRINT 
  31. 310  GOSUB 1120: FOR T = 1 TO 7
  32. 320  PRINT DY$(T);
  33. 330  NEXT 
  34. 340  PRINT 
  35. 350  GOSUB 880
  36. 360  PRINT 
  37. 370  FOR R = 1 TO 6
  38. 380  GOSUB 1120: PRINT "!";
  39. 390  FOR F = 1 TO 7
  40. 400  IF Y%(J,R,F) = NM(J)  AND F = 7  THEN  PRINT Y%(J,R,F);: GOSUB 1100: GOSUB 940: GOTO 960
  41. 410  IF Y%(J,R,F) = 0  THEN  PRINT "  ";: GOSUB 940: NEXT F: GOTO 960
  42. 420  PRINT Y%(J,R,F);: GOSUB 1100
  43. 430  GOSUB 940
  44. 440  NEXT F
  45. 450  GOSUB 990
  46. 460  NEXT R
  47. 470  PRINT  CHR$(12)
  48. 480 J = J +1: GOTO 230
  49. 490  REM  ***ROUTINES AND SUBROUTINES***
  50. 500  REM  ***LEAP YEAR ROUTINE***
  51. 510  IF  ABS(((1980 -Y)/4) - INT((1980 -Y)/4)) >.000001  THEN LY = 0: RETURN 
  52. 520  IF  RIGHT$( STR$(Y),2) < >"00"  THEN LY = 1: RETURN 
  53. 530  IF  ABS((Y/400) - INT(Y/400)) >.000001  THEN LY = 0: RETURN 
  54. 540 LY = 1
  55. 550  RETURN 
  56. 560  REM  ***ZELLER'S CONGRUENCE LAW***
  57. 570 C =  INT(Y/100): IF  RIGHT$( STR$(Y),2) = "00"  THEN C = C -1
  58. 580 D = (Y -(100 *C)) -1: IF D =  -1  THEN D = 99
  59. 590 K = 1
  60. 600 M = 11
  61. 610 X = ( INT(2.6 *M -.2) +K +D + INT(D/4) + INT(C/4) -(2 *C))/7
  62. 620 G =  ABS(X - INT(X))
  63. 630 F =  INT(7 *G +.00001) +1
  64. 640  RETURN 
  65. 650  REM  ***SET UP MATRICES***
  66. 660  FOR X = 1 TO 12: IF X = 2  THEN  NEXT 
  67. 670  READ NM(X)
  68. 680  NEXT 
  69. 690  IF LY  THEN NM(2) = 29: GOTO 710
  70. 700 NM(2) = 28
  71. 710  FOR X = 1 TO 12
  72. 720  READ M$(X)
  73. 730  NEXT 
  74. 740  FOR X = 1 TO 7
  75. 750  READ DY$(X)
  76. 760  NEXT 
  77. 770  FOR X = 1 TO 12
  78. 780 R = 1
  79. 790  FOR G = 1 TO NM(X)
  80. 800  LET Y%(X,R,F) = G
  81. 810 F = F +1
  82. 820  IF F = 8  THEN F = 1:R = R +1
  83. 830  NEXT : NEXT 
  84. 840  RETURN 
  85. 850  DATA  31,31,30,31,30,31,31,30,31,30,31
  86. 860  DATA   JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  87. 870  DATA  "!   SUN   !","   MON   !","   TUE   !","   WED   !","   THU   !","   FRI   !","   SAT   !"
  88. 880  REM  ***LINES OF DASHES***
  89. 890  GOSUB 1120: FOR N = 1 TO 71
  90. 900  PRINT "-";
  91. 910  NEXT 
  92. 920  RETURN 
  93. 930  REM  SUBROUTINE TO PRINT !'S
  94. 940  FOR L = 1 TO 7: PRINT " ";: NEXT : PRINT "!";: IF F = 7  THEN  PRINT 
  95. 950  RETURN 
  96. 960  REM  ***SUBROUTINE FOR END OF THE WEEK***
  97. 970  GOSUB 990
  98. 980  GOTO 470
  99. 990  REM  ***SUBROUTINE TO PRINT ROWS OF !'S AND -'S***
  100. 1000  FOR X = 1 TO 6
  101. 1010  GOSUB 1120: FOR T = 0 TO 6
  102. 1020  PRINT "!         ";: REM 9 SPACES
  103. 1030  NEXT T
  104. 1040  PRINT "!"
  105. 1050  NEXT X
  106. 1060  GOSUB 880
  107. 1070  PRINT 
  108. 1080  RETURN 
  109. 1090  FOR L = 1 TO TB: PRINT " ";: NEXT : RETURN 
  110. 1100  IF Y%(J,R,F) <10  THEN  PRINT " ";: RETURN 
  111. 1110  RETURN 
  112. 1120  PRINT "    ";: RETURN : REM  4 SPACES