home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / database / vcr.arc / VCR.BAS next >
BASIC Source File  |  1985-06-15  |  25KB  |  489 lines
  1. 1000 ' VIDEOCASSETTE CATALOGUE PROGRAM       by     Tom Gilday
  2. 1010 KEY OFF
  3. 1020 REM *******************************************************************
  4. 1030 REM                            SET-UP SECTION
  5. 1040 REM                      *************************
  6. 1050 REM
  7. 1060 MEMOR$="FREE"
  8. 1070 COU=0                                   ' RESET COUNTER TO 0
  9. 1080 COUMAX=0                                ' RESET MAX TO 0 BEFORE INPUT
  10. 1090 MMODE=0                                 ' RESET EDITING MODE TO OFF
  11. 1100 ANS$=""                                 ' RESET INPUT VARIABLE TO NULL
  12. 1110 AGAIN=2                                 ' SET VARIABLES TO UNIQUE
  13. 1120 FIRSTTIME=-1                            '    VALUES SO WHEN WE SET
  14. 1130 EDI=1                                   '    SOMETHING LIKE MMODE
  15. 1140 DELE=4                                  '    EQUAL TO THEM THE ANSWER
  16. 1150 ADDD=5                                  '    WILL BE UNIQUE
  17. 1160 ONN=1:OFFF=0                            '                    
  18. 1170 ENDD=99                                 '
  19. 1180 HARDCOPY=OFFF:HARDPRINT=0               ' HARDCOPY SET TO OFF
  20. 1190 RESETT=OFFF                             ' 
  21. 1191 KEY 1,  CHR$(29)                        ' FLAG START OF SEARCH
  22. 1192 KEY 2,  CHR$(17)                        ' FLAG HARDCOPY
  23. 1195 KEY 3,  CHR$(16)                        ' FLAG ADD RECORD
  24. 1200 KEY 4,  CHR$(25)                        ' FLAG DELETE RECORD
  25. 1210 KEY 5,  CHR$(23)                        ' FLAG SELECTION CRITERIA
  26. 1220 KEY 6,  CHR$(15)                        ' FLAG EDITING 
  27. 1230 KEY 7,  CHR$(14)                        ' FLAG END OF SESSION
  28. 1235 KEY 10, CHR$(28)                        ' FLAG END OF SEARCH
  29. 1240 REM
  30. 1250 REM  THE DIMENSION IS THE MAXIMUM THAT YOU EXPECT TO FIND IN THE FILE.
  31. 1260                              MIX = 1000
  32. 1270 REM
  33. 1280 DIM A$(MIX),B$(MIX),C$(MIX),D$(MIX),E$(MIX)
  34. 1281 DUMM1$="        "
  35. 1282 DUMM2$="                      "
  36. 1283 DUMM3$="      "
  37. 1284 DUMM4$="                       "
  38. 1285 DUMM5$="                       "
  39. 1290 REM ********************************************************************
  40. 2000 REM                       SIGN-ON SCREEN
  41. 2010 REM                      ****************
  42. 2020 CLS:COLOR 14,0:LOCATE 7,25:PRINT"Data Update and Editing Module"
  43. 2030 LOCATE 10,10
  44. 2040 PRINT TAB(17);"This program will allow you to enter and update"
  45. 2050 PRINT TAB(15);"information to a file recording your videocassettes"
  46. 2060 PRINT:PRINT TAB(13);
  47. 2070 PRINT "please be patient while data is being loaded from the file"
  48. 2080 PRINT
  49. 2090 PRINT TAB(11);"this will take some time as the entire data file is being"
  50. 2100 PRINT TAB(19);"loaded to make the program faster to run"
  51. 2101 PRINT 
  52. 2105 PRINT TAB(15);"This process will go faster if you use a ramdisk"
  53. 2106 PRINT
  54. 2107 PRINT TAB(15);"What disk drive is the file 'VCR.FIL' on ?";:INPUT DRIV$
  55. 2108 IF LEN(DRIV$)>1 THEN DIRECT$=DRIV$:DRIV$=MID$(DIRECT$,1,1)
  56. 2109 IF ASC(DRIV$)<64 OR ASC(DRIV$)>100 THEN PRINT "try again";:LOCATE 20,1
  57. 2110 IF ASC(DRIV$)>68 AND ASC(DRIV$)<97 THEN PRINT "try again";:LOCATE 20,1
  58. 2112 IF LEN(DIRECT$)>2 THEN DRIV$=DIRECT$+"\" ELSE DRIV$=DRIV$+":"
  59. 2120 FILNAME$=DRIV$+"vcr.fil" : COLOR 4,0
  60. 2128 REM ********************************************************************
  61. 2130 REM
  62. 3000 REM ********************************************************************
  63. 3010 REM                   READ IN OPENING INFORMATION
  64. 3020 REM                  *****************************
  65. 3030 MMODE=FIRSTTIME
  66. 3035 LOCATE 25,55:PRINT "Reading record # ";
  67. 3040 OPEN FILNAME$ FOR INPUT AS #1
  68. 3050 COU=COU+1
  69. 3060 INPUT #1, A$(COU),B$(COU),C$(COU),D$(COU),E$(COU)
  70. 3075 LOCATE 25,74:PRINT COU;
  71. 3080 IF EOF(1) THEN CLOSE #1:COUMAX=COU:GOTO 3500
  72. 3090 GOTO 3050
  73. 3100 REM
  74. 3500 REM  ******************************************************************
  75. 3510 REM                       MAIN ROUTINE
  76. 3520 REM                     *****************
  77. 3530 REM **************************************************************
  78. 3540 REM                      SELECT OPTION
  79. 3550 REM                      **************
  80. 3560 CLS: COLOR 0,2
  81. 3570 LOCATE  3,20:PRINT"       PLEASE CHOOSE ONE OF THESE OPTIONS          "    
  82. 3575 LOCATE  4,20:PRINT"                                                   "
  83. 3580 LOCATE  5,20:PRINT"      AND HIT THE APPROPRIATE FUNCTION KEY         "
  84. 3590 LOCATE  7,20:PRINT"    F1       Start a search                        "
  85. 3595 LOCATE  8,20:PRINT"                                                   "
  86. 3600 LOCATE  9,20:PRINT"    F2       Send the output to the printer        "
  87. 3605 LOCATE 10,20:PRINT"                                                   "
  88. 3610 LOCATE 11,20:PRINT"    F3       Add a new record to the file          "
  89. 3620 LOCATE 12,20:PRINT"    F4       Delete a record from the file         "
  90. 3625 LOCATE 13,20:PRINT"                                                   "
  91. 3630 LOCATE 14,20:PRINT"    F5       Specify the selection criteria to use "
  92. 3635 LOCATE 15,20:PRINT"                                                   "
  93. 3640 LOCATE 16,20:PRINT"    F6       Edit a record                         "
  94. 3645 LOCATE 17,20:PRINT"                                                   "
  95. 3650 LOCATE 18,20:PRINT"    F7       End this session                      "
  96. 3660 LATES$=""
  97. 3665 IF MEMOR$="OUTT" THEN COLOR 7,0    :GOSUB 22000: END
  98. 3670 LATES$=INKEY$:IF LATES$="" THEN 3670
  99. 3675 COLOR 7,0
  100. 3680 IF LATES$=CHR$(29) THEN MMODE=AGAIN:GOSUB 4000 : GOTO 3500
  101. 3690 IF LATES$=CHR$(16) THEN MMODE=ADDD :GOSUB 20000: GOTO 3500
  102. 3700 IF LATES$=CHR$(25) THEN MMODE=DELE :COU=1:GOSUB 18000:GOSUB 19000:GOTO 3500
  103. 3710 IF LATES$=CHR$(23) THEN RESETT=OFFF:GOSUB 4000 : GOTO 3500
  104. 3720 IF LATES$=CHR$(15) THEN MMODE=EDI  :GOSUB 5400 : GOTO 3500  
  105. 3730 IF LATES$=CHR$(17) THEN HARDCOPY=ONN : GOTO 3500
  106. 3740 IF LATES$=CHR$(14) THEN GOSUB 22000: END
  107. 3750 GOTO 3500
  108. 3780 REM **************************************************************
  109. 4000 REM **************************************************************
  110. 4010 REM                         MAIN SUBROUTINE                  
  111. 4020 REM                         ***************
  112. 4030 REM                
  113. 4040 COU=0                                        '  SET COUNTER TO START AT 1
  114. 4050 ATT=1                                        '  DEFAULT ATTRIBUTE TO VOL.
  115. 4060 CLS
  116. 4080 GOSUB 11000                                  '  SET UP SELECTION SCREEN
  117. 4100 GOSUB 14000                                  '  SPECIFY SELECTION CRITERIA
  118. 4105 REVIEW$=INKEY$
  119. 4106 REVIEW$=""
  120. 4110 IF REVIEW$=CHR$(28) THEN RETURN
  121. 4115 COLOR 7,0
  122. 4120 IF RESETT=ONN THEN RESETT=OFFF:CLS:GOTO 4080 '  RESET CATEGORY
  123. 4140 LOCATE 1,1:CLS                               '  POSITION COLUMNS ON SCREEN
  124. 4150 GOSUB 7000                                   '  SET UP COLUMN HEADINGS
  125. 4160 IF HARDCOPY=ONN THEN HARDPRINT=0             '  HARDCOPY COLUMN HEADINGS
  126. 4170 REM *******************************************************************
  127. 5000 REM                            MAIN LOOP COUNTER
  128. 5010 REM                            *****************
  129. 5013 REVIEW$=""
  130. 5014 COLOR 2,5
  131. 5015 LOCATE 25,1:PRINT  " HIT F10 TO STOP NOW ";
  132. 5016 LOCATE 25,25:PRINT " VOL. ";
  133. 5017 LOCATE 25,42:PRINT " RECORD ";
  134. 5018 LOCATE 25,57:PRINT " FREE MEMORY ";
  135. 5019 LOCATE 4,1
  136. 5020 FOR COU=1 TO COUMAX
  137. 5025 REVIEW$=INKEY$
  138. 5026 IF REVIEW$=CHR$(28) THEN COU=COUMAX
  139. 5030 REM 
  140. 5040 REM                         UPDATE VOLUME COUNTER                     
  141. 5050 REM                         *********************
  142. 5060 A=CSRLIN:B=POS(0)
  143. 5070 COLOR 2,15                           
  144. 5080 LOCATE 25,31:PRINT " ";:PRINT USING "\      \";A$(COU);
  145. 5100 LOCATE 25,50:PRINT COU;
  146. 5101 LOCATE 25,70:PRINT FRE(0);
  147. 5102 IF FRE(0)<200 THEN 5105 ELSE 5110
  148. 5105 LOCATE 25,60:PRINT "OUT OF MEMORY    ";:MEMOR$="OUTT":COU=COUMAX:GOTO 5290
  149. 5110 LOCATE A,B:COLOR 7,0                         '  RETURN TO CURSOR POSITION
  150. 5120 REM
  151. 5130 REM                    TEST INPUT AGAINST STRING TO MATCH 
  152. 5140 REM                    **********************************
  153. 5150 IF FIR$=CHR$(28) THEN COU=COUMAX             '  IF  FINISHED , END
  154. 5160 REM  
  155. 5161 ON ATT GOTO 5165,5175,5185,5195,5205
  156. 5162 REM                       ************************
  157. 5165 IF A$(COU)=A$(0)                THEN GOSUB 9000   :GOTO 5280
  158. 5166 GOTO 5290         
  159. 5167 REM                       ************************
  160. 5175 IF LEN(B$(0))>LEN(B$(COU)) THEN 5290              
  161. 5176 IF INSTR(B$(COU),B$(0))        THEN GOSUB 9000   :GOTO 5280           
  162. 5177 GOTO 5290                                         
  163. 5178 REM                       ************************
  164. 5185 IF LEN(C$(0))>LEN(C$(COU)) THEN 5290
  165. 5186 IF INSTR(C$(COU),C$(0))        THEN GOSUB 9000   :GOTO 5280           
  166. 5187 GOTO 5290                                         
  167. 5188 REM                       ************************
  168. 5195 IF LEN(D$(0))>LEN(D$(COU)) THEN 5290
  169. 5196 IF INSTR(D$(COU),D$(0))        THEN GOSUB 9000   :GOTO 5280           
  170. 5197 GOTO 5290                                         
  171. 5200 REM                       ************************
  172. 5205 IF LEN(E$(0))>LEN(E$(COU)) THEN 5290
  173. 5206 IF INSTR(E$(COU),E$(0))        THEN GOSUB 9000   :GOTO 5280           
  174. 5207 GOTO 5290                                         
  175. 5210 REM  
  176. 5220 REM                       ******************
  177. 5230 REM                       IF THERE'S A MATCH
  178. 5240 REM                       ******************
  179. 5270 REM                                          '  FOR SEARCH CRITERIA
  180. 5280 IF HARDCOPY=ONN THEN GOSUB 10000             '  PRINT HARDCOPY IF MATCH
  181. 5290 NEXT COU                                     '  LAST ROW  OF LOOP
  182. 5292 REVIEW$=""
  183. 5295 HARDPRINT=0
  184. 5296 PRINT"Press any key to continue ";:INPUT PAUSS$
  185. 5330 IF HARDCOPY=ONN THEN LPRINT CHR$(12)         '  IF HARDCOPY, FORMFEED
  186. 5340 HARDCOPY=OFFF                                '  RESET HARDCOPY TO OFF
  187. 5360 RETURN
  188. 5370 REM ******************************************************************
  189. 5390 REM                          EDITING SUBROUTINE
  190. 5400 REM                          ******************
  191. 5410 COU=0
  192. 5430 GOSUB 18000                                  '  ASK FOR SPECIFIC RECORD
  193. 5440 IF REVIEW$<>"" THEN GOSUB 4040 :GOTO 5430    '  REVIEW RECORDS FIRST
  194. 5450 IF COU=0 THEN 6110                           '   IF NOT, RESTART
  195. 5460 CLS:GOSUB 7000                               '  PRINT COLUMN HEADINGS
  196. 5470 GOSUB 9000                                   '  PRINT CURRENT VALUES
  197. 5471 LOCATE 3,1 
  198. 6040 GOSUB 11000                                  '  SET UP SELECTION SCREEN
  199. 6060 GOSUB 14000                                  '  ALLOW TO CHANGE DESCRIPT
  200. 6100 REM                                          '     FOR ORIGINAL CATEGORY
  201. 6110 RETURN
  202. 6120 REM **************************************************************
  203. 7000 REM **************************************************************     
  204. 7010 REM                     COLUMN HEADING SUBROUTINE
  205. 7020 REM                    ***************************
  206. 7030 COLOR 14,0
  207. 7040 PRINT " FILE                                  TAPE                  "
  208. 7050 PRINT "RECORD  VOL.    ARTIST / SHOW          COUNT  SELECTION / EPISODE "
  209. 7060 PRINT "------ -------- ---------------------- ------ --------------------"
  210. 7070 COLOR 7,0
  211. 7080 RETURN
  212. 7090 REM ***************************************************************
  213. 8000 REM **************************************************************     
  214. 8010 REM                 HARDCOPY COLUMN HEADING SUBROUTINE
  215. 8020 REM                 **********************************
  216. 8030 LPRINT:LPRINT:LPRINT:LPRINT
  217. 8040 LPRINT " FILE                                  TAPE                  "
  218. 8050 LPRINT "RECORD  VOL.    ARTIST / SHOW          COUNT  SELECTION / EPISODE"
  219. 8060 LPRINT "------ -------- ---------------------- ------ --------------------"
  220. 8070 RETURN
  221. 8080 REM ***************************************************************
  222. 9000 REM ***************************************************************
  223. 9010 REM                     PRINT INFORMATION IN RECORD
  224. 9020 REM                     ***************************
  225. 9040    COLOR 6,0
  226. 9050    PRINT USING "\     \";STR$(COU);
  227. 9060    PRINT USING "\       \";A$(COU);
  228. 9070    PRINT USING "\                     \";B$(COU);
  229. 9080    PRINT USING "\     \";C$(COU);
  230. 9090    PRINT USING "\                            \";D$(COU);
  231. 9100    PRINT ,,,,"    ";
  232. 9110    PRINT USING "\                            \";E$(COU)
  233. 9120    COLOR 7,0
  234. 9130 RETURN
  235. 9140 REM ***************************************************************
  236. 10000 REM ***************************************************************
  237. 10010 REM                 HARDCOPY PRINT INFORMATION IN RECORD
  238. 10020 REM                 ************************************
  239. 10030 HARDPRINT=HARDPRINT+1
  240. 10031 IF HARDPRINT=1 THEN GOSUB 8000
  241. 10040 REM
  242. 10050    LPRINT USING "\     \";STR$(COU);
  243. 10060    LPRINT USING "\       \";A$(COU);
  244. 10070    LPRINT USING "\                     \";B$(COU);
  245. 10080    LPRINT USING "\     \";C$(COU);
  246. 10090    LPRINT USING "\                            \";D$(COU);
  247. 10100    LPRINT ,,,,"    ";
  248. 10110    LPRINT USING "\                            \";E$(COU)
  249. 10120 IF HARDPRINT<> 28 THEN  10150
  250. 10130 LPRINT CHR$(12)
  251. 10140 HARDPRINT=0
  252. 10150 RETURN
  253. 10160 REM ***************************************************************
  254. 11000 REM ***************************************************************    
  255. 11010 REM                      REQUEST SELECTION CRITERIA
  256. 11020 REM                     ****************************
  257. 11030 ATT$="0"
  258. 11040 PRINT:PRINT:PRINT:COLOR 0,2
  259. 11050 PRINT "    PLEASE CHOOSE ONE OF THE FOLLOWING ATTRIBUTES:             "
  260. 11060 PRINT
  261. 11070 PRINT "1.  VOLUME                         2.  ARTIST / SHOW           "
  262. 11080 PRINT "3.  TAPE COUNTER                   4.  SELECTION /  EPISODE    "
  263. 11090 PRINT "5.  COMMENTS                                                   "
  264. 11100 PRINT
  265. 11110 PRINT "NOTE: YOUR SELECTION NEED ONLY INCLUDE SEVERAL LETTERS"
  266. 11120 PRINT "          OF THE NAME YOU WANT TO SEARCH FOR          "
  267. 11130 COLOR 7,0
  268. 11140 PRINT:PRINT "PLEASE SELECT AN ATTRIBUTE (1 - 5) TO SEARCH FOR OR CHANGE"
  269. 11150 ATT$=INKEY$                                   '  INPUT CRITERIA
  270. 11160 IF  ATT$=CHR$(13) THEN 11190                  '  USE DEFAULT IF RETURN
  271. 11170 IF  ATT$=""       THEN 11150
  272. 11180 ATT=VAL(ATT$)
  273. 11190 RETURN
  274. 11200 REM  *******************************************************************
  275. 14000 REM *****************************************************************
  276. 14010 REM                    REQUEST SELECTION MATCH CRITERIA
  277. 14020 REM                    ********************************
  278. 14030 LOCATE 17,1
  279. 14040 COLOR 11,0
  280. 14050 FIR$=""                                      '  RESET INKEY
  281. 14060 FIRNAME$=""                                  '  RESET TEXT INPUT     
  282. 14065 REM  *****************************************************************
  283. 14070 PRINT "FOR THE CATEGORY : ";:COLOR 7,0
  284. 14071 ON ATT GOTO 14072,14073,14074,14075,14076
  285. 14072 PRINT "VOLUME";:GOTO 14080
  286. 14073 PRINT "ARTIST / SHOW";:GOTO 14080
  287. 14074 PRINT "TAPE COUNTER";:GOTO 14080
  288. 14075 PRINT "SELECTION / EPISODE";:GOTO 14080
  289. 14076 PRINT "COMMENTS";:GOTO 14080
  290. 14078 REM  ****************************************************************
  291. 14080 COLOR 11,0: PRINT "  FOR RECORD #";COU
  292. 14085 PRINT "THE EXISTING DESCRIPTION IS : ";:COLOR 7,0
  293. 14091 ON ATT GOTO 14092,14093,14094,14095,14096
  294. 14092 PRINT A$(COU):GOTO 14100
  295. 14093 PRINT B$(COU):GOTO 14100
  296. 14094 PRINT C$(COU):GOTO 14100
  297. 14095 PRINT D$(COU):GOTO 14100
  298. 14096 PRINT E$(COU):GOTO 14100
  299. 14098 REM  ****************************************************************
  300. 14100 COLOR 11,0: PRINT "WHAT, IF ANYTHING, WOULD YOU LIKE TO CHANGE IT TO ?"
  301. 14101 PRINT             "  (IF NO CHANGE , JUST HIT RETURN ) :";
  302. 14110 REM  ****************************************************************
  303. 14120 REM                  
  304. 14130 REM                        SETUP BOTTOM OF SCREEN
  305. 14135 REM                        **********************
  306. 14138 COLOR 2,15
  307. 14140 IF HARDCOPY=ONN THEN 14170 
  308. 14150 LOCATE 23,1:PRINT " HIT F2  IF YOU WANT A HARDCOPY OF THE REPORT";
  309. 14160 LOCATE 23,60:PRINT " Hardcopy OFF ";
  310. 14165 LOCATE 24,1:PRINT " HIT F5  IF YOU WANT TO CHANGE THE SELECTION CATEGORY";
  311. 14167 LOCATE 25,1:PRINT " HIT F10 IF YOU WANT TO STOP NOW";
  312. 14180 LOCATE 20,45
  313. 14190 REM                  ************************************
  314. 14200 REM                  INPUT CHARACTERS FOR NEW DESCRIPTION
  315. 14210 REM                  ************************************
  316. 14215 GOSUB 14700
  317. 14220 FIR$="":COLOR 0,2
  318. 14230 FIR$=INKEY$                                 
  319. 14240 IF FIR$=CHR$(13) THEN 14490                   '  IF NONE, USE DEFAULT
  320. 14250 IF FIR$=""       THEN 14230
  321. 14260 IF ASC(FIR$)>96 AND ASC(FIR$)<123 THEN FIR$=CHR$(ASC(FIR$)-32)
  322. 14270 REM               **************************************
  323. 14280 REM               TEST IF CHANGING EDITING/HARDCOPY MODE
  324. 14290 REM               **************************************
  325. 14295 REM                                                                 
  326. 14300 REM              F2  TO TURN ON HARDCOPY     ' SET HARDCOPY ON
  327. 14301 REM              *********************************************
  328. 14310 IF FIR$<>CHR$(17) THEN 14320
  329. 14311 HARDCOPY=ONN : FIR$="" : A=CSRLIN:B=POS(0)
  330. 14314 LOCATE 23,60: PRINT " Hardcopy ON  ";:LOCATE A,B
  331. 14316 GOTO 14230
  332. 14320 REM                             F10   TO END
  333. 14321 REM                             ************
  334. 14330 IF FIR$<>CHR$(28) THEN 14370
  335. 14360 GOTO 14640                                                          
  336. 14370 REM              F5   TO RESELECT CATEGORY   ' RESET SELECTION CRITERIA
  337. 14371 REM              ******************************************************
  338. 14380 IF FIR$<>CHR$(23) THEN 14430                   
  339. 14390 RESETT=ONN                                   ' SET MODE TO RESET 
  340. 14400 FIR$=""                                      ' RESET INKEY
  341. 14410 CLS : GOTO 14640
  342. 14430 REM                  ********************************
  343. 14450 IF FIR$=CHR$(8) THEN 14550                   '  IF EDITING, DON'T ADD
  344. 14460 FIRNAME$=FIRNAME$+FIR$                       '  ADD INPUT TO STRING
  345. 14470 COLOR 4,0 : PRINT FIR$;                      '  PRINT INPUT 
  346. 14490 IF FIRNAME$="" THEN 14640                         
  347. 14500 REM                ***********************************
  348. 14510 REM                EDITING INPUT OF SELECTION CRITERIA
  349. 14520 REM                ***********************************             
  350. 14530 REM
  351. 14540 IF FIR$<>CHR$(8) THEN 14580                  '  IF BACKSPACE, THEN EDIT
  352. 14550 IF FIRNAME$="" THEN  14220                   '  IF FIRST CHARACT,RESTART 
  353. 14560 LOCATE ,POS(0)-1:PRINT "  ";                 '  ERASE CHAR ON SCREEN
  354. 14570 LOCATE ,POS(0)-2                             '  RELOCATE CURSOR
  355. 14580 IF FIR$<>CHR$(13) THEN 14220              
  356. 14600 REM  ******************************************************************
  357. 14610 FIR$=""                                      '  RESET INKEY
  358. 14611 ON ATT GOTO 14612,14613,14614,14615,14616
  359. 14612 A$(COU)=FIRNAME$:GOTO 14630
  360. 14613 B$(COU)=FIRNAME$:GOTO 14630
  361. 14614 C$(COU)=FIRNAME$:GOTO 14630
  362. 14615 D$(COU)=FIRNAME$:GOTO 14630
  363. 14616 E$(COU)=FIRNAME$:GOTO 14630
  364. 14617 REM
  365. 14630 FIRNAME$=""                                  '  RESET INPUT STRING
  366. 14640 IF MMODE<>EDI AND ATT=5 THEN CLS 
  367. 14670 RETURN
  368. 14680 REM  ***************************************************************
  369. 14700 REM  ***************************************************************
  370. 14701 REM                           SET UP INPUT FIELD
  371. 14710 REM                           ******************       
  372. 14721 POSSIT=POS(0)
  373. 14730 ON ATT GOTO 14740,14750,14760,14770,14780
  374. 14740 COLOR 2,7:PRINT "<<";DUMM1$;">>";:LOCATE ,POSSIT+2:GOTO 14800
  375. 14750 COLOR 2,7:PRINT "<<";DUMM2$;">>";:LOCATE ,POSSIT+2:GOTO 14800
  376. 14760 COLOR 2,7:PRINT "<<";DUMM3$;">>";:LOCATE ,POSSIT+2:GOTO 14800
  377. 14770 COLOR 2,7:PRINT "<<";DUMM4$;">>";:LOCATE ,POSSIT+2:GOTO 14800
  378. 14780 COLOR 2,7:PRINT "<<";DUMM5$;">>";:LOCATE ,POSSIT+2
  379. 14800 COLOR 7,0: RETURN
  380. 18000 REM  ***************************************************************
  381. 18010 REM                SELECT THE RECORD TO DELETE OR EDIT
  382. 18020 REM                ***********************************
  383. 18030 REM
  384. 18050 REVIEW$=INKEY$:REVIEW$=""                   '  ERASE STRAY INPUT
  385. 18055 PRINT
  386. 18060 PRINT "WOULD YOU LIKE TO REVIEW THE RECORDS BEFORE SELECTING ONE ?"
  387. 18070 REVIEW$=INKEY$                              '  TEST FOR SPECIFIC INPUT
  388. 18080 IF REVIEW$=CHR$(13) THEN REVIEW$="": GOTO 18210  '  IF NOT THEN SEARCH
  389. 18090 IF REVIEW$="" THEN 18070
  390. 18100 IF REVIEW$="Y" OR REVIEW$="y" THEN MMODE=AGAIN :CLS  :RETURN
  391. 18110 REVIEW$="": COUU$=INKEY$ : COUU$="":COUUN$="" :COUU=0   
  392. 18160 PRINT "WHICH RECORD WOULD YOU LIKE TO USE "
  393. 18170 PRINT "         (IF YOU KNOW WHICH ONE )?  " ;
  394. 18180 INPUT COUUN$: IF COUUN$="" THEN 18200      
  395. 18200 COU=VAL(COUUN$)    
  396. 18210 RETURN
  397. 18220 REM *****************************************************************
  398. 19000 REM *****************************************************************
  399. 19010 REM                             DELETE RECORD
  400. 19020 REM                             *************
  401. 19022 CLS:GOSUB 7000:GOSUB 9000
  402. 19023 PRINT:PRINT "ARE YOU SURE YOU WANT TO DELETE IT ?"
  403. 19024 ANS$=""
  404. 19025 ANS$=INKEY$:IF ANS$="" THEN 19025
  405. 19026 IF ANS$="y" OR ANS$="Y" THEN 19030 ELSE 19110
  406. 19030 LOCATE 25,45:PRINT "MOVING RECORD #";
  407. 19035 FOR N=COU+1 TO COUMAX
  408. 19040 SWAP A$(N),A$(N-1) 
  409. 19050 SWAP B$(N),B$(N-1)
  410. 19060 SWAP C$(N),C$(N-1)
  411. 19070 SWAP D$(N),D$(N-1)
  412. 19080 SWAP E$(N),E$(N-1)
  413. 19090 LOCATE 25,62:PRINT N;:NEXT
  414. 19100 COUMAX=COUMAX-1
  415. 19110 RETURN
  416. 19120 REM  ***************************************************************
  417. 20000 REM                             ADD A RECORD  
  418. 20009 REM                             ************
  419. 20010 REM
  420. 20011 PRINT
  421. 20012 PRINT "DO WANT TO ADD THE RECORD 1) TO THE END OF THE FILE , OR"
  422. 20013 PRINT "                          2) AFTER A SPECIFIC RECORD   ?    ";
  423. 20014 ANS$=""
  424. 20015 ANS$=INKEY$:IF ANS$="" THEN 20015
  425. 20016 IF ANS$<>"1" AND ANS$<>"2" THEN RETURN
  426. 20017 IF ANS$="1" THEN COU=COUMAX+1:PRINT ANS$;:GOTO 20045
  427. 20018 IF ANS$="2" THEN PRINT ANS$;:GOTO 20020                      
  428. 20019 REM   ***********************************************************
  429. 20020 PRINT "WOULD YOU LIKE TO REVIEW THE RECORDS BEFORE SELECTING ONE ?";
  430. 20021 REVIEW$=INKEY$ 
  431. 20022 IF REVIEW$=CHR$(13) THEN 20025  
  432. 20023 IF REVIEW$="" THEN 20021
  433. 20024 IF REVIEW$="Y" OR REVIEW$="y" THEN MMODE=AGAIN :CLS  :RETURN
  434. 20025 REVIEW$="": COUU$=INKEY$ : COUU$="":COUUN$="" :COU=COUMAX:PRINT " NO";  
  435. 20026 PRINT "AT WHICH LOCATION (RECORD #) WOULD YOU LIKE TO ADD A RECORD";
  436. 20028 INPUT COUUN$: IF COUUN$="" THEN RETURN
  437. 20029 COU=VAL(COUUN$)  :LOCATE 25,45:PRINT "MAKING ROOM AT RECORD #";
  438. 20030 FOR N=COUMAX TO COU STEP -1
  439. 20031 SWAP A$(N),A$(N+1)
  440. 20032 SWAP B$(N),B$(N+1)
  441. 20033 SWAP C$(N),C$(N+1)
  442. 20034 SWAP D$(N),D$(N+1)
  443. 20035 SWAP E$(N),E$(N+1)
  444. 20036 LOCATE 25,72:PRINT N;:NEXT N
  445. 20045 REM  *************************************************************
  446. 20046 CLS                  
  447. 20047 COLOR 6,0
  448. 20048 LOCATE 5,20
  449. 20049 PRINT "FOR RECORD #";COU
  450. 20050 LOCATE 12,20:PRINT "VOLUME #.................";
  451. 20052 ATT=1:POSSIT=POS(0): GOSUB 14200
  452. 20060 LOCATE 14,20:PRINT "ARTIST / SHOW ...........";
  453. 20065 ATT=2:POSSIT=POS(0): GOSUB 14200
  454. 20080 LOCATE 16,20:PRINT "TAPE COUNTER ............";
  455. 20085 ATT=3:POSSIT=POS(0): GOSUB 14200
  456. 20100 LOCATE 18,20:PRINT "SELECTION / EPISODE......";
  457. 20105 ATT=4:POSSIT=POS(0): GOSUB 14200
  458. 20120 LOCATE 20,20:PRINT "COMMENTS.................";
  459. 20125 ATT=5:POSSIT=POS(0): GOSUB 14200
  460. 20140 COUMAX=COUMAX+1
  461. 20200 COLOR 7,0:RETURN
  462. 20210 REM  ***************************************************************
  463. 22000 REM  ***************************************************************
  464. 22001 REM                               END PROGRAM
  465. 22002 REM                               ***********
  466. 22003 REM
  467. 22004 ANS$=""
  468. 22005 PRINT:PRINT "DO YOU WANT TO UPDATE THE FILE FIRST FOR ANY CHANGES ?";
  469. 22006 ANS$=INKEY$:IF ANS$="" THEN 22006 
  470. 22007 IF ANS$="y" OR ANS$="Y" THEN 22010 ELSE 22130
  471. 22008 REM 
  472. 22010 REM                       CLOSE FILE WITH CHANGES
  473. 22020 REM                       ***********************
  474. 22030 COLOR 11,0
  475. 22050 LOCATE 25,55:PRINT "Writing record # ";
  476. 22060 DEF SEG
  477. 22080 OPEN FILNAME$ FOR OUTPUT AS #2
  478. 22090 FOR NN=1 TO COUMAX
  479. 22100 WRITE #2,A$(NN),B$(NN),C$(NN),D$(NN),E$(NN)
  480. 22105 LOCATE 25,74:PRINT NN;
  481. 22110 NEXT NN
  482. 22120 CLOSE #2
  483. 22130 COLOR 11,0:RETURN
  484. 22140 REM  **************************************************************
  485. 0 NEXT NN
  486. 22120 CLOSE #2
  487. 22130 COLOR 11,0:RETURN
  488. 22140 REM  *********************************************