home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1994 July / 1994-07b.d64 / listmaker (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  165 lines
  1. 5 rem copyright 1994 - compute publications intl. ltd. - all rights reserved
  2. 10 clr:n=224:m=74:dima$(250):print chr$(14):s$="":n$="[147]":dr=8
  3. 15 poke53281,6:poke53280,6:poke646,1
  4. 20 print n$s$s$:h$="***** [212][200][197] [204][201][211][212][205][193][203][197][210] *****":l=len(h$):ta=(40-l)/2-1
  5. 30 for h=l to 1 step-1:h1$=" "+mid$(h$,h,1)
  6. 40 if h1$<>"  "then for hh=1 to h:printtab(ta+hh-1)h1$"[145]":next
  7. 50 next:print s$s$
  8. 60 printtab(6)"[208]ress [204] to [204]oad a [198]ile"
  9. 70 printtab(6)"[208]ress [197] to [208]roceed to [197]ntry"
  10. 80 get l$:if l$="e"then120
  11. 90 if l$<>"l"then80
  12. 100 gosub1070:if k<1then60
  13. 110 goto340
  14. 120 print n$tab(6)s$"[197]nter a [212]itle for your [204]ist"
  15. 130 printtab(4):inputc$:if c$=""then120
  16. 140 print n$"[204][201][205][201][212][211]:"n"entries -"m"characters each";
  17. 150 print"[213]se [201][206][211][212]-[196][197][204] to [195]orrect in current entry";
  18. 160 print"[208]ress ^ on blank line to [197]nd entry mode"
  19. 170 ll=0:k=k+1:a$(k)="":print"[157]"k"[157]-";:if k<10then print" ";
  20. 180 if k<100then print" ";
  21. 190 print"[164][157]";:get a$:if a$=""then190
  22. 200 ll=len(a$(k)):if a$=chr$(20)and ll<1or a$=chr$(34)then190
  23. 210 if a$=chr$(20)then a$(k)=left$(a$(k),ll-1):goto270
  24. 220 if a$=chr$(13)and ll<1 or a$=chr$(19)then190
  25. 230 if a$=chr$(13)then print" ":goto290
  26. 240 if asc(a$)<32 or asc(a$)>96and asc(a$)<191then190
  27. 250 if ll>m-1then190
  28. 260 a$(k)=a$(k)+a$
  29. 270 print a$;:if a$="^"and ll=0then a$(k)="":k=k-1:goto310
  30. 280 goto190
  31. 290 if k=n then310
  32. 300 goto170
  33. 310 print n$tab(11)s$k"[197]ntries [205]ade"
  34. 320 printtab(13)s$"[208]ress [193]ny [203]ey"
  35. 330 wait198,15:get m$
  36. 340 print n$ tab(2)s$"[208] = [208]rintout (turn printer on)"
  37. 350 printtab(5)"[196] = [196]elete [213]nwanted [197]ntries"
  38. 360 printtab(8)"+ = [205]ake [193]dditions to [204]ist"
  39. 370 printtab(11)"[214] = [214]iew [195]omplete [204]ist"
  40. 380 printtab(14)"[206] = [211]tart a [206]ew [204]ist"
  41. 390 printtab(17)"[193] = [193]lphabetize [204]ist":printtab(20)"[211] = [211]ave to [196]isk"
  42. 400 printtab(23)"[209] = [209]uit"
  43. 410 get p$:if p$="+"then m=74:goto140
  44. 420 if p$="s"and k>1 then gosub880:goto340
  45. 430 if p$="p" and k>1then gosub540:goto340
  46. 440 if p$="v"then gosub1290:goto340
  47. 450 if p$="n"or p$="q"then1570
  48. 460 if p$="d"then gosub1340:goto340
  49. 470 if p$<>"a"then410
  50. 480 print n$tab(10)s$"[215]ait - [193]lphabetizing"
  51. 490 for j=k to 2step-1:r$=a$(1):f=1
  52. 500 for l=2 to j
  53. 510 if a$(l)>r$then r$=a$(l):f=l
  54. 520 next:a$(f)=a$(j):a$(j)=r$
  55. 530 next:printtab(8)"[145][193]lphabetizing [195]omplete":for x=1 to 1200:next:goto340
  56. 540 print n$s$"[208]lease [215]ait: [195]hecking for [204]ongest [197]ntry"
  57. 550 le=0:for x=1 to k:ll=len(a$(x))
  58. 560 if ll>le then le=ll
  59. 570 next:if le>38 or k<10then nc=1:m=74:goto690
  60. 580 print n$s$" [195][200][207][207][211][197] [206][213][205][194][197][210] of [195]olumns for [208]rintout":print" [206][207][212][197]: [195]hoices";
  61. 590 print" are determined by longest"spc(7)"entry -"le"characters/spaces"
  62. 600 printtab(11)"1 = [211]ingle [195]olumn"
  63. 610 if le<39then printtab(11)"2 = [212]wo [195]olumns":y=2
  64. 620 if le<26then printtab(11)"3 = [212]hree [195]olumns":y=3
  65. 630 if le<19then printtab(11)"4 = [198]our [195]olumns":y=4
  66. 640 get nc$:nc=val(nc$):if nc<1 or nc>y then640
  67. 650 if nc=1then m=74
  68. 660 if nc=2then m=38
  69. 670 if nc=3then m=25
  70. 680 if nc=4then m=18
  71. 690 print n$s$" [198]orm [198]eed will occur when any column"spc(4)"exceeds 56 entries"
  72. 700 printtab(7)s$"[208] = [195]ontinue with [208]rintout":printtab(7)"[195] = [195]ancel"
  73. 710 get h$:if h$="c"then return
  74. 720 if h$<>"p"then710
  75. 730 mh=39:hh=mh-(len(c$)/2):hi=int(hh)
  76. 740 print n$tab(13)s$"[208]rinting...."
  77. 750 open4,4,7:open2,4
  78. 760 print#4,spc(hi);c$:print#4:print#4
  79. 770 tc=int(k/nc):z=k-(tc*nc):if z>0then tc=tc+1
  80. 780 for i=1 to tc:if i=57 or i=113 or i=169then print#2,chr$(12)
  81. 790 pi=m+2-len(a$(i)):pj=m+2-len(a$(i+tc)):pk=m+2-len(a$(i+tc*2))
  82. 800 if nc=1then print#4,a$(i):goto850
  83. 810 if nc=2then print#4,a$(i);spc(pi);a$(i+tc):goto850
  84. 820 if nc=3then print#4,a$(i);spc(pi);a$(i+tc);spc(pj);a$(i+tc*2):goto850
  85. 830 if nc=4then print#4,a$(i);spc(pi);a$(i+tc);spc(pj);a$(i+tc*2);
  86. 840 print#4,spc(pk);a$(i+tc*3)
  87. 850 next i:close4:close2
  88. 860 printtab(11)"[145][208]rintout [195]omplete"
  89. 870 for x=1 to 2000:next:return
  90. 880 print n$s$" [196]o you want to view the [196]isk [196]irectory  before";
  91. 890 print" making [211]ave?":gosub1560
  92. 900 get d$:if d$="y"then gosub1510:goto920
  93. 910 if d$<>"n"then900
  94. 920 print n$s$"  *** [208]ress [210]eturn [193]lone to [195]ancel ***"
  95. 930 printtab(6)s$"[197]nter [198]ilename use lower case":print
  96. 940 printtab(11);:input f$
  97. 950 if f$=""then return
  98. 960 if len(f$)>16then printtab(13)"[210]e-enter-[212]oo [204]ong":goto940
  99. 970 printtab(10)s$"[211]aving "f$:cr$=chr$(13)
  100. 980 open 15,8,15:print#15,"s0:"f$
  101. 990 open2,8,2,"@0:"+f$+",s,w":gosub1260
  102. 1000 print#2,k;cr$;c$
  103. 1010 for i=1 to k
  104. 1020 print#2,chr$(34);a$(i)
  105. 1030 next:gosub1260
  106. 1040 close2:close15
  107. 1050 printtab(12)s$"[211]ave [195]ompleted":for x=1 to 1000:next
  108. 1060 return
  109. 1070 print n$s$" [196]o you want to view the [196]isk [196]irectory  before [204]oading?"
  110. 1080 gosub1560
  111. 1090 get ld$:if ld$="y"then gosub1510:goto1110
  112. 1100 if ld$<>"n"then1090
  113. 1110 print n$s$"  *** [208]ress [210]eturn [193]lone to [195]ancel ***"
  114. 1120 printtab(6)s$"[197]nter [198]ilename use lower case":print
  115. 1130 printtab(11);:input g$
  116. 1140 if g$=""then print n$s$chr$(14):return
  117. 1150 printtab(10)s$"[204]ooking for ";g$
  118. 1160 open 15,8,15
  119. 1170 open2,8,2,"0:"+g$+",s,r":gosub1260
  120. 1180 input#2,k,c$
  121. 1190 for i=1 to k
  122. 1200 input#2,a$(i)
  123. 1210 gosub1260
  124. 1220 next
  125. 1230 close2:close15
  126. 1250 return
  127. 1260 input#15,en,em$,et,es
  128. 1270 if en>1thenprint ,em$
  129. 1280 return
  130. 1290 print n$" [208]ress [211]pace [194]ar [212]o [211]tart/[208]ause [204]isting "
  131. 1300 get m$:if m$<>chr$(32)then1300
  132. 1310 for i=1 to k:get m$:print a$(i):if m$=chr$(32)then wait198,15:get m$
  133. 1320 for x=1to100:next:next:print:printtab(14)"[208]ress [193]ny [203]ey":wait198,15:get m$
  134. 1330 return
  135. 1340 gosub1500:a=1:aa=1:for i=1 to k:print i"[157]-"left$(a$(i),34)
  136. 1350 if i/22=int(i/22)or i=k then print" "chr$(19):poke204,0:goto1380
  137. 1360 next:if z$="^" or k=0 then poke204,255:return
  138. 1370 goto1340
  139. 1380 getz$:ifz$=chr$(32)then aa=i+1:a=aa:gosub1500:goto1360
  140. 1390 if z$=""and aa<>i and aa<k then aa=aa+1:print" [157]"
  141. 1400 if z$="[145]"and i=k and aa<a+1 then1380
  142. 1410 if z$="[145]"and aa>i-21 then aa=aa-1:print" [157][145][145]"
  143. 1420 if z$="^"then i=k:goto1360
  144. 1430 if z$=chr$(4)then for y=1to38:print" ";:next:print" ":goto1450
  145. 1440 goto1380
  146. 1450 a$(aa)="":p=1:for x=1 to k
  147. 1460 if a$(x)=""then1480
  148. 1470 a$(p)=a$(x):p=p+1
  149. 1480 next:for j=p to k:a$(j)="":next:k=p-1
  150. 1490 i=k+1:goto1360
  151. 1500 print" "n$"[211][208][193][195][197] [194][193][210]=list  [195][212][210][204]/[196]=delete  ^=cancel[146]":return
  152. 1510 sys57812"$",dr:poke43,1:poke44,192:poke768,174:poke769,167:sys47003,1
  153. 1520 poke782,192:sys65493:sys42291:list:poke44,8:poke768,139:poke769,227
  154. 1530 print:printtab(8)"[208]ress [193]ny [203]ey"
  155. 1540 wait198,15:get m$
  156. 1550 return
  157. 1560 printtab(17)"[217]es/[206]o":return
  158. 1570 print n$s$:if p$="q"then printtab(17)"[209]uit??"
  159. 1580 if p$="n"then printtab(12)"[211]tart [206]ew [204]ist??"
  160. 1590 printtab(13)"[193]re [217]ou [211]ure??":gosub 1560
  161. 1600 get q$:if q$="n"then340
  162. 1610 if q$="y"and p$="n"then10
  163. 1620 if q$="y"and p$="q"then sys64738
  164. 1630 goto1600
  165.