1 REM Ins{nd av Mikael Lid`n <5651>    1986-06-08 12.57.21
1000 ! CREDEV   (c) LID@N DATA
1010 ! 
1020 ! - Utvecklat
1030 ! - av:  LID@N DATA
1040 ! -
1050 ! - Projekt:     Skapa egna enheter under UFD-DOS
1060 ! - Konstrukt|r: Mikael Lid`n
1070 ! - Vers:        1.0
1080 ! - P}b|rjat:    860608
1090 ! - [ndring:     860608
1100 ! 
1110 ! 
1120 INTEGER : EXTEND 
1130 ! *
1140 ! 
1150 ! L{s sektor
1160 ! 
1170 DEF FNL{ssekt(Dev,Sekt)
1180   POKE -767,Dev
1190   Z=CALL(24678,Sekt)
1200   RETURN PEEK(-747)
1210 FNEND 
1220 ! *
1230 ! 
1240 ! L{s fil ur bibsekt
1250 ! 
1260 DEF FNL{sfil(Fil,Fi$,Cluster) LOCAL F$=0,Size,Sect,Adr
1270   Adr=62720+Fil*16
1280   POKE VAROOT(F$),16,0,Adr,SWAP%(Adr),16,0
1290   Sect=PEEK(Adr)*8*Cluster+PEEK(Adr+1)/32*Cluster
1300   IF Sect=-1 RETURN 0
1310   IF Fi$=MID$(F$,5,11) RETURN Sect
1320   Size=PEEK2(Adr+2)
1330   RETURN 0
1340 FNEND 
1350 ! *
1360 ! 
1370 ! Spacebort
1380 ! 
1390 DEF FNSpbort$(In$) LOCAL A$=100,I,A
1400   I=1
1410   WHILE I<=LEN(In$)
1420     A=ASCII(RIGHT$(In$,I))
1430     IF A<>32 A$=A$+CHR$(A)
1440     I=I+1
1450   WEND 
1460   RETURN A$
1470 FNEND 
1480 ! *
1490 ! 
1500 ! Konvertera gemener till versaler
1510 ! 
1520 DEF FNKonvert$(A$) LOCAL B$=160,A,J
1530   J=1
1540   WHILE J<=LEN(A$)
1550     A=ASCII(RIGHT$(A$,J))
1560     B$=B$+CHR$(A+32*(A>95))
1570     J=J+1
1580   WEND 
1590   RETURN B$
1600 FNEND 
1610 ! *
1620 ! 
1630 ! S|k UFD
1640 ! 
1650 DEF FNUfds|k(Dev,Ufd$,Bibsect,Cluster) LOCAL I,J,A
1660   WHILE I<16
1670     Z=FNL{ssekt(Dev,I+Bibsect)
1680     J=0
1690     WHILE J<16
1700       A=FNL{sfil(J,Ufd$+'Ufd',Cluster) : IF A RETURN A
1710       J=J+1
1720     WEND 
1730     I=I+1
1740   WEND 
1750   RETURN 0
1760 FNEND 
1770 ! *
1780 ! 
1790 ! Selektkod f|r enhet
1800 ! 
1810 DEF FNDevsel(Dev$)
1820   RETURN INSTR(1,'HDMFMOSF',LEFT$(Dev$+'  ',2))/2*4+ASCII(RIGHT$(Dev$+'   ',3))-44
1830 FNEND 
1840 ! *
1850 ! 
1860 ! Klusterstorlek f|r enhet
1870 ! 
1880 DEF FNClusize(Dev)
1890   IF Dev>3 AND Dev<8 Cluster=32
1900   IF (Dev>7 AND Dev<12) OR (Dev>15 AND Dev<20) Cluster=4
1910   IF Dev>11 AND Dev<16 Cluster=1
1920   RETURN Cluster
1930 FNEND 
1940 ! *
1950 ! 
1960 ! S|k efter UFD sektor
1970 ! 
1980 DEF FNS|kufd(Dev,Cluster,Ufd$) LOCAL U$=100,A$=20,P,Bibsect,Sect
1990   U$=Ufd$ : IF U$='' RETURN 0
2000   P=INSTR(1,U$,'/')
2010   IF Dev>1 Bibsect=16 ELSE Bibsect=8
2020   WHILE P<>0
2030     A$=LEFT$(U$,P-1) : U$=RIGHT$(U$,P+1)
2040     Bibsect=FNUfds|k(Dev,A$+SPACE$(8-LEN(A$)),Bibsect,Cluster)
2050     IF Bibsect=0 RETURN 0
2060     Bibsect=Bibsect+2
2070     P=INSTR(1,U$,'/')
2080   WEND 
2090   Sect=FNUfds|k(Dev,U$+SPACE$(8-LEN(U$)),Bibsect,Cluster) : IF Sect=0 RETURN 0
2100   Sect=Sect+2
2110   RETURN Sect
2120 FNEND 
2130 ! *
2140 ! 
2150 ! L{nka in egen enhet
2160 ! 
2170 DEF FNDev(A,D$,Ufdoffset,Ufdselect,Selcode)
2180   POKE A,PEEK(65403),PEEK(65404)
2190   POKE A+2,ASCII(D$),ASCII(RIGHT$(D$,2)),ASCII(RIGHT$(D$,3))
2200   POKE A+5,Drivrut,SWAP%(Drivrut),Selcode
2210   POKE A+8,Ufdoffset,SWAP%(Ufdoffset),Ufdselect
2220   POKE 65403,A,SWAP%(A)
2230   RETURN 0
2240 FNEND 
2250 ! *
2260 ! 
2270 ! Drivrutin f|r egna device
2280 ! 
2290 DEF FNDrivrut(A) LOCAL B,Ufd
2300   B=PEEK2(65403)
2310   WHILE CHR$(PEEK(B+2),PEEK(B+3),PEEK(B+4))<>'UFD'
2320     B=PEEK2(B)
2330     IF B=0 RETURN -1
2340   WEND 
2350   Ufd=PEEK2(B+5)
2360   Drivrut=A
2370   POKE A,205,A+6,SWAP%(A+6),205,Ufd,SWAP%(Ufd)
2380   POKE A+6,229,213,197,245,221,110,4,221,102,5,17,247,255,6,3
2390   POKE A+21,35,35,35,26,78,119,235,113,35,19,16,247,241,193,209,225
2400   POKE A+37,201
2410   RETURN 0
2420 FNEND 
2430 ! *
2440 ! 
2450 ! L{nka in egen enhet
2460 ! 
2470 DEF FNUdevin(Ant) LOCAL A,J
2480   A=PEEK2(65302)-39-11*Ant : POKE 65302,A,SWAP%(A) : POKE 65294,A-630,SWAP%(A-630)
2490   Z=FNDrivrut(A+1) : A=A+39
2500   WHILE J<Ant
2510     IF FNUfddev(A,Dev$(J),Ufd$(J)) RETURN E9
2520     J=J+1 : A=A+11
2530   WEND 
2540   RETURN 0
2550 FNEND 
2560 ! *
2570 ! 
2580 ! L{nka in egen UFD enhet
2590 ! 
2600 DEF FNUfddev(Adr,Dev$,Ufd$) LOCAL D$=100,A,D,Sect,Selcode
2610   A=INSTR(1,Ufd$,':') : IF A=0 E9=21 : RETURN E9
2620   D$=LEFT$(Ufd$,A-1)
2630   D=FNDevsel(D$)
2640   Sect=FNS|kufd(D,FNClusize(D),RIGHT$(Ufd$,A+1))
2650   IF Sect=0 Selcode=D ELSE Selcode=30
2660   Z=FNDev(Adr,Dev$+'   ',Sect,D,Selcode)
2670   RETURN 0
2680 FNEND 
2690 ! *
2700 ! 
2710 ! Huvudprogram
2720 ! 
2730 ; : ; 
2740 ; 'System 800  Create UFD-DOS device''s    vers 1.0  (c) LID@N DATA'
2750 ; 
2760 WHILE -1
2770   INPUT 'Device name:  'D$
2780   WHILE D$=''
2790     Z=FNUdevin(A)
2800     ; : ; 
2810     END 
2820   WEND 
2830   B=INSTR(1,D$,':') : IF B>0 D$=LEFT$(D$,B-1)
2840   INPUT 'UFD           'U$
2850   Dev$(A)=FNKonvert$(FNSpbort$(D$))
2860   Ufd$(A)=FNKonvert$(FNSpbort$(U$))
2870   A=A+1
2880 WEND 
2900 CHAIN 'nul:'