home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64-128BBS / PRG.CALENDAR (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  2.4 KB  |  53 lines
  1. 512 Y=VAL(MID$(D1$,2,2))+1900:M=VAL(MID$(D1$,4,2)):D=VAL(MID$(D1$,6,2))
  2. 513 Q=Y+(M<3):J=INT(275*M/9)-INT((7*Q+7)/4)+367*Y+D-INT((INT(Q/100)+1)*3/4)
  3. 514 P=J/29.530588+.2:PH=P-INT(P)
  4. 515 A$="\F1[139]-*>[212]HE [205]ICRO[196]OT [194][194][211] [195]ALENDAR/[193]LMANAC <*-":GOSUB40
  5. 516 A$="[139][139][212]HE MOON'S AGE IS NOW "+STR$(INT(PH*29.530588))
  6. 517 GOSUB40:A$="[139]IN THE CURRENT LUNATION.[139][139][212]HIS MEANS THAT IT'S[139][139]"
  7. 518 IFPH<=.125ORPH>=.875THENA$="[139][206]EW [205]OON":A$=A$+"[139]"
  8. 519 IFPH>.125ANDPH<=.375THENA$="[139][198]IRST [209]UARTER[139]"
  9. 520 IFPH>.375ANDPH<=.625THENA$="[139][198]ULL [205]OON! [212]IME TO [200][207][215][204]![139]"
  10. 521 IFPH>.625ANDPH<=.875THENA$="[139][204]AST [209]UARTER[139]"
  11. 522 GOSUB40
  12. 523 A$="[139][139][212]HE [202]ULIAN [196]AY IS "+STR$(J):GOSUB40:A$="[139][139][205]AYAN [195]ALENDAR:[139]":GOSUB40
  13. 524 K=INT(J/7200):KT=INT((J/7200-INT(J/7200))*7200+.5):A$="[139][203]ATUN "+STR$(K):GOSUB40
  14. 525 T=INT(KT/360):TU=INT((KT/360-INT(KT/360))*360+.5):A$="[139][212]UN "+STR$(T):GOSUB40
  15. 526 U=INT(TU/20):UI=INT((TU/20-INT(TU/20))*20+.5):A$="[139][213]INAL "+STR$(U):GOSUB40
  16. 527 A$="[139][203]IN"+STR$(UI):GOSUB40:PH=INT(((J+63)/365-INT((J+63)/365))*365+.5)
  17. 528 IFPH<=91.25THENA$="[139][139][208]ALE OF [194]ELTANE"
  18. 529 IFPH>91.25ANDPH<=182.5THENA$="[139][139][208]ALE OF [204]AMMAS"
  19. 530 IFPH>182.5ANDPH<=273.75THENA$="[139][139][208]ALE OF [193]LL [200]ALLOWS"
  20. 531 IFPH>273.75THENA$="[139][139][208]ALE OF [195]ANDLEMAS"
  21. 532 A$=A$+"[139]_________________"
  22. 533 GOSUB40
  23. 534 PH=VAL(MID$(D1$,1,1))+VAL(MID$(D1$,9,1))
  24. 535 UI=INT((PH/7-INT(PH/7))*7+.5)    
  25. 35586 UI=0THENA$="[139][139][208]LANETARY [200]OUR OF [205]ERCURY"
  26. 537 IFUI=1THENA$="[139][139][208]LANETARY [200]OUR OF [214]ENUS"
  27. 538 IFUI=2THENA$="[139][139][208]LANETARY [200]OUR OF [205]ARS"
  28. 539 IFUI=3THENA$="[139][139][208]LANETARY [200]OUR OF [202]UPITER"
  29. 540 IFUI=4THENA$="[139][139][208]LANETARY [200]OUR OF [211]ATURN"
  30. 541 IFUI=5THENA$="[139][139][208]LANETARY [200]OUR OF THE [211]UN"
  31. 542 IFUI=6THENA$="[139][139][208]LANETARY [200]OUR OF THE [205]OON"
  32. 543 GOSUB40:A$="[139](<[192])\G1":GOSUB40:AN$="":A$="\F1-*>[212]HE [205]ICRO[196]OT [193]LMANACH<*-"
  33. 544 GOSUB40:UI=27+1/3
  34. 545 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  35. 546 A$="[139][212]HE [205]OON IS IN [218]ODIACAL [200]OUSE     :"+STR$(PH):GOSUB40:UI=88
  36. 547 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  37. 9 A$="[139][205]ERCURY IS IN [218]ODIACAL [200]OUSE      :"+STR$(PH):GOSUB40:UI=243
  38. 549 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  39. 550 A$="[139][214]ENUS IS IN [218]ODIACAL [200]OUSE        :"+STR$(PH):GOSUB40:UI=687
  40. 551 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  41. 552 A$="[139][205]ARS IS IN [218]ODIACAL [200]OUSE         :"+STR$(PH):GOSUB40:UI=4331.865
  42. 553 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  43. 554 A$="[139][202]UPITER IS IN [218]ODIACAL [200]OUSE      :"+STR$(PH):GOSUB40:UI=10760.265
  44. 555 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  45. 556 A$="[139][211]ATURN IS IN [218]ODIACAL [200]OUSE       :"+STR$(PH):GOSUB40:UI=30681
  46. 557 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  47. 558 A$="[139][213]RANUS IS IN [218]ODI    
  48. 51232 OUSE       :"+STR$(PH):GOSUB40:UI=60266.25
  49. 559 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  50. 560 A$="[139][206]EPTUNE IS IN [218]ODIACAL [200]OUSE      :"+STR$(PH):GOSUB40:UI=90582
  51. 561 P=J/UI-INT(J/UI):PH=INT(P*12)+1
  52. 562 A$="[139][208]LUTO IS IN [218]ODIACAL [200]OUSE        :"+STR$(PH)+"[139][139]":GOSUB40:GOTO1300
  53.