Compucolor.org – Virtual Media

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

100 REM  ** CRSEG - MAY 27,79 **
110 CLEAR  200:ADR= 256* PEEK (32941)+ PEEK (32940)
120 DD= PEEK (ADR+ 1):TT= PEEK (ADR+ 2):TF= PEEK (ADR+ 3):LL= PEEK (ADR+ 8)
130 IF TT= 99THEN SAVE "1:CRSEG":LOAD "DBS16":RUN
140 PLOT 6,0,12,14,6,37,3,13,0
150 PRINT " C R E A T E    R A N D O M    F I L E "
160 PLOT 6,6,15,3,0,4
170 IF DD= 2THEN GOSUB 890:INPUT "INSERT DATA DISK - HIT RETURN";I$
180 GOSUB 890:INPUT "ENTER NAME OF RANDOM FILE: ";F$:REM 
190 IF  F$= "EXIT" THEN 860
200 P$= F$:IF  DD= 3 THEN F$= "1:"+ F$
210 FILE "T",250:FILE "R",1,F$+ ".RND",1:FILE "C",1
220 PRINT TAB( 10);"A RANDOM FILE NAMED ";P$;" ALREADY EXIST."
230 PRINT TAB( 10):INPUT "DO YOU WISH TO CREATE A NEW ONE? ";I$:REM 
240 IF  LEFT$ (I$,1)< > "Y" THEN 860
250 GOSUB 890:INPUT "ENTER NAME OF DESCRIPTOR FILE: ";F1$:REM 
260 IF  F1$= "EXIT" THEN 860
270 IF DD= 3THEN F1$= "CD1:"+ F1$
280 FILE "T",290:FILE "R",1,F1$+ ".DDL",1:GOTO 300
290 PRINT TAB( 10);"CANNOT LOCATE DESCRIPTOR FILE":GOTO 250
300 FILE "A",1,CR,N,BS,BF
310 REM

    ** CREATE INF FILE **

320 FILE "N",F$+ ".INF",N+ 1,24,5
330 FILE "R",2,F$+ ".INF",2
340 GOSUB 890:INPUT "ENTER TODAYS DATE (M,D,Y):  ";M,D,Y
350 Y= Y- (INT (Y/ 100)* 100)
360 MDY= M* 3200+ D* 100+ Y
370 PUT 2,1;0,1,1,MDY,0,0
380 RC= 0
390 FOR I= 1TO N
400 GET 1,I;F1$[16],L,R
410 IF I= 1THEN KL= ABS (L)
420 PUT 2,I+ 1;F1$[16],L,R
430 RC= RC+ ABS (L)* R
440 NEXT I
450 REM

    ** FIND NO. OF KEYS **

460 IF RC< 4THEN RC= 4
470 KN= 5
480 RL= (KL+ 8)* KN+ 8
490 RD= INT ((RL+ 127)/ 128)* 128
500 KN= INT ((RD- 8)/ (KL+ 8))
510 IF TT= 1THEN PRINT "NUMBER OF KEYS=";KN
520 REM

    ** FIND BLOCKING FACTOR **

530 I= 1
540 RL= RC* I
550 RD= INT ((RL+ 127)/ 128)* 128
560 IF ((RD- RL)/ I)> (.1* RC)THEN I= I+ 1:GOTO 540
570 IF TT< > 1THEN 620
580 PRINT "AUTOMATIC BLOCKING IS";I;" RECORDS PER BLOCK"
590 INPUT "DO YOU WISH TO OVERIDE? ";A$
600 IF LEFT$ (A$,1)= "Y"THEN INPUT "RECORDS PER BLOCK ";I
610 REM

    ** FIND NUMBER OF RECORDS **

620 GOSUB 890:INPUT "ENTER NUMBER OF EXPECTED RECORDS: ";NR
630 GOSUB 890:PRINT "THIS WILL TAKE AWHILE..."
640 IF NR/ I< > INT (NR/ I)THEN NR= INT ((NR+ I)/ I)* I
650 PUT 2,1,17;NR,0
660 I1= I:IF TT= 0THEN 700
670 PRINT "INDEX",INT (NR/ (INT (KN/ 2)))+ 2,(KL+ 8)* KN+ 8,1
680 PRINT "RANDOM",NR,RC,I
690 REM

    ** CREATE INX FILE **

700 FILE "N",F$+ ".INX",INT (NR/ (INT (KN/ 2)))+ 2,(KL+ 8)* KN+ 8,1
710 FILE "N",F$+ ".RND",NR,RC,I1
720 FILE "R",3,F$+ ".INX",3
730 FOR I= 1TO INT (NR/ (INT (KN/ 2)))+ 2
740 PUT 3,I;0,I+ 1
750 NEXT I
760 REM

    ** CREATE RND FILE **

770 FILE "R",4,F$+ ".RND",RD/ 128
780 FOR I= 1TO NR
790 PUT 4,I;CHR$ ((I+ 1)/ 255)[1],CHR$ ((I+ 1)AND 255)[1]
800 PUT 4,I,3;CHR$ (0)[1],CHR$ (0)[1]
810 NEXT I
820 GOSUB 890:PRINT "A RANDOM FILE NAMED ";P$;" HAS BEEN CREATED"
830 PRINT TAB( 10);"WITH ";NR;" RECORDS."
840 REM

    ** CLOSE FILES - RETURN TO DBS16 **

850 FILE "C",1,2,3,4
860 GOSUB 890
870 IF DD= 2THEN GOSUB 890:INPUT "INSERT PROGRAM DISK - HIT RETURN ";I$
880 LOAD "MAIN":RUN
890 PRINT :PRINT TAB( 10);:RETURN