home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 1 / rerun-productivity-pak-i.d64 / datafile (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  9KB  |  275 lines
  1. 10 rem datafile 3.3 (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$=d$: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 en=0:em$=d$:et=0:es=0:a1$=d$:a2$=d$:a3$=d$:s1$=d$:fl=0
  8. 23 mem=30000:return
  9. 24 dim f$(f+1),t%(f+1),l%(f+1):return
  10. 26 dim rec$(r+1,f+1),ml$(9,4),pc(10),tt$(5),hc$(9),k%(r+1):return
  11. 28 rem--get
  12. 30 geta$:ifa$=""then30
  13. 32 return
  14. 34 rem--create
  15. 36 ifck<>0thengosub394
  16. 38 print"[147]          initialize datafile          "
  17. 40 clr:gosub16:input"how many fields in each record? 0 [157][157][157][157]";f:iff=0then68
  18. 42 gosub24:fori=1tof
  19. 44 print"field #";i:print"title ? >                           "
  20. 46 print"length? 0                           "
  21. 47 print"";tab(6);:inputf$(i):iff$(i)=""thenf$(i)=">"
  22. 48 printtab(6);:inputl%(i):ifl%(i)=0then68
  23. 49 nexti
  24. 50 rem--compute # records
  25. 52 forj=0tof:rl=rl+l%(j):nextj:rl=rl+3*(f+1)+5:r=int((mem-12*(f+1)-2100)/rl)
  26. 54 print" your selections will allow approx"
  27. 56 printr;"records.  a[146]ccept or r[146]eject?"
  28. 58 gosub30:ifa$="r"then38
  29. 59 ifa$="a"thengosub26:ck=1
  30. 60 fori=1tof:iflen(f$(i))>s1thens1=len(f$(i))
  31. 62 nexti:goto68
  32. 64 rem--menu
  33. 66 print"[147]  datafile 3.3 (c)1983 by mike konshak ":goto70
  34. 68 print"[147]            datafile menu              "
  35. 70 print"     c[146]reate new file  q[146]uit program
  36. 72 [153]"     awaitdd record to current file"
  37. 74 [153]"     mwaitodify record in current file"
  38. 76 [153]"     dwaitelete record in current file"
  39. 78 [153]"     vwaitiew file on screen
  40. 80 print"     s[146]ort records by field
  41. 82 [153]"     pwaitrint records by selection
  42. 84 print"     r[146]ead old file from disk"
  43. 86 print"     w[146]rite new file to disk
  44. 88 [153]"     @wait disk drive commands
  45. 90 print"       press the appropriate key       "
  46. 92 print"  there are";x;"records in memory"
  47. 94 ifr>0thenprint"  space for";r-x;"more records[145]"
  48. 96 gosub30:ifa$="a"thengosub350:iffl=0then124
  49. 98 ifa$="m"thengosub354:iffl=0then244
  50. 100 ifa$="d"thengosub354:iffl=0then272
  51. 102 ifa$="c"then36
  52. 104 ifa$="r"then170
  53. 106 ifa$="p"thengosub354:iffl=0then358
  54. 108 ifa$="v"thengosub354:iffl=0then192
  55. 110 ifa$="w"thengosub350:iffl=0then144
  56. 112 ifa$="s"thengosub354:iffl=0then304
  57. 114 ifa$="q"then342
  58. 116 ifa$="@"then462
  59. 118 iffl<>0thenfl=0:goto68
  60. 120 goto96
  61. 122 rem--add records
  62. 124 fori=x+1tor:print"[147] press the return[146] key after each entry"
  63. 126 print" press return[146] without any entry to stop"
  64. 128 print" record number ";i;""
  65. 130 forn=1tof
  66. 132 printf$(n)spc(s1-len(f$(n)))"   >[157][157][157]";:inputrec$(i,n)
  67. 133 ifrec$(i,n)=""thenrec$(i,n)=">"
  68. 134 iflen(rec$(i,n))>l%(n)thengosub140:goto132
  69. 135 ifrec$(i,n)="="thenrec$(i,n)=rec$(i-1,n)
  70. 136 ifrec$(i,1)=">"then x=i-1:ck=1:goto68
  71. 138 nextn:k%(i)=i:nexti:x=r:ck=1:goto68
  72. 140 print" [150]cannot exceed"+str$(l%(n))+" characters[146][158]":return
  73. 142 rem--save
  74. 144 print"[147]enter name of current file to be saved"
  75. 146 print"(12 characters max).  any existing file"
  76. 148 print"with the same name will be scratched."
  77. 150 print"  ";nf$:input"[145]";nf$:ifnf$=""then68
  78. 152 open15,8,15:print#15,"s0:df] "+left$(nf$,8)+"!old":gosub414:ifet=8then68
  79. 154 print#15,"r0:df] "+left$(nf$,8)+"!old=df] "+nf$:gosub414:ifet=8then68
  80. 156 open5,8,5,"0:df] "+nf$+",s,w":gosub414:ifet=8then68
  81. 158 print#5,r;cr$;f;cr$;x:forn=1tof:print#5,f$(n);cr$;l%(n):nextn
  82. 159 gosub414:ifet=8then68
  83. 160 fori=1tox:print" saving record #";i;"[145][145]"
  84. 162 forn=1tof:print#5,rec$(k%(i),n):nextn:nexti:print:gosub414:ifet=8then68
  85. 164 fori=1tox:print" saving pointers";i;"[145][145]":print#5,i:nexti
  86. 165 print#5,e$:gosub414:ifet=8then68
  87. 166 close5:close15:ck=0:goto68
  88. 168 rem--load
  89. 170 ifck<>0thengosub394
  90. 172 clr:gosub16:print"[147] enter name of file to be loaded":inputnf$
  91. 173 ifnf$=""then68
  92. 174 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub414:ifet=8then68
  93. 175 ifen=62thengosub416:goto68
  94. 176 input#5,r,f,x:gosub414:ifet=8then68
  95. 177 gosub24:gosub26:forn=1tof:input#5,f$(n),l%(n):nextn:gosub414:ifet=8then68
  96. 178 fori=1tox:print" reading record #";i;"[145][145]"
  97. 180 forn=1tof:input#5,rec$(i,n):nextn:nexti:print:gosub414:ifet=8then68
  98. 182 fori=1tox:print" reading pointers";i;"[145][145]":input#5,k%(i):nexti
  99. 184 s=st:ifs<>0then188
  100. 186 input#5,e$:gosub414:ifet=8then68
  101. 188 close5:close15:goto60
  102. 190 rem--view
  103. 192 i=1
  104. 194 ifi=0then68
  105. 196 ifi>xthen68
  106. 198 print"[147] record number:"+str$(i)+"  file:"+nf$+""
  107. 200 forn=1tof:printf$(n)spc(s1-len(f$(n)))" "rec$(k%(i),n):nextn
  108. 202 print" n[146]ext, l[146]ast, j[146]ump, f[146]ind, e[146]xit to menu"
  109. 204 gosub30:ifa$="n"theni=i+1:goto194
  110. 206 ifa$="l"theni=i-1:goto194
  111. 208 ifa$="j"then216
  112. 210 ifa$="f"then218
  113. 212 ifa$="e"then68
  114. 214 goto204
  115. 216 input" jump to record number";i:goto194
  116. 218 print"[147]    find records with common items "
  117. 220 forn=1tof:print" ";n;"[146] ";f$(n):nextn
  118. 222 input" which field is to be searched? 0 [157][157][157][157]";sf:ifsf=0then68
  119. 224 ifsf<1orsf>fthenprint"[145][145][145]":goto222
  120. 226 print" enter common item[146] ":print" (the entire string is not required)"
  121. 228 print"";f$(sf);"[146] ";:inputt$:ift$=d$then68
  122. 230 fori=1tox:print" searching record";i;"[145][145]"
  123. 232 ift$=left$(rec$(k%(i),sf),len(t$))then236
  124. 234 goto240
  125. 236 print"[147] record #";i;""
  126. 237 forn=1tof:printf$(n)spc(s1-len(f$(n)))" "rec$(k%(i),n):nextn
  127. 238 print" n[146]ext record":gosub30
  128. 240 nexti:goto68
  129. 242 rem--modify
  130. 244 print"[147] modify which record? enter #[146] or a[146]ll":inputmr$:ifmr$=d$then68
  131. 246 ifmr$="a"thenmr$=d$:goto254
  132. 248 i=val(mr$):mr$=d$
  133. 250 ifi>xthengosub348:goto244
  134. 252 gosub256:goto68
  135. 254 fori=1tox:gosub256:print" n[146]ext or e[146]xit":gosub30:ifa$="e"then68
  136. 255 nexti:goto68
  137. 256 print"[147] to modify record #";i;", make changes"
  138. 258 print" as each field is displayed, then return[146]"
  139. 260 forn=1tof:printf$(n)":":print"   ";rec$(k%(i),n)
  140. 261 iflen(rec$(k%(i),n))>36thenprint"[145]";
  141. 262 print"[145] ";:inputrec$(k%(i),n)
  142. 264 iflen(rec$(k%(i),n))>l%(n)thengosub140:goto260
  143. 265 ifrec$(k%(i),n)="="thenrec$(k%(i),n)=rec$(k%(i-1),n)
  144. 266 ifrec$(k%(i),n)=""thenrec$(k%(i),n)=">"
  145. 268 nextn:ck=1:return
  146. 270 rem--delete
  147. 272 print"[147] delete which record? enter #[146] or a[146]ll"
  148. 274 inputdr$:ifdr$=d$then68
  149. 276 ifdr$="a"thendr$=d$:goto282
  150. 278 i=val(dr$):dr$=d$:ifi>xthengosub348:goto274
  151. 280 gosub284:goto68
  152. 282 fori=1tox:gosub284:print" n[146]ext or e[146]xit":gosub30:ifa$="e"then68
  153. 283 nexti:goto68
  154. 284 print"[147] to delete record number";i;", press"
  155. 286 print" shift[146] d[146], press space bar[146] to advance"
  156. 288 forn=1tof:printf$(n)spc(s1-len(f$(n)))" "rec$(k%(i),n):nextn
  157. 290 gosub30:ifa$="[196]"then294:rem shifted d
  158. 292 ck=1:return
  159. 294 print"deleting record";i:print"records may now be out of order"
  160. 296 forn=1tof:rec$(k%(i),n)=rec$(x,n):rec$(x,n)="":nextn
  161. 298 forj=1tox:ifk%(j)=xthenk%(j)=k%(x):k%(x)=0:x=x-1:goto292
  162. 300 nextj
  163. 302 rem--sort
  164. 304 print"[147]         sort records in order         "
  165. 306 for n=1tof:print" ";n;"[146] ";f$(n):nextn
  166. 308 input"which field is to be sorted? 0 [157][157][157][157]";sf:ifsf=0then68
  167. 310 ifsf>f thenprint"[145][145][145]":goto308
  168. 311 input"a[146]scending or d[146]escending? a [157][157][157][157]";a$
  169. 312 print" please wait[146]":m=x
  170. 314 m=int(m/2):ifm=0thenck=1:goto68
  171. 316 j=1:k=x-m
  172. 318 i=j
  173. 320 l=i+m
  174. 322 print" sorting       [157][157][157][157][157]";i;"[145]":ifa$<>"a"then325
  175. 323 if rec$(k%(i),sf)<=rec$(k%(l),sf) then328
  176. 324 goto326
  177. 325 if rec$(k%(i),sf)>=rec$(k%(l),sf) then328
  178. 326 t%(n)=k%(i):k%(i)=k%(l):k%(l)=t%(n):i=i-m:ifi>0then320
  179. 328 j=j+1:ifj>kthen314
  180. 330 goto318
  181. 332 rem--quit
  182. 334 print"[147] [150]you have not saved your changes![158]"
  183. 336 print" do you really want to quit? y[146] or n[146]
  184. 338 [141]30:[139]a$[178]"y" [167]344
  185. 340 [137]68
  186. 342 [139]ck[179][177]0[167]334
  187. 344 [153]"loaddatafile terminated":[128]
  188. 346 [143]--error check
  189. 348 [153]" defno such record existssys":[142]
  190. 350 [139]r[177]0[167][142]
  191. 352 [153]" def    no records or files in memory     syswait "
  192. 353 [129]i[178]1[164]500:[130]i:fl[178]1:[142]
  193. 354 [139]x