home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 38 / 038.d81 / calendar maker (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1987-01-01  |  4.3 KB  |  147 lines
  1. 200 gosub60100:clr
  2. 210 dim d(42),mo$(12),m$(12,8),dm(12),fd(12)
  3. 220 for x = 1 to 12 : read mo$(x) : next
  4. 230 data january,february,march,april
  5. 240 data may,june,july,august,september
  6. 250 data october,november,december
  7. 260 for x = 1 to 12 : read dm(x) : next
  8. 270 data 31,28,31,30,31,30,31,31,30,31,30,31
  9. 280 for x = 1 to 12 : read fd(x) : next
  10. 290 data 0,3,3,-1,1,4,-1,2,5,0,3,5
  11. 300 sp$="                        ":rem 24 spaces
  12. 310 dn$=" su mo tu we th fr sa   "
  13. 320 dl$="---------------------":rem 21 dashes
  14. 330 print "[147]             calendar maker "
  15. 335 print"            by  bruce jeager"
  16. 340 print
  17. 345 print"enter  q [146] to quit."
  18. 350 print "enter starting year:";:gosub60500:y1=val(b$)
  19. 355 ifb$="q"thengosub60000:goto345
  20. 360 if y1<1752 then gosub 62000:goto 330
  21. 370 print
  22. 380 print "( return alone =" y1 ")"
  23. 390 y2=y1
  24. 400 print
  25. 410 print "enter ending year:     [157][157][157][157][157]";:gosub60500:y2=val(b$):ifb$=""theny2=y1
  26. 411 ifb$="q"orb$="[209]" then 330
  27. 412 ifb$=""theny2=y1
  28. 415 ify2<y1 then gosub 62100:goto 410
  29. 420 if y2<1752 then gosub62000:goto330
  30. 425 gosub9000:ifnot(ok)thenrun210
  31. 430 print
  32. 440 print : print"calculating..."
  33. 450 close4 : open4,4
  34. 460 for yr = y1 to y2
  35. 470 print : printchr$(18)yr
  36. 480 z=(yr/100) : c=int(yr/100) : a=z-c
  37. 490 if a=0 then 530
  38. 500 z=(yr/4) : c=int(yr/4) : a=z-c
  39. 510 if a=0 then xd=1 : goto 560
  40. 520 goto 550
  41. 530 z=(yr/400) : c=int(yr/400) : a=z-c
  42. 540 if a=0 then xd=1 : goto 560
  43. 550 xd=0
  44. 560 f=int(yr/4) : g=int(yr/400) : h=int(yr/100)
  45. 570 j=f+g-h
  46. 580 l=(yr+j)/7 : m=int((yr+j)/7)
  47. 590 q=(l-m)*7 : ys=int(q) : r=q-ys
  48. 600 if r>0.9 then ys=ys+1
  49. 610 ys=ys-xd
  50. 620 if ys<0 then ys=ys+7
  51. 630 for mh=1 to 12
  52. 640 mn$=mo$(mh) : print left$(mn$+sp$,20);
  53. 650 dm = dm(mh) : if mh=2 then dm=dm+xd
  54. 660 fd=ys+fd(mh)+xd : if mh=1 then fd=ys
  55. 670 if mh=2 then fd=ys+3
  56. 680 if fd>6 then fd=fd-7
  57. 690 if fd<0 then fd=fd+7
  58. 700 w=20
  59. 710 yr=int(yr)
  60. 720 m$(mh,0)=left$(mn$+sp$,24)
  61. 730 m$(mh,1)=dn$
  62. 740 m$(mh,2)=dl$
  63. 745 for i=3to8:m$(mh,i)="":next
  64. 750 for x = 1 to 42 : d(x)=0 : next
  65. 760 y=1 : z=y : for x = fd+1 to 42 : d(x)=z
  66. 770 y=y+1 : z=y : if z>dm then z=0
  67. 780 next : we=0 : y=0
  68. 790 for x = 1 to 42 : y=y+1 : if y>6 then y=0
  69. 800 if d(x)=0 then m$(mh,we+3)=m$(mh,we+3)+"   " : goto820
  70. 810 m$(mh,we+3) = m$(mh,we+3) + right$( "    "+ str$(d(x)),3)
  71. 820 if y=0 then we=we+1
  72. 830 next x
  73. 840 next mh
  74. 850 print#4:print#4,yr
  75. 860 print#4:print#4:ln=4
  76. 870 for x = 0 to 12 : for y = 0 to 8
  77. 880 m$(x,y) = left$(m$(x,y)+sp$,24)
  78. 890 next y : next x
  79. 900 for x=0to8:print#4,"   "m$(1,x)m$(2,x)m$(3,x):next:print#4:print#4
  80. 910 for x=0to8:print#4,"   "m$(4,x)m$(5,x)m$(6,x):next:print#4:print#4
  81. 920 for x=0to8:print#4,"   "m$(7,x)m$(8,x)m$(9,x):next:print#4:print#4
  82. 930 for x=0to8:print#4,"   "m$(10,x)m$(11,x)m$(12,x):next:print#4:print#4
  83. 940 for x = 1 to 18 : print#4 : next
  84. 950 next yr : close4
  85. 960 run210
  86. 9000 ok=-1:open15,4,15:close15:ifst=.thenreturn
  87. 9010 ok=.:print"     error: printer not online!"
  88. 9015 fora=1to50:poke54296,15:poke54296,.:next
  89. 9020 fora=1to3000:next:return
  90. 60000 print"[145][145]                                      "
  91. 60010 print"  are you sure you want to quit? (y/n)"
  92. 60020 a=peek(203):ifa<>25anda<>39then60020
  93. 60030 ifa=39thenprint"[145]                                      [145][145]":return
  94. 60040 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  95. 60050 ifer<>63thenend
  96. 60060 load"hello connect",8
  97. 60100 poke53280,1:poke53281,1
  98. 60110 printchr$(142)"[147][149][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]";
  99. 60120 fora=1to23:print"[221]"spc(38)"[221]";:next
  100. 60130 print"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203][157][148][192]"
  101. 60140 fora=217to242:pokea,peek(a)or128:next
  102. 60150 print"          loadstar presents:"
  103. 60160 print"                              "
  104. 60170 print"           calendar  maker    [155] "
  105. 60180 print"                              [155] "
  106. 60190 print"           by bruce jeager    [155] "
  107. 60200 print"                              [155] "
  108. 60210 print"           copyright  1987    [155] "
  109. 60220 print"                              [155] "
  110. 60230 print"                               "
  111. 60240 print"        press space to continue"
  112. 60250 ifpeek(203)<>60then60250
  113. 60260 return
  114. 60500 b$="":print"[164]";:fora=1to5
  115. 60510 geta$:ifa$=""then60510
  116. 60520 ifa$=chr$(13)thenprint"[157] ":return
  117. 60530 ifa$=chr$(20)anda>1thenprint"[157][157]  [157][157][164]";:a=a-1:b$=left$(b$,a-1):goto60510
  118. 60535 if(a=5)then60510
  119. 60540 ifa$="q"ora$="[209]"then60560
  120. 60550 ifa$<"0"ora$>"9"then60510
  121. 60560 print"[157]"a$"[164]";:b$=b$+a$:next
  122. 62000 print""
  123. 62010 print"                  "
  124. 62011 print"  starting date   [152] "
  125. 62012 print" should be larger [152] "
  126. 62015 print"    than 1751     [152] "
  127. 62020 print"                  [152] "
  128. 62021 print" [152]                  "
  129. 62025 forx=1to2500:next
  130. 62030 return
  131. 62100 print""
  132. 62110 print"                  "
  133. 62111 print"   ending  date   [152] "
  134. 62112 print" should be larger [152] "
  135. 62115 print"    than "str$(y1)"    [152] "
  136. 62120 print"                  [152] "
  137. 62121 print" [152]                  "
  138. 62125 forx=1to2500:next
  139. 62130 print""
  140. 62131 print"                  "
  141. 62132 print"                   "
  142. 62133 print"                   "
  143. 62134 print"                   "
  144. 62135 print"                   "
  145. 62136 print"                     "
  146. 62140 return
  147.