home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 83 / 083.d81 / cal.track (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  15KB  |  442 lines
  1. 100 poke 55,0:poke 56,128:clr
  2. 110 de=peek(186):ifde<8thende=8
  3. 115 goto230
  4. 120 sys 52496,fr,fc,tr,tc,ad,fu,co,rv
  5. 130 ad=ad+(tr-fr+1)*(tc-fc+1)*2:n=n+1
  6. 140 if ad>52495thenprint"windows abort!":end
  7. 150 fr(n)=fr:fc(n)=fc:tr(n)=tr:tc(n)=tc
  8. 160 return
  9. 170 :
  10. 180 fr=fr(n):fc=fc(n):tr=tr(n):tc=tc(n)
  11. 190 ad=ad-(tr-fr+1)*(tc-fc+1)*2:n=n-1
  12. 200 sys 52496,fr,fc,tr,tc,ad,8,1,1
  13. 210 return
  14. 220 :
  15. 230 print"[147]":dim l$(12),l(12),la(12),lw$(7),mm$(4)
  16. 240 dim la$(106),lb(106),lc(106),lp(106),pi(22)
  17. 250 l$(1)="[197]ach ":l$(2)="[199]ram ":l$(3)="[207]unce":l$(4)="[208]ound":l$(5)="[212]sp  "
  18. 260 l$(6)="[212]bl  ":l$(7)="[207]unce":l$(8)="[195]up  ":l$(9)="[208]int ":l$(10)="[209]uart"
  19. 270 l$(11)="[199]al  ":l$(12)="     "
  20. 280 l(1)=1.0:l(2)=.035273:l(3)=1.0:l(4)=16:l(5)=.16666667:l(6)=0.5
  21. 290 l(7)=1.0:l(8)=8.0:l(9)=16.0:l(10)=32.0:l(11)=64.0:l(12)=-1.0
  22. 300 a3$=chr$(125):a6$="[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]"
  23. 310 la(1)=0.:la(2)=31.:la(3)=59.:la(4)=90.:la(5)=120.:la(6)=151.
  24. 320 la(7)=181.:la(8)=212.:la(9)=243.:la(10)=273.:la(11)=304.:la(12)=334.
  25. 330 lw$(0)="[211][213][206]":lw$(1)="[205][207][206]":lw$(2)="[212][213][197]":lw$(3)="[215][197][196]":lw$(4)="[212][200][210]"
  26. 340 lw$(5)="[198][210][201]":lw$(6)="[211][193][212]"
  27. 350 mm$(1)="[194][210][197][193][203][198][193][211][212]":mm$(2)="[204][213][206][195][200]":mm$(3)="[196][201][206][206][197][210]":mm$(4)="[211][206][193][195][203]"
  28. 360 ss$="                               ":zc=0
  29. 370 gosub540:end
  30. 380 fr=21:fc=09:tr=23:tc=29:fu=7 :co=1 :rv=3:gosub120
  31. 390 yy=23:xx=10:gosub530
  32. 400 print"[159] [193]ny [203]ey [195]ontinues";
  33. 410 poke198,0:wait198,15:geta$:gosub180:return
  34. 420 if zc=1then return
  35. 430 fr=18:fc=08:tr=22:tc=32:fu=7 :co=1 :rv=3:gosub120:yy=21:xx=09:gosub530
  36. 440 print"[159] [204]oading [195]ategory [198]ile":gosub1130:gosub180:zc=1:return
  37. 450 gosub520:print"[144][147]new":print"load"chr$(34)f$chr$(34)","de
  38. 460 print"?c[200](144)c[200](142):run"
  39. 470 poke198,3:poke631,13:poke632,13:poke633,13:poke56,160:end
  40. 480 input#15,e,e$,a,b:ife<20 orre=73 then return
  41. 490 if e=50thenreturn
  42. 500 print "[147]  [196][201][211][203] [208][210][207][194][204][197][205]: [195]an't [195]ontinue!":gosub380
  43. 510 gosub520:end
  44. 520 close3:close15:open15,de,15,"i0":gosub480:fori=1to150:next:close15:return
  45. 530 poke 214,yy:poke211,xx:print"[145]";:return
  46. 540 rem hskpng
  47. 560 dim ca$(30),ci$(30),cx(30),cs(30),sd(6,7)
  48. 570 dim fr(20),fc(20),tr(20),tc(20)
  49. 580 ad=49920:fori=1to30:cx(i)=0:cs(i)=0:next
  50. 590 poke 147,0:sys57812"windows.o",de,1:sys62631
  51. 600 poke147,0:sys57812"cal.rd.o",de,1:sys62631
  52. 610 printchr$(14)
  53. 620 poke53280,0:poke53281,0
  54. 630 poke53280,0:fr=07:fc=05:tr=20:tc=33:fu=7:co=7:rv=3:gosub5000:gosub120
  55. 640 yy=10:xx=16:gosub530:print"[159][207][208][212][201][207][206][211]"
  56. 650 print"[159][163][163][163][163][163][163][163]"
  57. 660 print"[159]1. [208]lan [210]eview/[213]pdate"
  58. 670 print"2. [195]onsume [210]eview/[213]pdate"
  59. 680 print"3. [208]rint & [193]nalysis"
  60. 690 print"4. [194]rowse [195]alorie [212]able"
  61. 700 print"5. [195]alorie [212]able [213]pdate"
  62. 710 print"6. [209]uit [212]his [208]rogram"
  63. 720 print"[208]lease [211]elect"
  64. 730 poke198,0:wait198,15:geta$:ifa$<"1"ora$>"6"then730
  65. 740 if a$="1" then gosub180:zt=1:gosub2780:goto630
  66. 750 if a$="2" then gosub180:zt=0:gosub2780:goto630
  67. 760 if a$="3" then gosub180:f$="cal.print":goto450
  68. 770 if a$="5" then gosub180:f$="cal.tab.upte":goto450
  69. 780 if a$="4" thengosub180:goto810
  70. 790 if a$="6" then gosub180:f$="hello connect":de=8:goto450
  71. 800 goto 730
  72. 810 gosub420:gosub1250:goto630
  73. 820 wait198,15:geta$:gosub180:return
  74. 830 rem get routine
  75. 840 a1$=""
  76. 850 gosub1050
  77. 860 geta$:ifa$=""ora$=","ora$=";"then860
  78. 870 a=asc(a$):if a=20 thengosub1080:goto940
  79. 880 if a=13then 960
  80. 890 if a5$="a"then 1100
  81. 900 if a$="."ora$="," then930
  82. 910 if a$ = "-" and len(a1$) = 0 then 930
  83. 920 if a < 48 or a > 60 then 860
  84. 930 iflen(a1$)<al then a1$=a1$+a$
  85. 940 gosub950:goto 860
  86. 950 gosub1050:return
  87. 960 dv=0:l =len(a1$):a = 0:at = 0:p = 0:an = 1
  88. 970 if a5$="a"then return
  89. 980 for i=1 to l:a$ = mid$(a1$,i,1)
  90. 990 if a$="-" then an=-1:goto 1040
  91. 1000 ifa$=","then 1040
  92. 1010 if a$="."thendv=1:goto 1040
  93. 1020 if dv=0 then a=val(a$):at = at*10 + a
  94. 1030 if dv=1 then p=p+1:a=val(a$):at = at + a/(10^p)
  95. 1040 next:at=at*an:return
  96. 1050 a4$=left$(a6$,al)
  97. 1060 gosub530:printa7$;a2$;" "; a3$;a1$" ";spc(al-len(a1$));"[157]"a3$
  98. 1070 print a7$;spc(xx+    len(a2$)+1);chr$(173);a4$;chr$(189);"[145][145]":return
  99. 1080 l=len(a1$):ifl=0then return
  100. 1090 l=l-1:a1$=mid$(a1$,1,l):return
  101. 1100 if a> 31 and a <94 then 930
  102. 1110 if a> 159 and a <221 then 930
  103. 1120 goto 860
  104. 1130 rem get category file
  105. 1140 close15:open15,de,15,"i0":print#15,"r0:%%mast.cat=%%mast.cat"
  106. 1150 input#15,er:close15
  107. 1160 if er<>63 then 65535
  108. 1170 close15:open15,de,15,"i0":gosub1220:open3,de,3,"%%mast.cat,s,r":gosub1220
  109. 1180 i=0:input#3,nc:rem nc=nxt cat num
  110. 1190 i=i+1:input#3,ca$(i):input#3,ci$(i):input#3,cx(i)
  111. 1200 ifleft$(ca$(i),1)<>chr$(255)then1190
  112. 1210 gosub1220:close3:close15:cl=i:return
  113. 1220 input#15,e,e$,a,b:ife<20ore=73then return
  114. 1230 if e=50 then return
  115. 1240 goto500
  116. 1250 pg=0:print"[147] _ = [197]scape  f1 = [208]age  <[210]tn> = [211]elect"
  117. 1260 fr=04:fc=09:tr=22:tc=30:fu=7 :co=1:rv=3:gosub120
  118. 1270 yy=6:xx=13:gosub530:print"[159]  [195][193][212][197][199][207][210][201][197][211]":yy=7:gosub530
  119. 1280 print"  [163][163][163][163][163][163][163][163][163][163]":cp=0
  120. 1290 cp=cp+1:if cp+pg*13>clthen cp=cp-2:goto1340
  121. 1300 if cp>13 then cp=13:goto1340
  122. 1310 yy=7+cp:gosub530:print""ca$(cp+(pg*13))
  123. 1320 if cp+pg*13 =clthen gosub530:print "   [146][197]nd [204]ist[159]"
  124. 1330 goto1290
  125. 1340 pm=cp:cp=1:xx=11:cq=1
  126. 1350 gosub1470
  127. 1360 xx=11:wait198,15:geta$:ifa$=""thencr=1:goto1420
  128. 1370 if a$="[133]"then cr=pm-cp+1:goto1420
  129. 1380 if a$="_"then gosub180:return
  130. 1390 if a$="[145]"thencr=-1:goto1420
  131. 1400 a=asc(a$):ifa=13then1480
  132. 1410 goto1360
  133. 1420 cp=cp+cr:ifcp<1thencp=pm:goto1350
  134. 1430 if cp<=pmthen1350
  135. 1440 ifcl<15thencp=1:goto1350
  136. 1450 pg=pg+1:if pg>1thenpg=0
  137. 1460 gosub180:goto1260
  138. 1470 yy=cq+7:gosub530:print"[159] ":yy=cp+7:gosub530:print">":cq=cp:return
  139. 1480 ax=pg*13+cp:cr=pm:gosub1710
  140. 1490 fr=09:fc=02:tr=24:tc=37:fu=7 :co=1 :rv=5:gosub120
  141. 1500 cs=cs(ax):print"[159]";
  142. 1510 sys32771,cs,rt:dl=rt:if rt>127 then 1510
  143. 1520 if rt=64 then 1500
  144. 1530 if rt>63 then dl=dl-65
  145. 1540 dp=0:xx=4:poke198,0:dq=0
  146. 1550 gosub1640:wait198,15:geta$
  147. 1560 if a$="" then dp=dp+1:ifdp>dl then dp=0
  148. 1570 if a$="[145]" then dp=dp-1:ifdp<0  then dp=dl
  149. 1580 if asc(a$)=13 then cs=dpor64:goto1650
  150. 1590 if a$="[133]"then cs=0:goto1620
  151. 1600 if a$="_" then gosub180:pm=cr:goto1360
  152. 1610 goto1550
  153. 1620 if rt>63  then 1500
  154. 1630 goto 1510
  155. 1640 yy=dq+12:gosub530:print" ":yy=dp+12:gosub530:print">":dq=dp:return
  156. 1650 sys32771,cs,rt,n$
  157. 1660 if rt>999 thengosub180:gosub1810:goto1680
  158. 1670 goto1550
  159. 1680 ifza=1 then za=0:gosub180:return
  160. 1690 goto1360
  161. 1700 s3=int(si/1000000):si=si-s3*1000000:s1=int(si/1000):s2=si-s1*1000:return
  162. 1710 rem get subcat fle
  163. 1720 a$=ci$(ax):if cs(ax)<>0then 1800
  164. 1730 close15:open15,de,15:gosub1220
  165. 1740 open3,de,3,a$+",s,r":gosub1220:fl=cx(ax):sys32768,fl,cc,cs,rt
  166. 1750 i=0:rt=int(rt)
  167. 1760 i=i+1:ifi>clthen1790
  168. 1770 if cs(i)<=cc and cs(i)>=cs thencs(i)=0
  169. 1780 goto 1760
  170. 1790 cs(ax)=cs:gosub1220:close3:close15
  171. 1800 return
  172. 1810 fr=07:fc=02:tr=20:tc=36:fu=07:co=1:rv=3:gosub120
  173. 1820 yy=9:xx=4:gosub530:print n$:print
  174. 1830 si=rt:gosub1700
  175. 1840 b$=str$(s1):ba$=right$("    "+b$,5)
  176. 1850 print "[159][195]alories per       [212][207][212][193][204]  ";ba$:bb$=" [197]ach           "
  177. 1860 b$=str$(s2):ba$=right$("    "+b$,5):s4=s3-(int(s3/10)*10)
  178. 1870 if s4=3 then bb$=" [207]unce by [214]olume"
  179. 1880 if s4=2 then bb$=" [207]unce by [215]eight"
  180. 1890 print"[159]";bb$;"   [211][193][212] [198][193][212]";ba$
  181. 1900 gosub1930:iflq<0then gosub180:return
  182. 1910 gosub2050:gosub2080:iflq<0then gosub180:return
  183. 1920 gosub180:return
  184. 1930 if s4=1 then pt=1:lq=1:return
  185. 1940 fr=12:fc=10:tr=23:tc=19:fu=7:co=1:rv=3:gosub120:p1=2:p2=4:pl=13
  186. 1950 ifs4=3 then p1=5:p2=11:pl=10
  187. 1960 yy=14:xx=13:gosub530:print"[1