'
' XDIR_ACC
' 4/12/1989
' (C) by PKF
'
' After compilation, please rename
' the file .PRG into a file .ACC
'
Reserve 90000
Dim A$(1000)
Num_dsk%=0
Ap.id%=Dpeek(Lpeek(Gb+4)+4)
Nam$="  Print Directory"
@Menu_register(Ap.id%,Nam$)
Buff$=String$(16,0)
Do
  @Evnt_mesag(Varptr(Buff$))
  If Cvi(Buff$)=40
    @Programme
  Endif
Loop
Procedure Menu_register(Ap.id%,Nam$)
  Nam$=Nam$+Chr$(0)
  Bmove Varptr(Nam$),Basepage+192,Len(Nam$)
  Dpoke Gintin,Ap.id%
  Lpoke Addrin,Basepage+192
  Gemsys 35
Return
Procedure Evnt_mesag(Adr%)
  Lpoke Addrin,Adr%
  Gemsys 23
Return
Procedure Programme
  Path$=Chr$(Gemdos(25)+65)+":\*.*"
  Devno%=1
  Sort%=1
  Brk%=2
  Cdv%=2
  @Grow_box(10,10,120,25,120,135,400,130,0)
  @Obj_box(400,130,1)
  @Centre("PRINTER DIRECTORY",10,0)
  @Centre("(C) 4/12/1989, by PKF",11,0)
  @Centre("Path: _____________________________________",14,0)
  @Centre("Device  Sort  Loop  Flags   Ok   Help  Undo",16,0)
  @Centre(Path$,14,-12)
  Do
    Do
      Z%=Inp(2)
      If Z%=226
        Print At(51,16);" Help "
        Alert 0,"Control keys define flags used|UNDO exits, CR starts printing|ESC and BS delete path string.|",1,"  Ok  ",Pkf%
        Print At(51,16);" Help "
      Endif
      If Z%=19
        Print At(26,16);" Sort "
        Alert 0,"|Set desired sorting type |",Sort%,"Name|Size|Type",Sort%
        Print At(26,16);" Sort "
      Endif
      If Z%=12
        Print At(32,16);" Loop "
        Alert 0,"|Set desired looping mode |",Brk%," On |Off",Brk%
        Print At(32,16);" Loop "
      Endif
      If Z%=4
        Print At(18,16);" Device "
        Alert 0,"|Set desired printing device |",Devno%,"Printer|Disk",Devno%
        If Devno%=2
          Alert 3,"|Choose drive to use |",Cdv%," A |B",Cdv%
        Endif
        Print At(18,16);" Device "
      Endif
      If Z%=6
        Print At(38,16);" Flags "
        Sort$="NAMESIZETYPE"
        Brk$="ON OFF"
        Devno$="PRINTERDISK"
        Alert 0,"Device is  "+Mid$(Devno$,(Devno%-1)*7+1,7)+" "+Chr$(Abs(Devno%=2)*(32+Cdv%)+32)+"|Sorting mode  "+Mid$(Sort$,(Sort%-1)*4+1,4)+" |Looping mode  "+Mid$(Brk$,(Brk%-1)*3+1,3),1," Ok ",Pkf%
        Print At(38,16);" Flags "
      Endif
      If Z%=225
        Print At(58,16);" Undo "
        Alert 2,"Breaking working session? ",1,"Ok|Cancel",Pkf%
        If Pkf%=2
          Z%=355
        Endif
        Print At(58,16);" Undo "
      Endif
      If Z%=27
        Path$=""
        Print At(25,14);String$(37,"_")
      Endif
      If Z%=8
        If Len(Path$)>0
          Path$=Left$(Path$,Len(Path$)-1)
          Print At(25,14);Path$+String$(37-Len(Path$),"_")
        Endif
      Endif
      If Z%>32 And Z%<127 And Len(Path$)<36
        Path$=Path$+Upper$(Chr$(Z%))
        Print At(25,14);Path$+String$(37-Len(Path$),"_")
      Endif
      Exit If (Z%=13 And Len(Path$)>5) Or Z%=225
    Loop
    Exit If Z%=225
    Print At(45,16);"  Ok  "
    @Getdir(Path$,-1,*A$(),*N%)
    If A$(0)=""
      Alert 2,"Empty directory!|Printing?",2,"Ok|Cancel",Pf%
    Else
      Pf%=1
      If Sort%>1
        @F_sort
      Else
        @Q_sort(*A$(),0,N%)
      Endif
    Endif
    If Devno%=1 And Pf%=1 And Out?(0)=-1
      Inc Num_dsk%
      Lprint "  Directory of  ";Path$
      Lprint
      Lprint Space$(10)+"FILENAME       SIZE   FLAGS     DATE       TIME"
      Lprint
      For I%=0 To N%
        Lprint Space$(8)+A$(I%)
      Next I%
      Lprint
      Lprint
      Lprint chr$(27);"@";
    Endif
    If Devno%=2 And Pf%=1
      Inc Num_dsk%
      Pkf$=Chr$(64+Cdv%)+":\DISK_"+Str$(Num_dsk%)+".DIR"
      Open "o",#1,Pkf$
      Print #1,"  Directory of  "+Path$
      Print #1,"  FILENAME       SIZE   FLAGS     DATE       TIME"
      For I%=0 To N%
        Print #1,A$(I%)
      Next I%
      Close #1
    Endif
    Print At(45,16);"  Ok  "
    Exit If Brk%=2
    Alert 0,"|Directories printed up to now |",1,Str$(Num_dsk%),Pkf%
  Loop
  @Obj_box(400,130,0)
  @Grow_box(10,10,120,25,120,135,400,130,1)
Return
Procedure Getdir(File_$,Attr%,Str_arr%,Num_%)
  Local I_%,E_%,X$
  Swap *Str_arr%,File$()
  Void Gemdos(26,L:Basepage+128)
  File_$=File_$+Chr$(0)
  E_%=Gemdos(78,L:Varptr(File_$),Attr%)
  While E_%=0
    X$=Space$(20)
    Bmove Basepage+158,Varptr(X$),14
    X$=Left$(X$,Instr(X$,Chr$(0))-1)
    X$=Left$(X$+Space$(20),15)
    L$=Space$(7)
    A%=Peek(Basepage+149)
    If A% And 16
      Rset L$=" �DIR� "
    Else
      If A% And 8
        Rset L$=" LABEL "
      Else
        Rset L$=Str$(Lpeek(Basepage+154))
      Endif
    Endif
    X$=X$+L$
    If A% And 32
      X$=X$+" A"
    Else
      X$=X$+"  "
    Endif
    If A% And 16
      X$=X$+"D"
    Else
      X$=X$+" "
    Endif
    If A% And 8
      X$=X$+"L"
    Else
      X$=X$+" "
    Endif
    If A% And 4
      X$=X$+"S"
    Else
      X$=X$+" "
    Endif
    If A% And 2
      X$=X$+"H"
    Else
      X$=X$+" "
    Endif
    If A% And 1
      X$=X$+"R"
    Else
      X$=X$+" "
    Endif
    D%=Dpeek(Basepage+152)
    D$="  "+Right$("0"+Str$(D% And 31),2)+"/"
    D$=D$+Right$("0"+Str$(D%/32 And 15),2)+"/"
    D$=D$+Str$(D% Div 512+1980)
    X$=X$+D$
    T%=Dpeek(Basepage+150)
    T$="  "+Right$("0"+Str$(T%\2048),2)+":"
    T$=T$+Right$("0"+Str$(T%\32 And 63),2)+":"
    T$=T$+Right$("0"+Str$(T%+T% And 63),2)
    X$=X$+T$
    File$(I_%)=X$
    Inc I_%
    E_%=Gemdos(79)
  Wend
  File$(I_%)=""
  Swap *Str_arr%,File$()
  *Num_%=I_%-1
Return
Procedure Q_sort(Str_arr%,L%,R%)
  Local X$
  Swap *Str_arr%,A$()
  @Quick(L%,R%)
  Swap *Str_arr%,A$()
Return
Procedure Quick(L%,R%)
  Local Ll%,Rr%
  Ll%=L%
  Rr%=R%
  X$=A$((L%+R%)/2)
  Repeat
    While A$(L%)<X$
      Inc L%
    Wend
    While A$(R%)>X$
      Dec R%
    Wend
    If L%<=R%
      Swap A$(L%),A$(R%)
      Inc L%
      Dec R%
    Endif
  Until L%>R%
  If Ll%<R%
    @Quick(Ll%,R%)
  Endif
  If L%<Rr%
    @Quick(L%,Rr%)
  Endif
Return
Procedure Obj_box(Lx%,Ly%,O_c%)
  If O_c%=1
    Deffill ,5,5
    L1_x%=320-Lx%/2
    L1_y%=200-Ly%/2
    L2_x%=320+Lx%/2
    L2_y%=200+Ly%/2
    Get L1_x%,L1_y%,L2_x%,L2_y%,Objbox$
    Pbox L1_x%,L1_y%,L2_x%,L2_y%
    Box L1_x%+3,L1_y%+3,L2_x%-3,L2_y%-3
    Box L1_x%+4,L1_y%+4,L2_x%-4,L2_y%-4
  Else
    Put L1_x%,L1_y%,Objbox$
  Endif
Return
Procedure Grow_box(Xa%,Ya%,B1%,H1%,Xn%,Yn%,B2%,H2%,O_c%)
  Dpoke Gintin,Xa%
  Dpoke Gintin+2,Ya%
  Dpoke Gintin+4,B1%
  Dpoke Gintin+6,H1%
  Dpoke Gintin+8,Xn%
  Dpoke Gintin+10,Yn%
  Dpoke Gintin+12,B2%
  Dpoke Gintin+14,H2%
  Gemsys 73+O_c%
Return
Procedure Centre(Txt$,Txt%,Off%)
  Print At((81-Len(Txt$))/2+Off%,Txt%);Txt$
Return
Procedure F_sort
  Local Num_ber%
  For Y_%=0 To 1000
    Exit If A$(Y_%+1)="" Or Y_%=1000
  Next Y_%
  Num_ber%=Y_%
  For Y_%=0 To Num_ber%-1
    For X_%=0 To Num_ber%-1
      If Sort%=3
        If Mid$(A$(X_%),Instr(A$(X_%),"."),3)>Mid$(A$(X_%+1),Instr(A$(X_%+1),"."),3) Or A$(X_%)<A$(X_%+1)
          Swap A$(X_%),A$(X_%+1)
        Endif
      Else
        If Val(Mid$(A$(X_%),15,7))<Val(Mid$(A$(X_%+1),15,7))
          Swap A$(X_%),A$(X_%+1)
        Endif
      Endif
    Next X_%
  Next Y_%
Return