{ filesel.inc by Kari Lammassaari 1997 }
{ Uses:
 - readvram.inc
 - wrtvram.inc
 - fillvram.inc
 - msxdos2.inc
 - blink.inc
 - txtwin.inc
 - readstr2.inc
 - filename.inc
}
{
 REM filesel.inc DOES NOT WORK with Turbo Pascal 3.3 due to the BUG in the
 pointer operations of TP 3.3
}

Function  FileSelect(Column:Byte):StringType;

Const Row = 1;

Type
      DirListPtrType  = ^DirListType;
      DirListType = Record
                       Next     :DirListPtrType;
                       Previous :DirListPtrType;
                       FileName :FileNameType;
                       Attribute:Byte;
                    End;
     { Pointer      = ^Byte;}

Var Origx,OrigY,OrigDrv  :Byte;
    DirListPtr,DlistPtr  :DirListPtrType;
    FileListPtr,FlistPtr :DirListPtrType;
    FileFilter           :FileNameType;
    CurrentDirectory     :StringType;
    FileName             :StringType;
    CurDirWindowPtr      :Pointer;
    DriveWindowPtr       :Pointer;
    DriveSt              :String[39];
    DriveCount           :Byte;
    FileNameWindowPtr    :Pointer;
    SubDirWindowPtr      :Pointer;
    FileWindowPtr        :Pointer;
    i,WindowNumber       :Integer;
    Ch                   :Char;

Function CreateFileList(FileFilter:StringType):DirListPtrType;
  Var  FileListPtr,Apu,Viitta,Root :DirListPtrType;
  Begin
    FindFirst(FileFilter,Directory+System+Archive+Hidden+ReadOnly ,Fib);
    If MsxIOResult <> 0 Then
      Begin
        CreateFileList := Nil;
        Exit;
      End;
    New(FileListPtr);
    Root := FileListPtr;
    FileListPtr^.Previous := Nil;
    FileListPtr^.Next := Nil;
    FileListPtr^.Attribute := Fib.FileAttribute;
    FileListPtr^.FileName := AsciiZToString(Fib.FileName);
    If (FilelistPtr^.Attribute And Directory) <> Directory Then
      PadFileName(FileListPtr^.FileName)
    Else FileListPtr^.Filename :=
       Copy(FileListPtr^.FileName+'            ',1,12);

    While MsxIOResult = 0 Do
     Begin
       FindNext(Fib);
       If MsxIOResult = 0 Then
        Begin
          Apu := FileListPtr;
          New(FileListPtr);
          Apu^.Next := FileListPtr;
          FileListPtr^.Next := Nil;
          FileListPtr^.Previous := Apu;

          FileListPtr^.FileName := AsciiZToString(Fib.FileName);
          FileListPtr^.Attribute := Fib.FileAttribute;
          If (FilelistPtr^.Attribute And Directory) <> Directory Then
            PadFileName(FileListPtr^.FileName)
          Else FileListPtr^.Filename :=
            Copy(FileListPtr^.FileName+'            ',1,12);

        End; {If}
     End;
   CreateFileList := Root;
  End; {CreateFileList}

Procedure RemoveFromList(Attribute:Byte;Var ListPtr:DirListPtrType);

  Var Viitta,apu :DirListPtrType;
  Begin
     If ListPtr = Nil Then Exit;
     Viitta :=ListPtr;
     While Viitta <> Nil Do
      Begin
         Apu := Viitta^.Next;
         If (Viitta^.Attribute And Attribute) = Attribute Then
           Begin
             If (Viitta^.Next = Nil) And (Viitta^.Previous = Nil) Then
               Begin {The only item in list }
                 Dispose(Viitta);
                 ListPtr := Nil;
                 Exit;
               End;

             If Viitta^.Previous = Nil Then {First in list  }
               Begin
                 ListPtr := Apu;
                 ListPtr^.Previous := Nil;
                 Dispose(Viitta);
               End
             Else
             If Viitta^.Next = Nil Then {Last in list }
               Begin
                 Viitta^.Previous^.Next := Nil;
                 Dispose(Viitta);
                 Exit;     {last item ,All done }
               End
             { In the middle of list }
             Else
              Begin
                Viitta^.Previous^.Next := Viitta^.Next;
                Viitta^.Next^.Previous := Viitta^.Previous;
                Dispose(Viitta);
              End;
           End; {If attribute ..}
        Viitta := apu;
      End; {While}
    End; {removefromlist}

Procedure RenumberList(ListPtr:DirListPtrType);

  Var Viitta :DirListPtrType;
      Index  :Integer;    {Reversal index , last is 1.}

  Begin
    Viitta := ListPtr;
    If Viitta = Nil Then Exit;

    While Viitta^.Next <> Nil Do Viitta := Viitta^.Next; {Find top}
    Index := 1;
    While Viitta <> Nil Do
     Begin
       Viitta^.Attribute := Index;
       Index := Index +1 ;
       Viitta := Viitta^.Previous;
     End;
  End; {RenumberList}

Procedure DisposeFilelist(Var ListRoot:DirListPtrType);

  Var Viitta,apu :DirListPtrType;
  Begin
   If ListRoot = Nil Then Exit;
   Viitta := ListRoot;
   While Viitta <> Nil Do
    Begin
      apu := Viitta^.next;
      Dispose(Viitta);
      Viitta := apu;
    End;
   ListRoot := Nil;
 End;

Function CreateDirList:DirListPtrType;
  Var  DirListPtr,Apu,Viitta,DRoot :DirListPtrType;
  Begin
    If FileListPtr = Nil Then
     Begin
       CreateDirList := Nil;
       Exit;
     End;
    Viitta := FileListPtr;
    New(DirListPtr);
    DirListPtr^.Previous := Nil;
    DirListPtr^.Next := Nil;
    DRoot := DirListPtr;

    While Viitta <> Nil Do
     Begin
       If (Viitta^.Attribute And Directory) = Directory  Then
         Begin
           Apu := DirListPtr;
           New(DirListPtr);
           DirlistPtr^.Next := Nil;
           DirListPtr^.Previous :=Apu;
           Apu^.Next := DirListPtr;
           If Pos(' .',Viitta^.FileName) = 0 Then
                          Apu^.FileName := Viitta^.FileName
            Else If Pos('..',Viitta^.FileName) <> 0 Then
                          Apu^.FileName := '..          '
                     Else Apu^.FileName := '.           ';
         End;
       Viitta := Viitta^.Next;
     End;
   If DRoot^.Next = Nil Then DRoot := Nil {No directories found}
    Else Apu^.Next := Nil;
   Dispose(DirListPtr);    {Remove last , empty item}
   CreateDirList := DRoot;

  End; {CreateDirList}

Procedure DisposeDirList(Var ListRoot:DirListPtrType);

  Var Viitta,apu :DirListPtrType;
  Begin
   If ListRoot = Nil Then Exit;
   Viitta := ListRoot;
   While Viitta <> Nil Do
    Begin
      apu := Viitta^.next;
      Dispose(Viitta);
      Viitta := apu;
    End;
   ListRoot := Nil;
 End;

Procedure UpdateFileList(pt:DirListPtrType);
  Var i :Byte;
      Viitta :DirListPtrType;
      at     :Integer Absolute FileWindowPtr;
  Begin
   Mem[at+5] := 1;
   Viitta := pt;
     For i := 1 to 13 Do
       Begin
        If Viitta <> Nil Then
          Begin
             WritelnWindow(FileWindowPtr,' '+Viitta^.FileName+' ');
             Viitta := Viitta^.Next;
          End
        Else WritelnWindow(FileWindowPtr,'             ');

    End;
   Mem[at+5] := 1;
  End;

Procedure UpdateDirList(pt:DirListPtrType);
  Var i :Byte;
      Viitta :DirListPtrType;
      at     :Integer Absolute SubDirWindowPtr;
  Begin
   Mem[at+5] := 1;
   Viitta := pt;
   For i := 1 to 13 Do
    Begin
       If Viitta <> Nil Then
        Begin
          WritelnWindow(SubDirWindowPtr,' '+Viitta^.FileName+' <DIR>');
          Viitta := Viitta^.Next;
        End
       Else WritelnWindow(SubDirWindowPtr,'                   ');
    End;
   Mem[at+5] := 1;
  End;



Procedure DriveInfoWindow;
   Var
       Ramdisk  :String[2];
       i        :Byte;

   Begin
    DriveCount := GetDriveCount;
    If GetRamdiskSize = 0 Then Ramdisk :='  ' Else Ramdisk := 'H:';
    DriveWindowPtr := MakeWindow(Column,Row+21,39,3,' Drives ');
    DriveSt :='';
    For i := 1 to DriveCount Do DriveSt := DriveSt+'  '+Chr(64+i)+':';
    DriveSt := DriveSt +'  '+Ramdisk;
    WritelnWindow(DriveWindowPtr,DriveSt);
   End;

Procedure FileNameWindow(Filter:FileNameType);

   Begin
      FileNameWindowPtr := MakeWindow(Column,Row,39,3,' Filename / filter ');
      WritelnWindow(FileNameWindowPtr,' File name : '+Filter);
   End;

Procedure SubDirInfoWindow;

    Begin
       SubDirWindowPtr := MakeWindow(Column,Row+6,22,15,' Directories ');
       UpdateDirList(DirListPtr);
    End;


Procedure CurDirInfoWindow;

  Begin
      CurrentDirectory := ' '+GetCurrentDrive + '\' + GetCurrentDirectory(0);
      CurDirWindowPtr := MakeWindow(Column,Row+3,39,3,' Current path ');
      WritelnWindow(CurDirWindowPtr,CurrentDirectory);
  End;

Procedure FileWindow;
 Begin
  FileWindowPtr :=MakeWindow(Column+23,Row+6,16,15,' Files ');
  UpdateFileList(FileListPtr);
 End;

Procedure GetDirectoryData; {Updates FilelistPtr,DirListPtr}
  Begin
    If FileListPtr <> Nil Then DisposeFileList(FileListPtr);{Destroy old list }
    If DirListPtr <> Nil Then DisposeDirList(DirListPtr);

    FileListPtr := CreateFileList(FileFilter);
    DirListPtr := CreateDirList;
    RemoveFromList(Directory,FileListPtr);
    FlistPtr := FileListPtr;
    DListPtr := DirListPtr;
    ReNumberList(FileListPtr);
    ReNumberList(DirListPtr);
 End;

Procedure FreeMemory; {Remove window buffers,lists}
  Begin
    DisposeFileList(FileListPtr);
    DisposeDirList(DirListPtr);
    EraseWindow(FileWindowPtr);
    EraseWindow(FileNameWindowPtr);
    EraseWindow(CurDirWindowPtr);
    EraseWindow(DriveWindowPtr);
    EraseWindow(SubDirWindowPtr);
  End;

Procedure FileOperation;   {Uses global pointer to list = FListPtr }
  Var at  :Integer Absolute FileWindowPtr;
      Row :Byte;
  Begin
   Row := Mem[at+5];
   GotoWindowXY(FileWindowPtr,1,Row);
   CursorBlink(14);
   Repeat
    Ch := '@';
    If keyPressed Then Read(Kbd,ch);

      Case Ch Of
        #31 : Begin
                ClearCursorBlink(14);
                Row := Row + 1;
                If Row = 14 Then
                 Begin
                  Row := 13;
                  If FlistPtr <> Nil Then
                   If FlistPtr^.Attribute > 13 Then
                    Begin
                      FlistPtr:= FlistPtr^.Next;
                      UpdateFileList(FlistPtr);
                    End;
                 End;
                GotoWindowXY(FileWindowPtr,1,Row);
                CursorBlink(14);
                Mem[At+5] :=Row;
              End;

        #30 : Begin
                ClearCursorBlink(14);
                Row := Row - 1;
                If Row = 0 Then
                 Begin
                   Row := 1;
                   If FlistPtr <> Nil Then
                    If FlistPtr^.Previous <> Nil Then
                     Begin
                      FlistPtr:= FlistPtr^.Previous;
                      UpdateFileList(FlistPtr);
                     End;
                 End;
                GotoWindowXY(FileWindowPtr,1,Row);
                CursorBlink(14);
                Mem[At+5] :=Row;
              End;

        #9  : Begin
               WindowNumber := WindowNumber+1;
               ClearCursorBlink(14);
              End;
       #13  : Begin
                ClearCursorBlink(14);
                FileName := Copy(ReadCursorString(13),2,12)
                ; {Return Value }
                If FileName[1] <> ' 'Then
                      Begin
                        WindowNumber := 100;  {Exit value}
                        FileName := RestoreFileName(FileName);
                      End;
                Ch := #9;
              End;
      End; {Case}

   Until Ch = #9;

  End; {FileOperation}

Procedure DirectoryOperation;   {Uses global pointer to list = DListPtr }
  Var at  :Integer Absolute SubDirWindowPtr;
      Row :Byte;
      St  :StringType;
  Begin
   Row := Mem[at+5];
   GotoWindowXY(SubDirWindowPtr,1,Row);
   CursorBlink(20);
   Repeat
    Ch := '@';
    If keyPressed Then Read(Kbd,ch);
      Case Ch Of
        #31 : Begin
                Row := Row + 1;
                ClearCursorBlink(20);
                If Row = 14 Then
                 Begin
                   Row := 13;
                   If DlistPtr <> Nil Then
                    If  DlistPtr^.Attribute > 13 Then
                     Begin
                       DlistPtr:= DlistPtr^.Next;
                       UpdateDirList(DlistPtr);
                     End;
                 End;
                GotoWindowXY(SubDirWindowPtr,1,Row);
                CursorBlink(20);
                Mem[at+5] := Row;
              End;

        #30 : Begin
                Row := Row - 1;
                ClearCursorBlink(20);
                If Row = 0 Then
                  Begin
                    Row := 1;
                    If DlistPtr <> Nil Then
                     If DlistPtr^.Previous <> Nil Then
                       Begin
                         DlistPtr:= DlistPtr^.Previous;
                         UpdateDirList(DlistPtr);
                       End;
                  End;
                GotoWindowXY(SubDirWindowPtr,1,Row);
                CursorBlink(20);
                Mem[at+5] := Row;
              End;

        #13,#32
            : Begin
                ClearCursorBlink(20);
                St := Copy(ReadCursorString(13),2,12);
                If Pos('..',St) <> 0 Then St := '..'
                Else If Pos(' ',St) <> 0 Then St := Copy(St,1,Pos(' ',St)-1);

                ChDir(St);
                GotoWindowXy(CurDirWindowPtr,1,1);
                ClrEolWindow(CurDirWindowPtr);
                CurrentDirectory := ' '+GetCurrentDrive + '\' +
                                     GetCurrentDirectory(0);
                WritelnWindow(CurDirWindowPtr,CurrentDirectory);

                GetDirectoryData;
                UpdateDirList(DirListPtr);
                UpdateFileList(FileListPtr);
                GotoWindowXY(SubDirWindowPtr,1,Row);
                CursorBlink(20);
              End;

        #9  : Begin
               ClearCursorBlink(20);
               WindowNumber := WindowNumber+1;
              End;
      End; {Case}

   Until Ch = #9;

  End; {DirectoryOperation}

Procedure DriveOperation;
  Var Index  :Integer;
      DCh    :Char;
  Begin
   Index := Pos(GetCurrentDrive,DriveSt) Div 4;
   GotoWindowXy(DriveWindowPtr,Index * 4 +3,1);
   CursorBlink(1);
   Repeat
    Ch := '@';
    If KeyPressed Then Read(Kbd,ch);

    Case Ch Of
        #29 : Begin
                ClearCursorBlink(1);
                Index := Index -  1 ;If Index < 0 Then Index := DriveCount;
                GotoWindowXY(DriveWindowPtr,Index*4+3,1);
                CursorBlink(1);
              End;
        #28 : Begin
                ClearCursorBlink(1);
                Index := Index +  1 ;If Index > DriveCount Then Index := 0;
                GotoWindowXY(DriveWindowPtr,Index*4+3,1);
                CursorBlink(1);
              End;

        #32,#13
            : Begin
                DCh := ReadCursorChar;
                ChDrv(Ord(DCh)-65);

                GotoWindowXy(CurDirWindowPtr,1,1);
                ClrEolWindow(CurDirWindowPtr);
                CurrentDirectory := ' '+GetCurrentDrive + '\' +
                                     GetCurrentDirectory(0);
                WritelnWindow(CurDirWindowPtr,CurrentDirectory);
                GotoWindowXY(DriveWindowPtr,Index*4+3,1);

                GetDirectoryData;
                UpdateDirList(DirListPtr);
                UpdateFileList(FileListPtr);

              End;

        #9  : Begin
               ClearCursorBlink(1);
               WindowNumber := WindowNumber+1;
              End;
      End; {Case}

   Until Ch = #9;

  End; {DriveOperation}


Procedure PathOperation;
  Var Path :StringType;
      DCH  :Char;
  Begin
   GotoWindowXy(CurDirWindowPtr,2,1);
   CursorBlink(35);
   Repeat
    Ch := '@';
    If keyPressed Then Read(Kbd,ch);

    Case Ch Of
        #13,#32
            : Begin
                ClearCursorBlink(35);
                GotoWindowXy(CurDirWindowPtr,2,1);
                ClrEolWindow(CurDirWindowPtr);
                Path := ReadString(35);
                ChDir(Path);
                If MsxIOResult <> 0 Then
                  Begin
                    Write(^g) ;
                    GotoWindowXy(CurDirWindowPtr,1,1);
                    ClrEolWindow(CurDirWindowPtr);
                  End
                 Else
                  Begin
                    If Pos(':',Path)<> 0 Then
                      Begin
                         DCh := UpCase(Path[1]);
                         ChDrv(Ord(DCh)-65);
                      End;
                    GetDirectoryData;
                    UpdateDirList(DirListPtr);
                    UpdateFileList(FileListPtr);
                  End;
                GotoWindowXy(CurDirWindowPtr,2,1);
                CursorBlink(35);
                CurrentDirectory := ' '+GetCurrentDrive + '\' +
                                     GetCurrentDirectory(0);
                GotoWindowXy(CurDirWindowPtr,2,1);

                WritelnWindow(CurDirWindowPtr,CurrentDirectory);
                GotoWindowXy(CurDirWindowPtr,2,1);
              End;

        #9  : Begin
               ClearCursorBlink(35);
               WindowNumber := WindowNumber+1;
              End;
      End; {Case}

   Until Ch = #9;

  End; {PathOperation}

Procedure FileNameOperation;

  Begin
   GotoWindowXy(FileNameWindowPtr,14,1);
   CursorBlink(12);
   Repeat
    Ch := '@';
    If keyPressed Then Read(Kbd,ch);

    Case Ch Of

        #13,#32
            :Begin
               ClearCursorBlink(12);
               GotoWindowXy(FileNameWindowPtr,14,1);
               ClrEolWindow(FileNameWindowPtr);
               FileFilter := ReadString(12);
               If FileFilter = '' Then FileFilter := '*.*';
               GotoWindowXy(FileNameWindowPtr,14,1);
               CursorBlink(12);

               If FileListPtr <> Nil Then DisposeFileList(FileListPtr);
               FileListPtr := CreateFileList(FileFilter);
               RemoveFromList(Directory,FileListPtr);
               FlistPtr := FileListPtr;
               ReNumberList(FileListPtr);
               UpdateFileList(FileListPtr);

               CursorBlink(12);
             End;
        #9  : Begin
               ClearCursorBlink(12);
               WindowNumber := WindowNumber+1;
              End;
      End; {Case}

   Until Ch = #9;

  End; {FileNameOperation}



{*** main ***}

Begin
  OrigX := WhereX;OrigY:= WhereY;
  OrigDrv := Ord(Copy(GetCurrentDrive,1,1))-65;
  ClearAllBlinks;
  SetBlinkColors(Black,DYellow);
  SetBlinkRate(15,0);

  FileListPtr := Nil; {Init}
  DirListPtr  := Nil;
  FileFilter := '*.*';
  GetDirectoryData;

  DriveInfoWindow;
  FileNameWindow(FileFilter);
  SubDirInfoWindow;
  CurDirInfoWindow;
  FileWindow;

  WindowNumber := 1;
  Repeat
   Case WindowNumber Of
     1 :FileOperation;
     5 :DirectoryOperation;
     2 :DriveOperation;
     3 :FileNameOperation;
     4 :PathOperation;
   End;
   If WindowNumber = 6 Then WindowNumber := 1;
  Until WindowNumber = 100; {File Selected}

  FreeMemory;
  ClearAllBlinks;
  If Length(CurrentDirectory)= 4 Then
    FileSelect := Copy(CurrentDirectory,2,Length(CurrentDirectory)-1) +Filename
   Else FileSelect := Copy(CurrentDirectory,2,Length(CurrentDirectory)-1)
                      + '\' + FileName;
  GotoXY(OrigX-1,OrigY-1);
  ChDrv(OrigDrv);
End;  {Filesel }