home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #1 / utv1n1s2.d64 / video phile (.txt) < prev   
Encoding:
Commodore BASIC  |  1988-01-01  |  19.2 KB  |  662 lines
  1. 1 rem video phile v12
  2. 2 rem video tape library database with         indices
  3. 3 rem by michael reich 9/07/86
  4. 4 rem using relative file - use 'create'      program to start rel.file
  5. 5 rem *******************
  6. 10 poke53280,0:poke53281,0:c1$=chr$(5)   :c2$=chr$(152)
  7. 15 uptime=(8*4096)+4
  8. 20 print"[147]"chr$(142)chr$(8)
  9. 25 sp$="                                     ":rem len 37
  10. 30 nf=10:n=100:rem # fields and records-    also see line 20020
  11. 40 dim temp$(nf),kk$(nf),s(nf),l(nf),rc$(4),ia$(n),ib$(n),ic$(n),k$(n)
  12. 50 nr=0: ls$="[171][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][192][192][192][192][192][192][179]"
  13. 52 lp$="*******************"
  14. 55 dim q1$(n),m%(n),s%(20):rem *** used in sort ***
  15. 60 fori=1tonf:readf$(i),s(i),l(i):next
  16. 70 data title,1,20,star,21,20,co-star,41,20
  17. 80 data start,61,4,end,65,4,speed,69,2,time,71,3,year,74,4,type,78,5
  18. 90 data tape #,83,3
  19. 170 gosub 8000: gosub 9800
  20. 175 gosub 200: goto 800
  21. 180 poke781,x:poke782,0:goto195:             rem line select
  22. 185 poke781,21:poke782,0:goto195
  23. 190 poke781,peek(214):poke782,y:             rem tab
  24. 195 poke783,0:sys65520:return
  25. 196 rem *********
  26. 197 rem read index
  27. 198 rem *********
  28. 199 :
  29. 200 gosub470: rem *** init disk ***
  30. 205 nr=0: if mo=4 then print sc$
  31. 210 open 2,8,2,"0:video.index,s,r": i=0
  32. 220 gosub 400: rem *** ck disk error ***
  33. 225 if er=0 then 250
  34. 230 gosub640: rem *** close on no index ***
  35. 235 return
  36. 250 x=17: gosub 180: print"[150]   reading index[157][157][157][157][157][157][157][157][157][157][157][157][157]";
  37. 252 input#2,nr
  38. 255 for i=1 to nr: input#2,ia$(i): next
  39. 260 for i=1 to nr: input#2,ib$(i): next
  40. 270 for i=1 to nr: input#2,ic$(i): next
  41. 340 gosub 460
  42. 350 gosub 370: print"             ": return
  43. 370 in=150
  44. 380 t=ti+in
  45. 385 if ti<t then goto 385
  46. 390 return
  47. 400 :
  48. 402 rem disk utilities
  49. 404 :
  50. 410 er=0:input#15,er,er$
  51. 420 return
  52. 430 close2:ifer>0thenprinter,er$
  53. 440 return
  54. 450 close15:return
  55. 460 gosub430:gosub450:return:               rem close all files
  56. 470 open15,8,15,"i0":return
  57. 500 rem *********
  58. 502 rem write index
  59. 504 rem *********
  60. 510 ifnr<1thenprint"no records in file to save":gosub370:gosub370:goto800
  61. 520 gosub470:rem open command channel
  62. 530 gosub185:print"scratching old index"    :print#15,"s0:video.index"
  63. 560 open2,8,2,"0:video.index,s,w":          gosub400:ifer=0thengoto570
  64. 565 gosub430:gosub450:stop
  65. 570 gosub22300:gosub185:print"writing index":print#2,nr
  66. 580 fori=1tonr:print#2,ia$(i):next:         fori=1tonr:print#2,ib$(i):next
  67. 590 fori=1tonr:print#2,ic$(i):next
  68. 600 gosub460:return
  69. 620 printtab(14)"[145] [150] invalid  [157][157][157][157][157][157][157][157][157][157][157][146]";: gosub 370: return
  70. 630 :
  71. 636 rem *****************
  72. 637 rem close on no index
  73. 638 rem *****************
  74. 639 :
  75. 640 close 2: close 15
  76. 650 em$="no index on disk"
  77. 660 if er<>62 then em$="disk unusable"
  78. 670 x=17: gosub 180
  79. 680 print em$
  80. 690 return
  81. 796 rem *********
  82. 797 rem menu
  83. 798 rem *********
  84. 799 :
  85. 800 x=6: gosub 180
  86. 805 print"[150]>> main  menu [150]<<": print
  87. 810 print "[150]  1[150]- display"
  88. 820 print "[150]  2[150]- edit"
  89. 830 print "[150]  3[150]- add to file"
  90. 840 print "[150]  4[150]- printer"
  91. 845 print "[150]        options"
  92. 850 print "[150]  5[150]- create file": print
  93. 860 print "[150] f8[150]- uptime"
  94. 865 x=21: gosub 180
  95. 870 print "[153]   there are ";nr;"[157][153] records available."
  96. 875 print"                                     "
  97. 880 get k$: if k$="" then 880
  98. 882 if k$=chr$(140) then sys uptime
  99. 884 k=val(k$): if (k<1) or (k>5) then 880
  100. 886 mo=k
  101. 890 on mo gosub 2000,5000,4000,7000,20000
  102. 895 goto800
  103. 935 rem screen displays using                    c-64 graphics chars.
  104. 940 y=21: n$="  rambo  ": r$="[146]": d$="": gosub 8500
  105. 945 for x=1tozz: next
  106. 950 y=23: n$="star wars": r$="": d$="": gosub 8500
  107. 955 for x=1tozz: next
  108. 960 y=25: n$=" top gun ": r$="[146]": d$="": gosub 8500
  109. 970 return
  110. 1000 rem *********
  111. 1002 rem sort indices
  112. 1004 rem *********
  113. 1008 :
  114. 1009 ti$="000000":ifnr<2thenreturn
  115. 1010 rem ia$ array
  116. 1015 ifmo=2thenifp1=0thengoto1100
  117. 1020 forq=1tonr:q1$(q)=ia$(q):next:          so=1:gosub55000
  118. 1030 forq=1tonr:ia$(q)=q1$(q):next
  119. 1100 :
  120. 1110 rem ib$ array
  121. 1115 ifmo=2thenifp2=0thengoto1200
  122. 1120 forq=1tonr:q1$(q)=ib$(q):next:          so=2:gosub55000
  123. 1130 forq=1tonr:ib$(q)=q1$(q):next
  124. 1200 :
  125. 1210 rem ic$ array
  126. 1215 ifmo=2thenifp3=0thengoto1300
  127. 1220 forq=1tonr:q1$(q)=ic$(q):next:          so=1:gosub55000
  128. 1230 forq=1tonr:ic$(q)=q1$(q):next
  129. 1300 return
  130. 1750 :
  131. 1770 gosub1790:printc1$mid$(ti$,4,1);":";right$(ti$,2):return
  132. 1780 gosub1790:printc2$mid$(ti$,4,1);":";right$(ti$,2)c1$:return
  133. 1790 gosub185:print"sorting index...wait   ";:return
  134. 1996 rem *********
  135. 1997 rem display
  136. 1998 rem *********
  137. 1999 :
  138. 2000 if nr<>0 then 2010
  139. 2002 x=21: gosub 180: print"[153]       no records to display! [153]       "
  140. 2004 for x=1to 1750: next
  141. 2006 return
  142. 2010 w=0: print"[147]": gosub 2620: y=11
  143. 2020 print: print "select by: [150]s[146][158]tar": gosub 190: print "[150]m[146][158]ovie title"
  144. 2030 gosub 190: print "[150]t[146][158]ape #": gosub 190: print "[150]r[146][158]ecord #"
  145. 2035 gosub 190: print "[150]q[146][158]uit": print
  146. 2040 x=16:gosub180
  147. 2045 print "[155]          <<- enter choice ->>[146]"
  148. 2050 get s$: if s$="" then 2050
  149. 2054 t$="name                record #"
  150. 2055 if s$="q" then gosub 8000: return
  151. 2060 if s$="s" then print"[147]": gosub 2330: goto 2200
  152. 2070 if s$="m" then print"[147]": gosub 2100: goto 2200
  153. 2080 if s$="t" then print"[147]": gosub 2430: goto 2200
  154. 2082 if s$<>"r" then 2050
  155. 2084 gosub 2700: rem *** get record # ***
  156. 2085 if (s>0) and (s<=nr) then ch=s: goto 2235
  157. 2086 print"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]                ": goto 2050
  158. 2090 x=16: gosub180: print "                [150] invalid  [146]     "
  159. 2095 gosub 370: goto 2040
  160. 2100 t$="title               record #": gosub 2600
  161. 2110 w=1: print"[158]";: for i=1 to nr: print left$(ia$(i),20)" "mid$(ia$(i),21)
  162. 2115 gosub6600:next:poke198,0:return
  163. 2200 printspc(8)"[155]enter rec. # to display"
  164. 2210 print:printspc(12)"[155]or <cr> to exit[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";: k=0: ex=0
  165. 2220 gosub 9500: rem *** get rec # from kbd ***
  166. 2225 if ex=1 then gosub 8000: return
  167. 2230 ch=val(t$)
  168. 2235 gosub 3000
  169. 2240 goto2000
  170. 2330 printsc$:gosub2600
  171. 2340 w=1: print"[158]";: fori=1tonr:printleft$(ib$(i),20)" "mid$(ib$(i),21)
  172. 2345 gosub6600:next:poke198,0:return
  173. 2430 t$="tape #              record #":      printsc$:gosub2600
  174. 2440 w=1: print"[158]";: fori=1tonr:printleft$(ic$(i),l(10));tab(20)mid$(ic$(i),4)
  175. 2450 gosub6600:next:poke198,0:return
  176. 2600 gosub2620:print"[154]"t$
  177. 2610 print"******"tab(20)"*******": print: return
  178. 2620 print "[155]there are "nr"[157][146][155] records in file": print: return
  179. 2700 print "[145][145][145][145][145][145][155]enter record #:";
  180. 2710 gosub 9500: rem *** get kbd input ***
  181. 2720 s=val(t$): return
  182. 3000 rem *********
  183. 3002 rem display record
  184. 3004 rem *********
  185. 3010 printc1$"[147]display record #"ch:         printls$:r1$="":r2$=""
  186. 3020 rc=ch:gosub22000:rc$=r1$+r2$
  187. 3040 x=4: gosub 180
  188. 3042 for z=1 to nf: if z=3 then print
  189. 3045 kk$(z)=mid$(rc$,s(z),l(z)): rem *** temporarily saves fields ***
  190. 3050 print"[153]"f$(z);": [155]";tab(12);kk$(z)
  191. 3060 next: print: if mo<>1 then return
  192. 3070 print: print"[155] press any key to continue "
  193. 3080 poke 198,0: wait 198,1: poke 198,0: return
  194. 3996 rem **********
  195. 3997 rem add record
  196. 3998 rem **********
  197. 3999 :
  198. 4000 print"[147] [159] add record  ": cr=nr+1: rc$="": print
  199. 4020 print "[155] entries for record number"cr":"
  200. 4030 print: print: for i=1 to nf: temp$(i)=""
  201. 4040 if i<>10 then 4046
  202. 4042 print"[155]tape #?  000[157][157][157][150]";
  203. 4044 gosub 9000: if t$="" then temp$(i)="000": goto 4055
  204. 4045 goto 4050
  205. 4046 print"[155]"f$(i)"?"
  206. 4048 print"[145][150]";: gosub 9000: if t$="" then goto 4048
  207. 4050 temp$(i)=left$(t$+sp$,l(i))
  208. 4055 rc$=rc$+temp$(i): next: print
  209. 4060 print"[147]": print"[147] [159] add record  ": print
  210. 4065 gosub 3040: print
  211. 4070 print"            ok?   < y or n >[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  212. 4080 get v$: if (v$<>"n") and (v$<>"y") then 4080
  213. 4090 if v$="n" then rc$="": gosub 8000: return
  214. 4100 print"                    "
  215. 4110 nr=cr:r1$="":r2$=""
  216. 4120 ia$(nr)=temp$(1)+mid$(str$(nr),2):      ib$(nr)=temp$(2)+mid$(str$(nr),2)
  217. 4130 ic$(nr)=temp$(10)+mid$(str$(nr),2)
  218. 4140 fori=1to8:r1$=r1$+temp$(i):next
  219. 4150 fori=9tonf:r2$=r2$+temp$(i):next
  220. 4155 rem write record to rel.file                & update index
  221. 4160 gosub 21000: if er=70 then 4190
  222. 4165 gosub 1000: gosub 500
  223. 4170 print"[145][158]          enter another record?"
  224. 4180 get k$: if (k$<>"y") and (k$<>"n") then 4180
  225. 4185 if k$="y" then 4000
  226. 4190 gosub 8000: return
  227. 4200 print"[145]"sp$:print"[145]";:return
  228. 4996 rem *********
  229. 4997 rem edit
  230. 4998 rem *********
  231. 4999 :
  232. 5000 if nr=0 then gosub 2002: return
  233. 5010 cr$="":cr=0:gosub5900
  234. 5020 print"[158]enter  record [146] number to edit or": print
  235. 5025 print tab(13) "[159]i[146][158]ndex or [159]q[146][158]uit": print
  236. 5030 get cr$: if cr$="" then 5030
  237. 5031 if cr$="i" or cr$="q" then 5040
  238. 5032 printchr$(13)spc(5)"[155]enter record #";cr$;: ct=1: t$=cr$: gosub 9510
  239. 5035 cr=val(t$)
  240. 5040 if cr$="i" then gosub 6000: poke198,0: goto 5000
  241. 5050 if cr$="q" then gosub 8000: return
  242. 5060 if (cr<1) or (cr>nr) then print: gosub 620: print"           [145]": goto 5030
  243. 5096 rem *******************************
  244. 5097 rem display selected record to edit
  245. 5098 rem *******************************
  246. 5099 :
  247. 5100 gosub 5900: rc=cr: gosub 22000: rc$=r1$+r2$
  248. 5110 print: gosub 3040: rem *** line 3050 saves title, star and tape# ***
  249. 5120 rc$="": x=4: gosub 180
  250. 5130 for i=1 to nf: if i=3 then print
  251. 5140 print tab(10)"[150]?";: gosub 9000: rem *** get input (t$) from kbd ***
  252. 5142 if t$="" then temp$(i)=kk$(i): goto 5150
  253. 5145 temp$(i)=left$(t$+sp$,l(i))
  254. 5150 rc$=rc$+temp$(i): next
  255. 5152 print: print"[155]            ok?   < y or n >[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  256. 5155 get k$: if (k$<>"n") and (k$<>"y") then goto 5155
  257. 5160 if k$="n" then 5000
  258. 5162 print"                    "
  259. 5165 r1$="": r2$="": for z=1 to 8
  260. 5170 r1$=r1$+temp$(z): next: for z=9 to nf: r2$=r2$+temp$(z): next
  261. 5176 rem check indices
  262. 5177 :
  263. 5180 p1=0: p2=0: p3=0: p4=0
  264. 5190 if kk$(1)<>temp$(1) then gosub 5400: p1=1
  265. 5200 if kk$(2)<>temp$(2) then gosub 5450: p2=1
  266. 5210 if kk$(nf)<>temp$(nf) then gosub 5500: p3=1
  267. 5220 p4=p1+p2+p3
  268. 5230 gosub 21000: rem *** rewrite record ***
  269. 5240 if er>0 then goto 5300: rem *** bad file ***
  270. 5250 if p4>0 then gosub 1000: gosub 500: rem *** index changed-resave ***
  271. 5300 goto5000
  272. 5400 :
  273. 5402 rem ia$  index changed
  274. 5410 forz=1tonr:ifmid$(ia$(z),21)<>mid$(str$(cr),2)thengoto5430
  275. 5420 ia$(z)=temp$(1)+mid$(str$(cr),2):       z=nr
  276. 5430 next:return
  277. 5440 :
  278. 5450 forz=1tonr:ifmid$(ib$(z),21)<>mid$(str$(cr),2)thengoto5470
  279. 5460 ib$(z)=temp$(2)+mid$(str$(cr),2):       z=nr
  280. 5470 next:return
  281. 5480 :
  282. 5500 forz=1tonr:ifmid$(ic$(z),4)<>mid$(str$(cr),2)thengoto5520
  283. 5510 ic$(z)=temp$(10)+mid$(str$(cr),2):      z=nr
  284. 5520 next:return
  285. 5900 :
  286. 5910 print"[147][159] edit record ";
  287. 5915 if cr then print"#"cr"[157]           <cr> for ok ": goto 5930
  288. 5920 print: print
  289. 5930 return
  290. 6000 rem *********
  291. 6002 rem display index
  292. 6004 rem *********
  293. 6010 pg=0:x$="title":t$="title               record #":gosub6500:gosub2600
  294. 6020 w=1: print"[158]";: for i=1tonr
  295. 6025 print left$(ia$(i),20)" "mid$(ia$(i),21): gosub 6600
  296. 6030 next: pg=0: x$="star": t$="name                record #"
  297. 6035 gosub 6610: gosub 2600
  298. 6040 w=1: print"[158]";: fori=1tonr
  299. 6045 print ib$(i): gosub 6600
  300. 6050 next: pg=0: x$="tape #"
  301. 6055 t$="tape #              record #": gosub 6610: gosub 2600
  302. 6060 w=1: print"[158]";: for i=1tonr
  303. 6065 print left$(ic$(i),3) tab(20) mid$(ic$(i),4): gosub 6600
  304. 6070 next
  305. 6080 gosub 3070: return
  306. 6500 pg=pg+1: print "[147][158] index.....by "x$: printtab(30) "[145]page "pg: return
  307. 6600 ifi/15<>int(i/15)thengoto6630
  308. 6610 ifmo=1thengosub3070:goto6630
  309. 6620 gosub3070:gosub6500
  310. 6630 ifw=1thenprint"[155]";:w=0:goto6650
  311. 6640 ifw=0thenprint"[158]";:w=1
  312. 6650 ifi/15=int(i/15)thengosub2600
  313. 6660 return
  314. 6996 rem ***************
  315. 6997 rem printer options
  316. 6998 rem ***************
  317. 7000 gosub 8600: rem *** clear text areas ***
  318. 7005 x=6: gosub 180
  319. 7010 print" print  options [150]": print
  320. 7015 print"  tape l[150]abel": print
  321. 7020 print"  listing by:"
  322. 7025 print"    movie t[150]itle"
  323. 7030 print"    s[150]tar"
  324. 7040 print"    tape n[150]umber"
  325. 7050 print: print"  m[150]ain menu"
  326. 7060 getp$: if p$="" then 7060
  327. 7080 if p$="m" then gosub 8600: return
  328. 7082 if p$="l" then gosub 7100: goto 7095
  329. 7084 if (p$="t") or (p$="s") or (p$="n") then gosub 7600: goto 7095
  330. 7090 goto7060
  331. 7095 if de<>4 then gosub 8000: return
  332. 7096 gosub 185: print"[155] press any key to continue "
  333. 7097 gosub 3080: print "[147]": gosub 8000: return
  334. 7100 x=21: gosub 180
  335. 7105 print"[153]        enter the tape number       "
  336. 7110 print"    you want to print a label for    "
  337. 7120 for i=1 to 4: fo$(i)="": next
  338. 7130 ex=0: k=1: print"[153]                 ";: gosub 9500
  339. 7135 if ex=1 then gosub 8000: return
  340. 7140 cr$=t$: cr=val(cr$): j=0
  341. 7150 de=4: sc$="": rv$=chr$(14): c1$="": c2$=""
  342. 7160 if de=3 then sc$=chr$(147): rv$=chr$(18): c1$=chr$(5): c2$=chr$(152)
  343. 7200 for i=1 to nr: a=val(left$(ic$(i),3)): b$=mid$(ic$(i),4)
  344. 7220 if a=cr then j=j+1: fo$(j)=b$: a$=left$(ic$(i),3)
  345. 7240 next: if j<>0 then goto 7255
  346. 7245 print: print"[145][145][153]                                     "
  347. 7250 print: print"[145][153]           [150] file not found [153]          ": goto 7520
  348. 7255 x=20: gosub 180
  349. 7256 for x=1to4: print"[153]                                     ": next
  350. 7260 print"[145][145][145][153]      is printer ready? < y/n >      "
  351. 7262 get k$: if (k$<>"y") and (k$<>"n") then 7262
  352. 7264 if k$="n" then return
  353. 7265 ifj>4thenj=4
  354. 7270 open4,de: if (st and 128) then gosub 9700: gosub 8000: return
  355. 7275 if de=4 then print#4,chr$(27);"[194]";chr$(3);
  356. 7300 p=0:fori=1toj:rc=val(fo$(i)):          gosub22000:p=p+1:rc$(p)=r1$+r2$:next
  357. 7304 rem fields 1,4,5,6,7 - title,start,end,speed,time
  358. 7310 fori=1tojstep4:x$=" ":                  print#4,mid$(rc$(1),s(1),l(1));
  359. 7320 ifj>1thenprint#4,x$;mid$(rc$(2),s(1),l(1));
  360. 7330 ifj>2thenprint#4,x$;mid$(rc$(3),s(1),l(1));
  361. 7340 ifj>3thenprint#4,x$;mid$(rc$(4),s(1),l(1));
  362. 7350 print#4
  363. 7410 fork=4to7:x$=left$(sp$,21-l(k))
  364. 7420 print#4,mid$(rc$(1),s(k),l(k));
  365. 7430 ifj>1thenprint#4,x$;mid$(rc$(2),s(k),l(k));
  366. 7440 ifj>2thenprint#4,x$;mid$(rc$(3),s(k),l(k));
  367. 7450 ifj>3thenprint#4,x$;mid$(rc$(4),s(k),l(k));
  368. 7455 ifk>6thenprint#4,rv$;" # :";a$
  369. 7460 print#4:next
  370. 7470 next:gosub185
  371. 7480 print"[153]     another copy of same label      "
  372. 7485 print"              < y/n >[157][157][157][157][157][157][157]";
  373. 7490 get k$: if (k$<>"y") and (k$<>"n") then 7490
  374. 7495 : print"       ": if k$="y" then 7310
  375. 7500 ifde=4thenprint#4,chr$(27);"[194]";chr$(1);
  376. 7510 print#4,chr$(0);:close4
  377. 7520 return
  378. 7596 rem **********************
  379. 7597 rem lists and list devices
  380. 7598 rem **********************
  381. 7599 :
  382. 7600 x=21: gosub 180
  383. 7602 print"[153]                                     "
  384. 7604 print"                                     "
  385. 7605 print"[145][145]s[153]creen or p[153]rinter"
  386. 7606 get k$: if (k$<>"s") and (k$<>"p") then 7606
  387. 7608 de=4: if k$="s" then de=3
  388. 7610 sc$=chr$(12): c1$="": c2$=""
  389. 7615 ifde=3thensc$=chr$(147):c1$="[155]": c2$="[158]"
  390. 7620 open 4,de: if (st and 128) then gosub 9700: return
  391. 7625 print#4,sc$
  392. 7630 pa=0: gosub 7900: fori=1tonr
  393. 7635 get k$: if k$="q" then i=nr: goto7750: rem *** interrupt & abort ***
  394. 7640 if p$="t" then x$=ia$(i): x=21
  395. 7650 if p$="s" then x$=ib$(i): x=21
  396. 7660 if p$="n" then x$=ic$(i): x=4
  397. 7670 x$=mid$(x$,x): x=val(x$): rc=x: gosub 22000: rc$=r1$+r2$
  398. 7672 if er<>0 then i=nr: goto 7740
  399. 7677 print#4,i;: if i<10 then print#4," ";
  400. 7678 if i<100 then print#4," ";
  401. 7679 print#4," ";
  402. 7680 print#4,mid$(rc$,s(1),l(1));" ";
  403. 7690 print#4,mid$(rc$,s(2),l(2));" ";
  404. 7700 fork=4to9
  405. 7710 print#4,mid$(rc$,s(k),l(k));" ";
  406. 7720 next:print#4," ";mid$(rc$,s(10),l(10))
  407. 7725 ln=ln+1
  408. 7730 if ln>58 then for bz=1to3: print#4,chr$(7);: gosub 370: next
  409. 7735 if ln>58 then gosub 3070: print#4,sc$: gosub7900
  410. 7740 next
  411. 7750 if de=4 then print#4,sc$
  412. 7760 close 4: if de=4 then return
  413. 7765 print"[158]      press space bar to continue"
  414. 7770 get k$: if k$<>chr$(32) then 7770
  415. 7780 return
  416. 7900 :
  417. 7901 pa=pa+1:print#4,c1$;"video tape list by: ";c2$;
  418. 7902 ifp$="t"thenprint#4,"movie title";
  419. 7903 ifp$="s"thenprint#4,"star name  ";
  420. 7904 ifp$="n"thenprint#4,"tape number";
  421. 7906 if de=4 then print#4,spc(6);
  422. 7908 print#4,spc(30);c1$;"page:";pa;chr$(13): rem *** page header ***
  423. 7910 print#4,spc(8);"title";
  424. 7915 print#4,spc(15);"star";
  425. 7920 print#4,spc(13);"start end sp time year type tape #"
  426. 7925 ifde=4thenprint#4,spc(4);
  427. 7930 li$=lp$:ifde=3thenli$=ls$: rem *** default is for printer ***
  428. 7940 print#4,li$;li$;:ln=3
  429. 7950 ifde=4thenprint#4,li$;li$
  430. 7960 print#4,c2$:ln=ln+1:return
  431. 7997 :
  432. 7998 rem *** screen display ***
  433. 7999 :
  434. 8000 print"[147][176][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][192][192][192][192][192][174]"
  435. 8110 print"[221][159]  [219] [219] [219] [219] [219]              [159] [219] [219] [219] [219] [219]  [146][221]"
  436. 8120 print"[221][159]  [219][219][219][219][219][219][219][219][219][219] video phile [159][219][219][219][219][219][219][219][219][219][219]  [146][221]"
  437. 8140 print"[221][159]  [219] [219] [219] [219] [219]              [159] [219] [219] [219] [219] [219]  [146][221]"
  438. 8150 print"[171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"
  439. 8200 ss$="[221][150]                  [146][221]"+chr$(158)+"                  [146][221]"
  440. 8220 for x=1to14: printss$: next
  441. 8230 print"[171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"
  442. 8240 ss$="[221][153]                                     [146][221]"
  443. 8250 printss$: printss$: printss$: printss$
  444. 8260 print"[173][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][192][192][192][192][192][189]";
  445. 8280 print"[145][145][145][145]";
  446. 8282 print"[153](c)1986 by michael reich"
  447. 8285 print"[153]published by softdisk publishing,inc."
  448. 8290 gosub 940
  449. 8300 return
  450. 8496 rem ***************
  451. 8497 rem print cassette
  452. 8498 rem ***************
  453. 8499 :
  454. 8500 print""d$
  455. 8505 gosub 190: print"[158][169]           "
  456. 8510 gosub 190: printr$"[155][176][192][192][192][192][192][192][192][192][192][174][146] "
  457. 8515 gosub 190: printr$"[194][213][192][192][201] [213][192][192][201][194][146] "
  458. 8520 gosub 190: printr$"[221][221]()[221] [221]()[221][221][146] "
  459. 8530 gosub 190: printr$"[221][202][192][192][203] [202][192][192][203][221][146] "
  460. 8540 gosub 190: printr$"[221]"n$"[221][146] "
  461. 8550 gosub 190: printr$"[173]=========[189][158][169]"
  462. 8560 return
  463. 8596 rem ***************
  464. 8597 rem clear text area
  465. 8598 rem ***************
  466. 8599 :
  467. 8600 x=6: gosub 180
  468. 8610 for x=1 to 13
  469. 8620 print"[150]                  "
  470. 8630 next
  471. 8640 return
  472. 8996 rem ************
  473. 8997 rem get keypress
  474. 8998 rem ************
  475. 8999 :
  476. 9000 t$="": ct=0
  477. 9010 get k$: if k$="" then 9010
  478. 9015 k=asc(k$)
  479. 9020 if k=44 then 9010: rem *** comma ***
  480. 9025 if k=13 then 9200: rem *** <cr> ***
  481. 9030 if k<>20 then 9100: rem *** other than delete ***
  482. 9040 if ct=0 then 9010
  483. 9050 print"[157] [157]";: ct=ct-1: t$=left$(t$,ct)
  484. 9060 goto 9010
  485. 9100 if ct=20 then 9010
  486. 9110 if ((k>31) and (k<96)) or ((k>192) and (k<219)) then 9130
  487. 9120 goto 9010
  488. 9130 printk$;: ct=ct+1: t$=t$+k$: goto 9010
  489. 9200 print: return
  490. 9496 rem ********************
  491. 9497 rem input rec # from kbd
  492. 9498 rem ********************
  493. 9499 :
  494. 9500 ct=0: t$=""
  495. 9510 get k$: if k$="" then 9510
  496. 9520 if k$=chr$(13) then 9600
  497. 9530 if k$<>chr$(20) then 9560
  498. 9540 if ct=0 then 9510
  499. 9550 print"[157] [157]";: ct=ct-1: t$=left$(t$,ct): goto 9510
  500. 9560 if (ct=3) then 9510
  501. 9570 if (k$<chr$(48)) or (k$>chr$(57)) then 9510
  502. 9580 if k=0 then k=1: print"               [157][157][157][157][157][157][157][157][157][157]";
  503. 9590 printk$;: ct=ct+1: t$=t$+k$: goto 9510
  504. 9600 if ct=0 then ex=1: return
  505. 9610 if (val(t$)<=nr) and (val(t$)<>0) then return
  506. 9620 printleft$("[157][157][157]",ct)+left$("   ",ct)+left$("[157][157][157]",ct);: goto 9500
  507. 9700 x=20: gosub 180
  508. 9710 for x=1to4: print"[153]                                     ": next
  509. 9720 print"[145][145][145][153]         [150] printer not ready  [153]        "
  510. 9730 print"     press space bar to continue     "
  511. 9740 get k$: if k$<>chr$(32) then 9740
  512. 9750 return
  513. 9800 x=6: gosub 180
  514. 9805 print"[150]    video tape"
  515. 9810 print"    cataloging"
  516. 9815 print"      system"
  517. 9820 print"[150] 1[150]- run it"
  518. 9825 print"[150] 2[150]- read about it"
  519. 9830 get k$: if (k$<>"1") and (k$<>"2") then 9830
  520. 9835 if k$="2" then gosub 10000: gosub 8000: goto 9850
  521. 9840 x=6: gosub 180
  522. 9845 for x=1to11: print"[150]                  ": next
  523. 9850 return
  524. 10000 print"[147]"
  525. 10010 printspc(14)"[155]video phile"
  526. 10020 printspc(11)"by  michael reich"
  527. 10025 print"    video phile is a database library"
  528. 10026 print"used to keep track of a video tape col- lection, using relative ";
  529. 10027 print"files and a se- quential file index. it will provide"
  530. 10028 print"printed labels for the video tapes as   well as a listing of your ";
  531. 10029 print"collection    sorted several ways to provide easy     location of";
  532. 10030 print" your tapes."
  533. 10035 gosub 11000
  534. 10040 print"[147]    each video phile record contains"
  535. 10041 print"10 fields of information:"
  536. 10042 print"     1) movie title
  537. 10043 [153]"     2) star name
  538. 10044 print"     3) co-star name
  539. 10045 [153]"     4) vcr counter- start
  540. 10046 print"     5) vcr counter- stop
  541. 10047 [153]"     6) vcr running speed
  542. 10048 print"     7) running time- mins
  543. 10049 [153]"     8) year (ex. 1987)
  544. 10050 print"     9) type (color or b&w)
  545. 10051 [153]"    10) tape number
  546. 10052 print"    the title, star, and tape number"
  547. 10053 print"are the fields which make up the in-"
  548. 10054 print"dices."
  549. 10055 gosub 11000
  550. 10060 print"[147]    the first thing that needs to be"
  551. 10061 print"done is to create the relative file"
  552. 10062 print"with the create option in the menu."
  553. 10063 print"of course, that's provided it hasn't"
  554. 10064 print"been done already"
  555. 10065 print"    while 'create' is only used once"
  556. 10066 print"to create the relative file, an index"
  557. 10067 print"file is constantly being modified and"
  558. 10068 print"read to keep track of the data in the"
  559. 10069 print"main video file. this file is read"
  560. 10070 print"when the program is first run and se-"
  561. 10071 print"veral times thereafter."
  562. 10075 gosub 11000
  563. 10080 print"[147]    this index file, a seq file, "
  564. 10081 print"contains sorted lists of the titles,"
  565. 10082 print"stars, and tape numbers, of the tapes"
  566. 10083 print"you've entered into the database."
  567. 10084 print"these lists are sorted on the first"
  568. 10085 print"character of each field as they were"
  569. 10086 print"entered, except the tape number index,"
  570. 10087 print"which is sorted numerically."
  571. 10088 print"    this file is updated on every mod-"
  572. 10089 print"ification to the main video file."
  573. 10090 gosub 11000
  574. 10100 print"[147]    video phile is a menu driven"
  575. 10110 print"program with prompts, so there is no"
  576. 10120 print"guess work involved. simly follow the"
  577. 10130 print"prompts as they are given and before"
  578. 10140 print"long, your entire video library will"
  579. 10150 print"be nicely and neatly cataloged."
  580. 10160 print"             have fun!"
  581. 10170 gosub 11000
  582. 10180 return
  583. 11000 x=23: gosub 180
  584. 11010 print"       press <cr> to continue"
  585. 11020 getk$: if k$<>chr$(13) then 11020
  586. 11030 return
  587. 19996 rem **********************
  588. 19997 rem create a relative file
  589. 19998 rem **********************
  590. 19999 :
  591. 20000 x=21: gosub 180
  592. 20010 print"[153]                                     "
  593. 20020 print"[145]  standbye...creating relative file"
  594. 20030 a2=n: rem *** # of records +1 ***
  595. 20040 a1=88: rem *** record length +2 ***
  596. 20050 hb=int(a2/256): lb=a2-(hb*256)
  597. 20060 close15: open15,8,15,"i0"
  598. 20062 print#15,"s0:video phile data"
  599. 20065 print#15,"s0:video.index ": nr=0
  600. 20070 open1,8,2,"video phile data,l,"+chr$(a1)
  601. 20080 print#15,"p"+chr$(2+96)+chr$(lb)+chr$(hb)+chr$(1)
  602. 20090 print#1,"end"
  603. 20100 input#15,er,er$,et,es
  604. 20110 close 1: close 15: if er=50 then goto 20160
  605. 20120 x=21: gosub 180
  606. 20130 print"[153]                                     "
  607. 20135 sp=int((40-len(er$))/2)
  608. 20140 print"[145]"spc(sp-1)""er$
  609. 20150 for x=1to 1750: next
  610. 20160 gosub 8000: return
  611. 21000 rem *********
  612. 21002 rem write record to rel.file
  613. 21004 rem *********
  614. 21010 close15:close1:gosub470
  615. 21020 open1,8,2,"video phile data,l"
  616. 21030 hb=int(cr/256):lb=cr-(hb*256)
  617. 21040 print#15,"p"+chr$(2+96)+chr$(lb)+chr$(hb)+chr$(1)
  618. 21050 print#1,r1$;chr$(13);r2$:close1:gosub410:close15:ifer=0thengoto21080
  619. 21060 gosub22200:gosub180:print"[152]press return ";
  620. 21070 input"to attempt save [214][157][157][157]";key$:gosub22300:goto21000
  621. 21080 ifer=0thengosub185:print"record "cr" written":in=75:gosub380
  622. 21090 return
  623. 22000 rem *********
  624. 22002 rem read record from rel.file
  625. 22004 rem *********
  626. 22010 gosub470:r1$="":r2$=""
  627. 22020 open1,8,2,"video phile data"
  628. 22030 hb=int(rc/256):lb=rc-(hb*256)
  629. 22040 print#15,"p"+chr$(2+96)+chr$(lb)+chr$(hb)+chr$(1)
  630. 22050 input#1,r1$,r2$:close1:gosub410:        close15:ifer=0thenreturn
  631. 22070 gosub22200:x=2:gosub180: return
  632. 22100 :
  633. 22150 q=abs(1-q):gosub185
  634. 22155 ifq=0thenprint"";
  635. 22160 ifq=1thenprint"[146]";: if de=4 then print"[153]";
  636. 22170 print" data file missing - check disk!!! "
  637. 22180 in=25:gosub380:return
  638. 22200 :
  639. 22210 ifer=70thenforg=1to15:x=22:             gosub22150:next:gosub22300
  640. 22220 ifer<>70thenprint"disk status:"er$
  641. 22230 return
  642. 22300 gosub 185: if de=4 then print"[153]";
  643. 22400 print sp$: return
  644. 55000 rem *********
  645. 55002 rem quick sort routine
  646. 55004 rem *********
  647. 55020 fort=1tonr:m%(t)=2*t:next:               rem array to sort is in q1$
  648. 55040 s%(1)=1:s%(2)=nr:p=2
  649. 55060 l=s%(p):p=p-1:f=s%(p):p=p-1:i=f
  650. 55080 j=l:d$=q1$((f+l)/2)
  651. 55100 gosub55300:ifq1$(i)<d$theni=i+1:        goto55100
  652. 55120 gosub55300:ifq1$(j)>d$thenj=j-1:        goto55120
  653. 55140 ifi<=jthenq2$=q1$(i):q1$(i)=q1$(j)      :q1$(j)=q2$:i=i+1:j=j-1
  654. 55160 gosub55300:ifi<=jthengoto55100
  655. 55180 iff<jthenp=p+1:s%(p)=f:p=p+1:            s%(p)=j
  656. 55200 f=i:iff<lthengoto55080
  657. 55220 ifp<>0thengoto55060
  658. 55230 return
  659. 55240 :
  660. 55300 onsogosub1770,1780:rem show time
  661. 55310 return
  662.