Compucolor.org – Virtual Media

Listing of file='FILES.BAS;01' on disk='vmedia/ncc_17-sector.ccvf'

10 REM :@@@ FILES7 - BY HARLAN HOWARD
20 REM :@@@ -  SUNNYVAL E, CA.
70 POKE  33289,80:REM @@@ SET LINE TO  80 CHARACTERS FOR  PRINT ER.
80 CLEAR  640
90 DIM  PO$(30),PH$(30)
92 DIM  PO(30),PH(30)
95 DIM  QO$(30),QH$(30)
97 DIM  QO(30),QH(30)
100 PLOT  12,15,29,6,2
110 :::CC= 5:BB= 32:FF= 12:BF= 1
120 PRINT TAB( 6)"                                                  "
130 PRINT TAB( 6)"        A PROGRAM TO EXPERIMENT WITH FILES        "
140 PRINT TAB( 6)"                                                 "
150 PRINT :PRINT :PRINT "  THIS PROGRAM SIMULATES A TYPICAL APPLICATION REQUIRING "
160 PRINT "RANDOM FILES.  YOU MAY MODIFY IT TO MORE CLOSELY RESEMBLE"
170 PRINT "YOUR APPLICATION. "
180 PRINT :PRINT " IN ANSWERING THE FOLLOWING QUESTIONS YOU WILL BE DIMENSIONING "
190 PRINT " A FILE 'N' INSTRUCTION. THEN WHEN YOU 'CREATE A NEW FILE',"
200 PRINT " YOU MAY ACTUALLY TRY IT, OBSERVE THE ERRORS AND TRY ANOTHER "
210 PRINT " COMBINATION UNTIL IT WORKS. "
215 PRINT "THIS PROGRAM WILL ONLY ACCOMODATE  30 RECORDS OF 18 BYTES EACH "
217 PRINT "--OR 7 RECORDS OF 80 BYTES EACH-- ETC."
220 PRINT :PRINT "START SMALL, THEN WHEN IT WORKS, ADD SOME FOR SAFETY."
230 PRINT :PRINT "IF YOU PRESS 'RETURN'(OR ENTER 0 - ONLY), THE PROMPT WILL"
240 PRINT "DEFAULT TO USEABLE NUMBERS OR THE LAST NUMBERS ENTERED. "
250 PRINT :PRINT "FILE DIMENSIONS WILL NOT CHANGE UNTIL A NEW ONE IS CREATED."
255 PRINT "THE PROGRAM WILL RECYCLE UNTIL DOWN-ARROW (RETURN) IS PRESSED"
260 PRINT :PRINT "IF YOU SHOULD BREAK OUT OF THE PROGRAM TYPE'GOTO 210' "
265 PRINT "INSTEAD OF 'RUN' IN ORDER TO KEEP VARIABLES"
267 REM :@@@CLEAR  VARIABLES WHEN RE- CYCLING:
270 :::FOR  N= 1 TO  X:PO$(N)= "":PH$(N)= "":NEXT :FILE "T",800
275 :::FOR  N= 1 TO  X:QO$(N)= "":QH$(N)= "":NEXT
277 :::R=  0
280 :::PRINT :PRINT :INPUT  "READ FILE (1) OR WRITE NEW DATA (0)?  OR MENU II (3)? ";Q1
285 IF  Q1= 3 THEN  GOSUB  1000
290 IF  Q1> 1 THEN PLOT  28,11:GOTO 270
300 IF  Q1= 1 THEN GOTO 650
310 :::INPUT "CREATE A NEW FILE (1) OR RUN THE SAME ONE AGAIN? (0)";FI
312 IF  FI<  2 GOTO  315
313 PRINT "               INVALID"
314 FOR  T=  1 TO  2000:NEXT :PLOT  28,11,28,11:GOTO  310
315 IF  FI=  0 THEN  GOTO  450
320 PRINT :PRINT :INPUT  "HOW MANY RECORDS ? ";Q
322 IF  Q> 30 THEN  PRINT  "NO MORE THAN 30 PLEASE -":GOTO  332
325 IF  Q< > 1 THEN  GOTO  340
330 PRINT "NO LESS THAN 2 PLEASE -"
332 :::FOR  T=  1 TO  1000
335 NEXT  T:PLOT  28,11,28,11:GOTO 320
340 :::IF  Q< > 0 THEN CC= Q
350 INPUT  "HOW MANY BYTES PER RECORD? ";Q
352 IF  Q < 80 THEN  GOTO  360
353 PRINT "OUT OF RANGE "
354 FOR  T=  1 TO  1000:NEXT :PLOT  28,11,28,11:GOTO  350
360 :::IF  Q< > 0 THEN BB= Q
370 INPUT "BLOCKING FACTOR ? ";Q
380 :::IF  Q< > 0 THEN FF= Q
390 IF  FI =  1 THEN GOTO 410
400 GOTO 450
410 REM
420 PLOT  27,4:PRINT "DEL FILE.RND;01":PLOT  27,27
430 REM
440 PRINT "CREATING A NEW FILE.":FILE "N","FILE",CC,BB,FF
450 :::PLOT  12:INPUT  "TYPE OF DATA - NUMBERS (0) OR STRINGS (1)";Q2
455 IF  Q2 = 1 AND  BB* CC >  540 THEN  R=  BB* CC:GOTO  553
460 :::FOR  N=  1 TO  CC- 1
470 IF  Q2=  1 THEN GOTO 510
480 PRINT  "INPUT NUMERICAL DATA FOR RECORD "N;
490 :::INPUT  ": - 1ST PART OF RECORD ? ";PO(N)
500 :::INPUT  ": - 2ND PART OF RECORD ? ";PH(N):GOTO 540
510 PRINT  "INPUT STRING DATA FOR RECORD "N;
520 :::INPUT  ": - 1ST PART OF RECORD ? ";PO$(N)
530 :::INPUT  ": - 2ND PART OF RECORD ? ";PH$(N)
540 PLOT  12
542 NEXT  N
544 :::FOR  N=  1 TO  CC :R=  R+  (LEN (PO$(N)))+ (LEN (PH$(N))):NEXT  N
550 REM
552 IF   R < 600 GOTO  555
553 PRINT "OS ERROR IN 530"
554 PRINT "YOU ARE USING>";R" BYTES. INCREASE  STRING ALLOCATION (LINE 80 & 552)":GOTO  270
555 IF  Q2= 1 THEN  PRINT :PRINT :PRINT "PUT1;PO$(N)["BB/ 2"],PH$(N)["BB/ 2"]"
557 IF  Q2= 0 THEN  PRINT :PRINT :PRINT "PUT1;PO(N),PH(N)"
560 FILE "R",1,"FILE",BF
570 REM
580 PUT  1;CC,Q2
590 :::FOR  N=  1 TO  CC- 1
600 IF  Q2< >  1 THEN PUT 1;PO(N),PH(N):GOTO 620
610 PUT 1;PO$(N)[BB/ 2],PH$(N)[BB/ 2]
620 NEXT
630 FILE "C",1
640 GOTO 270
650 IF  CC= 1 THEN JJ= 1:IF  JJ=  1 THEN GOTO 670
660 PRINT :PRINT :PRINT "FILE 'N','FILE',"CC","BB","FF"":GOTO 680
670 PRINT "EXISTING FILE PARAMETERS UNKNOWN - CREATE A NEW ONE."
680 IF  Q2= 1 THEN  PRINT :PRINT :PRINT "GET 1;QO$(N)["BB/ 2"],QH$(N)["BB/ 2"]"
683 IF  Q2= 0 THEN  PRINT :PRINT :PRINT "GET1;QO(N),QH(N)"
685 FILE "R",1,"FILE",BF
690 GET  1;X,Q2
700 REM
710 :::FOR  N=  1 TO  X- 1
720 REM
730 IF  Q2< >  1 THEN GET  1;QO(N),QH(N):GOTO 750
740 GET 1;QO$(N)[BB/ 2],QH$(N)[BB/ 2]
750 IF  Q2< >  1 THEN PRINT  N,QO(N),QH(N):GOTO 770
760 PRINT  N,QO$(N),QH$(N)
770 NEXT
780 FILE "C",1
790 GOTO 270
800 PRINT :PRINT :PRINT "FILE 'N','FILE',"CC","BB","FF""
810 PRINT "FILE 'T' ERROR:DISK FILE DIMENSIONS NOT CURRENT":FILE "C",1:GOTO 280
900 END
1000 PLOT  12:PRINT  "          MENU II        "
1010 PRINT :PRINT "ADVANCED STUFF! ARE YOU SURE YOU ARE READY FOR THIS? "
1020 PRINT :PRINT  "(1) - CHANGE NUMBER OF FILE BUFFERS ALLOCATED IN FILE 'R'"
1030 PRINT :PRINT "(2) RESERVED FOR FUTURE GOOD THINGS."
1040 PRINT :PRINT "(3) RESERVED FOR FUTURE GOOD THINGS."
1050 PRINT :PRINT "(4) RESERVED FOR FUTURE GOOD THINGS."
1100 PRINT :INPUT  "CHOOSE ONE:";Q3
1120 ON  Q3 GOTO  1200,1400,1500,1600
1200 PRINT :PRINT  "CURRENTLY: FILE 'R',1,'FILE',"BF""
1210 PRINT :INPUT  "ENTER NUMBER DESIRED, 1 TO 8 ";BF
1215 IF  BF = > 1 AND  BF < 8 THEN  PLOT  12:RETURN
1220 PRINT "OUT OF RANGE "
1230 FOR  T=  1 TO  1000:NEXT :PLOT  28,11,28,11,28,11:GOTO  1210
1400 PLOT  12:PRINT "RESERVED FOR FUTURE GOOD THINGS."
1405 FOR  T=  1 TO  2000:NEXT
1407 PLOT  12
1410 RETURN
1500 PLOT  12:PRINT "RESERVED FOR FUTURE GOOD THINGS."
1505 FOR  T=  1 TO  2000:NEXT
1507 PLOT  12
1510 RETURN
1600 PLOT  12:PRINT "RESERVED FOR FUTURE GOOD THINGS."
1605 FOR  T=  1 TO  2000:NEXT
1607 PLOT  12
1610 RETURN