home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1984 Half 2 / rerun-1984-07-12.d64 / datafile (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  228 lines
  1. 10 rem datafile 2.6 (c)1983 by mike konshak
  2. 12 poke53280,13:poke53281,11:print"[158]":gosub16:ifx=0thengoto66
  3. 14 goto68
  4. 16 d$=chr$(0):mr$=d$:dr$=d$:s=0:b1$=chr$(10):pw=0:cw=0:b$=chr$(32)
  5. 18 nc=0:nl=0:pg=0:f1=0:f2=0:f3=0:l$=d$:rl=0:sb$=d$:cr$=chr$(13):hn$=d$:id$=d$
  6. 20 a$=d$:c$=d$:t%=0:i$=d$:ck=0:i=0:j=0:k=0:l=0:m=0:n=0:rw=5:sf=0:z=0:e$="eof"
  7. 22 mem=31000:en=0:em$=d$:et=0:es=0:a1$=d$:a2$=d$:a3$=d$:return
  8. 24 dim f$(f+1),t%(f+1),l%(f+1):return
  9. 26 dim rec$(r+1,f+1),ml$(9,4),pc(10),tt$(5),hc$(9),k%(r+1):return
  10. 28 rem--get
  11. 30 geta$:ifa$=""then30
  12. 32 return
  13. 34 rem--create
  14. 36 ifck<>0thengosub394
  15. 38 print"[147]          initialize datafile          "
  16. 40 clr:gosub16:input"how many fields in each record? 0 [157][157][157][157]";f:iff=0then68
  17. 42 gosub24:fori=1tof
  18. 44 print"field #";i:print"title ? >                           "
  19. 46 print"length? 0                           "
  20. 48 print"";tab(6);:inputf$(i):printtab(6);:inputl%(i):nexti
  21. 50 rem--compute # records
  22. 52 forj=0tof:rl=rl+l%(j):nextj:rl=rl+3*(f+1)+5:r=int((mem-12*(f+1)-2100)/rl)
  23. 54 print" your selections will allow approx"
  24. 56 printr;"records.  a[146]ccept or r[146]eject?"
  25. 58 gosub30:ifa$="r"then38
  26. 60 ifa$="a"thengosub26:ck=1:goto68
  27. 62 goto58
  28. 64 rem--menu
  29. 66 print"[147]  datafile 2.6 (c)1983 by mike konshak ":goto70
  30. 68 print"[147]            datafile menu              "
  31. 70 print"     c[146]reate new file  q[146]uit program
  32. 72 [153]"     awaitdd record to current file"
  33. 74 [153]"     mwaitodify record in current file"
  34. 76 [153]"     dwaitelete record in current file"
  35. 78 [153]"     rwaitead old file from disk"
  36. 80 [153]"     pwaitrint records by selection
  37. 82 print"     v[146]iew file on screen
  38. 84 [153]"     swaitort records by field
  39. 86 print"     w[146]rite new file to disk
  40. 88 [153]"     fwaitormat a disk  $wait disk directory
  41. 90 print"       press the appropriate key       "
  42. 92 print"  there are";x;"records in memory"
  43. 94 ifr>0thenprint"  space for";r-x;"more records[145]"
  44. 96 gosub30:ifa$="a"thengosub350:goto124
  45. 98 ifa$="m"thengosub350:goto244
  46. 100 ifa$="d"thengosub350:goto272
  47. 102 ifa$="c"then36
  48. 104 ifa$="r"then170
  49. 106 ifa$="p"thengosub354:goto356
  50. 108 ifa$="v"thengosub350:goto192
  51. 110 ifa$="w"thengosub350:goto144
  52. 112 ifa$="s"thengosub350:goto304
  53. 114 ifa$="q"then342
  54. 116 ifa$="f"then402
  55. 118 ifa$="$"then422
  56. 120 goto96
  57. 122 rem--add records
  58. 124 fori=x+1tor:print"[147]press the return[146] key after each entry"
  59. 126 print"press return[146] without any entry to stop"
  60. 128 print"record number ";i;""
  61. 130 forn=1tof
  62. 132 printf$(n);"   >[157][157][157]";:inputrec$(i,n):ifrec$(i,n)=""thenrec$(i,n)=">"
  63. 134 iflen(rec$(i,n))>l%(n)thengosub140:goto132
  64. 136 ifrec$(i,1)=">"then x=i-1:ck=1:goto68
  65. 138 nextn:k%(i)=i:nexti:x=r:ck=1:goto68
  66. 140 print"cannot exceed";l%(n);" characters":return
  67. 142 rem--save
  68. 144 print"[147]enter name of current file to be saved"
  69. 146 print"(12 characters max).  any existing file"
  70. 148 print"with the same name will be scratched."
  71. 150 print"  ";nf$:input"[145]";nf$:ifnf$=""then68
  72. 152 open15,8,15:print#15,"s0:df] "+left$(nf$,8)+"!old":gosub414
  73. 154 print#15,"r0:df] "+left$(nf$,8)+"!old=df] "+nf$:gosub414
  74. 156 open5,8,5,"0:df] "+nf$+",s,w":gosub414
  75. 158 print#5,r;cr$;f;cr$;x:gosub414:forn=1tof:print#5,f$(n);cr$;l%(n):nextn
  76. 160 fori=1tox:print"saving record #";i;"[145][145]"
  77. 162 forn=1tof:print#5,rec$(i,n):nextn:gosub414:nexti:print
  78. 164 fori=1tox:print"saving pointers";i;"[145][145]":print#5,k%(i):nexti:gosub414
  79. 166 print#5,e$:close5:close15:ck=0:goto68
  80. 168 rem--load
  81. 170 ifck<>0thengosub394
  82. 172 clr:gosub16:print"[147]enter name of file to be loaded":inputnf$
  83. 174 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub414
  84. 176 input#5,r,f,x:gosub414:gosub24:gosub26:forn=1tof:input#5,f$(n),l%(n):nextn
  85. 178 fori=1tox:print"reading record #";i;"[145][145]"
  86. 180 forn=1tof:input#5,rec$(i,n):nextn:gosub414:nexti:print
  87. 182 fori=1tox:print"reading pointers";i;"[145][145]":input#5,k%(i):nexti
  88. 184 gosub414:s=st:ifs<>0then188
  89. 186 input#5,e$
  90. 188 close5:close15:goto68
  91. 190 rem--view
  92. 192 i=1
  93. 194 ifi=0then68
  94. 196 ifi>xthen68
  95. 198 print"[147]record number[146]";i;" in file[146] ";nf$;""
  96. 200 forn=1tof:print f$(n);": ";rec$(k%(i),n):nextn
  97. 202 print" n[146]ext, l[146]ast, j[146]ump, f[146]ind, e[146]xit to menu"
  98. 204 gosub30:ifa$="n"theni=i+1:goto194
  99. 206 ifa$="l"theni=i-1:goto194
  100. 208 ifa$="j"then216
  101. 210 ifa$="f"then218
  102. 212 ifa$="e"then68
  103. 214 goto204
  104. 216 input"jump to record number";i:goto194
  105. 218 print"[147]    find records with common items "
  106. 220 forn=1tof:print" ";n;"[146] ";f$(n):nextn
  107. 222 input"which field is to be searched? 0 [157][157][157][157]";sf:ifsf=0then68
  108. 224 ifsf<1orsf>fthenprint"[145][145][145]":goto222
  109. 226 print"enter common item[146] ":print"(the entire string is not required)"
  110. 228 print"";f$(sf);"[146] ";:inputt$
  111. 230 fori=1tox:print"searching record";i;"[145][145]"
  112. 232 ift$=left$(rec$(k%(i),sf),len(t$))then236
  113. 234 goto240
  114. 236 print"[147] record #";i;"":forn=1tof:printf$(n);": ";rec$(k%(i),n):nextn
  115. 238 print" n[146]ext record":gosub30
  116. 240 nexti:goto68
  117. 242 rem--modify
  118. 244 print"[147]modify which record? enter #[146] or a[146]ll":inputmr$:ifmr$=d$then68
  119. 246 ifmr$="a"thenmr$=d$:goto254
  120. 248 i=val(mr$):mr$=d$
  121. 250 ifi>xthengosub348:goto244
  122. 252 gosub256:goto68
  123. 254 fori=1tox:gosub256:nexti:goto68
  124. 256 print"[147]to modify record number";i;", make changes"
  125. 258 print"as each field is displayed, then return[146]"
  126. 260 forn=1tof:printf$(n)":":print"   ";rec$(k%(i),n)
  127. 261 if len(rec$(k%(i),n))>36 then print"[145]";
  128. 262 print"[145] ";:inputrec$(k%(i),n)
  129. 264 iflen(rec$(k%(i),n))>l%(n)thengosub140:goto260
  130. 266 ifrec$(k%(i),n)=""thenrec$(k%(i),n)=">"
  131. 268 nextn:ck=1:return
  132. 270 rem--delete
  133. 272 print"[147]delete which record? enter #[146] or a[146]ll"
  134. 274 inputdr$:ifdr$=d$then68
  135. 276 ifdr$="a"thendr$=d$:goto282
  136. 278 i=val(dr$):dr$=d$:ifi>xthengosub348:goto274
  137. 280 gosub284:goto68
  138. 282 fori=1tox:gosub284:nexti:goto68
  139. 284 print"[147]to delete record number";i;", press"
  140. 286 print"shift[146] d[146], press space bar[146] to advance"
  141. 288 forn=1tof:printf$(n);"   ";rec$(k%(i),n):nextn
  142. 290 gosub30:ifa$="[196]"then294:rem shifted d
  143. 292 ck=1:return
  144. 294 print"deleting record";i:print"records may now be out of order"
  145. 296 forn=1tof:rec$(k%(i),n)=rec$(x,n):rec$(x,n)="":nextn
  146. 298 forj=1tox:ifk%(j)=xthenk%(j)=k%(x):k%(x)=0:x=x-1:goto292
  147. 300 nextj
  148. 302 rem--sort
  149. 304 print"[147]     sort records in ascending order   "
  150. 306 for n=1tof:print" ";n;"[146] ";f$(n):nextn
  151. 308 input"which field is to be sorted? 0 [157][157][157][157]";sf:ifsf=0then68
  152. 310 ifsf>f thenprint"[145][145][145]":goto308
  153. 312 print" please wait[146]":m=x
  154. 314 m=int(m/2):ifm=0thenck=1:goto68
  155. 316 j=1:k=x-m
  156. 318 i=j
  157. 320 l=i+m
  158. 322 print"sorting       [157][157][157][157][157]";i;"[145]"
  159. 324 if rec$(k%(i),sf)<=rec$(k%(l),sf) then328
  160. 326 t%(n)=k%(i):k%(i)=k%(l):k%(l)=t%(n):i=i-m:ifi>0then320
  161. 328 j=j+1:ifj>kthen314
  162. 330 goto318
  163. 332 rem--quit
  164. 334 print"[147] you have not saved your changes!
  165. 336 [153]" do you really want to quit? ywait or nwait
  166. 338 gosub30:ifa$="y" then344
  167. 340 goto68
  168. 342 ifck<>0then334
  169. 344 print"[147]datafile terminated":end
  170. 346 rem--error check
  171. 348 print" no such record exists":return
  172. 350 ifr>0thenreturn
  173. 352 print"[147] no files in memory":fori=1to1000:nexti:goto68
  174. 354 ifx<1thengosub352:goto68
  175. 356 rem--load print
  176. 358 print"[147]             printer main menu         "
  177. 360 print"  print records using:
  178. 362 [153]"      rwaiteports and lists
  179. 364 print"      m[146]ailing labels
  180. 366 [153]"      uwaitser defined subprogram
  181. 368 print"      e[146]xit to main menu
  182. 370 [153]"       press the appropriate key       "
  183. 372 [141]30:[139]a$[178]"r"[167]384
  184. 374 [139]a$[178]"e"[167]68
  185. 376 [139]a$[178]"u"[167]386
  186. 378 [139]a$[178]"m"[167]382
  187. 380 [137]372
  188. 382 [153]"load   loading mailing label subprogram":[147]"dfmail",8
  189. 384 [153]"load   loading report/listing subprogram":[147]"dfreport",8
  190. 386 [153]"load enter name of subprogram"
  191. 388 [153]"";sb$:[133]"on";sb$:[139]sb$[178]d$[167]358
  192. 389 [159]15,8,15:[159]5,8,5,"0:"[170]sb$[170]",p,r":[141]414:[139] en[178]62 [167] 416
  193. 390 [147]sb$,8
  194. 392 [143]--warning
  195. 394 [153]"load this will destroy the file in memory!
  196. 396 print" save t