home *** CD-ROM | disk | FTP | other *** search
/ Loadstar - Compleat Programmer / comprog1.d81 / b.calendar (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  3KB  |  128 lines
  1. 10 poke53280,0:poke53281,0:print"[147]"
  2. 20 poke650,128:rem all keys repeat
  3. 22 poke788,52:rem disable stop
  4. 30 dimm$(13),ml(13),d$(8)
  5. 40 fori=0to11:readm$(i),ml(i):next
  6. 50 data" [202]anuary ",31
  7. 60 data"[198]ebruary ",28
  8. 70 data"  [205]arch  ",31
  9. 80 data"  [193]pril  ",30
  10. 90 data"   [205]ay   ",31
  11. 100 data"  [202]une   ",30
  12. 110 data"  [202]uly   ",31
  13. 120 data" [193]ugust  ",31
  14. 130 data"[211]eptember",30
  15. 140 data" [207]ctober ",31
  16. 150 data"[206]ovember ",30
  17. 160 data"[196]ecember ",31
  18. 170 fori=0to6:readd$(i):next
  19. 180 data" [211]unday  "
  20. 190 data" [205]onday  "
  21. 200 data" [212]uesday "
  22. 210 data"[215]ednesday"
  23. 220 data"[212]hursday "
  24. 230 data" [198]riday  "
  25. 240 data"[211]aturday "
  26. 250 bx$(0)="[176][192][192][192][192][192][192][192][192][192][174][157][221][157][157][157][157][157][157][157][157][157][157][157][221][157][173][192][192][192][192][192][192][192][192][192][189]
  27. 260 bx$(1)[178]"ortantantantan^cmd(NULL)cmdcmdcmdcmdcmdcmd(NULL)cmd/tantantantanexp"
  28. 270 bx$(2)[178]"ortantantantantantan^cmd(NULL)cmdcmdcmdcmdcmdcmdcmdcmd(NULL)cmd/tantantantantantanexp"
  29. 280 bx$(3)[178]bx$(0)
  30. 282 h[178]100:f[178]400
  31. 290 y[178]4:[129]i[178]0[164]3:[135]x(i):[130]
  32. 300 [131]1,12,19,28:[143] tabs for boxes
  33. 307 :
  34. 308 :[143] screen
  35. 309 :
  36. 310 [153]"loadfor   (NULL)left$val (NULL)right$chr$left$(NULL)(NULL) (NULL)(NULL)atnstr$(NULL)(NULL)atn(NULL) str$atn(NULL) lenatn(NULL)len(NULL)(NULL)atn(NULL)(NULL)(NULL)
  37. 320 print"[154]    [205]onth    [196]ate    [217]ear       [196]ay"
  38. 330 print"[155]  [195][210][211][210] [210][201][199][200][212]/[204][197][198][212][152] - [205]ove box
  39. 340 b[178]8:[153][163]b)"list  len(NULL)(NULL)(NULL) (NULL)(NULL)print# - ascorward
  40. 350 printtab(b)"[155][195][210][211][210] [196][207][215][206][152] - [194]ack
  41. 360 [153][163]b)"list       asc1print# - (NULL)ear back 10
  42. 370 printtab(b)"[155]       [198]2[152] - [217]ear forward 10
  43. 380 [153][163]b)"list       asc3print# - (NULL)ear back 100
  44. 390 printtab(b)"[155]       [198]4[152] - [217]ear forward 100
  45. 410 [153][163]b)"list        (NULL)print# - (NULL)uit
  46. 420 fori=0to3:poke214,y:print"":printtab(x(i))bx$(i):next
  47. 430 x=0:y0=0:y1=1:y2=1994:dw=6:rem starting values
  48. 440 poke214,y+1:print"[159]"
  49. 450 printtab(x(0)+1)m$(y0)
  50. 460 poke214,y+1:print
  51. 470 printtab(x(1)+1)"   [157][157][157]"str$(y1)
  52. 480 poke214,y+1:print
  53. 490 printtab(x(2)+1)str$(y2)
  54. 492 gosub820
  55. 497 :
  56. 498 :rem get loop
  57. 499 :
  58. 500 poke214,y:print:printtab(x(x))""bx$(x):rem highlight
  59. 510 geta$:ifa$=""then510
  60. 520 ifa$<>"[157]"anda$<>""then570
  61. 530 poke214,y:print:printtab(x(x))""bx$(x):rem de-highlight
  62. 540 ifa$=""thenx=x+1:ifx>2thenx=0:rem right
  63. 550 ifa$="[157]"thenx=x-1:ifx<0thenx=2:rem left
  64. 560 goto500
  65. 567 :
  66. 568 :rem down
  67. 569 :
  68. 570 ifa$<>""then650
  69. 580 onx+1goto590,610,630
  70. 590 y0=y0-1:ify0<0theny0=11
  71. 592 ify0=1thenify1>28theny1=28
  72. 600 goto440
  73. 610 y1=y1-1:ify1<1theny1=ml(y0)-((y0=1)and(y2/4=int(y2/4)))
  74. 612 ify2/h=int(y2/h)thenify2/f<>int(y2/f)thenify0=1andy1=29theny1=y1-1
  75. 620 goto440
  76. 630 y2=y2-1:ify2<1584theny2=1584:rem earliest date
  77. 637 :
  78. 638 :rem up
  79. 639 :
  80. 640 goto440
  81. 650 ifa$<>"[145]"then730
  82. 660 onx+1goto670,690,710
  83. 670 y0=y0+1:ify0>11theny0=0
  84. 672 ify0=1thenify1>28theny1=28
  85. 680 goto440
  86. 690 y1=y1+1:ify1>ml(y0)-((y0=1)and(y2/4=int(y2/4)))theny1=1
  87. 692 ify2/h=int(y2/h)thenify2/f<>int(y2/f)thenify0=1andy1=29theny1=1
  88. 700 goto440
  89. 710 y2=y2+1:ify2>9999theny2=9999
  90. 720 goto440
  91. 727 :
  92. 728 :rem f-keys
  93. 729 :
  94. 730 ifa$<chr$(133)ora$>chr$(138)then800
  95. 750 ifa$=chr$(133)theny2=y2-10:ify2<1584theny2=1584
  96. 760 ifa$=chr$(137)theny2=y2+10:ify2>9999theny2=9999
  97. 770 ifa$=chr$(134)theny2=y2-h:ify2<1584theny2=1584
  98. 780 ifa$=chr$(138)theny2=y2+h:ify2>9999theny2=9999
  99. 790 goto440
  100. 800 ifa$="q"then990:rem quit
  101. 802 goto440
  102. 807 :
  103. 808 :rem calculate
  104. 809 :
  105. 820 ny=y2-1584:rem # of years
  106. 830 nl=int(ny/4)-int((y2-1500)/h)+int((y2-1200)/f):rem # of leap yrs
  107. 840 nd=ny*365+nl+1:rem # of days
  108. 850 if(y2-1200)/f=int((y2-1200)/f)then880:rem is year 1600,2000,2400?
  109. 860 if(y2-1500)/h=int((y2-1500)/h)then890:rem is year 1700,1800,1900?
  110. 870 ify2/4<>int(y2/4)then890:rem leap year?
  111. 880 ify0<2thennd=nd-1:rem before feb 29?
  112. 890 nq=0:ify0thenfori=0toy0-1:nq=nq+ml(i):next
  113. 900 nq=nq+y1-1:nd=nd+nq:rem # of days including current year
  114. 910 dq=int(nd/7):dw=nd-dq*7:rem modulo to get # of day of week
  115. 920 poke214,y+1:print:printtab(x(3)+1)d$(dw)
  116. 922 return
  117. 960 goto520
  118. 987 :
  119. 988 :rem return to ls
  120. 989 :
  121. 990 poke788,49:rem  re-enable stop
  122. 992 a$="hello connect":fori=8to9:close2:open2,i,2:close2:ifstthen1010
  123. 1000 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then1020
  124. 1010 next:print"[147]":poke2048,0:poke44,8:poke53272,23:poke186,8:end
  125. 1020 poke646,peek(53281):print"[147]load"chr$(34)a$chr$(34)","i
  126. 1030 print"run":poke44,8:poke2048,0:poke631,13:poke632,13:poke198,2:end
  127. 10000 open15,8,15,"s0:b.calendar":close15:save"b.calendar",8:end
  128.