home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / prt / cal.ba < prev    next >
Text File  |  2006-10-19  |  3KB  |  89 lines
  1. 90 'CAL.BA CODEWORKS 3838 S.WARNER ST. TACOMA WA 98409
  2. 95 '206 475-2219 : PLEASE DO NOT 'OVE THESE CREDIT LINES.
  3. 100 'CAL.BAS * WRITTEN FOR CODEWORKS MAGAZINE **
  4. 105 'Adapted for the Model 100, Tandy 200, and NEC 8201 by Dave Thomas
  5. 106 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  6. 110 CLEAR 1000:DIM A$(15):CLS
  7. 150 PRINT STRING$(12,"-");" The CodeWorks ";STRING$(13,"-");
  8. 160 PRINT"     C A L E N D A R  P R O G R A M"
  9. 170 PRINT"     prints a calendar for any year"
  10. 175 PRINT"            from 1753 to 3999"
  11. 180 PRINT STRING$(40,"-");
  12. 200 '** INITIALIZATION **
  13. 210 ' 012345678901234567890123456789012345678901234567890
  14. 220 D$="             1 2 3 4 5 6 7 8 910111213141516171819202122232425262728293031
  15. 230 '012345678901234567890123456789012345678901234567890
  16. 240 FM$="   \\":HW$="     SUN  MON  TUE  WED  THU  FRI  SAT"
  17. 250 H$="            \        \            ####"
  18. 260 PRINT"Use SHIFT/BREAK to end program."
  19. 270 INPUT"CALENDAR for what year";Y
  20. 280 '** GO PRINT THE YEAR HEADING **
  21. 290 GOSUB 730
  22. 300 '** PRINT THE CALENDAR **
  23. 310 FOR MB=1 TO 12 STEP 2
  24. 320 MC=MB:YC=Y:GOSUB 550:W1=W
  25. 330 MC=MB+1:YC=Y:GOSUB 550:W2=W
  26. 340 MC=MB:GOSUB 690:M1$=MY$
  27. 350 MC=MB+1:GOSUB 690:M2$=MY$
  28. 360 LPRINT"  ":LPRINT USING H$;M1$;Y;M2$;Y
  29. 370 LPRINT HW$;HW$
  30. 380 MC=MB:GOSUB 610:D1=DM:MC=MB+1:GOSUB 610:D2=DM
  31. 390 FOR I=1 TO 6
  32. 400 LPRINT"   ";
  33. 410 FOR J=1 TO 7:E1=((I-1)*7+J+6-W1)*2-1
  34. 420 IF((I-1)*7+J)>D1+W1 THEN DY$="  "ELSE DY$=MID$(D$,E1,2)
  35. 430 LPRINT USING FM$;DY$;
  36. 440 NEXT J
  37. 450 LPRINT"   ";
  38. 460 FOR J=1 TO 7:E2=((I-1)*7+J+6-W2)*2-1
  39. 470 IF((I-1)*7+J)>D2+W2 THEN DY$="  "ELSE DY$=MID$(D$,E2,2)
  40. 480 LPRINT USING FM$;DY$;
  41. 490 NEXT J
  42. 500 LPRINT"  "
  43. 510 NEXT I
  44. 520 NEXT MB
  45. 530 RUN 110
  46. 540 '** DAY OF THE WEEK ROUTINE
  47. 550 IF MC>2 THEN 560 ELSE MC=MC+12:YC=YC-1
  48. 560 W=1+2*MC+INT(.6*(MC+1))+YC+INT(YC/4)-INT(YC/100)+INT(YC/400)+2
  49. 570 W=W-INT(W/7)*7
  50. 580 W=W+6:W=W-INT(W/7)*7
  51. 590 RETURN
  52. 600 '** NUMBER OF DAYS IN THE MONTH **
  53. 610 IF MC<>2 THEN 630 ELSE LP=0
  54. 620 IF(Y-INT(Y/4)*4)=0 THEN IF((Y-INT(Y/100)*100)=0)AND((Y-INT(Y/400)*400)<>0) THEN LP=0 ELSE LP=1
  55. 630 M$="312831303130313130313031"
  56. 640 DM=VAL(MID$(M$,2*MC-1,2))
  57. 650 IF MC=2 THEN DM=DM+LP
  58. 660 RETURN
  59. 670 '** MONTH OF THE YEAR **
  60. 680 '012345678901234567890123456789012345678901234567890
  61. 690 MN$="JANUARY  FEBRUARY MARCH    APRIL    MAY      " +"JUNE     JULY     AUGUST   SEPTEMBEROCTOBER  " +"NOVEMBER DECEMBER "
  62. 700 MY$=MID$(MN$,(MC-1)*9+1,9):RETURN
  63. 710 END
  64. 720 '** PRINT YEAR HEADING ROUTINE **
  65. 730 YD$=STR$(Y)
  66. 740 FOR I=1 TO 4
  67. 750 DG(I)=ASC(MID$(YD$,I+1,1))-48
  68. 760 NEXT I
  69. 770 FOR L=1 TO 7
  70. 780 READ ST$
  71. 790 I6=2
  72. 800 FOR I=1 TO 10
  73. 810 Z$(I)=MID$(ST$,I6,5)
  74. 820 I6=I6+6
  75. 830 NEXT I
  76. 840 FOR D=1 TO 4:LPRINT TAB(D*10+15);Z$(DG(D)+1);:NEXT D
  77. 845 LPRINT""
  78. 850 NEXT L
  79. 860 LPRINT" ":LPRINT" "
  80. 870 '* 123456123456123456123456123456123456123456123456123456123456
  81. 880 DATA . WW    WW   WWW   WWWW     W  WWWW  WWWW  WWWW  WWWW  WWWW
  82. 890 DATA .W  W    W      W     W    W   W     W        W  W  W  W  W
  83. 900 DATA .W  W    W     W     WW   W W  W     W        W  W  W  W  W
  84. 910 DATA .W  W    W    W     WWW  WWWW  WWWW  WWWW     W  WWWW  WWWW
  85. 920 DATA .W  W    W   W       WW     W     W  W  W     W  W  W     W
  86. 930 DATA .W  W    W   W        W     W     W  W  W     W  W  W     W
  87. 940 DATA . WW    WWW  WWWW  WWWW     W  WWWW  WWWW     W  WWWW   WWW
  88. 950 RETURN
  89.