home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 83 / 083.d81 / cal.print (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  14KB  |  406 lines
  1. 100 poke 55,0:poke 56,160:clr:n$="ab":goto220
  2. 110 :
  3. 120 sys 52496,fr,fc,tr,tc,ad,fu,co,rv
  4. 130 ad=ad+(tr-fr+1)*(tc-fc+1)*2:n=n+1
  5. 140 if ad>52495thenprint"windows abort!":end
  6. 150 fr(n)=fr:fc(n)=fc:tr(n)=tr:tc(n)=tc
  7. 160 return
  8. 170 :
  9. 180 fr=fr(n):fc=fc(n):tr=tr(n):tc=tc(n)
  10. 190 ad=ad-(tr-fr+1)*(tc-fc+1)*2:n=n-1
  11. 200 sys 52496,fr,fc,tr,tc,ad,8,1,1
  12. 210 return
  13. 220 de=peek(186):ifde<8thende=8
  14. 230 dim la(12),lw$(7),mm$(4),l$(12)
  15. 240 dim la$(106),lb(106),lc(106),lp(106),pi(21)
  16. 250 l$(1)="[197]ach ":l$(2)="[199]ram ":l$(3)="[207]unce":l$(4)="[208]ound":l$(5)="[212]sp  "
  17. 260 l$(6)="[212]bl  ":l$(7)="[207]unce":l$(8)="[195]up  ":l$(9)="[208]int ":l$(10)="[209]uart"
  18. 270 l$(11)="[199]al  ":l$(12)="     "
  19. 280 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]"
  20. 290 la(1)=0.:la(2)=31.:la(3)=59.:la(4)=90.:la(5)=120.:la(6)=151.
  21. 300 la(7)=181.:la(8)=212.:la(9)=243.:la(10)=273.:la(11)=304.:la(12)=334.
  22. 310 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]"
  23. 320 lw$(5)="[198][210][201]":lw$(6)="[211][193][212]"
  24. 330 mm$(1)="[194][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] "
  25. 340 ss$="                               ":zc=0:z$=chr$(0):lm=66
  26. 350 forx=900to933:ready:pokex,y:next
  27. 360 gosub610
  28. 370 gosub1770:ifga=1 then 390
  29. 380 ifga=2then 2450
  30. 390 gosub690:ifbt=0then 370
  31. 400 yy=22:xx=0:gosub600:print"f1 = [208]age  <[210][212][206]> = [211]elect  _ = [197]scape"
  32. 410 goto 2140
  33. 420 data 160,2,177,45,153,137,0,200,192,6,208,246,162
  34. 430 data 1,32,198,255,32,228,255,164,142,145,140,200
  35. 440 data 132,142,196,139,208,242,76,204,255
  36. 450 fr=21:fc=09:tr=23:tc=29:fu=7 :co=0 :rv=02:gosub120
  37. 460 yy=23:xx=10:gosub600
  38. 470 print" [193]ny [203]ey [195]ontinues";
  39. 480 poke198,0:wait198,15:geta$:gosub180:return
  40. 490 if zc=1then return
  41. 500 fr=18:fc=08:tr=22:tc=32:fu=7 :co=2 :rv=12:gosub120:yy=21:xx=09:gosub600
  42. 510 print"[152]   [204]oading [196]irectory ":gosub1080:gosub180:return
  43. 520 gosub590:print"[147]new":print"load"chr$(34)f$chr$(34)","de
  44. 530 print"?c[200](144)c[200](142):run"
  45. 540 poke198,3:poke631,13:poke632,13:poke633,13:poke56,160:end
  46. 550 input#15,e,e$,a,b:ife<20 orre=73 then return
  47. 560 if e=50thenreturn
  48. 570 print "[147]  [196][201][211][203] [208][210][207][194][204][197][205]: [195]an't [195]ontinue!":gosub450
  49. 580 gosub590:end
  50. 590 close3:close15:open15,de,15,"i0":close15:return
  51. 600 poke 214,yy:poke211,xx:print"[145]";:return
  52. 610 rem hskpng
  53. 620 poke53281,1:poke53280,1
  54. 630 dim dp$(53),dc$(53):dp=1:dp$(1)=chr$(255):dc=1:dc$(1)=chr$(255)
  55. 640 dim fr(20),fc(20),tr(20),tc(20)
  56. 650 ad=49920
  57. 660 rempoke 147,0:sys57812"windows.o",de,1:sys62631:poke53281,1
  58. 670 yy=10:xx=10:gosub600
  59. 680 return:poke147,0:sys57812"cal.rd.o",de,1:sys62631:return
  60. 690 print"[147]":poke53280,1:fr=07:fc=10:tr=15:tc=30:fu=7 :co=0 :rv=02:gosub120
  61. 700 yy=9:xx=13:gosub600:print"[193][206][193][204][217][218][197] & [208][210][201][206][212]":yy=10:gosub600
  62. 710 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]":yy=11:xx=16:gosub600:print"[197]nter [206]ame":xx=15
  63. 720 a7$="":a5$="a":al=8:a2$="":yy=13:gosub750:pn$=left$(a1$+"........",8)
  64. 730 gosub500:gosub180:ifbt=0then return
  65. 740 gosub1430:return
  66. 750 rem get routine
  67. 760 a1$=""
  68. 770 gosub970
  69. 780 get a$:if a$="" then 780
  70. 790 a=asc(a$):if a=20 thengosub1000:goto860.
  71. 800 if a=13then 880
  72. 810 if a5$="a"then 1020
  73. 820 if a$="."ora$="," then850
  74. 830 if a$ = "-" and len(a1$) = 0 then 850
  75. 840 if a < 48 or a > 60 then 780
  76. 850 iflen(a1$)<al then a1$=a1$+a$
  77. 860 gosub870:goto 780
  78. 870 gosub970:return
  79. 880 dv=0:l =len(a1$):a = 0:at = 0:p = 0:an = 1
  80. 890 if a5$="a"then return
  81. 900 for i=1 to l:a$ = mid$(a1$,i,1)
  82. 910 if a$="-" then an=-1:goto 960
  83. 920 ifa$=","then 960
  84. 930 if a$="."thendv=1:goto 960
  85. 940 if dv=0 then a=val(a$):at = at*10 + a
  86. 950 if dv=1 then p=p+1:a=val(a$):at = at + a/(10^p)
  87. 960 next:at=at*an:return
  88. 970 a4$=left$(a6$,al)
  89. 980 gosub600:printa7$;a2$;" "; a3$;a1$" ";spc(al-len(a1$));"[157]"a3$
  90. 990 print a7$;spc(xx+    len(a2$)+1);chr$(173);a4$;chr$(189);"[145][145]":return
  91. 1000 l=len(a1$):ifl=0then return
  92. 1010 l=l-1:a1$=mid$(a1$,1,l):return
  93. 1020 if a> 31 and a <94 then 850
  94. 1030 if a> 159 and a <221 then 850
  95. 1040 goto 780
  96. 1050 mm=int(mc/100000000):mc=mc-mm*100000000:mt=int(mc/10000):mf=mc-mt*10000
  97. 1060 md=int(mu/10000000):mu=mu-md*10000000:mx=int(mu/100):mq=mu-mx*100
  98. 1070 return
  99. 1080 rem get directory
  100. 1090 n$="az":forx=1to6:n$=n$+n$:next:n$=mid$(n$,2):n$=n$+n$
  101. 1100 dp=1:dp$(1)=chr$(255):dc=1:dc$(1)=chr$(255)
  102. 1110 close15:open15,de,15,"i0":gosub550:open1,de,2,"$":gosub550:bt=0
  103. 1120 sys900:gosub550
  104. 1130 sys900:forx=1to254step32:a=asc(mid$(n$,x,1))
  105. 1140 if a<>129 then 1180
  106. 1150 a=asc(mid$(n$,x+3,1)):ifa<>037 then 1180
  107. 1160 a=asc(mid$(n$,x+4,1)):if a=33 then 1240*
  108. 1170 ifa=36 then 1260*
  109. 1180 next:ifst=0 then 1130
  110. 1190 ifbt=0 then 1210
  111. 1200 close1:close15:return
  112. 1210 fr=10:fc=8:tr=15:tc=33:fu=7:co=.:rv=5:gosub120:print""
  113. 1220 yy=14:xx=10:gosub600:print"[206]ame [206]ot in [196]irectory!"
  114. 1230 gosub 450:gosub180:goto1200
  115. 1240 a1$=mid$(n$,x+5,8):ifa1$<>pn$then1180
  116. 1250 bt=1:a1$=mid$(n$,x+13,6):gosub1350:goto1180
  117. 1260 a1$=mid$(n$,x+5,8):ifa1$<>pn$then1180
  118. 1270 bt=1:a1$=mid$(n$,x+13,6):gosub1390:goto1180
  119. 1280 a$="   [208][204][193][206]  ":if cx=1thena$="[195][207][206][211][213][205][208][212][201][207][206]"
  120. 1290 print#4,spc(3);a$;" for ";pn$;spc(30);"[196][193][212][197]: ";n$
  121. 1300 print#4,spc(15);" [215][197][201][199][200][212]: ";wa/10;spc(22);" -- [195][193][204][207][210][201][197][211] --"
  122. 1310 a$="[198][193][212]    [212][207][212]"
  123. 1320 print#4,spc(5);". . . . [197][206][212][210][217] . . . . . . . ."spc(9);"[209][213][193][206][212][201][212][217]"spc(6)a$
  124. 1330 gosub2430:gc=4:return
  125. 1340 for ga=1to(66-gc):print#4,:next:gosub1280:return
  126. 1350 k=0
  127. 1360 k=k+1:ifa1$>dp$(k)then 1360
  128. 1370 dp=dp+1:forj=dptokstep-1:dp$(j)=dp$(j-1):next
  129. 1380 dp$(k)=a1$:return
  130. 1390 k=0
  131. 1400 k=k+1:ifa1$>dc$(k)then 1400
  132. 1410 dc=dc+1:forj=dctokstep-1:dc$(j)=dc$(j-1):next
  133. 1420 dc$(k)=a1$:return
  134. 1430 fr=3:fc=7:tr=20:tc=17:fu=7:co=.:rv=6:gosub120:print""
  135. 1440 fr=3:fc=24:tr=20:tc=34:fu=7:co=.:rv=6:gosub120
  136. 1450 yy=1:xx=12:gosub600:ifga=1then print"[211]elect [201]tem to [208]rint."
  137. 1460 if ga=2 then print"[207]rder for [193]nalysis!"
  138. 1470 yy=5:xx=10:gosub600:print"[208][204][193][206] ";spc(12);"[193][195][212][213][193][204]"
  139. 1480 yy=7:gosub600
  140. 1490 gosub1560:gosub1570:pp=1:cp=1:gosub1580:gosub1660:return
  141. 1500 fr=10:fc=08:tr=15:tc=33:fu=7:co=.:rv=4:gosub120:print"[156]"
  142. 1510 yy=13:xx=10:gosub600:print"  [208][210][201][206][212][197][210] [213][206][193][214][193][201][204][193][194][204][197]!"
  143. 1520 gosub 450:gosub180:return
  144. 1530 fr=10:fc=08:tr=15:tc=33:fu=7:co=.:rv=4:gosub120:print"[156]"
  145. 1540 yy=13:xx=10:gosub600:print" [193][204][201][199][206] [212][207] [212][207][208] [207][198] [198][207][210][205]!"
  146. 1550 gosub 450:gosub180:return
  147. 1560 yy=6:xx=0:gosub600:forj=1to14:printtab(10);"      ":next:return
  148. 1570 yy=6:xx=0:gosub600:forj=1to14:printtab(27);"      ":next:return
  149. 1580 yy=6:xx=0:gosub600:ps=pp
  150. 1590 ifpp>dpthen 1640
  151. 1600 if (pp-ps)>12 then 1630
  152. 1610 if dp$(pp)=chr$(255) then 1640
  153. 1620 printtab(10);"";dp$(pp):pp=pp+1:goto1590
  154. 1630 print tab(11);"[205][207][210][197]":bp=12:return
  155. 1640 if ps=pp and dp>1 then pp=1:goto1580
  156. 1650 print tab(11);"[197][206][196]":bp=pp-ps-1:return
  157. 1660 yy=6:xx=0:gosub600:cs=cp
  158. 1670 ifcp>dcthen 1720
  159. 1680 if (cp-cs)>12 then 1710
  160. 1690 if dc$(cp)=chr$(255) then 1720
  161. 1700 printtab(27);"";dc$(cp):cp=cp+1:goto1670
  162. 1710 print tab(28);"[205][207][210][197]":bc=12:return
  163. 1720 if cs=cp and dc>1 then cp=1:goto1660
  164. 1730 print tab(28);"[197][206][196]":bc=cp-cs-1:return
  165. 1740 ifa$="[139]" or a$="[134]" ora$="[135]" or a$="[136]" thenreturn
  166. 1750 if a$="_"then return
  167. 1760 goto 1920
  168. 1770 gosub5000:print"":fr=10:fc=7:tr=20:tc=33:fu=7:co=.:rv=2:gosub120:print""
  169. 1780 yy=12:xx=0:gosub600:print tab(13);"[193][206][193][204][217][218][197] & [208][210][201][206][212]"
  170. 1790 print tab(13);"[163][163][163][163][163][163][163][163][163][163][163][163][163