'
'                             The Director
'                            by Robert Pyle
'                    (C) 1988 Antic Publishing Inc.
'
Rez%=Xbios(4)
If Rez%<>1
  If Rez%=0
    Alert 3,"   Sorry, this| program runs in|  medium or high| resolution only.",1," Rats!",But%
    System
  Endif
Endif
If Rez%=1
  Tx1%=6
  Tx2%=13
Else
  Tx1%=13
  Tx2%=32
Endif
@Dsk_map
Fol_num%=40       !default value
Fil_num%=500      !default value
Autoflag!=True
@Arr_dim1 ! dimensions the arrays that may be resized later
@Arr_dim2
'
' these arrays hold the output option data
'
Dim Op_mode!(7),Op_mode$(7)
Dim In_clude!(7),In_clude$(7)
'
' these arrays hold the file extenders to be (possibly) omitted
'
Dim S_ext$(4,22),S_ext!(4,22)
'
' this array holds the original color palette
'
Dim Spalette%(15,3)
@Initial
@Get_mouse
End
'
' main program loop
'
Procedure Dir_read
  If Fcnt%<>0
    Alert 2,"Do you want to replace|the files already in|the file array or add|on to them?",1," Append |Replace",But%
    If But%=2
      @Arr_dim1
      @Stat
    Endif
  Endif
  Repeat
    Mfull%=0
    '
    ' set up data transfer address
    '
    Buf$=Space$(44)
    '
    ' define initial directory path
    '
    File_path$="*.*"+Chr$(0)
    '
    Chdir "\"
    Alert 0,"Insert the disk to be|  cataloged into the |    Current Drive.",1,"Ready|Cancel",But%
    If But%=1
      Folder$(0)="\"    ! initial directory path
      N_folder%=1          ! points to the next empty slot
      C_folder%=0          ! points to the current directory path
      First_dir%=True      ! flag indicating first (true) or subsequent dir read
      Dta%=Varptr(Buf$)
      Void Gemdos(&H1A,L:Dta%)
      File_path_ptr%=Varptr(File_path$)
      @Volume
      Alert 0,"This disk is named:| |    "+Volume$+"|",1,"Continue",But%
      Alert 2,"Do you want to enter an|Alternate Disk Name? (This|can be any identifying|label or number.)",2,"Yes|No",But%
      If But%<>2
        Msg1$="Enter any number or description"
        Msg2$="that you wish (this can be a"
        Msg3$="different name or perhaps an"
        Msg4$="identifying serial number.)"
        Msg5$="(12 characters maximum length)"
        In%=12
        @In_box
        If In$<>""
          Avolume$=In$
        Else
          Avolume$=""
        Endif
      Else
        Avolume$=""
      Endif
      Temp$=Space$(12)
      Lset Temp$=Avolume$
      Avolume$=Temp$
      Defmouse 2
      Msg2$="Directory Information"
      Msg3$="Is"
      Msg4$="Being Read"
      @Msg_box2
      '
      ' set file attributes for directory read
      '
      File_attr%=23        ! 0 (normal) + 1 (protected) + 16 (subdirectory)
      '                      + 2 (hidden) + 4 (system)
      Repeat
        Chdir Folder$(C_folder%)
        Dta%=Varptr(Buf$)
        Void Gemdos(&H1A,L:Dta%)     ! Set disk transfer address
        File_path_ptr%=Varptr(File_path$)
        If First_dir%=True     ! Is this the first directory item
          @Dir_read_first
        Else
          @Dir_read_next
        Endif
        If D0=-49     ! No more files
          Inc C_folder%
          First_dir%=True
        Else
          If D0>-1     ! No errors
            @File_process
          Endif
        Endif
        Exit If Full_flag!=True
        If Mfull%=0
          If Fre(0)<5000
            Alert 3,"WARNING: Free Memory Low!|Save Data and then|Re-read this directory.",1,"OKAY!",Mfull%
            Fcnt%=Prev_fcnt%
            Sput M_scr$
            Msg1$="None of the files in the"
            Msg2$="directory currently being read"
            Msg3$="will be included in the saved"
            Msg4$="data. You must re-read this"
            Msg5$="directory after the save."
            @Msg_box1
            Sput M_scr$
          Endif
        Endif
        Exit If Mfull%=1
      Until C_folder%=N_folder%
      Sput M_scr$
      Full_flag!=False
      Prev_fcnt%=Fcnt%
      @Stat
      Chdir "\"
      Defmouse 0
      Alert 2,"Do You Want To| Read Another |  Directory?",1," YES | NO ",But%
    Endif
  Until But%=2
  @Stat
  B%=0
Return
'
' set it up
'
Procedure Initial
  '
  Full_flag!=False
  '
  Restore Op_1
  For I%=1 To 7     ! Initialize output mode
    Op_mode!(I%)=False
    Read Op_mode$(I%)
  Next I%
  Op_mode!(5)=True    ! this is the default value
  Op_flag%=5
  '
  Restore Op_2
  For I%=1 To 7     ! Initialize attribute flags
    In_clude!(I%)=True
    Read Z$
    In_clude$(I%)=Z$
  Next I%
  '
  Restore Ext_dat     ! Initialize 'exclude' array
  For I%=1 To 4
    For J%=1 To 22
      Read S_ext$(I%,J%)    ! put default values into array
      S_ext!(I%,J%)=True
    Next J%
  Next I%
  '
  @Savecolors
  '
  ' set up main screen
  '
  Setcolor 0,0,0,0
  Setcolor 3,0,0,0
  Setcolor 1,0,0,0
  Setcolor 2,0,0,0
  @Ext_box
  @Com_box
  If Exist("SETTINGS.CFG")
    Z$="SETTINGS.CFG"
    @Load_it_up
  Endif
  Autoflag!=False
  Setcolor 0,7,7,7 ! returns color #0 to white
  Setcolor 3,0,0,0 ! returns color #1! to black
  Setcolor 1,0,0,5 ! sets color #2! to dark blue
  Setcolor 2,0,5,0 ! sets color #3! to dark green
Return
'
' dimension or redimension file and folder arrays
'
Procedure Arr_dim1
  ' these arrays hold all the file information
  '
  Erase Finame$()
  Erase Fext$()
  Erase Fsize$()
  Erase Fdate$()
  Erase Ftime$()
  Erase Fpath$()
  Erase Fvolume$()
  Erase Favolume$()
  Dim Finame$(Fil_num%),Fext$(Fil_num%),Fsize$(Fil_num%),Fdate$(Fil_num%),Ftime$(Fil_num%)
  Dim Fpath$(Fil_num%),Fvolume$(Fil_num%),Favolume$(Fil_num%)
  Fcnt%=0            ! number of array entries
  Prev_fcnt%=0
Return
'
' dimension or redimension folder array
'
Procedure Arr_dim2
  ' this array holds the subdirectory paths until they can be processed
  Erase Folder$()
  Dim Folder$(Fol_num%)
Return
'
' change the file name maximum
'
Procedure Set_files
  Msg1$="This will erase any data"
  Msg2$="currently in the file array!"
  Msg3$=""
  Msg4$="(enter 0 to cancel) "
  Msg5$="Enter the new value:"
  In%=5
  @In_box
  If Val(In$)<>0 And In$<>""
    Fil_num%=Val(In$)
    On Error Gosub Err1
    @Arr_dim1
    On Error
    @Stat
  Endif
Return
'
' change the folder maximum
'
Procedure Set_folders
  Msg1$="Enter the new value"
  Msg2$="for the maximum number"
  Msg3$="of folders (subdirectories)"
  Msg4$="in any one of the directories"
  Msg5$="to be read."
  In%=4
  @In_box
  If Val(In$)<>0 And In$<>""
    Fol_num%=Val(In$)
    On Error Gosub Err2
    @Arr_dim2
    On Error
    @Stat
  Endif
Return
'
' error in redimensioning arrays
'
Procedure Err1
  Msg1$="An error occured during the"
  Msg2$="redimensioning of the arrays."
  Msg3$="Please repeat this function"
  Msg4$="with a smaller value (sizes"
  Msg5$="shown now are not accurate). "
  @Msg_box1
  Fil_num%=0      !default value
  Erase Finame$()
  Erase Fext$()
  Erase Fsize$()
  Erase Fdate$()
  Erase Ftime$()
  Erase Fpath$()
  Erase Fvolume$()
  Erase Favolume$()
  Resume
Return
'
Procedure Err2
  Msg1$="An error occured during the"
  Msg2$="redimensioning of the arrays."
  Msg3$="Please repeat this function"
  Msg4$="with a smaller value (sizes"
  Msg5$="shown now are not accurate). "
  @Msg_box1
  Fol_num%=0      !default value
  Erase Folder$()
  Resume
Return
'
' request information from user
'
Procedure In_box     ! Draw generic input box
  Graphmode 1
  Color 1
  Defline 1,3
  Deffill 0,1
  Deftext 1,0,0,Tx1%
  Sget M_scr$
  Pbox 170,Rez%*52,470,Rez%*148
  Box 170,Rez%*52,470,Rez%*148
  Text (300-8*Len(Msg1$))/2+170,Rez%*74,Msg1$
  Text (300-8*Len(Msg2$))/2+170,Rez%*86,Msg2$
  Text (300-8*Len(Msg3$))/2+170,Rez%*98,Msg3$
  Text (300-8*Len(Msg4$))/2+170,Rez%*110,Msg4$
  Text (300-8*Len(Msg5$))/2+170,Rez%*122,Msg5$
  Print At(36,17);
  Form Input In%,In$
  Msg1$=" "
  Msg2$=" "
  Msg3$=" "
  Msg4$=" "
  Msg5$=" "
  Sput M_scr$
  Sput M_scr$
Return
'
' message display
'
Procedure Msg_box1     ! Generic message box - user termination required
  Color 1
  Graphmode 1
  Defline 1,3
  Deffill 0,1
  Deftext 1,0,0,Tx1%
  Sget M_scr$
  Pbox 170,Rez%*52,470,Rez%*148
  Box 170,Rez%*52,470,Rez%*148
  Text (300-8*Len(Msg1$))/2+170,Rez%*74,Msg1$
  Text (300-8*Len(Msg2$))/2+170,Rez%*86,Msg2$
  Text (300-8*Len(Msg3$))/2+170,Rez%*98,Msg3$
  Text (300-8*Len(Msg4$))/2+170,Rez%*110,Msg4$
  Text (300-8*Len(Msg5$))/2+170,Rez%*122,Msg5$
  Text 192,Rez%*134,"<< Press [Return] to continue >>"
  Repeat
  Until Inkey$=Chr$(13)
  Msg1$=" "
  Msg2$=" "
  Msg3$=" "
  Msg4$=" "
  Msg5$=" "
  Sput M_scr$
Return
'
Procedure Msg_box2 ! Display message until calling routine terminates
  Color 1          ! with sput m_scr$.
  Graphmode 1
  Defline 1,3
  Deffill 0,1
  Deftext 1,0,0,Tx1%
  Sget M_scr$
  Pbox 170,Rez%*52,470,Rez%*148
  Box 170,Rez%*52,470,Rez%*148
  Text (300-8*Len(Msg1$))/2+170,Rez%*74,Msg1$
  Text (300-8*Len(Msg2$))/2+170,Rez%*86,Msg2$
  Text (300-8*Len(Msg3$))/2+170,Rez%*98,Msg3$
  Text (300-8*Len(Msg4$))/2+170,Rez%*110,Msg4$
  Text (300-8*Len(Msg5$))/2+170,Rez%*122,Msg5$
  Text (300-8*Len(Msg6$))/2+170,Rez%*134,Msg6$
  Msg1$=" "
  Msg2$=" "
  Msg3$=" "
  Msg4$=" "
  Msg5$=" "
  Msg6$=" "
Return
'
' get disk drive map
'
Procedure Dsk_map
  Map%=Bios(10)
  Map$=Right$(Space$(16)+Bin$(Map%),16)
  D0=Gemdos(&H19)     ! get current disk drive #
  Curr_drive%=D0
Return
'
' draw extension exclusion box
'
Procedure Ext_box
  Defline 1,3
  If Rez%<>2
    Color 2
  Endif
  Box 472,Rez%,639,Rez%*199
  Defline 1,1
  Line 514,Rez%,514,Rez%*199
  Line 555,Rez%,555,Rez%*199
  Line 596,Rez%,596,Rez%*199
  For I%=1 To 21
    Line 472,Rez%*(I%*9+1),639,Rez%*(I%*9+1)
  Next I%
  Deftext 1,0,0,Tx1%
  For I%=1 To 4
    For J%=1 To 22
      Text ((I%-1)*40)+473+I%,Rez%*((J%*8)+J%-1),"     "
      If S_ext!(I%,J%)=False
        Graphmode 4
      Else
        Graphmode 1
      Endif
      Text ((I%-1)*40)+473+I%,Rez%*((J%*8)+J%-1)," "+S_ext$(I%,J%)+" "
      Graphmode 1
    Next J%
  Next I%
Return
'
' Exclude this program?
'
Procedure Ext_chk
  Ext_f!=True
  For I%=1 To 4
    For J%=1 To 22
      If File_ext$=S_ext$(I%,J%) And S_ext!(I%,J%)=False
        Ext_f!=False
      Endif
    Next J%
  Next I%
Return
'
' draw command boxes
'
Procedure Com_box
  Sget M_scr$
  If Rez%<>2
    Color 2
  Endif
  Defline 1,3
  Box 3,Rez%*3,304,Rez%*70
  Line 3,Rez%*4,304,Rez%*4
  Line 3,Rez%*13,304,Rez%*13
  Line 3,Rez%*14,304,Rez%*14
  If Rez%=1
    Deftext 2,0,0,Tx1%
  Else
    Deftext 0,0,0,Tx1%
  Endif
  If Rez%<>2
    Deffill 3,1
  Else
    Deffill 1,1
  Endif
  Fill 6,Rez%*6
  Graphmode 2
  Temp$=Chr$(14)+Chr$(15)+" "
  Text 32,Rez%*11,Temp$+Temp$+Temp$+"THE DIRECTOR"+" "+Temp$+Temp$+Temp$
  Line 3,Rez%*32,304,Rez%*32
  Line 3,Rez%*33,304,Rez%*33
  Line 3,Rez%*42,304,Rez%*42
  Line 3,Rez%*51,304,Rez%*51
  Line 3,Rez%*52,304,Rez%*52
  Line 3,Rez%*61,304,Rez%*61
  Line 152,Rez%*52,152,Rez%*70
  If Rez%=1
    Deftext 3,0,0,Tx1%
  Else
    Deftext 0,0,0,Tx1%
  Endif
  Deffill 1,1
  Fill 44,Rez%*21
  Text 44,Rez%*21,"     by Robert H. Pyle     "
  Text 37,Rez%*30,"(C) 1988 Antic Publishing Inc."
  Graphmode 1
  Deftext 1,0,0,Tx1%
  Temp$="Number Of Files In Array: "+Str$(Fcnt%)
  Text (300-Len(Temp$)*8)/2+3,Rez%*40,Temp$
  Temp$="Current Free Memory: "+Str$(Fre(0))+" bytes"
  Text (300-Len(Temp$)*8)/2+3,Rez%*49,Temp$
  Text 26,Rez%*59,"File Maximum"
  Text 170,Rez%*59,"Folder Maximum"
  Text (150-(8*Len(Str$(Fil_num%))))/2,Rez%*68,Str$(Fil_num%)
  Text (150-(8*Len(Str$(Fol_num%))))/2+150,Rez%*68,Str$(Fol_num%)
  If Rez%<>2
    Deffill 2
  Endif
  Pbox 1,Rez%*75,306,Rez%*92
  Graphmode 2
  If Rez%=1
    Deftext 0,1,0,Tx2%
  Else
    Deftext 0,1,0,Tx1%
  Endif
  Text 70,Rez%*89,160,"CONTROL SETTINGS"
  Graphmode 1
  Box 3,Rez%*92,304,Rez%*110
  Line 3,Rez%*101,304,Rez%*101
  Defline 1,4
  Line 152,Rez%*92,152,Rez%*110
  Deftext 1,0,0,Tx1%
  Text 25,Rez%*99,"Load Settings"
  Text 177,Rez%*99,"Save Settings"
  Text 13,Rez%*108,"Set File Maximum"
  Text 156,Rez%*108,"Set Folder Maximum"
  Pbox 1,Rez%*115,303,Rez%*123
  Deftext 0,1,0,Tx1%
  Graphmode 2
  Text 80,Rez%*122,140,"OUTPUT OPTIONS"
  Graphmode 1
  Defline 1,3
  Box 3,Rez%*123,301,Rez%*195
  For I%=132 To 186 Step 9
    Line 3,Rez%*I%,301,Rez%*I%
  Next I%
  Defline 1,4
  Line 152,Rez%*123,152,Rez%*195
  Deftext 1,0,0,Tx1%
  Text 24,Rez%*130,"*OUTPUT MODE*"
  Text 190,Rez%*130,"*EXCLUDE*"
  @Show_out
  @Show_exclude
  ' extension master box
  Box 322,Rez%*104,460,Rez%*130
  Line 322,Rez%*121,460,Rez%*121
  Line 322,Rez%*112,460,Rez%*112
  If Rez%<>2
    Deffill 2,1
  Endif
  Fill 325,Rez%*107
  Deftext 0,0,0,Tx1%
  Graphmode 2
  Text 350,Rez%*111,"EXTENSIONS"
  Graphmode 1
  Deftext 1,0,0,Tx1%
  Text 346,Rez%*119,"Include All"
  Text 346,Rez%*128,"Exclude All"
  ' start box
  If Rez%<>2
    Deffill 3,1
  Endif
  Pbox 322,Rez%*74,460,Rez%*94
  Box 322,Rez%*74,460,Rez%*94
  Graphmode 3
  Text 335,Rez%*88,"READ DIRECTORY"
  Graphmode 1
  ' help box
  If Rez%<>2
    Deffill 3,1
  Endif
  Pbox 322,Rez%*14,460,Rez%*34
  Box 322,Rez%*14,460,Rez%*34
  Graphmode 3
  Text 375,Rez%*28,"HELP"
  Graphmode 1
  ' begin output box
  If Rez%<>2
    Deffill 2,1
  Endif
  Pbox 322,Rez%*44,460,Rez%*64
  Color 1
  Box 322,Rez%*44,460,Rez%*64
  If Rez%<>2
    Color 2
  Endif
  Graphmode 2
  Deftext 0,0,0,Tx1%
  Text 343,Rez%*58,"BEGIN OUTPUT"
  Deftext 1,0,0,Tx1%
  Graphmode 1
  ' exit box
  Color 1
  Box 322,Rez%*190,460,Rez%*199
  If Rez%<>2
    Deffill 3,1
  Endif
  Fill 326,Rez%*194
  Graphmode 2
  If Rez%=2
    Deftext 0,0,0,Tx1%
  Endif
  Text 332,Rez%*197,"Exit To Desktop"
  Graphmode 1
  ' disk selector
  If Rez%<>2
    Color 2
  Endif
  Defline 1,3
  Box 322,Rez%*141,460,Rez%*159
  Defline 1,1
  Line 391,Rez%*141,391,Rez%*159
  Deftext 1,0,0,Tx1%
  Text 329,Rez%*149,"CURRENT"
  Text 337,Rez%*157,"DRIVE"
  Defline 1,3
  Box 322,Rez%*159,460,Rez%*177
  Defline 1,1
  Line 323,Rez%*168,459,Rez%*168
  Deftext 1,0,0,Tx2%
  Text 421,Rez%*155,Chr$(Curr_drive%+65)
  For I%=340 To 442 Step 17
    Line I%,Rez%*159,I%,Rez%*177
  Next I%
  For J%=0 To 1
    For I%=0 To 7
      If Mid$(Map$,17-(J%*8+I%+1),1)="1"
        Deftext 1,0,0,Tx1%
      Else
        Deftext 1,2,0,Tx1%
      Endif
      Text (I%)*17+328,Rez%*(J%*9+166),Chr$(I%+J%*8+65)
    Next I%
  Next J%
Return
'
' draw exclude labels
'
Procedure Show_exclude
  Deftext 1,0,0,Tx1%
  For I%=1 To 7
    @T_exclude
  Next I%
  Graphmode 1
Return
'
' print exclude text
'
Procedure T_exclude
  If In_clude!(I%)=True
    Graphmode 1
    Text 155,Rez%*((I%-1)*9+139),Space$(18)
  Else
    Graphmode 1
    Text 155,Rez%*((I%-1)*9+139),Space$(18)
    Graphmode 4
  Endif
  Text 155,Rez%*((I%-1)*9+139),In_clude$(I%)
  Graphmode 1
Return
'
' draw output labels
'
Procedure Show_out
  Deftext 1,0,0,Tx1%
  For I%=1 To 7
    If Op_mode!(I%)=True
      Graphmode 1
      Text 6,Rez%*((I%-1)*9+139),Space$(18)
      Graphmode 4
    Else
      Graphmode 1
      Text 6,Rez%*((I%-1)*9+139),Space$(18)
    Endif
    Text 6,Rez%*((I%-1)*9+139),Op_mode$(I%)
  Next I%
  Graphmode 1
Return
'
' read first directory entry, set flag indicating first entry has been read
'
Procedure Dir_read_first
  First_dir%=False
  Mid$(Buf$,30,13)=Space$(13)
  D0=Gemdos(&H4E,L:File_path_ptr%,W:File_attr%)
  If D0=-33
    If File_attr%<>8
      Msg2$="File Not Found"
      Msg3$="No files or folders"
      Msg4$="are on this disk."
      @Msg_box1
    Endif
  Endif
Return
'
' read next directory entry
'
Procedure Dir_read_next
  Mid$(Buf$,30,13)=Space$(13)
  D0=Gemdos(&H4F)
  If Do=-33
    Msg2$="File Not Found"
    Msg3$="No files or folders"
    Msg4$="are on this disk."
    @Msg_box1
  Endif
Return
'
' process data in dta buffer (Buf$)
'
Procedure File_process
  If Fcnt%+1>Fil_num%
    Alert 1,"Not enough room in the Files|Array for this directory.|Save data and then re-read|this directory.",1,"Continue",But%
    Fcnt%=Prev_fcnt%
    Full_flag!=True
  Else
    Temp_attr%=Peek(Dta%+21)
    Temp_name$=Mid$(Buf$,31,12)
    If Left$(Temp_name$,1)<>"."
      Scnt%=13
      Repeat
        Dec Scnt%
      Until Mid$(Temp_name$,Scnt%,1)<>" "
      Temp_name$=Left$(Temp_name$,Scnt%)
      If Right$(Temp_name$,1)=Chr$(0)
        Temp_name$=Left$(Temp_name$,Len(Temp_name$)-1)
      Endif
      If Temp_attr%=16
        If C_folder%=0
          Folder$(N_folder%)="\"+Dir$(0)+Temp_name$+"\"
        Else
          Folder$(N_folder%)=Dir$(0)+"\"+Temp_name$+"\"
        Endif
        Inc N_folder%
        @Convert
        Inc Fcnt%
        Finame$(Fcnt%)=File_name$
        Fext$(Fcnt%)=File_ext$
        Fsize$(Fcnt%)=" FOLDER"
        Fdate$(Fcnt%)=File_date$
        Ftime$(Fcnt%)=File_time$
        Fpath$(Fcnt%)=Folder$(C_folder%)
        Fvolume$(Fcnt%)=Volume$
        Favolume$(Fcnt%)=Avolume$
      Else
        @Convert
        @Ext_chk
        If Ext_f!=True
          Inc Fcnt%
          Finame$(Fcnt%)=File_name$
          Fext$(Fcnt%)=File_ext$
          Fsize$(Fcnt%)=File_size$
          Fdate$(Fcnt%)=File_date$
          Ftime$(Fcnt%)=File_time$
          Fpath$(Fcnt%)=Folder$(C_folder%)
          Fvolume$(Fcnt%)=Volume$
          Favolume$(Fcnt%)=Avolume$
        Endif
      Endif
    Endif
  Endif
Return
'
' convert and format filesize, time, date, filename and extension
'
Procedure Convert
  '
  ' convert name and extension
  Ext%=Instr(Temp_name$,".")
  If Ext%>0
    File_ext$="   "
    Lset File_ext$=Mid$(Temp_name$,Ext%+1)
    File_name$=Left$(Left$(Temp_name$,Ext%-1)+"        ",8)
  Else
    File_ext$="   "
    File_name$=Left$(Temp_name$+"        ",8)
  Endif
  '
  File_size%=Lpeek(Dta%+26)
  Date%=Dpeek(Dta%+24)
  Time%=Dpeek(Dta%+22)
  '
  '   Now we extract time and date info and put'em into an array.
  Day%=Date% And (&H1F)   !DAY are bits 0-4   (1-31)
  Tempdate%=Date%
  Div Tempdate%,32
  Month%=Tempdate% And (&HF) !Months are bits 5-8  (1-12)
  Tempdate%=Date%
  Div Tempdate%,512
  Year%=(Tempdate% And (&H7F))+1980  !YEAR is bits 9-15 (add 1980)
  Seconds%=Time% And (&H1F)  !SECONDS are bits 0-4 (0-29)
  Mul Seconds%,2                     !multiply by two for correct val
  Temptime%=Time%
  Div Temptime%,32
  Minutes%=Temptime% And (&H3F)      !MINUTES are bits 5-10 (0-59)
  Div Temptime%,64
  Hours%=Temptime% And (&H1F)        !HOURS are bits 11-15 (0-23)
  File_time$=Right$("00"+Str$(Hours%),2)+":"+Right$("00"+Str$(Minutes%),2)+":"+Right$("00"+Str$(Seconds%),2)
  File_date$=Right$("00"+Str$(Month%),2)+"/"+Right$("00"+Str$(Day%),2)+"/"+Right$(Str$(Year%),2)
  File_size$=Right$("       "+Str$(File_size%),7)
Return
'
' read volume name
'
Procedure Volume
  File_attr%=8
  @Dir_read_first
  If D0<>-33 ! (-33 = file not found)
    Volume$=Mid$(Buf$,31,12)
    Scnt%=13
    Repeat     ! parse vol name, strip excess spaces
      Dec Scnt%
    Until Mid$(Volume$,Scnt%,1)<>" " Or Scnt%=0
    If Scnt%=0
      Volume$=""
    Else
      Volume$=Left$(Volume$,Scnt%)
    Endif
    @Vol_name
  Else
    Volume$=""
    @Vol_name
  Endif
  First_dir%=True
Return
'
' rename volume?
'
Procedure Vol_name
  If Volume$<>""
    If Right$(Volume$,1)=Chr$(0)
      Volume$=Left$(Volume$,Len(Volume$)-1)
      For Ii%=1 To Len(Volume$)
        If Mid$(Volume$,Ii%,1)<" "
          Mid$(Volume$,Ii%,1)=Chr$(Asc(Mid$(Volume$,Ii%,1))+32)
        Endif
      Next Ii%
    Endif
  Else
    Volume$="*UNNAMED*"
  Endif
  Temp$=Space$(12)
  Lset Temp$=Volume$
  Volume$=Temp$
Return
'
' *************************** save original pallette
Procedure Savecolors
  For Z%=0 To 15
    Dpoke Contrl,26
    Dpoke Contrl+2,0
    Dpoke Contrl+6,2
    Dpoke Intin,Z%
    Dpoke Intin+2,0
    Vdisys
    Spalette%(Z%,0)=Dpeek(Intout+2)
    Spalette%(Z%,1)=Dpeek(Intout+4)
    Spalette%(Z%,2)=Dpeek(Intout+6)
  Next Z%
Return
'
' *************************** restore original pallette
Procedure