DLO_BAS Version 0.6

In English: Version 0.6 of DLO_BAS (Disk Label Organizer), Réal Gagnon's public-domain SuperBASIC program that reads a floppy or microdrive directory, sorts it alphabetically (with a quicksort procedure credited to Sinclair QL World) and shows or prints it in six columns, with an optional title. Printing can be in very small (superscript compressed) letters for disk labels, compressed for disk sleeves, or normal 80-column. Bugs from the first version are fixed and the user interface is new. A sample screen and the full listing are given.

The article below is in French, as printed in QL_DOC n11 (August-September 1989).

---

Voici une nouvelle version du programme DLO_BAS qui nous permet de voir plus clairement le contenu d’une disquette ou d’un µdrive. La plupart des “BUGs” présents sur la première version ont été corrigés et de nouvelle options ont fait leurs apparitions en plus d’une nouvelle interface utilisateur.

Pour débuter DLO_BAS, on fait simplement LRUN xxxx_DLO_BAS où xxxx est le support contenant DLO_BAS.

L’écran initial nous demande de mettre un disquette formattée dans flp1_. Si on travaille avec des µdrives seulement (ou RAMdisk), on change à la ligne 227 la variable mast_cat$ pour ‘mdv1_dir1’ (ou ‘ram1_dir1’) au lieu de ‘flp1_dir1’.

Puis on demande le nom du “device”, ce dernier peut être flp1_,flp2_,mdv1_ ou mdv2_. Nous avons la possibilité d’ajouter un titre ou un commentaire, sinon on fait simplement [ENTER]. Le directory du “device” est lu, classé par ordre alphabétique et affiché. L’affichage (et l’impression) se fait sur 6 colonnes, cela peut être modifier en ajustant la variable nbr_col à la ligne 1650. Une fois ceci fait, nous pouvons lire un autre “device”, aller au menu d’impression ou bien retourner au SuperBASIC.

Pour l’impression, le programme offre 3 options:

Très petites lettres, impression en mode SUPERCRIPT COMPRESSE, idéale pour faire des étiquettes à coller sur la disquette elle-même.

Petites lettres, impression en mode COMPRESSE qui peut servir pour un petite feuille à coller sur la pochette de la disquette.

L’option impression normale imprime sur toute la largeur d’une feuille normale en 80 caractères par ligne en 6 colonnes.

DLO_BAS v0.6 par Réal Gagnon Montréal (Québec)

100 REMark ________________________
110 REMark ________________________Disk Label Organizer v.6
115 REMark ________________________par Réal Gagnon Mtl Qc 89
117 REMark ________________________
130  WINDOW 512,256,0,0
140  BORDER 3,45:PAPER 0:INK 2:CLS
170  PRINT 'Diskette Label Organizer',
     'par Réal Gagnon, Mtl Québec 1989'
180  PRINT 'version 0.6',,,
     'Logiciel du domaine public pour le Sinclair QL'
190  INK 7
200  PRINT "IMPORTANT: Disquette NON-PROTEGEE en
     écriture dans FLP1_..."
210  INPUT 'Contenu de quel "device" (ex. flp1_) ?  ';device$
220  INPUT 'Avez un TITRE ou une NOTE spéciale,
     sinon faites [ENTER] ? ';titre$
225 :
227  mast_cat$='flp1_dir1'
230  read_dir: IF empty=0 : RUN
240  sort fi$
250  list_scr
260 :
270  BORDER#0,1,7:CLS#0
290  PRINT#0,'[1] Lire un autre "device"',,'[2] Imprime le contenu'
291  PRINT#0,"[0] Retour au SuperBASIC"
300  REPeat loop
310     a=CODE(INKEY$(-1))
320     SELect ON a
330      =CODE("1"):RUN
340      =CODE("2"):choi_prt
350      =CODE("0"):PRINT#0,"Retour au SuperBASIC...":STOP
360     END SELect
370  END REPeat loop
380 :
390 DEFine PROCedure choi_prt
400  CLS#0
410  REPeat attend:IF INKEY$="":EXIT attend:ELSE :END REPeat attend
420  PRINT#0,"[1] Petites lettres",,"[2] Très petites lettres"
421  PRINT#0,"[3] Impression normale",,"[0] Menu principal"
425  REPeat loop2
430     a=CODE(INKEY$(-1))
440     SELect ON a
450      =CODE('1'):list_prt 1
460      =CODE('2'):list_prt 2
462      =CODE('3'):list_prt 3
465      =CODE('0'):EXIT loop2
470     END SELect
475  END REPeat loop2
480  CLS#0
490  PRINT#0,'[1] Lire un autre "device"',,'[2] Imprime le contenu'
491  PRINT#0,"[0] Retour au SuperBASIC"
500 END DEFine
510 :
520 DEFine PROCedure read_dir
530  empty=1
540  DELETE mast_cat$
550  OPEN_NEW#5,mast_cat$
560  DIR#5,device$
570  CLOSE#5:OPEN#5,mast_cat$
590 REMark ______________recherche le nombre de secteurs libres
610  CLS
620  PRINT "Lecture/Analyse du contenu de ";device$,
630  IF EOF(#5)
631     PRINT "Il n'y a aucun fichier sur ";device$
632     PRINT "Appuyez une touche...": PAUSE: CLOSE#5:empty=0:RETurn
633     PAUSE: CLOSE#5:empty=0:RETurn
636  END IF
640  INPUT#5,fr_sp$
650  PRINT fr_sp$
670 REMark ---------------trouve combien il y a de fichier et
671 REMark ---------------lequel est le plus long
690  INPUT#5,dummy$              :REMark ligne vide
700  nfiles=0
710  lmax=0
720  REPeat loop
730     INPUT #5,a$
750     lfi=LEN(a$)
760     IF lfi>lmax:lmax=lfi
770     IF a$<>'dir1':nfiles=nfiles+1
775     IF EOF(#5):EXIT loop
780  END REPeat loop
790  PRINT 'Il y a ';nfiles;' fichiers.'
800  CLOSE#5:OPEN#5,mast_cat$
810  INPUT#5,dummy$:INPUT#5,dummy$ :REMark secteurs libres+ligne vide
830 REMark ---------------creation du tableau contenant les noms
831 REMark ---------------de fichier.
850  DIM fi$(nfiles,lmax)
890  i=1
900  REPeat loop
910     INPUT#5,a$
930     IF a$<>'dir1'
940      fi$(i)=a$
950      i=i+1
960     END IF
965    IF EOF(#5):EXIT loop:END IF
970  END REPeat loop
980  CLOSE#5: DELETE mast_cat$
990 END DEFine
1010 REMark ----------------------PROCs sort & qsort
1011 REMark ----------------------source SINCLAIR QL WORLD!
1020 :
1030 DEFine PROCedure sort (array)
1040  INK 4
1050  PRINT 'Je classe ...'
1060  INK 7
1070  qsort array,1,DIMN(array)
1080 END DEFine sort
1090 :
1100 DEFine PROCedure qsort (array,bottom,top)
1110  LOCal loop,lo,hi,pointer
1120  lo=bottom:hi=top
1130  pointer=bottom
1140  REPeat loop
1150    IF lo>=hi:EXIT loop
1160    IF array(lo)>array(hi)
1170       temp$=array(lo)
1180       array(lo)=array(hi)
1190       array(hi)=temp$
1200         IF pointer=lo
1210            lo=lo+1:pointer=hi
1220         ELSE
1230            hi=hi-1:pointer=lo
1240         END IF
1250    ELSE
1260       IF pointer=lo
1270            hi=hi-1
1280       ELSE
1290            lo=lo+1
1300       END IF
1310   END IF
1320  END REPeat loop
1330  IF ABS(top-bottom)<2 THEN RETurn
1340  qsort array, bottom, pointer-1
1350  qsort array, pointer+1, top
1360 END DEFine qsort
1370 :
1390 DEFine PROCedure list_prt (style)
1395  esc$=CHR$(27)
1400  l$='                 '
1410  OPEN#5,ser1
1430  st=style
1435  SELect ON st
1437   =1
1460   PRINT#5,esc$;"M";CHR$(15);esc$;"S0";esc$;"3";CHR$(16);
1470   =2
1481   PRINT#5,esc$;"M";CHR$(15);
1485   =3
1487   PRINT#5,esc$;"P";
1488  END SELect
1510 PRINT#5,esc$;'W1';titre$fr_sp$;esc$;'W0':REMark large on/off
1520  display_files
1530  PRINT#5,esc$;"@"\\\:CLOSE#5
1540 END DEFine
1550 :
1560 DEFine PROCedure list_scr
1570  l$='                 '
1580  OPEN#5,scr_512x180a0x33:BORDER#5,2,2:PAPER#5,0:INK#5,4:CLS#5
1590  PRINT#5,titre$fr_sp$
1600  display_files
1610 END DEFine
1620 :
1630 DEFine PROCedure display_files
1640 REMark --------------------------NBR_COL=nombre de colonne
1650  nbr_col=6
1660  n_lignes=INT(nfiles/nbr_col)
1670  FOR ligne=0 TO n_lignes
1680     FOR colonne=1 TO nbr_col
1690        IF ((ligne*6)+colonne)>nfiles:EXIT ligne
1700        long_f=LEN(fi$((ligne*6)+colonne))
1710          IF long_f>12
1720          f$=fi$(((ligne*6)+colonne),1 TO 11)
1730          ELSE
1740          f$=fi$((ligne*6)+colonne)
1750          END IF
1760        l_f=13-LEN(f$)
1770        PRINT #5,f$;l$(1 TO l_f);
1780     END FOR colonne
1790    PRINT#5
1800  END FOR ligne
1810 END DEFine