home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 58 / 058side3.d64 / lunar.bas (.txt) < prev    next >
Commodore BASIC  |  2022-08-29  |  15KB  |  384 lines
  1. 10 rem @ s 1024
  2. 20 dimy%(12,31,2),p$(11),mo$(12),m$(12),mo%(12),dy$(7),w%(7,1)
  3. 30 sx=29.530588:rem@ e 3800
  4. 40 poke53248+21,0:z%=1
  5. 50 rem lunar phase calendar norm 56576 195,196
  6. 60 poke56576,195:poke648,4:poke53272,21
  7. 70 rem for 1525/801/803 and epson fx-80 printers and compatibles
  8. 80 vic=53248:poke2040,15:printchr$(142)"[147]":gosub1930:gosub2500:poke2041,14
  9. 90 poke53287,3:pokevi+29,3:poke53275,255:fori=960to983:pokei,255:next
  10. 100 fori=984to1022:pokei,0:next:x$=chr$(13)
  11. 110 fori=896to919:pokei,255:next:fori=920to959:pokei,0:next:poke53288,1
  12. 120 poke214,16:print:printtab(7)"please select type of output:"
  13. 130 printtab(7)"1. 1525 or compatible"
  14. 140 printtab(7)"2. epson fx-80 or compatible"
  15. 150 printtab(7)"3. screen":printtab(7)"q. quit"
  16. 160 geta$:gosub2570:if(a$<"1"ora$>"3")anda$<>"q"then160
  17. 170 ifa$="q"thenpoke646,0:gosub2580:gosub2540:gosub3160:gosub2540:goto120
  18. 180 poke646,0:gosub2580:gosub2540:poke214,18:print:print,"[152]    setting up...
  19. 190 pr[178][197](a$)
  20. 200 [145]pr[137]210,230
  21. 210 [129]i[178]0[164]11:p$(i)[178][199](8):[129]j[178]1[164]6:[135]p:p$(i)[178]p$(i)[170][199](p):[130]j:p$(i)[178]p$(i)[170][199](15):[130]
  22. 220 [137]250
  23. 230 [129]i[178]0[164]11:p$(i)[178][199](27)[170]"k"[170][199](6)[170][199](0)
  24. 240 [129]j[178]1[164]6:[135]p:p$(i)[178]p$(i)[170][199](p[171]128):[130]:[130]
  25. 250 [129]i[178]1[164]12:[135]mo$(i):[130]:[141]3200
  26. 260 [129]i[178]1[164]12:[135] mo%(i):[130]
  27. 270 [129]i[178]1[164]7:[135] dy$(i):[130]
  28. 280 [141]1380:[143] redefine characters
  29. 290 [131]128,128,128,128,128,128,128,128,128,194,194,188,128,128,128,194,254,188
  30. 300 [131]128,128,128,254,254,188,128,128,188,254,254,188,128,188,254,254,254,188
  31. 310 [131]188,254,254,254,254,188,188,254,254,254,188,128,188,254,254,188,128,128
  32. 320 [131]188,254,254,128,128,128,188,254,194,128,128,128,188,194,194,128,128,128
  33. 330 [131]"january  ","february ","march    ","april    ","may      "
  34. 340 [131]"june     ","july     ","august   ","september","october  "
  35. 350 [131]"november ","december "
  36. 360 [131]31,28,31,30,31,30,31,31,30,31,30,31
  37. 370 [131]s,m,t,w,t,f,s
  38. 380 [143] ifxp$="3"thengosub2340:goto1990
  39. 390 ly%[178]0:[141]2540:[151]214,16:[153]:[153]"print#input year (after 1583)"
  40. 400 [141]1290:y[178]v:[139]y[179]1583[167]390
  41. 410 [141]2540:[151]214,16:[153]:[153][163]10)"calculating phases..."
  42. 420 [139]y[173]4[178][181](y[173]4)[167]ly%[178]1:[139](y[173]100[178][181](y[173]100))[175](y[173]400[179][177][181](y[173]400))[167]ly%[178]0
  43. 430 mo%(2)[178]28:[139]ly%[178]1[167]mo%(2)[178]29
  44. 440 [129]m[178]1[164]12
  45. 450 [139]m[177]1[167][151]214,19:[153]:[153][163]20[171][195](m$(m[171]1))[173]2)"print#               "
  46. 460 [151]214,19:[153]:[153][163]20[171][195](m$(m))[173]2)"print#"m$(m):[139]m[178]2[167]490
  47. 470 [129]d[178]1[164]mo%(m):[141]1150:y%(m,d,z%)[178]ph:[141]1030:y%(m,d,2)[178]dy%:[130]:[130]
  48. 480 [137]500:[143] printout
  49. 490 [129]d[178]1[164]28[170]ly%:[141]1150:y%(m,d,z%)[178]ph:[141]1030:y%(m,d,2)[178]dy%:[130]:[130]
  50. 500 [139]pr[178]3[167]1630
  51. 510 [160]4:[141]2540:[151]214,18:[153]:[153][163]9)"print#set up printer/ return"
  52. 520 [161]a$:[139]a$[179][177][199](13)[167]520
  53. 530 ln$[178]"----------------------------------------"
  54. 540 ln$[178]ln$[170]"---------------------------------------"
  55. 550 [145]pr[137]560,580
  56. 560 [159]4,4:[152]4,ln$:[152]4:[152]4,[166]26);[199](14)"lunar calendar"[199](15)
  57. 570 [137]590
  58. 580 [159]4,4,5:[152]4,ln$:[152]4:[152]4,[166]26);[199](14)"lunar calendar"
  59. 590 [152]4,[199](10);[166]34);[199](14);y;[199](10)
  60. 600 [139]pr[178]1[167][152]4,[199](15);
  61. 610 [152]4,[166]29);:[129]i[178]1[164]11:[152]4,p$(i);" ";:[130]:[152]4
  62. 620 [152]4:[152]4,ln$:[141]630:[137]670
  63. 630 [152]4,"            0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 ";
  64. 640 [152]4,"2 2 3 3"
  65. 650 [152]4,"            1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 ";
  66. 660 [152]4,"8 9 0 1":[142]
  67. 670 ml$(1)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  68. 680 ml$(2)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  69. 690 ms$(1)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  70. 700 ms$(2)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  71. 710 fl$(1)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  72. 720 fl$(2)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  73. 730 fs$(1)[178]"+z+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  74. 740 fs$(2)[178]"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+"
  75. 750 [129]m[178]1[164]12:[139]m[178]2[167]890
  76. 760 [145]mo%(m)[171]29[137]770,830
  77. 770 [152]4,"           ";ms$(1)
  78. 780 [152]4," ";mo$(m);" !";
  79. 790 [129]d[178]1[164]30:[152]4,dy$(y%(m,d,2));"!";:[130]:[152]4:[152]4,"           !";
  80. 800 [129]d[178]1[164]30:[152]4,p$(y%(m,d,z%));"!";:[130]:[152]4
  81. 810 [152]4,"           ";ms$(2)
  82. 820 [137]880
  83. 830 [152]4,"           ";ml$(1)
  84. 840 [152]4," ";mo$(m);" !";
  85. 850 [129]d[178]1[164]31:[152]4,dy$(y%(m,d,2));"!";:[130]:[152]4:[152]4,"           !";
  86. 860 [129]d[178]1[164]31:[152]4,p$(y%(m,d,z%));"!";:[130]:[152]4
  87. 870 [152]4,"           ";ml$(2)
  88. 880 [130]:[141]630:[152]4,ln$:[160]4:[151]631,32:[151]198,1:[138]
  89. 890 [145]ly%[170]1[137]900,960
  90. 900 [152]4,"           ";fs$(1)
  91. 910 [152]4," ";mo$(m);" !";
  92. 920 [129]d[178]1[164]28:[152]4,dy$(y%(m,d,2));"!";:[130]:[152]4:[152]4,"           !";
  93. 930 [129]d[178]1[164]28:[152]4,p$(y%(m,d,z%));"!";:[130]:[152]4
  94. 940 [152]4,"           ";fs$(2)
  95. 950 [137]880
  96. 960 [152]4,"           ";fl$(1)
  97. 970 [152]4," ";mo$(m);" !";
  98. 980 [129]d[178]1[164]29:[152]4,dy$(y%(m,d,2));"!";:[130]:[152]4:[152]4,"           !";
  99. 990 [129]d[178]1[164]29:[152]4,p$(y%(m,d,z%));"!";:[130]:[152]4
  100. 1000 [152]4,"           ";fl$(2)
  101. 1010 [137]880
  102. 1020 [137]1630
  103. 1030 md[178]m:yy[178]y:[139]md[178]1[167]md[178]13:yy[178]yy[171]1:[137]1050
  104. 1040 [139]md[178]2[167]md[178]14:yy[178]yy[171]1
  105. 1050 m0[178]md[171]2:dy%[178](2.6[172]m0[171].2)[170]d[170]yy[171]1900[170][181]((yy[171]1900)[173]4):dy%[178]dy%[170][181](19[173]4)[171]2[172]1
  106. 1060 dy%[178]dy%[171][181](dy%[173]7)[172]7[170]1
  107. 1070 [139]md[178]4[176]md[178]9[167]dy%[178]dy%[170]1
  108. 1080 [139]md[178]13[167]md[178]1:yy[178]yy[170]1:[137]1110
  109. 1090 [139]md[178]14[167]md[178]2:yy[178]yy[170]1:dy%[178]dy%[170]1
  110. 1100 [139]dy%[178]8[167]dy%[178]1
  111. 1110 [139](yy[178]2100[175]md[177][178]3)[176](yy[177]2100)[167]dy%[178]dy%[171]1:[139]dy%[178]0[167]dy%[178]7
  112. 1120 [139](yy[178]2200[175]md[177][178]3)[176](yy[177]2200)[167]dy%[178]dy%[171]1:[139]dy%[178]0[167]dy%[178]7
  113. 1130 [139](yy[178]2300[175]md[177][178]3)[176](yy[177]2300)[167]dy%[178]dy%[171]1:[139]dy%[178]0[167]dy%[178]7
  114. 1140 [142]
  115. 1150 q[178]y[170](m[179]3)
  116. 1160 j[178][181](275[172]m[173]9)[171][181]((7[172]q[170]7)[173]4)[170]367[172]y[170]d[171][181](([181](q[173]100)[170]1)[172]3[173]4)
  117. 1170 p[178]j[173]sx[170].2
  118. 1180 ph[178]p[171][181](p):ph[178][181]((ph[172]12)[170].5):[139]ph[177]11[167]ph[178]0
  119. 1190 [142]
  120. 1200 [141]1150
  121. 1210 [139]ph[178]0[167]ph$[178]"new moon":[142]
  122. 1220 [139]ph[179]3[167]ph$[178]"waxing crescent":[142]
  123. 1230 [139]ph[178]3[167]ph$[178]"first quarter":[142]
  124. 1240 [139]ph[179]6[167]ph$[178]"waxing gibbous":[142]
  125. 1250 [139]ph[178]6[167]ph$[178]"full moon":[142]
  126. 1260 [139]ph[179]9[167]ph$[178]"waning gibbous":[142]
  127. 1270 [139]ph[178]9[167]ph$[178]"last quarter":[142]
  128. 1280 ph$[178]"waning crescent":[142]
  129. 1290 xx$[178]"cmd cmd< cmdcmd":b$[178]"":fg[178]0:[153]"print#>cmd";
  130. 1300 [161]a$:[139]a$[178]""[167]1300
  131. 1310 [139]a$[178][199](13)[167][153]" cmd";a$;:[137]1370
  132. 1320 [139]a$[178][199](20)[175]b$[179][177]""[167]b$[178][200](b$,[195](b$)[171]1):[153]xx$;:fg[178]0:[137]1300
  133. 1330 [139]fg[178]1[167]1300
  134. 1340 [139]a$[179]"0"[176]a$[177]"9"[167]1300:[143] limit to numerics
  135. 1350 [153]a$">cmd";:b$[178]b$[170]a$:[139][195](b$)[178]4[167]fg[178]1
  136. 1360 [137] 1300
  137. 1370 v[178][197](b$):l[178][195](b$):[142]
  138. 1380 [129]i[178]828[164]878:[135]a:[151]i,a:[130]i
  139. 1390 [151]56334,[194](56334)[175]254
  140. 1400 [151]1,[194](1)[175]251
  141. 1410 [151]249,0:[151]250,208:[151]251,0:[151]252,192:[151]253,0:[151]254,8:[158]828
  142. 1420 [151]1,[194](1)[176]4:[151]56334,[194](56334)[176]1
  143. 1430 [135]a:[139]a[178][171]1[167][142]
  144. 1440 k[178]49152[170](8[172]a):[129]i[178]0[164]7:[135]b:[151]k[170]i,b:[151]k[170]1024[170]i,255[171]b:[130]i:[137]1430
  145. 1450 [151]56576,4:[