Compucolor.org – Virtual Media

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

100 REM  ** FORMAT - MAY 27,79 **
110 CLEAR 2000:DIM KY$(100),FRMT(100,3)
120 PLOT 6,0,12,14,6,24,3,3,0,27,11
130 PRINT " C R E A T E    P R I N T E R    F O R M A T    F I L E "
140 PLOT 6,0,15,3,0,3
150 ADR= 256* PEEK (32941)+ PEEK (32940)
160 DD= PEEK (ADR+ 1):TT= PEEK (ADR+ 2):PP= PEEK (ADR+ 4):FG= PEEK (33265)
170 IF TT= 99THEN SAVE "1:FORMAT":LOAD "PARLST":RUN
180 IF DD< > 2OR D2< > 0THEN 200
190 D2= 1:PRINT TAB( 10);:INPUT "INSERT DATA DISK - HIT RETURN ";I$
200 PLOT 3,0,3,11
210 PRINT TAB( 10);:INPUT "ENTER NAME OF FORMAT FILE: ";F$:REM 
220 IF  F$= "EXIT"THEN 1650
230 PRINT "";:P$= F$
240 IF DD= 3THEN F$= "1:"+ F$
250 FILE "T",260:FILE "R",3,F$+ ".FMT",1:GOTO 280
260 FILE "E",F,E,L:IF E< > 14THEN PRINT TAB( 10);"BAD FILE NAME":GOTO 210
270 GOTO 520
280 REM

    ** READ OLD FORMAT FILE **

290 PRINT TAB( 10);"A FORMAT FILE NAMED ";P$;" ALREADY EXIST"
300 PRINT :PRINT TAB( 10);:PRINT "SELECT ONE OF THE FOLLOWING OPTIONS:"
310 PRINT :PRINT TAB( 15);"1. EDIT ";P$;" TO CREATE A NEW FILE"
320 PRINT TAB( 15);"2. CREATE A NEW FILE"
330 PRINT TAB( 15);"3. LIST FILE - RETURN TO MENU"
340 PRINT :PRINT TAB( 20);:INPUT "ENTER SELECTION: ";I
350 IF I< 1OR I> 3THEN 340
360 MU$= "Y":IF I< > 3THEN MU$= "N":GOTO 400
370 IF  PP= 0 THEN 400
380 PRINT  TAB( 10):INPUT "OUTPUT TO THE SCREEN OR A PRINTER? ";I$
390 PP$= "S":IF  LEFT$ (I$,1)= "P" THEN PP$= "P"
400 IF I= 2THEN FILE "C",3:GOTO 120
410 FILE "A",3,DV,NR,DV,DV
420 FOR I= 6TO 30:PLOT 3,0,I,11:NEXT I
430 PLOT 3,0,6:IF  MU$= "Y" THEN 460
440 PRINT TAB( 10):INPUT "ENTER NAME OF NEW FORMAT FILE: ";F$:REM 
450 IF DD= 3THEN F$= "1:"+ F$
460 FOR I= 1TO  NR
470 GET 3,I,5;FRMT(I,0),FRMT(I,1),FRMT(I,2),FRMT(I,3),KY$(I)[16]
480 NEXT I
490 LN= NR+ 1
500 GOTO 930
510 REM

    ** CREATE A NEW FORMAT FILE **

520 REM
530 PRINT
540 CL= 1:LN= 1:LC= 1
550 PRINT :PRINT "LINE ";LC:PRINT
560 PRINT LN;":COLUMN ";CL,:INPUT "";A$
570 REM



580 IF A$= "#"THEN 840
590 IF A$= " 0"OR A$= "0"OR A$= ""THEN 930
600 KY$(LN)= ""
610 IF LEFT$ (A$,2)= > "X0"AND LEFT$ (A$,2)< = "X9"THEN 870
620 REM


630 FOR I= 1TO LEN (A$)
640 IF MID$ (A$,I,1)= " "THEN 670
650 IF MID$ (A$,I,1)= "("THEN 740
660 KY$(LN)= KY$(LN)+ MID$ (A$,I,1):GOTO 790
670 I= I+ 1:IF MID$ (A$,I,1)= " "THEN 790
680 B$= MID$ (A$,I)
690 IF LEFT$ (B$,1)= "A"THEN FRMT(LN,0)= 1
700 IF LEFT$ (B$,1)= "N"THEN FRMT(LN,0)= - 1
710 CH= VAL (RIGHT$ (B$,LEN (B$)- 1))
720 FRMT(LN,1)= INT (CH):FRMT(LN,2)= INT ((CH- INT (CH))* 10+ .5)
730 GOTO 780
740 I= I+ 1
750 IF MID$ (A$,I,1)< > ")"THEN T$= T$+ MID$ (A$,I,1):GOTO 740
760 FRMT(LN,3)= VAL (T$):T$= ""
770 GOTO 790
780 I= LEN (A$):CL= CL+ INT (CH)
790 NEXT I
800 REM



810 LN= LN+ 1:IF MF= 1THEN 1210
820 GOTO 560
830 REM


840 CL= 1
850 LC= LC+ 1:PRINT :PRINT "LINE ";LC:PRINT
860 KY$(LN)= A$:GOTO 810
870 FRMT(LN,0)= 0:FRMT(LN,1)= VAL (MID$ (A$,2))
880 CL= CL+ VAL (MID$ (A$,2))
890 LN= LN+ 1
900 IF MF= 1THEN 1210
910 GOTO 560
920 REM

    ** SHOW HOW FILE WILL PRINT **

930 PLOT  6,0,12,14,6,24,3,3,0
940 PRINT " C R E A T E    P R I N T E R    F O R M A T    F I L E "
950 PLOT  6,0,15,3,0,3
960 IF  PP$= "P" THEN PLOT  27,13:PRINT "FORMAT FILE - ";P$:PRINT
970 PRINT TAB( 10);"";P$;" WILL PRINT LIKE THIS: "
980 PRINT :IF L1> LNTHEN LN= L1
990 FOR I= 1TO LN- 1
1000 ON FRMT(I,0)+ 2GOTO 1010,1050,1070
1010 IF FRMT(I,2)= 0THEN PRINT RIGHT$ ("9999999",FRMT(I,1));:GOTO 1080
1020 A= FRMT(I,1)- FRMT(I,2):IF A= 0THEN 1040
1030 PRINT RIGHT$ ("99999999.",A);
1040 PRINT LEFT$ ("9999999",FRMT(I,2));:GOTO 1080
1050 IF LEFT$ (KY$(I),1)= "#"THEN PRINT :GOTO 1080
1060 PRINT SPC( FRMT(I,1));:GOTO 1080
1070 PRINT LEFT$ (KY$(I)+ "                                             ",FRMT(I,1));
1080 NEXT I
1090 PRINT :PRINT :IF MU$= "Y"THEN 1130
1100 PRINT TAB( 10);:INPUT "DO YOU WANT TO MAKE ANY CHANGES? ";A$
1110 IF LEFT$ (A$,1)= "N"THEN 1300
1120 REM

    ** EDIT FORMAT FILE **

1130 MF= 1
1140 NR= LN- 1
1150 GOSUB 1670
1160 IF  MU$< > "Y" THEN 1200
1170 IF  PP$= "P" THEN POKE  33265,FG
1180 IF  DD< > 2 THEN PRINT TAB( 10);:INPUT "HIT RETURN TO RETURN TO MENU: ";I$:REM 
1190 GOTO 1650
1200 L1= LN
1210 PRINT TAB( 10);:INPUT "ENTER NUMBER OF ENTRY YOU WISH TO CHANGE: ";N0
1220 IF N0= 1THEN LN= 1:CL= 1:LC= 1:GOTO 560
1230 IF N0= 0AND L1> LNTHEN LN= L1:GOTO 930
1240 IF N0= 0THEN 930
1250 CL= 1:LC= 1:FOR LN= 1TO N0- 1
1260 IF KY$(LN)= "#"THEN CL= 1:LC= LC+ 1
1270 CL= CL+ FRMT(LN,1)
1280 NEXT LN:GOTO 560
1290 REM

     ** CREATE FORMAT FILE **

1300 IF BK= 1THEN 1330
1310 FILE "N",F$+ ".FMT",LN- 1,36,7
1320 FILE "R",1,F$+ ".FMT",INT (LN/ 7)+ 1
1330 FOR I= 1TO LN- 1:PUT 1,I;- 10:NEXT I
1340 PRINT TAB( 10)
1350 PRINT TAB( 10);:INPUT "ENTER NAME OF DESCRIPTOR FILE TO BE USED: ";D$:REM 
1360 D1$= D$:IF  D$= "EXIT" THEN 1650
1370 IF DD= 3THEN D$= "1:"+ D$
1380 FILE "T",1390:GOTO 1410
1390 FILE "E",F,E,L:IF E< > 14THEN PRINT TAB( 10);"BAD FILE NAME":GOTO 1340
1400 PRINT TAB( 10);"CANNOT LOCATE ";D1$;"":GOTO 1340
1410 FILE "R",2,D$+ ".DDL",3
1420 FILE "A",2,CR,NR,BS,BF
1430 BY= 1
1440 FOR J= 1TO NR
1450 GET 2,J;KY$[16],KY,R
1460 FOR I= 1TO LN- 1
1470 IF LEFT$ (KY$(I)+ "                ",16)< > KY$THEN 1500
1480 IF FRMT(I,3)= 0THEN PUT 1,I;BY:GOTO 1500
1490 PUT 1,I;BY+ (FRMT(I,3)- 1)* ABS (KY)
1500 NEXT I
1510 IF R= 0THEN R= 1
1520 BY= BY+ ABS (KY)* R
1530 NEXT J
1540 REM


1550 FOR I= 1TO LN- 1
1560 PUT 1,I,5;FRMT(I,0),FRMT(I,1),FRMT(I,2),FRMT(I,3),KY$(I)[16]
1570 IF KY$(I)= "#"THEN PUT 1,I;- 1
1580 IF LEN (KY$(I))= 0THEN PUT 1,I;0
1590 GET 1,I;TST:IF TST< > - 10THEN 1630
1600 PRINT TAB( 10);"BAD KEY - ";KY$(I):BK= 1
1610 PRINT TAB( 10):INPUT "HIT RETURN - TO CONTINUE ";I$
1620 BK= 1:GOTO 1130
1630 NEXT I
1640 FILE "C",1,2
1650 IF DD= 2THEN PRINT TAB( 10):INPUT "INSERT PROGRAM DISK - HIT RETURN ";I$
1660 LOAD "MAIN":RUN
1670 REM

     ** PRINT FORMAT **

1680 CL= 1:LN= 1:PLOT 18
1690 PRINT "   LINE  1";
1700 FOR I= 1TO NR
1710 A$= "A":IF FRMT(I,0)= - 1THEN A$= "N"
1720 IF FR(I,0)= 0AND (KY$(I)= ""OR LEFT$ (KY$(I),1)= " ")THEN A$= "X":KY$(I)= ""
1730 PRINT TAB( 12);I;":COLUMN";CL;" ";
1740 PRINT TAB( 30);
1750 FOR J= 1TO 16:L$= MID$ (KY$(I),J,1):IF L$< > " "THEN PRINT L$;
1760 NEXT J
1770 IF FR(I,3)< > 0THEN PRINT "(";FR(I,3);")";
1780 CL= CL+ FR(I,1):IF LEFT$ (KY$(I),1)= "#"THEN KY$(I)= "#":GOTO 1800
1790 PRINT TAB( 44);A$;FR(I,1);".";FR(I,2):GOTO 1810
1800 CL= 1:LN= LN+ 1:PRINT :PRINT "   LINE ";LN;
1810 NEXT I:LN= I:PRINT :PRINT :RETURN