2 ! **********************************************************************
3 ! Program          SD10.BAS         Utg}va  1.6      1985-05-05
4 ! av Ulf S|rensen, {ndrad av Bo Kullmar
5 ! Ins{nd av Bo Kullmar
6 ! F|r ABC800M ABC800C ABC802 ABC806
8 ! Testad p} ABC806
9 ! Programmet {r till f|r att l{sa floppydiskar.
10 ! Programmet {r avsett f|r alla DOS och diskar, men det {r fn enbart
11 ! testat p} UFD-DOS och disk ABC830. 
12 ! I framtiden planerar jag att anpassa programmet mer till ABC800-serien,
13 ! vilket bl annat inneb{r att funktionstangenter kommer att anv{nds i st{llet
14 ! f|r CTRL-tangenter som nu.
15 ! 
16 ! Jag f}r nog varken tid och lust att g|ra s} mycket mer med detta
17 ! }t detta program, s} jag l{gger in det som det {r i programbanken.
18 ! 
20 ! **********************************************************************
95 INTEGER : EXTEND 
100 G=PEEK(65364)-1 : Wid=G : True=-1 : False=0
101 IF G=39 THEN Fmax=8 ELSE Fmax=6
105 Pr$='PR:VSA36C72.55'
110 Dosver=FNDosver
120 IF Dosver=1 THEN Selcode=0 : Clusi=1 : Bitkarta1=6 : Bitkarta2=7
130 IF Dosver=2 THEN Selcode=0 : Clusi=4 : Bitkarta1=14 : Bitkarta2=15 ! ? f|r bitkartorna
140 IF Dosver=3 THEN Selcode=0 : Clusi=4 : Bitkarta1=14 : Bitkarta2=15
150 IF Dosver=4 THEN Selcode=0 : Clusi=4 : Bitkarta1=14 : Bitkarta2=15
160 IF Dosver=99 ; 'Kan ej avg|ra skillnaden mellan DOS ABC 6-1 och 800 8" (DD88)' : STOP 
170 IF Dosver=0 ; 'Ok{nt DOS' : STOP 
171 Devs$='DR0DR1DR2DR3DR4DR5DR6'
172 ! IF PEEK(65530)=165 THEN Devs$=Devs$+'RAM'
175 IF Dosver=4 OR Dosver=5 THEN Devs$='UFDDR0DR1DR2DR3HD0HD1HD2HD3SF0SF1SF2SF3MF0MF1MF2MF3MO0MO1MO2MO3RAM'
200 ; CHR$(12) TAB(15) 'Skivl{s' : ; 
210 ; : ; 'Skriv Ctrl-V om du beh|ver hj{lp' : ; : ; 
220 INPUT 'Vilken drive vill du l{sa/skriva? 'Dev$
222 Dev$=FNUpcase$(Dev$)
224 Nodev=INSTR(1,Devs$,Dev$) : IF Nodev=0 THEN ; 'Felaktig enhet!' : GOTO 220
230 IF (Dosver=1 OR Dosver=2 OR Dosver=3 OR Dosver=4) AND Nodev<>1 THEN Selcode=Nodev/3 ELSE Selcode=0
240 IF Dosver=5 OR Dosver=6 THEN Err=FNCluster(Dev$)
250 IF Err THEN Z=FNFel('Felaktigt enhetsnamn',True) : GOTO 200
251 IF (Dosver=5 OR Dosver=6) AND Clusi=1 THEN Bitkarta1=6 : Bitkarta2=7 ELSE Bitkarta1=14 : Bitkarta2=15
260 ; : Sector=FNInput
310 Err=FNRdwrsec('READ',Sector) : D=1 : IF Err THEN 260
315 Trac=Sector/8 : Sec=MOD(Sector,8)
320 ; CHR$(12) 'Drive: ' Dev$ '   Trac: ' Trac ' Sector: ' Sec '       Byte: '; : ; USING '###' D
330 ; CUR(23,0) STRING$(Wid,61);
340 ; CUR(1,0) STRING$(Wid,61) : ; 
360 FOR D=62720 TO 62975
370   E=PEEK(D) : IF E<33 OR E>127 ; '_'; ELSE ; CHR$(E); ! AND E<>255 BORTAGET
380 NEXT D 
390 F=3 : G=0 : D=1
400 ; CUR(21,0) SPACE$(Wid);
405 ; CUR(0,48); : ; USING '###' D : POKE 65506,0
410 ; CUR(21,0) 'Ascii:' PEEK(D+62719); : IF D<256 THEN ; PEEK(D+62720);
411 ; CUR(21,23) 'Hex: ' HEX$(PEEK(D+62719)) CUR(21,38) 'Oct: ' OCT$(PEEK(D+62719))
412 ; CUR(21,53) 'Bin: ' FNDecbin{r$(PEEK(D+62719))
415 ; '    '
420 ; CUR(F,G); : GET A$ : A$=FNUpcase$(A$) : K=ASCII(A$)
430 IF K=9 IF D=256 GOTO 440 ELSE IF G=Wid F=F+1 : G=0 : D=D+1 ELSE G=G+1 : D=D+1 ! I och h-pil
440 IF K=8 IF D=1 GOTO 460 ELSE IF G=0 F=F-1 : G=Wid : D=D-1 ELSE G=G-1 : D=D-1 ! H och v-pil
460 IF K=1 IF Sector>0 Sector=Sector-1 : GOTO 310 ! A
470 IF K=2 THEN 1720 ! B
480 IF K=20 THEN 390 ! T
490 IF K=5 THEN 870 ! E 
500 IF K=6 GOSUB 2300 ! F
510 IF K=7 THEN 920 ! G
520 ! K%=8% p} rad 440 = H
530 ! K%=9% p} rad 430 = I 
540 IF K=10 THEN 1970 ! J 
550 IF K=11 THEN 2220 ! K
560 IF K=16 THEN 2490 ! P
570 IF K=14 THEN 1920 ! N
580 IF K=15 THEN 2330 ! O 
590 IF K=18 GOSUB 2270 ! R
610 IF K=19 Sector=Sector+1 : GOTO 310 ! S  ****** Max borttaget fn
620 IF K=17 THEN 2180 ! Q
630 IF K=21 THEN 2000 ! U
640 IF K=22 GOSUB 1160 : GOTO 420 ! V
650 IF K=23 THEN 740 ! W
660 IF K=24 THEN 1020 ! X
670 IF K=25 THEN 1820 ! Y
680 IF K=26 THEN 970 ! Z
690 IF K>31 IF D<257 POKE D+62719,K : ; A$ ELSE 400 ELSE 400
700 IF D=256 THEN 400
710 IF G<Wid G=G+1 ELSE F=F+1 : G=0
720 IF D<256 D=D+1
730 GOTO 400
740 ; CUR(21,0) SPACE$(Wid) : ; CUR(21,0) 'Printer? (N)';
750 INPUT A$ : A$=FNUpcase$(A$)
760 IF A$='J' THEN 790
770 IF A$='N' OR A$='' 860
780 ; CUR(21,0) SPACE$(30) : GOTO 740
790 PREPARE Pr$ AS FILE 1
800 ; #1,'Sektor:' Sector
810 FOR H=62720 TO 62975
820   ; #1, USING '####' PEEK(H);
840 NEXT H : I=0
850 ; #1
860 ; CUR(21,0) SPACE$(Wid-1); : CLOSE 1 : GOTO 400
870 ; CUR(21,0) SPACE$(Wid) : Sector=FNInput : GOTO 310
920 ; CUR(21,0) SPACE$(Wid) : ; CUR(21,0) 'Drive'; : INPUT Dev$
922 Dev$=FNUpcase$(Dev$)
924 Nodev=INSTR(1,Devs$,Dev$) : IF Nodev=0 THEN ; Z=FNFel('Felaktigt enhetsnamn',True) : GOTO 920
926 IF (Dosver=1 OR Dosver=2 OR Dosver=3 OR Dosver=4) AND Nodev<>1 THEN Selcode=Nodev/3 ELSE Selcode=0
927 IF Dosver=5 OR Dosver=6 THEN Err=FNCluster(Dev$)
928 IF Err THEN Z=FNFel('Felaktigt enhetsnamn',True) : GOTO 920
929 IF (Dosver=5 OR Dosver=6) AND Clusi=1 THEN Bitkarta1=6 : Bitkarta2=7 ELSE Bitkarta1=14 : Bitkarta2=15
930 ; CUR(21,0) SPACE$(30) : GOTO 310
970 GOSUB 1690 : GOSUB 2450 : ; CUR(21,0) 'Jag skriver p} rekord:' A
980 ; CUR(21,0) 'Jag skriver p} sector:' Sector
990 Err=FNRdwrsec('WRITE',Sector) : IF Err THEN 970
1000 FOR K=1 TO 6000 : NEXT K 
1010 ; CUR(21,0) SPACE$(Wid-1) : GOTO 400
1020 ; CUR(21,0) SPACE$(Wid) : ; CUR(21,0) 'Ctrl-tecken (Ascii): ';
1025 Tecken=PEEK(D+62719) : IF Tecken>127 THEN Tecken=Tecken-128
1027 IF Tecken<32 THEN Tecken=Tecken+64
1030 ; CUR(F,G) CHR$(Tecken);
1080 ; CUR(21,21); : INPUT LINE A$ : A$=LEFT$(A$,LEN(A$)-2) : IF A$='' THEN 1150
1090 ; CUR(F,G) '_'
1100 IF G>Wid-1 F=F+1 : G=-1
1110 IF D<256 G=G+1
1120 A$=FNDigit$(A$) : IF Err THEN Z=FNFel('M}ste vara siffror!',True) : GOTO 1020
1130 K=VAL(A$) : IF K<0 OR K>256 GOTO 1020
1140 POKE 62719+D,K : IF D<256 D=D+1
1150 ; CUR(21,0) SPACE$(30) : GOTO 400
1160 ; CUR(11,0) SPACE$(480);
1170 ; CUR(11,0) '****** K O M M A N D O N ******'
1180 ; 
1190 ; 'Allt {r Ctrl-tecken'
1200 ; 'Du styr cursorn med pilarna'
1210 ; 
1220 ; 'V - Ger denna lista (Visa)'
1230 ; 'Q - Slut (Quite)'
1240 ; 'W - 256 bytes p} printer (Write)'
1250 ; 'E - Byt rekord-nummer (Exchange)'
1260 ; 'R - Cursor upp (40 tecken/steg)'
1270 ; 'T - Cursor home (Top)'
1280 ; 'Y - Repeat-tangent'
1290 GET A$ : GOSUB 1690
1300 ; CUR(11,0) '****** K O M M A N D O N ******'
1310 ; 
1320 ; 'Allt {r Ctrl-tecken'
1330 ; 'Du styr cursorn med pilarna'
1340 ; 
1350 ; 'U - Visar 10 ascii-tecken'
1360 ; 'I - V-PIL "FRAMSTEG-tangenten'
1370 ; 'O - Flytta rekord'
1380 ; 'P - Letar upp programsnuttar'
1390 ; '] -'
1400 ; '^ -'
1410 ; 
1420 GET A$ : GOSUB 1690
1430 ; CUR(11,0) '****** K O M M A N D O N ******'
1440 ; 
1450 ; 'Allt {r Ctrl-tecken'
1460 ; 'Du styr cursorn med pilarna'
1470 ; 
1480 ; 'A - Rekord -1'
1490 ; 'S - Rekord +1'
1500 ; 'D - '
1510 ; 'F - Cursor ner (40/80 tecken/steg)'
1520 ; 'G - Byt drive'
1530 ; 'H - V-PIL "BACKSTEG-tangenten'
1540 ; 'K - R{knar ut byte 1 & 2 i Lib-titel'
1550 GET A$ : GOSUB 1690
1560 ; CUR(11,0) '****** K O M M A N D O N ******'
1570 ; 
1580 ; 'Allt {r Ctrl-tecken'
1590 ; 'Du styr cursorn med pilarna'
1600 ; 
1610 ; 'Z - Skriv rekord'
1620 ; 'X - Skriva in Ctrl-tecken <31 och >127'
1630 ; 'C - N\DSTOPP'
1640 ; 'B - Auto header-s|kning'
1650 ; 'N - 5 Steg fram}t'
1660 ; 'J - 5 Steg bak}t'
1670 ; 'M - RETURN-tangent'
1680 GET A$ : GOSUB 1690 : RETURN 
1690 FOR H=10 TO 22
1700   ; CUR(H,0) SPACE$(38)
1710 NEXT H : RETURN 
1720 L=(PEEK(D+62719)*8)+(PEEK(D+62720)/32)
1730 ; CUR(21,0) 'Headern i prog:';
1740 FOR H=0 TO 10
1750   IF H=8 ; '.';
1760   ; CHR$(PEEK((H+D)+62723));
1770 NEXT H : ; 
1780 ; 'ligger p} rekord:' L
1790 FOR H=1 TO 8000 : NEXT H 
1800 GOSUB 1690
1810 GOTO 420
1820 IF D=1 THEN 400
1830 IF D>=256 THEN 400
1840 IF G<Wid G=G+1 ELSE F=F+1 : G=O
1850 J1=0
1860 J=PEEK(D+62718)
1870 IF J>=128 ; '_' : J1=1
1880 IF J<=33 ; '_' : J1=1
1890 IF J1=0 ; CHR$(J)
1900 POKE D+62719,J : J=0
1910 D=D+1 : GOTO 400
1920 IF F>Fmax THEN 400
1930 IF F=Fmax B1=11 ELSE B1=Wid-5
1940 IF G>B1 IF F>=Fmax GOTO 400 ELSE F=F+1 : G=5-(Wid+1-G) ELSE G=G+5
1950 D=D+5
1960 GOTO 400
1970 IF G<5 IF F=3 GOTO 400 ELSE F=F-1 : G=40-(5-G) ELSE G=G-5
1980 D=D-5
1990 GOTO 400
2000 IF D>247 B1=256-D ELSE B1=9
2010 ; CUR(19,0) SPACE$(Wid)
2020 ; CUR(19,0);
2030 FOR Z=0 TO B1
2040   ; USING '#####' PEEK(62719+Z+D);
2045 NEXT Z 
2050 GOTO 400
2180 ; CUR(22,0);
2185 END 
2220 M.=Sector
2230 A.=M./8. : IF INT(A.)-A.>0. A.=A.-1. : GOTO 2230
2240 M=A. : M1=(A-(M*8))*32
2250 ; CUR(21,0) SPACE$(Wid) : ; CUR(21,0) 'Byte 1:' M '  Byte 2:' M1
2260 GOTO 1000
2270 IF F>3 F=F-1 ELSE RETURN 
2280 IF F=9 D=D-16 ELSE D=D-40
2290 RETURN 
2300 IF F=Fmax-1 AND G>15 RETURN 
2310 IF F<Fmax F=F+1 ELSE RETURN 
2320 D=D+Wid+1 : RETURN 
2330 GOSUB 1690 : ; CUR(21,0) 'Flytta sektor'
2340 ; CUR(22,0); : INPUT 'Fr}n: 'Sector1
2380 ; CUR(22,20); : INPUT 'Till: 'Sector2
2420 FOR B3=0 TO 256 : POKE 62976+B3,PEEK(62720+B3) : NEXT B3 
2430 GOSUB 2450
2432 Err=FNRdwrsec('READ',Sector1) : IF Err THEN 2432
2434 Err=FNRdwrsec('WRITE',Sector2) : IF Err THEN 2432
2440 FOR B2=0 TO 256 : POKE 62720.+B2,PEEK(62976+B2) : NEXT B2 : GOTO 400
2450 GOSUB 1690 : ; CUR(21,0);
2460 ; 'ABSOLUT S[KER? (J/N)';
2470 INPUT A$ : A$=FNUpcase$(A$) : IF A$='J' RETURN ELSE ; CUR(21,0) Space(Wid) : GOTO 400
2480 ! ****** CTRL P ******
2490 GOSUB 1690 : ; CUR(22,0) 'S|kning av programsnuttar.' : ; CUR(21,0) 'Ctrl-< avbryter!'
2500 B1=PEEK(62720) : B2=23
2510 B3=-6 : B4=10
2520 ; CUR(22,27) 'Sector:' B2 ' ';
2530 IF B2=1231 ; 'Ok!' : GOTO 400
2540 IF INP(56.)=127 ; 'Ok!' : GOTO 400
2545 B2=B2+1
2547 Err=FNRdwrsec('READ',B2) : IF Err THEN 2547
2550 IF PEEK(62720)<>B1 THEN 2520
2560 IF B3<=29 B3=B3+6 ELSE B4=B4+1 : B3=0
2570 IF PEEK(62721)=0 AND PEEK(62722)=0 A$='*' ELSE A$=' '
2580 ; CUR(B4,B3) B2 A$ : GOTO 2550
2590 ! save   SD10
5000 DEF FNDosver LOCAL Vers,Sep$=21
5010   Vers=FNDosvers
5020   IF Vers=0 THEN Sep$=FNSepold$
5030   IF Vers=1 THEN Sep$=FNSepmell$
5040   IF Vers>=2 THEN Sep$=FNSepsup$
5050   IF Sep$='ABC 6-1x' THEN RETURN 1
5060   IF Sep$='8"/800' THEN RETURN 2
5070   IF Sep$='ABC 6-2x' THEN RETURN 3
5080   IF Sep$='ABC 6-3x' THEN RETURN 4
5090   IF Sep$='UFD-DOS' THEN RETURN 5
5100   IF Sep$='ABC-NET' THEN RETURN 6
5110   IF Sep$='ABC 6-1x eller 8"/800' THEN RETURN 99
5120   RETURN 0
5130 FNEND 
5140 DEF FNDosvers
5150   IF PEEK(24678)<>195 THEN RETURN 0 ! old 5" DOS
5160   IF PEEK2(PEEK2(24681)+2)<>ASCII("R")*256+ASCII("D") THEN RETURN 1
5170   RETURN PEEK(24687)
5180 FNEND 
5190 DEF FNSepold$ LOCAL F8,F5,C$=3
5200   C$=CHR$(211,2,201)
5210   Q7=CALL(VARPTR(C$))
5220   OUT 1,44
5230   IF INP(1)=125 THEN F8=T ELSE F8=F
5240   OUT 1,45
5250   IF INP(1)=125 THEN F5=T ELSE F5=F
5260   Q7=INP(7)
5270   IF F8=F5 THEN RETURN 'ABC 6-1x eller 8"/800'
5280   IF F8 THEN RETURN '8"/800'
5290   RETURN 'ABC 6-1x'
5300 FNEND 
5310 DEF FNSepmell$
5320   IF PEEK(PEEK2(24682))=8 THEN RETURN 'ABC 6-3x'
5330   IF PEEK(PEEK2(24682))=16 THEN RETURN 'ABC 6-2x'
5340   RETURN 'ok{nt'
5350 FNEND 
5360 DEF FNSepsup$ LOCAL Typ
5370   Typ=PEEK(24688)
5380   IF Typ=0 THEN RETURN 'UFD-DOS'
5390   IF Typ=4 THEN RETURN 'ABC-NET'
5400   RETURN 'UFD-DOS ver. '+NUM$(Vers)
5410 FNEND 
6000 ! Output Selcod,Clusi
6010 DEF FNCluster(Drive$) LOCAL Err
6030   Dev$=Drive$
6040   Table=PEEK2(24683)
6050   DIM Dev$=4
6070   Err=FNDesc
6080   RETURN Err
6090 FNEND 
6100 DEF FNDesc LOCAL Idev,Entry
6105   IF Dev$='' THEN RETURN True
6110   IF LEN(Dev$)=3 THEN Dev$=Dev$+':'
6120   IF Dev$='UFD:' THEN RETURN False
6130   Idev=ASCII(Dev$)+SWAP%(ASCII(RIGHT$(Dev$,2)))
6140   IF Dev$='RAM:' THEN Idev=ASCII('R')+SWAP%(ASCII('M'))
6150   Entry=0
6160   WHILE Entry<32
6170     IF PEEK2(Table+Entry+2)=Idev THEN GOTO 6210
6180     Entry=Entry+4
6190   WEND 
6200   RETURN True
6210   IF Scan IF Entry=PEEK(Table) AND 16+8+4 THEN RETURN T ! Don't show DR again if Scan 
6220   IF Entry=0 THEN Entry=PEEK(Table) AND 16+8+4
6230   Selcod=Entry
6240   IF Dev$<>'RAM:' THEN Selcod=Selcod OR VAL(MID$(Dev$,3,1))
6250   IF Dev$='RAM:' THEN Selcod=Selcod OR 1
6260   Clusi=2^(PEEK(Table+Entry+1) AND 7)
6270   Dirbeg=16
6280   RETURN False
6290 FNEND 
7000 DEF FNSectordd88(Sector,Clusi)=Sector/Clusi*32+(Sector AND (Clusi-1)) 
7100 DEF FNUpcase$(Text$)
7110   IF LEN(Text$)=0 THEN RETURN ''
7120   IF ASCII(Text$)>95 AND ASCII(Text$)<127 THEN RETURN CHR$(ASCII(Text$) AND 95)+FNUpcase$(RIGHT$(Text$,2))
7130   RETURN LEFT$(Text$,1)+FNUpcase$(RIGHT$(Text$,2))
7140 FNEND 
7200 DEF FNRdwrsec(Typ$,Secnr) LOCAL Ecod
7210   POKE -767,Selcod
7211   IF Dosver=1 THEN Secnr=Secnr*32
7212   IF Dosver=2 THEN Secnr=FNSectordd88(Secnr,Clusi)
7220   IF Typ$='READ' THEN Do=CALL(24678,Secnr) ELSE Do=CALL(24675,Secnr)
7230   Ecod=PEEK(-747)
7240   IF Ecod=0 THEN RETURN False
7250   IF Ecod AND 128 THEN Q7=FNFel('Enheter ej klar',True)
7260   IF Ecod AND 16 THEN Q7=FNFel(Dev$+'Skivan d}ligt formatterad.',False)
7270   IF Ecod AND 255-16 THEN Q7=FNFel(Dev$+'Diskfel '+NUM$(Ecod),False)
7280   RETURN True
7290 FNEND 
7300 DEF FNFel(Skriv$,Kvittera)
7310   ; CHR$(7);
7320   ; CUR(23,0);SPACE$(Wid);CUR(23,0) RED Skriv$;
7330   IF Kvittera=False THEN Q7=5000 : WHILE Q7 : Q7=Q7-1 : WEND : GOTO 7390
7340   ; RED ' - Tryck <CE>';
7350   Q$=' '
7360   WHILE INSTR(1,CHR$(24,13),Q$)=0
7370     GET Q$
7380   WEND 
7390   ; CUR(23,0);SPACE$(Wid);
7400   RETURN False
7410 FNEND 
7500 DEF FNDigit$(Dig$)
7510   IF LEN(Dig$)=0 THEN Err=False : RETURN ''
7520   IF ASCII(Dig$)<48 OR ASCII(Dig$)>57 THEN Err=True : RETURN ''
7530   RETURN LEFT$(Dig$,1)+FNDigit$(RIGHT$(Dig$,2))
7540 FNEND 
8000 DEF FNDecbin{r$(Dec) LOCAL C
8010   Svaret$=''
8020   Svar$=''
8030   C=128
8040   FOR Bit=1 TO 8
8050     IF Dec AND C THEN Svar(Bit)=1 ELSE Svar(Bit)=0
8060     C=C/2
8070     Svar$=NUM$(Svar(Bit))
8080     Svaret$=Svaret$+Svar$
8090   NEXT Bit 
8100   RETURN Svaret$
8110 FNEND 
8200 DEF FNInput LOCAL Trac,Ant,Sector$=20,Sectorh$=10,Trac$=10
8220   ; CUR(21,0) SPACE$(Wid); : ; CUR(21,0); : INPUT 'Sector: 'Sector$
8240   Ant=INSTR(1,Sector$,":") : IF Ant=0 THEN Sector=VAL(Sector$) : RETURN Sector
8265   Sectorh$=FNDigit$(RIGHT$(Sector$,Ant+1)) : IF Err THEN 8220
8266   Sector=VAL(Sectorh$)
8267   Trac$=FNDigit$(LEFT$(Sector$,Ant-1)) : IF Err THEN 8220
8268   Trac=VAL(Trac$)
8280   IF Trac<0 OR Sector<0 THEN Z=FNFel('Felaktig sekorspceifikation!',True) : GOTO 8220
8300   RETURN Sector+Trac*8
8310 FNEND