Compucolor.org – Virtual Media

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

1 GOTO 170
10 GOTO 1440
100 REM  ROUTINE TO LOAD MACHINE LANGUAGE PATCH TO READ
110 REM  KEYBOARD AS EACH KEY IS PRESSED.
120 DATA 245,229,197,62,255,211,8
130 DATA 1,206,40,205,36,0,202,-1,-1,11
140 DATA 121,176,194,-1,-1,29,194,-1,-1,17,255,255,195
150 DATA -1,-1,95,175,87,62,247,211,8,62,0
160 DATA 50,255,129,193,225,241,201
170 TM= PEEK (32940)+ 256* PEEK (32941):REM  CURRENT TOP OF MEMORY
180 GOSUB 2740:REM  DETERMINE ROM VERSION
190 REM  CHECK TO SEE IF ALREADY LOADED
200 IF TM> 65503THEN 270:REM 	NOT LOADED
210 IF  TM < >  48975- 48 AND  V678= 1THEN 270
220 RESTORE 120
230 FOR I= 1TO 48:READ A
240 IF A> 0AND A< > PEEK (TM+ I)THEN I= 48:A= 999
250 NEXT I
260 IF A< 256THEN 530:REM 		LOADED, TO SET JUMP
270 REM  LOAD PROGRAM
280 IF V678= 0THEN 400:REM  SKIP LOAD FOR V8.79
290 TM= 48975:REM  FORCE FOR COPY.PRG
300 Z= TM:AD= 32940:GOSUB 490:CLEAR  200:GOSUB 2740
305 DV= PEEK (33044)AND 1:REM  LOAD DEVICE
310 PLOT 12,15,6,2,3,1,20
320 PRINT "LOAD";DV;":COPY.PRG;1"
330 PLOT 27,27,27,11,3,0,8,11:REM 	CLEAR POSSIBLE FCS ERROR MSG
340 PLOT  27,4:PRINT "LOAD";DV;":COPY.PRG;1":PLOT  27,27
350 IF PEEK (29696)= 32THEN 400
360 PRINT "FAILED TO LOAD COPY"
370 PRINT "FILE COPY.PRG;1 MUST BE ON LOAD DISK"
380 PRINT "WHEN CPYAID IS LOADED AND RUN"
390 PRINT "ON VERSION 6.78 FCS":END :RUN
400 TM= PEEK (32940)+ 256* PEEK (32941)- 48:RESTORE 120
410 FOR I= 1TO 48:READ A:POKE TM+ I,A- (A< 0):NEXT I
420 REM  LOAD ADDRESSES
430 Z= TM+ 33:AD= TM+ 15:GOSUB 490
440 Z= TM+ 11:AD= TM+ 21:GOSUB 490
450 Z= TM+ 8:AD= TM+ 25:GOSUB 490
460 Z= TM+ 36:AD= TM+ 31:GOSUB 490
470 GOTO 510
480 REM  LOAD ADDRESS Z AT AD,AD+1
490 ZZ= INT (Z/ 256):POKE AD,Z- 256* ZZ:POKE AD+ 1,ZZ:RETURN
500 REM  CHANGE END OF BASIC RAM
510 Z= TM:AD= 32940:GOSUB 490
520 REM  LOAD BASIC JUMP LOCATION
530 Z= TM+ 1:AD= 33283:GOSUB 490
540 POKE 33282,195
550 CLEAR  4000:GOSUB 2740
560 MX= 86:KB= PEEK (33283)+ 256* PEEK (33284)
580 PLOT  6,2,12,27,24
585 REM
590 PRINT "FCS COPY AID BY EDGAR W. SWANK 16K V8.16.80"
600 PRINT "FOR DISK BASIC 6.78 AND 8.79":PLOT 10
610 PRINT "READS AND SORTS DIRECTORY OF SOURCE DISK"
620 PRINT "AND GENERATES 3-COLUMN DISPLAY."
630 PRINT "LATEST VERSIONS ARE IN GREEN."
640 PRINT "MOVE CURSOR AND PRESS X TO SELECT FILE,"
650 PRINT "OR R TO SELECT FILE AND RESET VERSION NUMBER TO 01."
660 PRINT "PRESS C TO CANCEL SELECTION."
670 PRINT "PRESS ENTER TO COPY SELECTED FILES."
680 PRINT "TO OTHER DISK"
690 PRINT "HOLD DOWN X, R, C AND CURSOR DIRECTION KEYS TO REPEAT"
700 PRINT "CAPACITY: LIMITED BY SCREEN DISPLAY TO 87 FILES"
710 IF V678= 0THEN PLOT 10,10,10,10:GOTO 750
720 PLOT 10:PRINT "SPECIAL SUPPORT FOR DISK BASIC 6.78"
730 PRINT "THIS VERSION USES A MODIFIED VERSION OF FCS COPY TO"
740 PRINT "BYPASS A PROGRAM BUG IN THE ROM VERSION."
750 PLOT 10,10:INPUT  "ENTER ID OF SOURCE DISK(0 OR 1): ";FD$
760 IF  FD$= "0" THEN TD$= "1":GOTO 790
770 IF  FD$= "1" THEN TD$= "0":GOTO 790
780 GOTO 750
790 FOR  N= 12TO 31:PLOT  3,0,N,11:NEXT :PLOT 3,0,12
800 DIM  BA(3),DE$(MX),DS(MX),NM$(1),TP$(1)
810 BF= PEEK (32986)+ 256* PEEK (32987)
820 BF= INT ((BF+ 200+ 256)/ 256)* 256
830 DI= BF:GOSUB 2420:BF$= DO$
840 EB= 256* (PEEK (32941)- 18):REM  END OF BUFFER AREA +1
850 EB= EB- 128:TM= EB
860 PLOT 10
870 DI= EB:GOSUB 2420:PRINT "DISK BUFFER ";BF$;"-";DO$
880 MR= (EB- BF)/ 128
890 REM  SCAN DIRECTORY
900 PLOT  3,0,15,11:PRINT "READING DIRECTORY"
910 DX= 0:NB= 1:LS= 0:CR= 0:BA(1)= BF:BA(2)= EB:LB$= ""
920 BA(2)= BA(1)+ 128* NB:IF BA(2)> EB THEN BA(2)= EB
930 GOSUB 2480:REM 	READ DIR FROM DISK
940 IF  PEEK (BF+ 2)< > 65THEN 970
950 NB= PEEK (BF+ 1)+ 1
960 FOR  N= 1TO 10:LB$= LB$+ CHR$ (PEEK (BF+ 2+ N)):NEXT
970 P= BF+ 2
980 REM
990 IF PEEK (P)= 1THEN 1200
1000 IF PEEK (P)< > 3THEN 1140
1010 IF  DX> MX THEN PLOT  3,0,15,11:MX= MX+ 1:PRINT "DIRECTORY TOO LARGE(>";MX;" FILES) FOR INTERNAL TABLES":END :RUN
1020 N$= ""
1030 FOR  N= 1TO 6:CH$= CHR$ (PEEK (P+ N))
1040 N$= N$+ CHR$ (PEEK (P+ N))
1050 NEXT
1060 DE$(DX)= N$
1070 N$= ""
1080 FOR  N= 7TO 9:CH$= CHR$ (PEEK (P+ N))
1090 N$= N$+ CHR$ (PEEK (P+ N))
1100 NEXT
1110 DE$(DX)= DE$(DX)+ N$
1120 DE$(DX)= DE$(DX)+ CHR$ (PEEK (P+ 10))+ CHR$ (PEEK (P+ 13))+ CHR$ (PEEK (P+ 14))
1130 DX= DX+ 1:PLOT  3,18,15:PRINT DX
1140 P= P+ 21
1150 IF INT (P/ 128)< > P/ 128THEN 980
1160 P= P+ 2:NB= NB- 1
1170 IF P< BA(2)THEN 980
1180 CR= CR+ (BA(2)+ 1- BA(1))/ 128
1190 GOTO 920
1200 REM  SORT DIRECTORY
1210 M= DX:IF M< 1THEN PLOT 10,10,11:PRINT "DIRECTORY IS EMPTY":END :RUN
1215 IF M= 1THEN 1440
1220 PLOT  3,0,15,11:PRINT "SORTING DIRECTORY"
1230 PLOT 10:PRINT "SORT INDEX",
1240 M= INT ((M+ 1)/ 2):PRINT M,
1245 REM GOSUB2100:PLOT0,30:END:REMDIAG
1250 IF M= 0THEN 1440
1260 K= DX- 1- M
1270 J= 0
1280 I= J
1290 L= I+ M
1310 IF DE$(I)< = DE$(L)THEN 1410
1350 N= N+ 1
1370 T$= DE$(I):DE$(I)= DE$(L):DE$(L)= T$
1390 I= I- M
1400 IF I> = 1THEN 1290
1410 J= J+ 1
1420 IF J< = KTHEN 1280
1425 IF M< 2THEN 1440
1430 GOTO 1240
1440 PRINT "":REM  EXIT SORT
1450 GOSUB 2100:REM  PRINT ARRAY
1455 CC= 0
1460 SB= 28672:REM 	BASE FOR SCREEN REFRESH RAM
1470 SY= 6:SX= 0:REM 	INITIAL SCREEN WRITE POS
1480 REM SETUP KEYBD READ
1490 PLOT  27,27
1500 SY= 3:SX= 0:PLOT  3,0,3:SA= SB+ 3* 128:NS= 0
1510 REM  READ KEYBOARD
1520 OUT  8,255:OUT  8,247
1530 IF  PEEK (33252)< > 0 THEN KY= PEEK (33278):GOTO 1550
1540 KY= CALL (5):IF KY= - 1 THEN 1540
1550 IF  KY= 10 THEN 1760:REM +Y
1560 IF  KY= 28 THEN 1740:REM -Y
1570 IF  KY= 26 THEN 1780:REM -X
1580 IF  KY= 25 THEN 1800:REM +X
1590 IF  KY= 9 THEN 1800:REM  TAB+X
1600 IF  KY= 13 THEN 1860:REM  ENTER/RETURN
1610 IF  KY< > 67 THEN 1650:REM  C CANCEL
1620 FOR  N= SA+ 1 TO  SA+ 35 STEP  2
1630 POKE  N,PEEK (N) AND  7:NEXT :REM  RESET BACKGROUND COLOR
1640 DS(NS)= DS(NS)AND 240:GOTO 1760
1650 IF  KY < >  88 THEN 1690:REM  X SET
1660 FOR  N= SA+ 1 TO  SA+ 35 STEP  2
1670 POKE  N,(PEEK (N)AND 7) OR  8:NEXT :REM  SET BACKGROUND COLOR RED
1680 DS(NS)= (DS(NS)AND 240)OR 1:GOTO 1760
1690 IF  KY < >  82 THEN 1510:REM  R SET
1700 FOR  N= SA+ 1 TO  SA+ 35 STEP  2
1710 POKE  N,(PEEK (N)AND 7) OR  32:NEXT :REM  SET BACKGROUND COLOR BLUE
1720 DS(NS)= (DS(NS)AND 240)OR 2:GOTO 1760
1730 REM :CURSOR DIRECTION KEYS
1740 IF  NS- 1< 0 THEN 1510:REM 	-Y
1750 NS= NS- 1:GOTO 1820
1760 IF  NS+ 1> DX- 1 THEN 1510:REM 	+Y
1770 NS= NS+ 1:GOTO 1820
1780 IF  NS- 29< 0 THEN 1510:REM 	-X
1790 NS= NS- 29:GOTO 1820
1800 IF  NS+ 29> DX- 1 THEN 1510:REM 	+X
1810 NS= NS+ 29:GOTO 1820
1820 REM 	COMMON MOVE CURSOR
1830 SX= INT (NS/ 29):SY= NS- 29* SX+ 3:SX= 22* SX
1840 SA= SB+ 2* (SX+ 64* SY):PLOT  3,SX,SY
1850 GOTO 1510
1860 REM  ENTER/RETURN--ISSUE FCS COPY COMMANDS
1870 PLOT 6,2,12:OUT 8,255
1900 IF  DX< 0 THEN PRINT "NO FILES SPECIFIED.":END :RUN
1910 REM  RELOAD BASIC JUMP LOCATION
1920 Z= 48976:AD= 33283:GOSUB 490
1930 CP= 49016:REM  LOCATION OF COPY PARM BUFFER-1
1940 FOR  J= 0 TO  DX- 1
1950 IF  (DS(J)AND 7)= 0 THEN 2070
1955 CC= CC+ 1:X= 0:Z= J:GOSUB 2221
1960 X$= NM$(0):GOSUB 2341:T$= X$:F$= " "+ FD$+ ":"
1961 X$= TP$(0):GOSUB 2341:T$= T$+ "."+ X$:F$= F$+ T$
1962 HI= ASC (MID$ (DE$(J),10,1)):GOSUB 2350
1970 F$= F$+ ";"+ HO$+ " TO "+ TD$+ ":"+ T$+ ";"
1990 IF (DS(J)AND 7)= 1THEN F$= F$+ HO$:GOTO 2020
2000 F$= F$+ "01"
2020 PRINT "COPY";F$
2030 IF V678= 0THEN PLOT  27,4:PRINT "COPY";F$:PLOT  27,27:GOTO 2062
2040 FOR  N= 1 TO  LEN (F$)
2050 POKE  CP+ N,ASC (MID$ (F$,N,1)):NEXT :POKE CP+ N,0:POKE CP+ N+ 1,0
2060 X= CALL (1):REM  CALL COPY ROUTINE
2062 IF PEEK (SB+ 128)= 32THEN 2070
2064 DS(J)= (DS(J)OR 16):PRINT "COPY ERROR PRESS RETURN TO CONTINUE";:INPUT "";RP$
2070 NEXT  J
2075 Z= KB:AD= 33283:GOSUB 490:REM  BASIC JUMP TO KB PATCH
2080 IF CC> 0THEN  1450
2090 PLOT  27,11,27,4:PRINT "DIR ";TD$;":":PLOT  27,27:END :GOTO 1450
2100 REM  PRINT CONTENTS OF DE$ IN 3-COLUMNS
2110 N= 0:PLOT  6,2,12,27,24:PRINT "CONTENTS OF CD";FD$;"  ";LB$;
2120 PRINT " X SELECT.   R SELECT/RESET VERS NO."
2130 PRINT TAB( 28);"C CANCEL.   ENTER GO"
2140 FOR  C= 0TO 2* 22 STEP  22
2150 FOR  L= 3TO 31:PLOT  3,C,L,6,7
2152 DS= DS(N):IF (DSAND 15)< > 0THEN DS= ((DSAND 15)* 32)OR (DSAND 16):DS(N)= DS
2154 IF (DSAND 225)= 32THEN PLOT 30,17,29
2155 IF (DSAND 225)= 64THEN PLOT 30,20,29
2156 IF (DSAND 16)= 16THEN PLOT 31
2157 X= 0:Z= N:GOSUB 2221
2158 VN= ASC (MID$ (DE$(N),10,1)):SZ= ASC (MID$ (DE$(N),11,1))
2159 SZ= SZ+ 256* ASC (MID$ (DE$(N),12,1))
2160 IF  N= MX THEN PLOT  18:GOTO 2180
2165 X= 1:Z= N+ 1:GOSUB 2221
2170 IF  NM$(0)+ TP$(0)< > NM$(1)+ TP$(1) THEN PLOT  18
2180 PRINT NM$(0);".";TP$(0);
2181 REM PRINTN+1;TAB(5);NM$(0);".";TP$(0);
2190 HI= VN:GOSUB 2350:PRINT ";";HO$;" ";
2191 DI= SZ:GOSUB 2420:PRINT DO$
2200 N= N+ 1:IF N> DX- 1THEN 2220
2210 NEXT L:NEXT C
2220 RETURN :REM EXIT
2221 NM$(X)= LEFT$ (DE$(Z),6):TP$(X)= MID$ (DE$(Z),7,3):RETURN
2230 REM  CONVERT HEX STRING IN CI$ TO ARITH  IN CO
2240 CO= 0
2250 IF MID$ (CI$,1,1)= "+"THEN CO= VAL (CI$):RETURN
2260 FOR I= 1TO LEN (CI$)
2270 C1= ASC (MID$ (CI$,I,1))
2280 C2= 16
2290 IF C1> 47AND C1< 58THEN C2= C1- 48
2300 IF C1> 64AND C1< 71THEN C2= C1- 55:REM  HEX A-F
2310 IF C2> 15THEN PRINT "HEX INPUT ERROR ";CI$:OUT  8,255:END
2320 CO= CO* 16+ C2
2330 NEXT I
2340 RETURN
2341 REM REMOVE TRL BLANKS FROM X$
2342 IF LEN (X$)= 0THEN  RETURN
2343 IF RIGHT$ (X$,1)< > " "THEN  RETURN
2344 IF LEN (X$)= 1THEN X$= "":RETURN
2345 X$= LEFT$ (X$,LEN (X$)- 1):GOTO 2342
2350 REM  CONVERT ARITH VALUE IN HI(0-255) TO TWO HEX CHAR
2360 REM  IN HO$
2370 IF HI< 0THEN HI= HI+ 256
2380 H0= INT (HI/ 16)+ 48:IF  H0> 57 THEN H0= H0+ 7
2390 H1= (HIAND 15)+ 48:IF  H1> 57 THEN H1= H1+ 7
2400 HO$= CHR$ (H0)+ CHR$ (H1)
2410 RETURN
2420 REM  CONVERT TWO-BYTE VALUE TO 4-BYTE HEX STRING
2430 IF DI< 0THEN DI= DI+ 65536
2440 HI= INT (DI/ 256):GOSUB 2350:DO$= HO$
2450 HI= (DI- HI* 256):GOSUB 2350
2460 DO$= DO$+ HO$
2470 RETURN
2480 REM 	DISK READ SUBR
2490 REM 	CR=START SECTOR,BA(1)=BUFFER START,
2500 REM 	BA(2)=BUFFER END
2510 RS$= "READ  CD"+ FD$+ ": "
2520 DI= CR:GOSUB 2420
2530 RS$= RS$+ DO$+ " "
2540 DI= BA(1):GOSUB 2420
2550 RS$= RS$+ DO$+ "-"
2560 DI= BA(2)- 1:GOSUB 2420:REM 	LIMITED BY BUFFER
2570 RS$= RS$+ DO$
2580 PLOT 3,0,20,11
2590 PLOT 27,4:REM 		ACCESS FCS
2600 PRINT RS$:PLOT 27,27
2610 SM= 28672+ 20* 128:IF PEEK (SM)< > 32THEN 2640
2620 REM 			DETECT FCS DISK ERR MSG
2630 RETURN
2640 REM
2650 REM 			SECT. NUM. FRM FCS ERR MSG
2660 CI$= CHR$ (PEEK (SM+ 26))
2670 CI$= CI$+ CHR$ (PEEK (SM+ 28))
2680 CI$= CI$+ CHR$ (PEEK (SM+ 30))
2690 CI$= CI$+ CHR$ (PEEK (SM+ 32))
2700 GOSUB 2230
2710 PLOT 3,0,22
2720 PRINT "READ ERROR AT RECORD ";CO;"[";CI$;"]"
2730 END :RUN
2740 V678= 0:IF PEEK (1)+ 256* PEEK (2)= 14188 THEN V678= 1
2750 RETURN