1000 ! * L.BAC
1005 INTEGER : EXTEND 
1020 ; '** Library listing **'
1040 ; '   Ver X.19, 1985-04-24'
1060 ; '   Copyright 1984 Dataindustrier AB'
1080 ! *
1100 ! *   Written by G|ran Nordenborg
1120 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1140 ! *
1160 ! * Rev date / Rev nr / Sign / Note
1180 ! * 84-06-21 /  X.00  /  GN  / Main
1200 ! * 84-06-26 /  X.01  /  GN  / No time print when bad time
1220 ! * 84-06-28 /  X.02  /  GN  / Proper tab handling
1240 ! * 84-07-30 /  X.03  /  GN  / Source close after dir list
1260 ! * 84-08-22 /  X.04  /  L-G / File protection are correctly listed
1280 ! * 84-08-26 /  X.05  /  L-G / Bug in LISTDEV%. Jump to wrong next
1300 ! * 84-08-30 /  X.06  /  L-G / File protection are correctly listed
1320 ! * 84-09-07 /  X.07  /  GN  / Print volume name
1340 ! * 84-09-14 /  X.08  /  GN  / Quick sort, reverce sort, extension sort etc
1341 ! * 84-09-21 /  X.09  /  GN  / Command argument in any order; special opt.
1342 ! * 84-09-28 /  X.10  /  GN  / Option -+ lists file group number
1343 ! * 84-10-12 /  X.11  /  GN  / Option -+ lists correct LDA
1344 ! * 84-10-23 /  X.12  /  GN  / Read file size from LFT when no direct acc
1345 ! * 84-10-29 /  X.13  /  GN  / Error if dir read posit (when empty dirsec)
1346 ! * 84-11-13 /  X.14  /  GN  / Proper list when reduced clustersize
1347 ! * 84-11-19 /  X.15  /  GN  / Record length set to 256 bytes
1348 ! * 84-12-05 /  X.16  /  GN  / Include RAM device in scan all driver list
1349 ! * 85-01-28 /  X.17  /  GN  / Close file 0
1350 ! * 85-02-26 /  X.18  /  GN  / Correct MO dirmap handling
1351 ! * 85-04-24 /  X.19  /  BL  / Accessible from DOS, FNStartpar$ handling
1360 ! *
1380 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1400 ! *
1420 ! EJECT
1440 ! ******************************
1460 ! *
1480 ! *  Main routine
1500 ! *
1520 IF FNL THEN ; 'L abort'
1530 C=CALL(Closeent)
1540 ; FNExit
1560 ! **********************************
1580 ! *
1600 ! *  Library list
1620 ! *
1640 DEF FNL
1660   IF FNInitialize THEN RETURN T
1680   IF FNListdir THEN RETURN T
1700   IF Option AND Opthelp THEN RETURN F
1720   IF Filefound=F THEN ; CHR$(7);'Can''t find file or device '; : IF Selname$+Extname$<>'' THEN ; '''';Selname$ '.' Extname$ '''' ELSE ; 
1740   RETURN F
1760 FNEND 
1780 ! *********************************
1800 ! *
1820 ! *  List directory/ies
1840 ! *
1860 DEF FNListdir
1865   Cmd$=FNStartpar$+'**' : IF Cmd$<>'**' GOTO 1940
1880   ; 'Command :';
1900   INPUT LINE Cmd$
1920   ; 
1940   Cmd$=FNCapstr$(LEFT$(Cmd$,LEN(Cmd$)-2))
1960   IF FNCmdscan(Cmd$) THEN RETURN T
1980   IF INSTR(1,Option$,'?') THEN Option=Opthelp : RETURN FNHelp
2000   IF INSTR(1,Option$,'T') THEN Option=Opttime
2020   IF INSTR(1,Option$,'S') THEN Option=Optsize
2040   IF INSTR(1,Option$,'E') THEN Option=Optext
2045   IF INSTR(1,Option$,'+') THEN Option=Optspec
2060   IF INSTR(1,Option$,'O') OR INSTR(1,Option$,'U') THEN Option=Optowner
2080   IF INSTR(1,Option$,'F') THEN Option=Option OR Optfast
2100   IF INSTR(1,Option$,'R') OR INSTR(1,Option$,'B') THEN Option=Option OR Optrew
2120   Selname$=RIGHT$(Selfile$,INSTR(1,Selfile$,':')+1)
2140   IF INSTR(1,Selname$,'.') THEN Extname$=RIGHT$(Selname$,INSTR(1,Selname$,'.')+1) : Selname$=LEFT$(Selname$,INSTR(1,Selname$,'.')-1)
2160   Sell=LEN(Selname$)
2180   Extl=LEN(Extname$)
2200   Dev$=LEFT$(Selfile$,INSTR(1,Selfile$,':'))
2220   IF Dev$<>'' THEN Error=FNListdev(Dev$) : IF Error=42 THEN ; 'Drive ''' Selfile$ ''' is off line' : RETURN T ELSE RETURN F
2240   WHILE FNGetdev=F
2260     Scanpnt=Devpnt
2280     Dev$=Dev$+':'
2300     IF Devhandler=Floppyhandler AND LEFT$(Dev$,2)<>'DR' AND Dev$<>'   :' AND Dev$<>'MFD:' THEN Error=FNListdev(Dev$)
2320     IF Error<>0 AND Error<>35 AND Error<>42 AND Error<>45 AND Error<>46 THEN RETURN T
2340     Devpnt=Scanpnt
2360   WEND 
2380   RETURN F
2400 FNEND 
2420 ! *****************************
2440 ! *
2460 ! *  All initialisations
2480 ! *
2500 DEF FNInitialize
2520   F=0
2540   T=-1
2560   Lus=1
2580   Lud=2
2600   Luv=3 ! Volume name read
2620   Nametab=43
2640   ! *
2660   ! *  Define sort buffer node structures
2680   ! *
2700   Namesort=0
2720   Namefd=Namesort+8
2740   Nameext=Namefd+8
2760   Namesize=Nameext+3
2780   Namegroup=Namesize+2
2800   Nameuser=Namegroup+2
2820   Nametime=Nameuser+8
2840   Nameyear=Nametime
2860   Namemonth=Nameyear+1
2880   Nameday=Namemonth+1
2900   Namehour=Nameday+1
2920   Nameminute=Namehour+1
2940   Namesec=Nameminute+1
2960   Namene=Namesec+1
2980   Nameprot=Namene+1
3000   Namel=Nameprot+1
3020   DIM Namesort$=256*Namel
3040   POKE VAROOT(Namesort$)+4,0,Namel
3060   ! *
3080   ! *  Rib sector definitions
3100   ! *
3120   Ribsize=234
3140   Ribgroup=Ribsize+2
3160   Ribuser=Ribgroup+2
3180   Ribtime=Ribuser+8
3200   Ribyear=Ribtime
3220   Ribmonth=Ribyear+1
3240   Ribday=Ribmonth+1
3260   Ribhour=Ribday+1
3280   Ribminute=Ribhour+1
3300   Ribsec=Ribminute+1
3320   Ribne=Ribsec+1
3340   Ribprot=Ribne+1
3360   Ribbuff$=' '
3380   POKE VAROOT(Ribbuff$),253,0,3,245,253,0 ! 253 long, pointing to DOS buffer 0+3
3400   Dosbuff$=' '
3420   POKE VAROOT(Dosbuff$),0,1,0,246,0,1 ! 256 long, pointing to DOS buffer 1
3440   ! *
3460   ! *  Define options
3480   ! *
3500   Opthelp=1
3520   Optsize=2*Opthelp
3540   Optowner=2*Optsize
3560   Opttime=2*Optowner
3580   Optext=2*Opttime
3600   Optrew=2*Optext
3620   Optfast=2*Optrew
3630   Optspec=2*Optfast
3640   ! *
3660   Optsort=Optext OR Opttime OR Optowner OR Optsize OR Optspec
3680   ! *
3700   Month$='JanFebMarAprMayJunJulAugSepOctNovDec'
3720   ! *
3740   ! *  Get quick sort routine
3760   ! *
3780   DIM Sortcode$=300
3800   Sortcode$=CHR$(24,2,207,0,175,237,82,25,208,229,213,213,229,235,175,237,82,235,237,98,237)
3820   Sortcode$=Sortcode$+CHR$(66,125,161,163,111,124,160,162,181,235,40,1,9,203,60,203,29,209,25,227,235)
3840   Sortcode$=Sortcode$+CHR$(175,237,82,25,48,93,235,227,235,175,237,82,25,40,10,205,205,0,56,20,40)
3860   Sortcode$=Sortcode$+CHR$(18,9,24,240,225,205,205,0,48,5,175,237,66,24,246,229,235,24,24,227,175)
3880   Sortcode$=Sortcode$+CHR$(237,82,25,40,10,205,205,0,48,10,175,237,66,24,240,209,213,235,24,2,235)
3900   Sortcode$=Sortcode$+CHR$(227,175,237,82,25,40,22,48,18,197,26,237,160,43,119,35,234,115,0,193,235)
3920   Sortcode$=Sortcode$+CHR$(175,237,66,237,66,235,24,164,9,235,237,66,235,24,157,51,51,213,229,33,6)
3940   Sortcode$=Sortcode$+CHR$(0,57,126,35,102,111,235,175,237,82,235,33,4,0,57,126,35,102,111,235,227)
3960   Sortcode$=Sortcode$+CHR$(235,175,237,82,235,227,237,82,48,11,225,209,217,225,217,227,217,229,217,24,8)
3980   Sortcode$=Sortcode$+CHR$(225,217,225,217,209,217,229,217,205,4,0,209,225,195,4,0,221,233,58,0,69)
4000   Sortcode$=Sortcode$+CHR$(0,198,0,203,0,122,0,90,0,0,0,50,50,50,50,50,50,50,50,50,51)
4020   Sortcode$=Sortcode$+CHR$(51,51,51,51,51,51,51,51,51,52,52,52,52,52,52,52,52,52,52,53,53)
4040   Sortcode$=Sortcode$+CHR$(53,53,53,53,53,53,53,53,54,54,54,54,54,54,54,54,54,54,55,55,55)
4060   Sortcode$=Sortcode$+CHR$(55,55,55,55,55,55,55,56,56,56,56,56,56,56,56,56,56,57,57,57,57)
4080   Sortcode$=Sortcode$+CHR$(57,57,57,57,57,57)
4100   Ap=VARPTR(Sortcode$)
4120   Rp=CVT$%(RIGHT$(Sortcode$,3))+Ap ! Relocation table pointer.
4140   WHILE PEEK2(Rp)
4160     A=PEEK2(PEEK2(Rp)+Ap)+Ap ! Get data.
4180     POKE PEEK2(Rp)+Ap,A,SWAP%(A)
4200     Rp=Rp+2
4220   WEND 
4240   ! *
4260   ! *
4280   ! *  Get compare routine
4300   ! *
4320   ! *  PUSH  DE
4340   ! *  PUSH  HL
4360   ! * (EXDR)     If backwards sort
4380   ! *  PUSH  BC
4400   ! *  LI    B,Namel
4420   ! *CL=     *
4440   ! *  L     A,(DE)
4460   ! *  C     (HL)
4480   ! *  JNZS  D
4500   ! *  INCD  DE
4520   ! *  INCD  HL
4540   ! *  DJNZ  CL
4560   ! *D =     *
4580   ! *  POP   BC
4600   ! *  POP   HL
4620   ! *  POP   DE
4640   ! *  RET
4660   Compare$=CHR$(213,229,0,197,6,Namel,26,190,32,4,19,35,16,248,193,225,209,201)
4680   Compent=VARPTR(Compare$)
4681   ! *
4682   ! *  Close routine
4683   ! *
4684   ! *  LI     B,0
4685   ! *  JMP    CLOSE.
4686   ! *
4687   Closecode$=CHR$(6,0,195,33,96)
4688   Closeent=VARPTR(Closecode$)
4700   Devpnt=PEEK2(-133)
4720   WHILE FNGetdev=0
4740     IF Dev$='DR0' THEN Floppyhandler=Devhandler : Devpnt=PEEK2(-133) : RETURN F
4760   WEND 
4780   ; 'Can''t find disk handler address'
4800   RETURN T
4820 FNEND 
4840 ! ******************************
4860 ! *
4880 ! *  List a specified directory
4900 ! *
4920 ! *  LDI  BC,Pdn    ! Code$ definition
4940 ! *  CALL OPEN.
4960 ! *  RC
4980 ! *  CALL BSP.
5000 ! *  CALL READ.
5020 ! *  RET
5040 ! *
5060 ! *
5080 DEF FNListdev(Dev$)
5100   Listdev$=Dev$
5120   ON ERROR GOTO 6180
5140   OPEN Listdev$ AS FILE Lus
5160   Pdn=PEEK(-767) AND 31
5180   Dev=PEEK(64783) AND 31
5200   Code$=CHR$(1,Pdn,0,205,24,96,216,205,63,96,205,45,96,201)
5210   Conttype=PEEK(PEEK2(24683)+(Dev AND 28)) AND 192
5220   Clusize=2^(PEEK(PEEK2(24683)+(Dev AND 28)+1) AND 7)
5240   Ldadiv=32/Clusize
5241   Ldamask=31
5260   Header=F
5280   Dacc=T
5300   Listnr=0
5320   Nameend=1
5340   Totsize.=0.
5360   IF Pdn=30 OR Pdn=31 OR Pdn=27 THEN POSIT #Lus,253-17 : Mfd=F ELSE Mfd=T : IF Conttype=128 THEN POSIT #Lus,7*253-17 ELSE POSIT #Lus,15*253-17
5380   IF Mfd=F THEN Vol$='' : GOTO 5540
5400   ! *
5420   ! *  MFD directory. Try to list volume name
5440   ! *
5460   ON ERROR GOTO 6260
5480   OPEN Listdev$+'SYSDIR.SYS' AS FILE Luv
5500   GET #Luv Vol$ COUNT 253
5520   IF MID$(Vol$,252,1)=CHR$(165) THEN Vol$=LEFT$(Vol$,INSTR(1,Vol$,CHR$(0))-3) ELSE Vol$=''
5540   ON ERROR GOTO 6180
5560   GET #Lus Dirmap$ COUNT 16
5561   GET #Lus Redclu$
5562   IF ASCII(Redclu$) AND 32 THEN Ldadiv=1 : Ldamask=Clusize-1
5580   IF Pdn<>30 AND Pdn<>31 AND Pdn<>27 THEN POSIT #1,16*253
5590   Dirpmask=-1 XOR Ldamask*256
5600   FOR Dirsec=0 TO 15
5620     IF ASCII(MID$(Dirmap$,Dirsec+1,1))=0 THEN 5780
5640     GET #Lus Dummy$ COUNT 0
5660     FOR Dirent=0 TO 15
5680       Dirname$=MID$(Dosbuff$,5+16*Dirent,11)
5700       IF ASCII(Dirname$)=255 OR ASCII(Dirname$)=0 OR Selname$<>LEFT$(Dirname$,Sell) OR Extname$<>MID$(Dirname$,9,Extl) THEN 5760
5720       MID$(Namesort$,Nameend,Namegroup)=CVT%$(CVT$%(MID$(Dosbuff$,1+16*Dirent,2)) AND Dirpmask)+CHR$(16*Dirent+Dirsec,0,0,0,0,0)+Dirname$
5740       Nameend=Nameend+Namel
5760     NEXT Dirent 
5780     POSIT #Lus POSIT(Lus)+253
5800   NEXT Dirsec 
5820   Nameend=Nameend-Namel
5840   MID$(Compare$,3,1)=CHR$(0) ! Be sure to remove rewerce sort
5860   IF Nameend>0 THEN IF FNQsort(VARPTR(Namesort$),VARPTR(Namesort$)+Nameend-1,Compent,Namel) THEN RETURN T
5880   IF Mfd=F THEN CLOSE Lus : IF FNDevnrname(Dev) RETURN T ELSE OPEN Dev$ AS FILE Lus ! Open MFD dev
5900   FOR Namepnt=1 TO Nameend STEP Namel
5920     IF FNGetfilepar(Namepnt,Ldadiv) THEN RETURN T
5940   NEXT Namepnt 
5960   IF Option AND Optrew THEN MID$(Compare$,3,1)=CHR$(235) ! Include 'EXDR' if rewerce sort
5980   IF Nameend>0 THEN IF FNQsort(VARPTR(Namesort$),VARPTR(Namesort$)+Nameend-1,Compent,Namel) THEN RETURN T
6000   IF Outfileopen=F THEN OPEN Outfile$ AS FILE Lud : Outfileopen=T
6020   ON ERROR GOTO 6360
6040   IF Nameend>0 THEN Filefound=T : ; #Lud : ; #Lud 'Device ' Listdev$ TAB(40) Vol$
6060   IF Nameend>0 AND (Option AND Optfast)=0 THEN Filefound=T : ; #Lud 'Pr U G O  Ne User        Size Time         File name';
6065   IF Nameend>0 THEN IF (Option AND Optspec) THEN ; #Lud '       Lda Pfn Group' ELSE ; #Lud
6080   FOR Namepnt=1 TO Nameend STEP Namel
6100     IF FNPrent(Namepnt) THEN RETURN T
6120   NEXT Namepnt 
6140   IF (Option AND Optfast)=0 AND Nameend>0 ; #Lud USING 'Total              ##########' Totsize.*256.; : ; #Lud ' in' (Nameend+Namel-1)/Namel 'files'
6160   RETURN F
6180   RESUME 6200
6200   Error=ERRCODE
6220   CLOSE Lus
6240   RETURN ERRCODE
6260   ! *
6280   ! *  Error during open of 'SYSDIR.SYS'
6300   ! *
6320   Vol$=''
6340   RESUME 5540
6360   ! *
6380   ! *  Error during outfile open
6400   ! *
6420   ; 'Error' ERRCODE 'during open of print file ''' Outfile$ ''''
6440   RESUME 6460
6460   RETURN T
6480 FNEND 
6500 ! ****************************************
6520 ! *
6540 ! *  Print directory entry
6560 ! *
6580 ! *
6600 DEF FNPrent(Namepnt)
6620   IF Option AND Optfast THEN RETURN FNFastlist(Namepnt)
6640   ON ERROR GOTO 7220
6660   Protect=ASCII(MID$(Namesort$,Namepnt+Nameprot,1))
6680   IF Protect AND 128 THEN ; #Lud 'D'; ELSE ; #Lud '-';
6700   IF Protect AND 64 THEN ; #Lud 'L'; ELSE ; #Lud '-';
6720   IF Protect AND 2 THEN ; #Lud '-'; ELSE ; #Lud 'W';
6740   IF Protect AND 1 THEN ; #Lud '-'; ELSE ; #Lud 'R';
6760   IF Protect AND 8 THEN ; #Lud '-'; ELSE ; #Lud 'W';
6780   IF Protect AND 4 THEN ; #Lud '-'; ELSE ; #Lud 'R';
6800   IF Protect AND 32 THEN ; #Lud '-'; ELSE ; #Lud 'W';
6820   IF Protect AND 16 THEN ; #Lud '-'; ELSE ; #Lud 'R';
6840   Ne=ASCII(MID$(Namesort$,Namepnt+Namene,1))
6860   IF Ne THEN ; #Lud USING ' ###' Ne; ELSE ; #Lud '    ';
6880   User$=MID$(Namesort$,Namepnt+Nameuser,8)
6900   IF ASCII(User$)<=16 OR ASCII(User$)=255 THEN User$=SPACE$(8)
6920   ; #Lud ' ';User$;
6940   Size=CVT$%(MID$(Namesort$,Namepnt+Namesize,2))
6980   IF Size<>-1 THEN Totsize.=Totsize.+FNNsgn.(Size) : ; #Lud USING '########' FNNsgn.(Size)*256.; ELSE ; #Lud SPACE$(8);
7000   Month=ASCII(MID$(Namesort$,Namepnt+Namemonth,1))
7020   Day=ASCII(MID$(Namesort$,Namepnt+Nameday,1))
7040   Year=ASCII(MID$(Namesort$,Namepnt+Nameyear,1))
7060   Hour=ASCII(MID$(Namesort$,Namepnt+Namehour,1))
7080   Minute=ASCII(MID$(Namesort$,Namepnt+Nameminute,1))
7100   IF Year<70 OR Month>12 OR Month=0 OR Day>31 OR Day=0 OR Hour>23 OR Minute>59 THEN ; #Lud TAB(Nametab); : GOTO 7160
7120   ; #Lud USING ' '+MID$(Month$,Month*3-2,3)+' ##' Day;
7140   IF Year<>PEEK(-17) THEN ; #Lud USING '  ####' 1900+Year; ELSE ; #Lud USING ' ##:' Hour; : ; #Lud RIGHT$(NUM$(100+Minute),2);
7160   ; #Lud ' ';MID$(Namesort$,Namepnt+Namefd,8) '.' MID$(Namesort$,Namepnt+Nameext,3);
7180   IF (Option AND Optspec)=0 THEN ; #Lud : RETURN F
7182   ; #Lud USING '  #####  ' FNNsgn.(SWAP%(CVT$%(MID$(Namesort$,Namepnt,2)))/Ldadiv);
7183   ; #Lud RIGHT$(HEX$(256+ASCII(MID$(Namesort$,Namepnt+2,1))),2);
7184   ; #Lud USING ' #####' FNNsgn.(CVT$%(MID$(Namesort$,Namepnt+Namegroup,2)))
7185   RETURN F
7220   RESUME 7240
7240   ; #Lud 'Error ' ERRCODE TAB(42);
7260   GOTO 7160
7280 FNEND 
7300 ! **********************************
7320 ! *
7340 ! *  Get next device
7360 ! *
7380 DEF FNGetdev
7400   IF Devpnt=0 THEN RETURN T
7420   Dev$=CHR$(PEEK(Devpnt+2),PEEK(Devpnt+3),PEEK(Devpnt+4))
7440   Devhandler=PEEK2(Devpnt+5)
7460   Devnumber=PEEK(Devpnt+7)
7480   Devpnt=PEEK2(Devpnt)
7500   RETURN F
7520 FNEND 
7540 ! ************************************
7560 ! *
7580 ! *  Just file name listing
7600 ! *
7620 DEF FNFastlist(Namepnt)
7640   IF MOD(Listnr,5)=0 AND Listnr<>0 THEN ; #Lud
7660   Listnr=Listnr+1
7680   ; #Lud ' ';MID$(Namesort$,Namepnt+Namefd,8) '.' MID$(Namesort$,Namepnt+Nameext,3);
7700   RETURN F
7720 FNEND 
8020 ! ********************************
8040 ! *
8060 ! *  Scan input string
8080 ! *
8100 DEF FNCmdscan(Str$)
8120   Selfile$=''
8140   Infile$='CON:'
8160   Outfile$='CON:'
8170   File$=''
8180   FOR Pnt=1 TO LEN(Str$)
8200     IF MID$(Str$,Pnt,1)>=CHR$(97) THEN MID$(Str$,Pnt,1)=CHR$(ASCII(MID$(Str$,Pnt,1)) AND 223)
8220   NEXT Pnt 
8240   FOR Pnt=1 TO LEN(Str$)
8260     ON INSTR(1,' <>-',MID$(Str$,Pnt,1))+1 GOSUB 8340,8440,8540,8800,9060
8280   NEXT Pnt 
8300   GOSUB 8440
8320   RETURN Error
8340   ! *
8360   ! *  No special but ascii character cound
8380   ! *
8400   File$=File$+MID$(Str$,Pnt,1)
8420   RETURN 
8440   ! *
8460   ! *  ' ' found
8480   ! *
8500   IF Termcont=0 THEN IF File$='' THEN RETURN ELSE Selfile$=File$ : File$='' : RETURN 
8520   ON Termcont GOTO 8660,8920,9160
8540   ! *
8560   ! *  '<' found. Infile descriptor
8580   ! *
8620   Termcont=1
8640   RETURN 
8660   ! *
8680   ! *  '<' termination
8700   ! *
8720   IF Infile$<>'CON:' THEN Error=3 : RETURN 
8740   Infile$=File$
8750   File$=''
8760   Termcont=0
8780   RETURN 
8800   ! *
8820   ! *  '>' found. Out file descriptor
8840   ! *
8880   Termcont=2
8900   RETURN 
8920   ! *
8940   ! *  '>' termination
8960   ! *
8980   IF Outfile$<>'CON:' THEN Error=4 : RETURN 
9000   Outfile$=File$
9010   File$=''
9020   Termcont=0
9040   RETURN 
9060   ! *
9080   ! *  '-' found. Option descriptor
9100   ! *
9120   Termcont=3
9140   RETURN 
9160   ! *
9180   ! *  '-' termination
9200   ! *
9220   Option$=Option$+File$
9230   File$=''
9240   Termcont=0
9260   RETURN 
9280 FNEND 
9300 ! **************************************
9320 ! *
9340 ! *  Make string block letters
9360 ! *
9380 DEF FNCapstr$(Str$)
9400   FOR Strpnt=1 TO LEN(Str$)
9420     IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223)
9440   NEXT Strpnt 
9460   RETURN Str$
9480 FNEND 
9500 ! ***********************************
9520 ! *
9540 ! *  Help text
9560 ! *
9580 DEF FNHelp
9600   OPEN Outfile$ AS FILE Lud
9620   ; #Lud 'L is a utility to list names of disk files. Command syntax'
9640   ; #Lud 'is ''DRIVE:SELNAME -OPTION''. If drive is not given, all drives'
9660   ; #Lud 'will be scanned. Options:'
9680   ; #Lud 'T  - sort file listing in time order'
9700   ; #Lud 'S  - sort file listing in file size order'
9720   ; #Lud 'E  - sort file listing in fd extension order'
9740   ; #Lud 'O  - sort file listing in owner order'
9760   ; #Lud 'R  - sort in reverse order'
9780   ; #Lud 'F  - fast; will give no sizes on files'
9800   RETURN F
9820 FNEND 
9840 ! *****************************************
9860 ! *
9880 ! *  Get file parameters
9900 ! *
9920 DEF FNGetfilepar(Namepnt,Ldadiv)
9960   IF Option AND Optfast THEN 10080
9980   Error=0
10000   Pfn=ASCII(MID$(Namesort$,Namepnt+2,1))
10010   ON ERROR GOTO 10200
10020   IF Dacc POSIT #Lus,FNNsgn.(SWAP%(CVT$%(MID$(Namesort$,Namepnt,2)))/Ldadiv)*253. : GET #Lus Ribbuff$ COUNT 253 ELSE Error=CALL(VARPTR(Code$),Pfn)
10040   IF Error THEN MID$(Namesort$,Namepnt,6)=STRING$(6,0) : MID$(Namesort$,Namepnt+Nameprot,Namel-Nameprot)=CHR$(63) : RETURN F
10060   MID$(Namesort$,Namepnt+Namesize,Namel-Namesize)=MID$(Ribbuff$,Ribsize,20)
10065   IF Dacc=F THEN MID$(Namesort$,Namepnt+Namesize,2)=CVT%$(PEEK2(64832+10))
10080   IF (Option AND Optsort)=0 THEN MID$(Namesort$,Namepnt,8)=STRING$(8,0) : RETURN F
10100   IF Option AND Opttime THEN MID$(Namesort$,Namepnt,8)=MID$(Ribbuff$,Ribtime,6)+STRING$(2,0) : RETURN F
10120   IF Option AND Optext THEN MID$(Namesort$,Namepnt,8)=MID$(Namesort$,Namepnt+Nameext,3)+STRING$(5,0) : RETURN F
10140   IF Option AND Optsize THEN MID$(Namesort$,Namepnt,8)=MID$(Ribbuff$,Ribsize,2)+STRING$(6,0) : RETURN F
10160   IF Option AND Optowner THEN MID$(Namesort$,Namepnt,8)=MID$(Ribbuff$,Ribuser,8) : RETURN F
10170   IF Option AND Optspec THEN MID$(Namesort$,Namepnt+3,5)=STRING$(5,0) : RETURN F
10180   RETURN T
10200   ! *
10220   ! *  Error during direct access
10240   ! *
10260   IF Dacc=F THEN Ribbuff$=STRING$(253,0) : RESUME 10040
10280   Dacc=F
10300   RESUME 10020 ! Try file rib read
10320 FNEND 
10340 ! **********************************
10360 ! *
10380 ! *  Convert device number to name
10400 ! *
10420 DEF FNDevnrname(Devnr)
10440   Devpnt=PEEK2(-133)
10460   WHILE FNGetdev=F
10480   IF Devhandler<>Floppyhandler OR Devnumber<>Devnr THEN WEND 
10500   Dev$=Dev$+':'
10520   RETURN F
10540 FNEND 
10560 ! * QSORT.BAC
10580 ! '** Quick sort function **'
10600 ! '   Ver 1.00, 1983-02-09'
10620 ! '   Copyright 1982 Dataindustrier AB'
10640 ! 
10660 ! *  Written by Felix Burton
10680 ! ** ** ** ** ** ** ** ** ** ** **
10700 ! *
10720 ! * Ver date / Ver nb / Sign / Note
10740 ! * 83-02-09 /  1.00  /  FB  / Main
10760 ! *
10780 ! ** ** ** ** ** ** ** ** ** ** **
10800 ! *
10820 ! EJECT
10840 ! ********************************
10860 ! *
10880 ! * Quick sort function.
10900 ! *
10920 ! * Function parameters:
10940 ! *
10960 ! * L% - Left element pointer.
10980 ! * R% - Right element pointer.
11000 ! * C% - Pointer to compare routine.
11020 ! * S% - Length of one element.
11040 ! *
11060 DEF FNQsort(L,R,C,S) LOCAL B$=20
11080   ! la hl,L ; la x,C ; la bc,S ; jmp Sortcode$
11100   B$=CHR$(33)+CVT%$(L)+CHR$(221,33)+CVT%$(C)+CHR$(1)+CVT%$(S)+CHR$(195)+CVT%$(Ap)
11120   A=CALL(VARPTR(B$),R)
11140   RETURN F
11160 FNEND 
12000 ! *************************************
12010 ! *
12020 ! *  Unsign integer
12030 ! *
12040 DEF FNNsgn.(Intgr)
12050   IF Intgr<0 THEN RETURN Intgr+65536. ELSE RETURN Intgr
12060 FNEND 
60000 ! 
60010 ! *********************************
60020 ! *
60030 ! *  Check if user entered from DOS or BASIC
60040 ! *
60050 DEF FNChkdos LOCAL I
60060   I=PEEK2(65302)-160
60070   WHILE I<160 : IF PEEK2(I)=-212 RETURN -1
60080   IF PEEK(I)<>13 I=I+1 : WEND 
60090   RETURN 0
60100 FNEND 
60110 ! 
60120 ! **********************************
60130 ! *
60140 ! *  Get start parameter string (if any)
60150 ! *
60160 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160
60170   Cmdsp=PEEK2(65302)-160
60180   WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 60210
60190     IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string
60200   WEND : RETURN '' ! No startpar string
60210   IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag
60220   WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 60250
60230     IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN ''
60240   Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 
60250   RETURN Cmd$
60260 FNEND 
60270 ! 
60280 ! *************************************
60290 ! *
60300 ! *  Exit to DOS or BASIC
60310 ! *
60320 DEF FNExit LOCAL A$=21,A
60330   IF FNChkdos=0 GOTO 60380 ELSE CLOSE ! We MUST close ALL files!!!
60340   A$='CMDINT  SYS'+CHR$(14,255,205,27,96,216,195,3,193)
60350   A=VARPTR(A$)
60360   IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!";
60370   GET A$ : IF CALL(0) REM Just a miracle would get through here...
60380   END ! End to get out of a function is ugly but...
60390 FNEND