10 ! Program CPMWrite
20 INTEGER : EXTEND : OPTION BASE 0
30 DIM Ori$=4,Dest$=4,Dummy$=1
40 True=-1 : False=0
50 ! 
60 Ori$="MF0:" : Dest$="MF1:"
70 ! 
80 ! Ver-/-Datum----/-Kommentar-----------------------------------------
90 ! 1.00 1989-12-29 <6057> Jan-Olof Svensson
92 ! 1.02 1990-02-26 <6057> Fel vid skrivning av ny katalogpost r{ttade.
93 ! .                      FNUpcase$ tillkommer.
98 ! 1.06 1990-09-01 <6057> FNUpcase$,FNDisplaydir$,FNClearline$,
99 ! .                      FNAddext$: nya versioner.
500 ! 
510 ; CHR$(12) "CPMWrite"
520 ; 
530 Dummy$=FNInit$+FNInform$
540 ; "Kopiering fr}n ABC-format i " Ori$ " till "; : IF Wid=40 THEN ; 
550 ; "CP/M 3.0 i " Dest$
560 ; 
570 ; "S{tt i CP/M-skivan i " Dest$ " och tryck "; : IF Wid=40 THEN ; 
580 ; "<RETURN>"
590 WHILE SYS(5)<>0 : GET Dummy$ : WEND 
600 GET Dummy$
610 ; "Katalogen l{ses in"
620 Dummy$=FNReaddir$
630 ! 
640 WHILE NOT Quit
650   Dummy$=FNMenu$
660   ON Choice GOTO 670,690,710,730,750,770,790
670   Dummy$=FNCopyfile$
680   GOTO 780
690   Dummy$=FNCpmdir$
700   GOTO 780
710   Dummy$=FNShowsector$
720   GOTO 780
730   Dummy$=FNShowreserved$
740   GOTO 780
750   Dummy$=FNErasefile$
760   GOTO 780
770   Dummy$=FNRenamefile$
780 WEND 
790 ; CHR$(12);
800 END 
810 ! 
820 DEF FNWherex=PEEK(65362) 
830 ! 
840 DEF FNWherey=PEEK(65363) 
850 ! 
860 DEF FNOdd(X)=(MOD(X,2)=1) 
870 ! 
880 DEF FNMax.(A.,B.)=(A.+B.+ABS(A.-B.))/2. 
890 ! 
900 DEF FNMin.(A.,B.)=(A.+B.-ABS(A.-B.))/2. 
910 ! 
920 DEF FNDevnumber(D$) LOCAL Devs$=93
930   Devs$='DR0DR1DR2DR3HD0HD1HD2HD3MF0MF1MF2MF3MO0MO1MO2MO3SF0SF1SF2SF3SO0SO1SO2SO3'+SPACE$(5*3)+'RAMUFD'
940   RETURN (INSTR(1,Devs$,LEFT$(D$,3))-1)/3
950 FNEND 
960 ! 
970 DEF FNInit$
980   Dirstart=32 : Dirlen=16 : Maxsec=2559
990   DIM Reserved$=157,Newclusters$=16,Cpmbuf$=0
1000   DIM Dir$(Dirlen-1)=256,Sort$(Dirlen*8-1)=15
1010   DIM Workline$=256,Abcbuf$=253,Filename$=16,Nameindir$=11
1020   POKE VAROOT(Cpmbuf$),0,1,0,245,0,1
1030   Ori=FNDevnumber(Ori$)
1040   Dest=FNDevnumber(Dest$)
1050   IF Ori<0 OR Dest<0 OR Ori=Dest THEN ; "Felaktigt enhetsnamn!" : STOP 
1060   Abc=800 : IF PEEK(39)=4 THEN Abc=806 ELSE IF PEEK(39)=3 THEN Abc=802
1070   Wid=PEEK(65364)
1080   RETURN ""
1090 FNEND 
1100 ! 
1110 DEF FNClearline$
1120   ; CHR$(13) SPACE$(Wid) CHR$(13);
1130   RETURN ""
1140 FNEND 
1150 ! 
1160 DEF FNUpcase$(Ch$)
1170   IF Ch$>="`" AND Ch$<="~" THEN RETURN CHR$(ASCII(Ch$) AND 223)
1180   RETURN Ch$
1190 FNEND 
1200 ! 
1210 DEF FNCaps$(Txt$) LOCAL Newtxt$=160,Pos
1220   Newtxt$="" : Pos=1
1230   WHILE Pos<=LEN(Txt$)
1240     Newtxt$=Newtxt$+FNUpcase$(MID$(Txt$,Pos,1))
1250     Pos=Pos+1
1260   WEND 
1270   RETURN Newtxt$
1280 FNEND 
1290 ! 
1300 DEF FNInform$ LOCAL Txt$=160,Info$=16,Answer$=1,Pf1$=1,Ln,Eof,Quit
1310   ; "Vill du ha information? (J/N)  N" CHR$(8);
1320   GET Answer$
1330   IF FNUpcase$(Answer$)<>"J" THEN RETURN FNClearline$
1340   ; CHR$(12) "CPMWrite"
1350   ; STRING$(Wid-1,45)
1360   ; 
1370   Info$="CPMWRITE.INF"
1380   Pf1$=CHR$(192) : Ln=3 : Eof=False : Quit=False
1390   ON ERROR GOTO 1530
1400   OPEN Info$ AS FILE 1
1410   WHILE NOT (Eof OR Quit)
1420     INPUT LINE #1,Txt$
1430     ; LEFT$(Txt$,LEN(Txt$)-2)
1440     Ln=Ln+1
1450     IF Ln>=22 THEN ; "Tryck <RETURN> "; : GET Answer$ : Ln=0 : Dummy$=FNClearline$
1460     IF Answer$=Pf1$ THEN Quit=True
1470   WEND 
1480   CLOSE 
1490   ; : ; " Starta ";
1500   WHILE SYS(5)<>0 : GET Dummy$ : WEND 
1510   GET Dummy$ : ; CHR$(12);
1520   RETURN ""
1530   ON INSTR(1,CHR$(21,34),CHR$(ERRCODE))+1 GOTO 1540,1550,1560
1540   ; "Fel nr" ERRCODE : RESUME 1480
1550   ; "Hittar ej filen " Info$ : RESUME 1480
1560   Eof=True : RESUME 1470
1570 FNEND 
1580 ! 
1590 DEF FNReadsec(Drive,Sec) LOCAL D
1600   POKE SYS(10)-511,Drive
1610   D=CALL(24678,Sec)
1620   RETURN (PEEK(SYS(10)-491)<>0)
1630 FNEND 
1640 ! 
1650 DEF FNWritesec(Drive,Sec) LOCAL D
1660   POKE SYS(10)-511,Drive
1670   D=CALL(24675,Sec)
1680   RETURN (PEEK(SYS(10)-491)<>0)
1690 FNEND 
1700 ! 
1710 DEF FNDiscerror$ LOCAL Txt$=20,I,Code
1720   RESTORE 1790
1730   WHILE I<4
1740     READ Code,Txt$
1750     IF (PEEK(SYS(10)-491) AND Code)=Code THEN RETURN Txt$
1760     I=I+1
1770   WEND 
1780   RETURN 'Ok{nd typ av diskfel!'
1790   DATA 8,'Checksummafel!'
1800   DATA 16,'D}lig disk!'
1810   DATA 64,'Skivan skrivskyddad!'
1820   DATA 128,'Luckan |ppen!'
1830 FNEND 
1840 ! 
1850 DEF FNRes$(Char$) LOCAL Pos,Found
1860   Pos=LEN(Reserved$) : Found=False
1870   WHILE NOT (Pos=0 OR Found)
1880     IF Char$<MID$(Reserved$,Pos,1) THEN Pos=Pos-1 ELSE Found=True
1890   WEND 
1900   Reserved$=LEFT$(Reserved$,Pos)+Char$+RIGHT$(Reserved$,Pos+1)
1910   RETURN ""
1920 FNEND 
1930 ! 
1940 DEF FNUnres$(Index,Pos) LOCAL Era
1950   WHILE INSTR(1,CHR$(0,229),MID$(Dir$(Index),Pos,1))=0
1960     Era=INSTR(1,Reserved$,MID$(Dir$(Index),Pos,1))
1970     Reserved$=LEFT$(Reserved$,Era-1)+RIGHT$(Reserved$,Era+1)
1980     Pos=Pos+1
1990   WEND 
2000   RETURN ""
2010 FNEND 
2020 ! 
2030 DEF FNClearentry$(Index,Pos)
2040   MID$(Dir$(Index),Pos,1)=CHR$(229)
2050   Cpmbuf$=Dir$(Index) : Sector=Dirstart+Index
2060   Errflag=FNWritesec(Dest,Sector)
2070   IF Errflag THEN ; : ; FNDiscerror$ : STOP 
2080   RETURN FNUnres$(Index,Pos+16)
2090 FNEND 
2100 ! 
2110 DEF FNCheckcluster$(Index) LOCAL Entry,Pos
2120   Entry=0
2130   WHILE Entry<8
2140     IF INSTR(1,CHR$(33,229),MID$(Dir$(Index),Entry*32+1,1))>0 THEN 2200
2150     Pos=17
2160     WHILE Pos<=32
2170       IF INSTR(1,CHR$(0,229),MID$(Dir$(Index),Entry*32+Pos,1))=0 THEN Dummy$=FNRes$(MID$(Dir$(Index),Entry*32+Pos,1))
2180       Pos=Pos+1
2190     WEND 
2200     Entry=Entry+1
2210   WEND 
2220   RETURN ""
2230 FNEND 
2240 ! 
2250 DEF FNReaddir$
2260   Sector=Dirstart : Index=0
2270   WHILE Index<Dirlen
2280     Errflag=FNReadsec(Dest,Sector)
2290     IF Errflag THEN ; : ; FNDiscerror$ : STOP 
2300     Dir$(Index)=Cpmbuf$
2310     Dummy$=FNCheckcluster$(Index)
2320     Sector=Sector+1 : Index=Index+1
2330   WEND 
2340   RETURN ""
2350 FNEND 
2360 ! 
2370 DEF FNMenu$ LOCAL Txt$=40,N,X
2380   ON ERROR GOTO 2520
2390   IF Wid=80 THEN X=10 ELSE X=6
2400   ; CHR$(12);
2410   ; CUR(0,X) "CPMWrite"
2420   ; STRING$(Wid-1,45)
2430   Txt$="" : N=0 : RESTORE 2530
2440   WHILE NOT LEFT$(Txt$+SPACE$(7),7)="Avsluta"
2450     N=N+1 : READ Txt$
2460     ; CUR(7+N,X) NUM$(N) "  " Txt$
2470   WEND 
2480   ; CUR(7+N+2,X); : INPUT Choice
2490   IF Choice<1 OR Choice>N THEN 2400
2500   Quit=(Choice=N)
2510   RETURN ""
2520   RESUME 2380 ! Inmatningsfel
2530   DATA "Kopiera textfil"
2540   DATA "Inneh}ll, CP/M-diskett"
2550   DATA "Titta p} CP/M-sektor"
2560   DATA "Vilka filsegment {r upptagna?"
2570   DATA "Radera CP/M-fil"
2580   DATA "D|pa om CP/M-fil"
2590   DATA "Avsluta / Byta CP/M-diskett"
2600 FNEND 
2610 ! 
2620 DEF FNAddext$(Filename$,Ext$) LOCAL Cpos
2630   IF Filename$="" THEN RETURN ""
2640   IF INSTR(1,Filename$,".")>0 THEN RETURN Filename$
2650   Cpos=INSTR(1,Filename$,":")
2660   IF Cpos>0 THEN IF Filename$="CAS:" OR INSTR(1," MEM: PR: V24: CON: NUL:"," "+LEFT$(Filename$,Cpos))>0 THEN RETURN Filename$
2670   IF ASCII(Ext$)=46 THEN RETURN Filename$+Ext$
2680   RETURN Filename$+"."+Ext$
2690 FNEND 
2700 ! 
2710 DEF FNRespell$(Filename$) LOCAL Tmp$=12,Pos,Diacritic
2720   Pos=1 : Tmp$=Filename$
2730   WHILE Pos<=LEN(Tmp$)
2740     Diacritic=INSTR(1,"][\}{|",MID$(Tmp$,Pos,1))
2750     IF Diacritic>0 THEN MID$(Tmp$,Pos,1)=MID$("AAOaao",Diacritic,1)
2760     Pos=Pos+1
2770   WEND 
2780   RETURN Tmp$
2790 FNEND 
2800 ! 
2810 DEF FNNameok(Msg) LOCAL Newname$=12,Wait
2820   Filename$=FNCaps$(Filename$)
2830   Filename$=FNAddext$(Filename$,".TXT")
2840   IF INSTR(1,Filename$,":")>0 THEN ; "Hittar ej filen " Ori$ Filename$ : Filename$="" : RETURN False
2850   Newname$=FNRespell$(Filename$)
2860   IF Newname$=Filename$ THEN 2880
2870   IF Msg THEN ; "CP/M godtar inte ],[ och \ i filnamn." : ; "Namnet {ndras d{rf|r till " Newname$ : WHILE Wait<1500 : Wait=Wait+1 : WEND 
2880   Nameindir$=LEFT$(Newname$,INSTR(1,Newname$,".")-1)
2890   Nameindir$=Nameindir$+SPACE$(8-LEN(Nameindir$))+RIGHT$(Newname$,INSTR(1,Newname$,".")+1)
2900   Nameindir$=Nameindir$+SPACE$(11-LEN(Nameindir$))
2910   RETURN True
2920 FNEND 
2930 ! 
2940 DEF FNUsed LOCAL Found
2950   Index=0 : Found=False
2960   WHILE Index<Dirlen AND NOT Found
2970     IF INSTR(1,Dir$(Index),CHR$(0)+Nameindir$)=0 THEN Index=Index+1 ELSE Found=True
2980   WEND 
2990   RETURN Found
3000 FNEND 
3010 ! 
3020 DEF FNCheckname$(Msg) LOCAL Answer$=1,Search
3030   IF NOT FNNameok(Msg) THEN RETURN ""
3040   IF NOT FNUsed THEN RETURN ""
3050   ; 
3060   ; "Filen finns redan!"
3070   INPUT "Skall den ers{ttas? (J/N)  "Answer$
3080   ; 
3090   IF FNUpcase$(Answer$)="N" THEN Filename$="" : RETURN ""
3100   IF FNUpcase$(Answer$)<>"J" THEN 3070
3110   WHILE Index<Dirlen
3120     Search=INSTR(1,Dir$(Index),CHR$(0)+Nameindir$)
3130     IF Search=0 THEN Index=Index+1 : GOTO 3150
3140     Dummy$=FNClearentry$(Index,Search)
3150   WEND 
3160   RETURN ""
3170 FNEND 
3180 ! 
3190 DEF FNNewsize$(Filesize) LOCAL Byte1,Byte2,Byte3
3200   Byte3=INT(Filesize/4225.)
3210   Byte2=INT((Filesize-(Byte3*4096)-1)/128.)
3220   Byte1=Filesize-(Byte3*4096+Byte2*128)
3230   RETURN CHR$(Byte2,0,Byte3,Byte1)
3240 FNEND 
3250 ! 
3260 DEF FNWritedir$ LOCAL Newentry$=32,Sector,Found
3270   Sector=Dirstart : Index=0 : Found=False
3280   WHILE Index<Dirlen AND NOT Found
3290     Entry=0
3300     WHILE Entry<8 AND NOT Found
3310       IF ASCII(RIGHT$(Dir$(Index),Entry*32+1))=229 THEN Found=True ELSE Entry=Entry+1
3320     WEND 
3330     IF NOT Found THEN Index=Index+1
3340   WEND 
3350   IF NOT Found THEN ; "Filen f}r inte plats!" : STOP 
3360   ! 
3370   Newentry$=CHR$(0)+Nameindir$+FNNewsize$(Filesize)+Newclusters$
3380   Newentry$=Newentry$+STRING$(32-LEN(Newentry$),0)
3390   MID$(Dir$(Index),Entry*32+1,32)=Newentry$
3400   ! 
3410   WHILE LEN(Newclusters$)>0
3420     Dummy$=FNRes$(LEFT$(Newclusters$,1))
3430     Newclusters$=RIGHT$(Newclusters$,2)
3440   WEND 
3450   ! 
3460   Cpmbuf$=Dir$(Index)
3470   Sector=Sector+Index
3480   Errflag=FNWritesec(Dest,Sector)
3490   IF Errflag THEN ; : ; FNDiscerror$ : STOP 
3500   RETURN ""
3510 FNEND 
3520 ! 
3530 DEF FNNextsector
3540   WHILE INSTR(1,Reserved$,CHR$(Cluster))>0
3550     Cluster=Cluster+1
3560   WEND 
3570   IF Eof AND Workline$="" THEN 3610
3580   IF Cluster>PEEK2(VAROOT(Reserved$)) THEN ; "Filen f}r inte plats!" : STOP 
3590   IF LEN(Newclusters$)=PEEK2(VAROOT(Newclusters$)) THEN Dummy$=FNWritedir$
3600   Newclusters$=Newclusters$+CHR$(Cluster)
3610   RETURN Cluster*16+32
3620 FNEND 
3630 ! 
3640 DEF FNReadfile$
3650   ON ERROR GOTO 3680
3660   INPUT LINE #1,Abcbuf$
3670   RETURN ""
3680   IF ERRCODE=34 THEN Eof=True : Abcbuf$=CHR$(26) : RESUME 3670 ELSE ; "Fel nr" ERRCODE : STOP 
3690 FNEND 
3700 ! 
3710 DEF FNWritefile$ LOCAL Pos
3720   IF LEN(Workline$)+LEN(Abcbuf$)>256 THEN Pos=256-LEN(Workline$) : Workline$=Workline$+LEFT$(Abcbuf$,Pos) : Abcbuf$=RIGHT$(Abcbuf$,Pos+1)
3730   IF LEN(Workline$)<=128 THEN Filesize=Filesize+1 ELSE Filesize=Filesize+2
3740   IF LEN(Workline$)<128 THEN Workline$=Workline$+STRING$(128-LEN(Workline$),26) ELSE Workline$=Workline$+STRING$(256-LEN(Workline$),26)
3750   Cpmbuf$=Workline$+STRING$(256-LEN(Workline$),0)
3760   Errflag=FNWritesec(Dest,Sector)
3770   IF Errflag THEN ; : ; FNDiscerror$ : STOP 
3780   Workline$=Abcbuf$ : Sector=Sector+1
3790   RETURN ""
3800 FNEND 
3810 ! 
3820 DEF FNCopyfile$ LOCAL Old,Ready
3830   Ready=False
3840   ; CHR$(12);
3850   WHILE NOT Ready
3860     INPUT "Filnamn: "Filename$
3870     Ready=(Filename$="")
3880     IF NOT Ready THEN Dummy$=FNCheckname$(True)
3890     WHILE NOT (Filename$="")
3900       ON ERROR GOTO 4070
3910       Workline$="" : Newclusters$="" : Cluster=1 : Eof=False
3920       Sector=FNNextsector : Old=Sector
3930       Filesize=0
3940       OPEN Ori$+Filename$ AS FILE 1
3950       WHILE NOT Eof
3960         Dummy$=FNReadfile$
3970         IF LEN(Workline$)+LEN(Abcbuf$)>256 THEN Dummy$=FNWritefile$ ELSE Workline$=Workline$+Abcbuf$
3980         IF Sector=Old+16 THEN Cluster=Cluster+1 : Sector=FNNextsector : Old=Sector
3990       WEND 
4000       IF LEN(Workline$)>0 THEN Dummy$=FNWritefile$
4010       IF LEN(Newclusters$)>0 THEN Dummy$=FNWritedir$
4020       CLOSE 
4030       Filename$=""
4040     WEND 
4050   WEND 
4060   RETURN ""
4070   IF ERRCODE=21 THEN ; "Hittar ej filen " Filename$ ELSE ; "Fel nr" ERRCODE
4080   RESUME 4030
4090 FNEND 
4100 ! 
4110 DEF FNOldsize(Code$) LOCAL Byte1,Byte2,Byte3
4120   Byte2=ASCII(Code$)
4130   Byte3=ASCII(RIGHT$(Code$,3))
4140   Byte1=ASCII(RIGHT$(Code$,4))
4150   RETURN Byte3*4096+Byte2*128+Byte1
4160 FNEND 
4170 ! 
4180 DEF FNQuicksort(Index) LOCAL R,L,M,H,I,J,K,End,T$=15,A$=15
4190   R=Index-1 : L=0 : M=10
4200   IF (R-L)>M THEN K=0 ELSE 4840
4210   I=L+1
4220   J=(L+R)/2
4230   T$=Sort$(J)
4240   Sort$(J)=Sort$(I)
4250   Sort$(I)=T$
4260   J=R
4270   WHILE Sort$(L)>Sort$(I)
4280     T$=Sort$(L)
4290     Sort$(L)=Sort$(I)
4300     Sort$(I)=T$
4310   IF End WEND 
4320   WHILE Sort$(I)>Sort$(R)
4330     T$=Sort$(R)
4340     Sort$(R)=Sort$(I)
4350     Sort$(I)=T$
4360   IF End WEND 
4370   WHILE Sort$(L)>Sort$(I)
4380     T$=Sort$(L)
4390     Sort$(L)=Sort$(I)
4400     Sort$(I)=T$
4410   IF End WEND 
4420   I=I+1 : IF I>(Index-1) THEN 4440
4430   IF T$>Sort$(I) THEN 4420
4440   J=J-1 : IF J<0 THEN 4460
4450   IF T$<Sort$(J) THEN 4440
4460   WHILE J>I
4470     A$=Sort$(I)
4480     Sort$(I)=Sort$(J)
4490     Sort$(J)=A$
4500     GOTO 4420
4510   IF End WEND 
4520   Sort$(L+1)=Sort$(J)
4530   Sort$(J)=T$
4540   H=R-J
4550   I=J-L
4560   WHILE H>=I AND I>M
4570     K=K+1
4580     L(K)=J+1
4590     R(K)=R
4600     R=J-1
4610     GOTO 4210
4620   IF End WEND 
4630   WHILE I>H AND H>M
4640     K=K+1
4650     L(K)=L
4660     R(K)=J-1
4670     L=J+1
4680     GOTO 4210
4690   IF End WEND 
4700   WHILE I>M AND H<=M
4710     R=J-1
4720     GOTO 4210
4730   IF End WEND 
4740   WHILE H>M AND I<=M
4750     L=J+1
4760     GOTO 4210
4770   IF End WEND 
4780   WHILE K
4790     L=L(K)
4800     R=R(K)
4810     K=K-1
4820     GOTO 4210
4830   IF End WEND 
4840   FOR I1=1 TO Index-1
4850     T$=Sort$(I1)
4860     FOR J1=I1-1 TO 0 STEP -1 : IF T$<Sort$(J1) THEN Sort$(J1+1)=Sort$(J1) : NEXT J1 
4870   Sort$(J1+1)=T$ : NEXT I1 
4880   RETURN 0
4890 FNEND 
4900 ! 
4910 DEF FNSize256(Filesize)
4920   IF FNOdd(Filesize) THEN RETURN (Filesize+1)/2
4930   RETURN Filesize/2
4940 FNEND 
4950 ! 
4960 DEF FNDisplaydir$(N) LOCAL Allowed,Index,More
4970   ; CHR$(12) "Filnamn och l{ngd i 256-bytes-sektorer"
4980   ; STRING$(Wid-1,45)
4990   Index=0
5000   WHILE Index<N
5010     More=True
5020     Filesize=CVT$%(MID$(Sort$(Index),12,2))
5030     WHILE (Index<N-1) AND More
5040       More=(LEFT$(Sort$(Index),11)=LEFT$(Sort$(Index+1),11))
5050       IF More THEN Filesize=FNMax.(Filesize,CVT$%(MID$(Sort$(Index+1),12,2))) : Index=Index+1
5060     WEND 
5070     ; LEFT$(Sort$(Index),8) "." MID$(Sort$(Index),9,3);
5080     ; USING "#####"+" : " FNSize256(Filesize);
5090     IF FNWherex>Wid-18 THEN ; 
5100     IF FNWherey>=19 THEN ; : ; "Mera"; : GET Dummy$ : ; CHR$(12);
5110     Index=Index+1
5120   WEND 
5130   ; : ; 
5140   Allowed=PEEK2(VAROOT(Reserved$))
5150   ; "]terst}r" Allowed-LEN(Reserved$) "filsegment "; : IF Wid=40 THEN ; 
5160   ; "(" NUM$((Allowed-LEN(Reserved$))*16) " sektorer av " NUM$(Allowed*16) ")"
5170   ; 
5180   WHILE SYS(5)<>0 : GET Dummy$ : WEND 
5190   ; "Menyn"; : GET Dummy$
5200   RETURN ""
5210 FNEND 
5220 ! 
5230 DEF FNCpmdir$ LOCAL Entry,Index,N,Found,Dummy
5240   ; CHR$(12) "Katalogen sorteras i bokstavsordning. "; : IF Wid=40 THEN ; 
5250   ; "Filer med flera katalogposter r{knas "; : IF Wid=40 THEN ; 
5260   ; "ihop."
5270   Index=0 : N=0
5280   WHILE Index<Dirlen
5290     Entry=0
5300     WHILE Entry<8
5310       IF NOT (MID$(Dir$(Index),Entry*32+1,1)=CHR$(0)) THEN 5350
5320       Filesize=FNOldsize(MID$(Dir$(Index),Entry*32+13,4))
5330       Sort$(N)=MID$(Dir$(Index),Entry*32+2,11)+CVT%$(Filesize)
5340       N=N+1
5350       Entry=Entry+1
5360     WEND 
5370     Index=Index+1
5380   WEND 
5390   Dummy=FNQuicksort(N) ! N|dv{ndig f|r sammanst{llningen av filer
5400   RETURN FNDisplaydir$(N)
5410 FNEND 
5420 ! 
5430 DEF FNInv806$
5440   RETURN NWBG+CHR$(128 OR (INP(53) AND 56)/8)
5450 FNEND 
5460 ! 
5470 DEF FNInv$(T$) LOCAL I
5480   IF Abc=806 THEN ; FNInv806$ T$ FNInv806$; : RETURN ""
5490   IF Abc=800 THEN ; " " T$ " "; : RETURN ""
5500   I=1 : WHILE I<=LEN(T$)
5510     PUT CHR$(ASCII(MID$(T$,I,1)) OR 128)
5520   I=I+1 : WEND 
5530   RETURN ""
5540 FNEND 
5550 ! 
5560 DEF FNShowsector$ LOCAL Answer$=1,Code,Pos,Quit
5570   ON ERROR GOTO 5780
5580   INPUT "Sektor nr (0-"+NUM$(Maxsec)+") "Sector
5590   ; CHR$(12);
5600   WHILE Sector>=0 AND Sector<=Maxsec AND NOT Quit
5610     ; "Sektor " Sector
5620     Errflag=FNReadsec(Dest,Sector)
5630     IF Errflag THEN ; : ; FNDiscerror$ : STOP 
5640     Pos=1
5650     WHILE Pos<=LEN(Cpmbuf$)
5660       Code=ASCII(RIGHT$(Cpmbuf$,Pos))
5670       IF (Code>32 AND Code<127) THEN ; CHR$(Code); ELSE Dummy$=FNInv$("#"+NUM$(Code))
5680       IF FNWherex>Wid-5 THEN ; 
5690       IF Wid=40 THEN IF Pos=128 THEN ; : ; "Tryck <RETURN> "; : GET Dummy$ : ; 
5700       Pos=Pos+1
5710     WEND 
5720     ; 
5730     ; "N{sta? (J/N)  J" CHR$(8); : GET Answer$
5740     IF FNUpcase$(Answer$)="N" THEN Quit=True ELSE Sector=Sector+1
5750     Dummy$=FNClearline$
5760   WEND 
5770   RETURN ""
5780   RESUME 5770
5790 FNEND 
5800 ! 
5810 DEF FNShowreserved$ LOCAL Pos
5820   Pos=1
5830   ; CHR$(12);
5840   IF Reserved$="" THEN ; "Disketten {r tom." ELSE ; "F|ljande filsegment {r upptagna: "
5850   WHILE Pos<=LEN(Reserved$)
5860     ; USING "####" ASCII(RIGHT$(Reserved$,Pos));
5870     IF FNWherex>Wid-5 THEN ; 
5880     Pos=Pos+1
5890   WEND 
5900   ; : ; 
5910   WHILE SYS(5)<>0 : GET Dummy$ : WEND 
5920   ; "Menyn"; : GET Dummy$
5930   RETURN ""
5940 FNEND 
5950 ! 
5960 DEF FNErasefile$ LOCAL Answer$=1,Search
5970   Sector=Dirstart
5980   ; "Vilken fil skall" FLSH FNInv$("RADERAS") STDY " ?  ";
5990   INPUT ""Filename$
6000   IF Filename$="" THEN RETURN ""
6010   IF NOT FNNameok(False) THEN 5970
6020   IF NOT FNUsed THEN ; "Hittar ej filen!" : GOTO 5970
6030   INPUT "Absolut s{ker? (J/N) "Answer$
6040   IF FNUpcase$(Answer$)="N" THEN Filename$="" : RETURN ""
6050   IF FNUpcase$(Answer$)<>"J" THEN 6030
6060   WHILE Index<Dirlen
6070     Search=INSTR(1,Dir$(Index),CHR$(0)+Nameindir$)
6080     IF Search=0 THEN Index=Index+1 : GOTO 6100
6090     Dummy$=FNClearentry$(Index,Search)
6100   WEND 
6110   RETURN ""
6120 FNEND 
6130 ! 
6140 DEF FNRenamefile$ LOCAL Oldname$=11,Oldindex,Search
6150   Sector=Dirstart
6160   ; "Vilken fil skall d|pas om? ";
6170   INPUT ""Filename$
6180   IF Filename$="" THEN RETURN ""
6190   IF NOT FNNameok(False) THEN 6150
6200   IF NOT FNUsed THEN ; "Hittar ej filen!" : GOTO 6150
6210   Oldname$=Nameindir$ : Oldindex=Index
6220   ; "Vad skall den heta?        ";
6230   INPUT ""Filename$
6240   IF Filename$="" THEN RETURN ""
6250   IF NOT FNNameok(True) THEN 6150
6260   IF FNUsed THEN ; "Filen finns redan!" : GOTO 6150
6270   Index=Oldindex
6280   WHILE Index<Dirlen
6290     Search=INSTR(1,Dir$(Index),CHR$(0)+Oldname$)
6300     IF Search=0 THEN Index=Index+1 : GOTO 6360
6310     MID$(Dir$(Index),Search+1,11)=Nameindir$
6320     Cpmbuf$=Dir$(Index)
6330     Sector=Dirstart+Index
6340     Errflag=FNWritesec(Dest,Sector)
6350     IF Errflag THEN ; : ; FNDiscerror$ : STOP 
6360   WEND 
6370   RETURN ""
6380 FNEND