1000 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1010 ! Program ....     CASDISK1.800
1020 ! Utg}va  2.0      1983-10-05
1030 ! av (c) Bo Kullmar  1789
1040 ! rev  Anders Sandberg  4104
1050 ! Kopierar ASCII, ABS och BAC filer fr}n CAS: till disk.
1060 ! [ven randomfiler enligt ABC-kassett nr 7.
1070 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1080 ! 
1090 EXTEND : INTEGER 
1100 DIM Files$=1200,Block$=253,Fil$(3)=12,Fmt$=6,Dev$=4,Ch$=1,Devdes$=0
1110 T=-1 : F=0 : Dev=PEEK2(24683) : Wid=PEEK(65364) : Tb=5 : IF Wid=80 Tb=25
1120 POKE VAROOT(Devdes$),32,0,Dev,SWAP%(Dev),32,0
1130 ! 
1140 Fmt$='&#####' : Dev$='DISK' : PRINT FNHead$
1150 PRINT TAB(Tb) YEL '\nskas anvisningar? (N) '; : GET Ch$
1160 IF INSTR(1,'jJ',Ch$) PRINT FNHelp$ ELSE PRINT CHR$(10)
1170 ; TAB(Tb) YEL; : INPUT 'Till drive: 'Fil$(0); : ; STRING$(LEN(Fil$(0)),8);
1180 IF FNDevck(FNUc$(Fil$(0))) PRINT CHR$(7,13); : GOTO 1170 ELSE PRINT Dev$
1190 ; : Fil$(1)=FNInfil$('Start') : ; : Fil$(2)=FNInfil$('Stopp') : ; 
1200 PRINT TAB(Tb) YEL 'Tryck "PLAY" och "RETURN" !'; : GET Ch$
1210 ! 
1220 ON ERROR GOTO 1470 : PRINT FNHead$ : Rad=2 : IF Fil$(1)<>'' Flag=T
1230 WHILE Fil$(0)<>Fil$(2)
1240   POKE 65363,0 : OPEN 'CAS:' AS FILE 1 : Fil$(0)=FNName$ : IF Flag 1240
1250   ! 
1260   PRINT CUR(1,0) SPACE$(20) : POKE 65363,Rad
1270   PREPARE Dev$+'TEMP.][\' AS FILE 2
1280   ! 
1290   GET #1 Block$ COUNT 253 : IF FNTyp=0 GOTO 1370
1300   IF Typ=4 Lgd=(CVT$%(MID$(Block$,5,2))+4*CVT$%(MID$(Block$,11,2)))/253
1310   PRINT CUR(Rad,Tb1) SPACE$(20) CUR(Rad,Tb1) GRN Fil$(0)
1320   PUT #2 Block$ : WHILE FNTest : Z=FNCopy : WEND : CLOSE 
1330   ! 
1340   Fil$(0)=FNFil$(Fil$(0)) : NAME Dev$+'TEMP.][\' AS Fil$(0)
1350   PRINT USING Fmt$ CUR(Rad,Tb1+14) B+2
1360   Sum=Sum+B+2 : PRINT USING Fmt$ CUR(0,Tb+22) Sum
1370   B=0 : Rad=Rad+1 : IF Rad>22 Rad=2 : Tb1=MOD(Tb1+20,Wid)
1380   IF Flag2 Z=FNGet
1390 WEND 
1400 IF Files$='' GOTO 1430
1410 PRINT CUR(23,Tb) RED 'Fel p}' LEN(Files$)/12 'filer. V{nd !';
1420 Flag2=T : GET Ch$ : PRINT CUR(23,0) SPACE$(Wid); : GOTO 1380
1430 PRINT CUR(23,0) SPACE$(Wid) CUR(23,Tb) YEL 'Slut f|r denna g}ng !' CUR(0,0)
1440 END 
1450 ! 
1460 STOP 
1470 CLOSE 
1480 IF ERRCODE<>64 PRINT CHR$(7) : GOTO 1520
1490 Fel=Fel+1 : RESUME 1500
1500 Fil$(3)='TEMP'+NUM$(Fel)+'.TMP' : NAME Dev$+'TEMP.][\' AS Fil$(3) : Rad=Rad+1
1510 PRINT CUR(Rad,Tb1) SPACE$(20) CUR(Rad,Tb1) GRN FNFix$(Fil$(3)) : GOTO 1350
1520 IF ERRCODE=35 PRINT FNAdd$ CUR(Rad,Tb1+15) 'Csum' : RESUME 1370
1530 IF ERRCODE=37 PRINT FNAdd$ CUR(Rad,Tb1+15) 'Form' : RESUME 1370
1540 IF ERRCODE=42 Ch$=FNErr$(Dev$+' {r ej klar','ok') : RESUME 1270
1550 IF ERRCODE=43 Ch$=FNErr$(Dev$+' {r skrivskyddad','ok') : RESUME 1270
1560 IF ERRCODE<>41 GOTO 1600
1570 KILL Dev$+'TEMP.][\'
1580 IF INSTR(1,'jJ',FNErr$(Dev$+' {r full','Sluta (N)')) RESUME 1440
1590 Ch$=FNErr$('Backa CAS:','Ny disk') : RESUME 1370
1600 IF INSTR(1,'nN',FNErr$('Error '+NUM$(ERRCODE),'Forts{tta (J)')) RESUME 1460
1610 Q=INSTR(1,'12',FNErr$('V{lj','1: RESUME, 2: Ny fil')) : IF Q=0 GOTO 1610
1620 IF Q=1 RESUME ELSE RESUME 1370
1630 ! 
1640 DEF FNHelp$
1650   PRINT FNHead$
1660   ; TAB(Tb) YEL 'Programmet kopierar f|ljande'
1670   ; TAB(Tb) YEL 'filer fr}n ABC-80 eller ABC-800'
1680   ; TAB(Tb) YEL 'kassetter:'
1690   ; 
1700   ; TAB(Tb) YEL 'ABS-filer'
1710   ; TAB(Tb) YEL 'ASCII-filer'
1720   ; TAB(Tb) YEL 'ABC-80 BAC-filer'
1730   ; TAB(Tb) YEL 'ABC-800 BAC-filer'
1740   ; 
1750   ; TAB(Tb) RED 'ABC-80 BAC-filer kan ej k|ras'
1760   ; TAB(Tb) RED 'eller listas p} ABC-800 !'
1770   ; TAB(Tb) RED 'F|rsiktighet b|r iakttagas med'
1780   ; TAB(Tb) RED 'ABS-filer f|r ABC-80 !'
1790   ; 
1800   ; TAB(Tb) YEL 'Programmet fr}gar efter disk-'
1810   ; TAB(Tb) YEL 'drive ( DR_:, MF_:, MO_:, SF_:)'
1820   ; 
1830   ; TAB(Tb) YEL 'Du f}r ocks} ange start- och'
1840   ; TAB(Tb) YEL 'stoppfil f|r kopieringen.'
1850   ; 
1860   ; TAB(Tb) CYA 'Klar ? '; : GET Ch$
1870   RETURN FNHead$
1880 FNEND 
1890 ! 
1900 DEF FNTyp LOCAL Ch
1910   Typ=0 : Ch=ASCII(Block$)
1920   IF Ch=0 Typ=3 ! ABS
1930   IF Ch=143 Typ=4 ! 800-BAC
1940   IF (Ch OR 1)=131 Typ=1 ! 80-BAC
1950   IF Ch>0 AND Ch<128 Typ=2 ! ASCII
1960   RETURN Typ
1970 FNEND 
1980 ! 
1990 DEF FNCopy
2000   GET #1 Block$ COUNT 253 : B=B+1 : PUT #2 Block$ : RETURN B
2010 FNEND 
2020 ! 
2030 DEF FNTest
2040   I=1 : ON Typ GOTO 2050,2090,2110,2140
2050   IF B=0 I=2 ! ABC-80 BAC
2060   L=ASCII(MID$(Block$,I,1)) : IF L=1 RETURN F ELSE IF L I=I+L : GOTO 2060
2070   RETURN T
2080   ! ASCII
2090   IF LEFT$(Block$,7)=STRING$(6,0)+CHR$(3) RETURN F ELSE RETURN FNRandom
2100   ! ABS
2110   IF ASCII(MID$(Block$,I,1))=255 RETURN FNRandom
2120   L=ASCII(MID$(Block$,I+1,1)) : IF L I=I+L+8 : GOTO 2110 ELSE RETURN F
2130   ! ABC-800 BAC
2140   IF B<Lgd RETURN T ELSE RETURN F
2150 FNEND 
2160 ! 
2170 DEF FNRandom=LEFT$(Block$,7)<>CHR$(253,192,253,192,253,192,52) 
2180 ! 
2190 DEF FNInfil$(A$) LOCAL File$=12
2200   PRINT TAB(Tb) YEL A$; : INPUT ' fil med EXT : 'File$; : IF File$='' 2220
2210   IF INSTR(1,File$,'.')=0 PRINT CHR$(7,13); : GOTO 2200
2220   PRINT STRING$(LEN(File$),8) FNUc$(File$) : RETURN File$
2230 FNEND 
2240 ! 
2250 DEF FNFil$(Fil$) LOCAL P,A$=12
2260   A$=Fil$
2270   P=INSTR(1,A$,' ') : IF P A$=LEFT$(A$,P-1)+RIGHT$(A$,P+1) : GOTO 2270
2280   RETURN A$
2290 FNEND 
2300 ! 
2310 DEF FNDevck(N$) LOCAL N,Ch$=1
2320   Dev$='' : N=LEN(N$) : IF N>4 OR N=2 OR N=0 RETURN T
2330   IF N=1 LET Ch$=N$ : Dev$='DR' ELSE Ch$=MID$(N$,3,1) : Dev$=LEFT$(N$,2)
2340   IF INSTR(1,'0123',Ch$)=0 RETURN T
2350   IF 0=INSTR(1,'DR_HD_MF_MO_SF_',Dev$) RETURN T
2360   Dev$=Dev$+Ch$+':' : RETURN FNDesc
2370 FNEND 
2380 ! 
2390 DEF FNDesc LOCAL Entry
2400   Entry=INSTR(1,Devdes$,LEFT$(Dev$,2))-3 : IF Entry=-3 RETURN T
2410   IF Entry=0 LET Entry=ASCII(Devdes$) AND 28
2420   MID$(Dev$,1,2)=MID$(Devdes$,Entry+3,2) : RETURN F
2430 FNEND 
2440 ! 
2450 DEF FNHead$=CHR$(12)+BLU+CUR(0,Tb)+'Copy  CAS: to  '+Dev$+CHR$(10) 
2460 ! 
2470 DEF FNName$ LOCAL A$=12,Adr
2480   IF PEEK(64267)=46 Adr=64259 ELSE Adr=64515
2490   POKE VAROOT(A$)+2,Adr,SWAP%(Adr),12,0 : MID$(A$,9,1)='.'
2500   IF Fil$(1)<>'' IF FNFil$(A$)=Fil$(1) Fil$(1)='' : Flag=F
2510   RETURN A$
2520 FNEND 
2530 ! 
2540 DEF FNUc$(A$) LOCAL Ch
2550   FOR I=1 TO LEN(A$) : Ch=ASCII(MID$(A$,I,1))
2560     IF Ch>95 AND Ch<127 MID$(A$,I,1)=CHR$(Ch AND 223)
2570   NEXT I : RETURN A$
2580 FNEND 
2590 ! 
2600 DEF FNErr$(A$,B$)
2610   PRINT CUR(23,0) SPACE$(Wid) CUR(23,Tb) RED A$ ' ! ' YEL B$ ' ?';
2620   GET Ch$ : PRINT CUR(23,0) SPACE$(Wid); : RETURN Ch$
2630 FNEND 
2640 ! 
2650 DEF FNFix$(A$) LOCAL P
2660   P=INSTR(1,A$,'.') : IF P=0 RETURN ''
2670   RETURN LEFT$(A$,P-1)+SPACE$(9-P)+'.'+SPACE$(3+P-LEN(A$))+RIGHT$(A$,P+1)
2680 FNEND 
2690 ! 
2700 DEF FNAdd$
2710   Files$=Files$+Fil$(0) : RETURN ''
2720 FNEND 
2730 ! 
2740 DEF FNGet
2750   IF Files$='' Flag=F : RETURN F
2760   Flag=T : Fil$(1)=FNFil$(LEFT$(Files$,12))
2770   IF LEN(Files$)>12 Files$=RIGHT$(Files$,13) ELSE Files$=''
2780   Fil$(2)=Fil$(1) : RETURN T
2790 FNEND