//**********************************************************************
// Use Fdx5.utl     // Basic administration of FDX objects
//
// By Sture Andersen
//
// Create: Sun  16-01-2000
// Update:
//
//**********************************************************************

Use FDX.nui      // cFDX class
Use Fdx4.utl     // FDX aware cFileList_List selector object
Use Files.utl    // Utilities for handling file related stuff
Use Macros.utl   // Various macros (FOR_EX...)
Use MsgBox.utl   // obs procedure
Use Wait.utl     // Something to put on screen while batching.
Use SetFiles.utl // SetOfFiles class
Use FdxSet.nui   // cFdxSetOfFiles, cFdxSetOfFields, cFdxSetOfIndices

#IFDEF IS$WINDOWS
 object oSentinelAbstraction is a cBatchCompanion no_image
  #IFDEF DF_FLEX_ALL_RIGHTS // VDF6
   set Allow_Cancel_State to false
  #ENDIF
#ELSE
 object oSentinelAbstraction is a cArray no_image
#ENDIF
  procedure Wait_On
    #IFDEF IS$WINDOWS
     //send cursor_wait to (cursor_control(self))
     send batch_on "DFMatrix batch process"
    #ELSE
     send ScreenEndWait_On 0 0
    #ENDIF
  end_procedure
  procedure Wait_Off
    #IFDEF IS$WINDOWS
     //send cursor_ready to (cursor_control(self))
     send batch_off
    #ELSE
     send ScreenEndWait_Off
    #ENDIF
  end_procedure
  procedure Wait_Text1 string str#
    #IFDEF IS$WINDOWS
     send batch_update str#
    #ELSE
     send ScreenEndWait_SetText str#
    #ENDIF
  end_procedure
  procedure Wait_Text2 string str#
    #IFDEF IS$WINDOWS
     send batch_update2 str#
    #ELSE
     send ScreenEndWait_SetText2 str#
    #ENDIF
  end_procedure
end_object

class cDFM_ListDir_SnapShot is a cSetOfFiles
  procedure Wait_SetText string str#
    delegate send Wait_SetText str#
  end_procedure
  procedure Wait_SetText2 string str#
    delegate send Wait_SetText2 str#
  end_procedure
end_class // cDFM_ListFile_SnapShot

procedure fdx.wait.on global
  send wait_on to (oSentinelAbstraction(self))
end_procedure
procedure fdx.wait.off global
  send wait_off to (oSentinelAbstraction(self))
end_procedure
procedure fdx.wait.text1 global string str#
  send wait_text1 to (oSentinelAbstraction(self)) str#
end_procedure
procedure fdx.wait.text2 global string str#
  send wait_text2 to (oSentinelAbstraction(self)) str#
end_procedure

class cDFM_Fdx is a cFDX
  procedure construct_object integer img#
    forward send construct_object img#
    property integer piDirsPresentInFile public 0 //> Is dir information present in most currently read file?
    property integer piDirsLoaded        public 0 //> Have the dir information already been loaded?
    property integer piDirsOffSet        public 0 //> Offset where dir information begins
    object oListDir_SnapShot is a cDFM_ListDir_SnapShot no_image
    end_object
  end_procedure
  procedure Reset
    forward send Reset
    set piDirsLoaded to false
    set piDirsPresentInFile to false
    send reset to (oListDir_SnapShot(self))
  end_procedure
  procedure Read_Directory_Contents_From_File
    local integer ch#
    local string fn#
    if (piDataOrigin(self)) eq FDX_READ_FROM_FILE begin
      if (piDirsPresentInFile(self)) begin
        get psFileName to fn#
        if fn# ne "" begin
          move (SEQ_DirectInput(fn#)) to ch#
          if ch# ge 0 begin
            set_channel_position ch# to (piDirsOffSet(self))
            send Seq_Read to (oListDir_SnapShot(self)) ch#
            set piDirsLoaded to true
            send SEQ_CloseInput ch#
          end
          else begin
            send fdx.wait.off
            send obs "File name" fn# "not found on disk"
          end
        end
        else begin
          send fdx.wait.off
          send obs "File name of previously read file is unknown"
        end
      end
      else begin
        send fdx.wait.off
        send obs "Directory contents not present in previously read file"
      end
    end
    else begin
      send fdx.wait.off
      send obs "Contents not previously read from file"
    end
  end_procedure
  procedure Read_Directory_Contents
    local integer obj#
    move (oListDir_SnapShot(self)) to obj#
    send AddDFPath to obj#
    send SnapShot_Build to obj#
    set piDirsLoaded to true
  end_procedure
  procedure Wait_SetText string str#
    send fdx.wait.text1 str#
  end_procedure
  procedure Wait_SetText2 string str#
    send fdx.wait.text2 str#
  end_procedure
  procedure Seq_Write integer ch#
    forward send Seq_Write ch#
    if (piDirsLoaded(self)) send Seq_Write to (oListDir_SnapShot(self)) ch#
  end_procedure
  procedure Seq_Read integer ch#
    local integer ch_pos#
    local string str#
    forward send Seq_Read ch#
    get_channel_position ch# to ch_pos#
    readln channel ch# str#
    if str# eq "DIRCONT1.0" begin
      set piDirsPresentInFile to 1
      set piDirsLoaded        to 0
      set piDirsOffSet        to ch_pos#
    end
    else begin
      set piDirsPresentInFile to 0
      set piDirsLoaded        to 0
      set piDirsOffSet        to 0
    end
  end_procedure
end_class // cDFM_Fdx

//function iFdxIsEncapsulated for cDFM_Fdx returns integer
//  function_return DFTRUE
//end_function

desktop_section
  object oFdxObjectList is a cArray no_image
    //> Creates a new FDX object and returns its object ID
    function iCreateFdxObject returns integer
      local integer rval#
      object oFdx is a cDFM_Fdx no_image
        move self to rval#
      end_object
      function_return rval#
    end_function
    function iFdxObjectID.i integer itm# returns integer
      local integer rval#
      get value item itm# to rval#
      ifnot rval# begin
        get iCreateFdxObject to rval#
        set value item itm# to rval#
      end
      function_return rval#
    end_function
    //> Delete all FDX objects and reset the array
    procedure reset
      local integer itm# max# obj#
      get item_count to max#
      for itm# from 0 to (max#-1)
        send entry_delete itm#
      loop
      send delete_data
    end_procedure
    //> Deletes an FDX object specified by its entry number.
    procedure entry_delete integer itm#
      local integer obj#
      get value item itm# to obj#
      if obj# begin
        send request_destroy_object to obj#
      end
      set value item itm# to 0
    end_procedure
    //> Save an FDX object to a sequential file.
    procedure entry_save integer itm# string fn#
      local integer fdx# ch#
      get value item itm# to fdx#
      if fdx# begin
        move (SEQ_DirectOutput(fn#)) to ch#
        set psFileName of fdx# to fn#
        send Seq_Write to fdx# ch#
        send SEQ_CloseOutput ch#
      end
      else send obs ("No FDX entry in slot "+string(itm#)+" to save")
    end_procedure
    //> Save an FDX object to a sequential file. File name prompted by the user.
    procedure entry_save_as integer itm#
      local integer fdx#
      local string fn#
      #IFDEF IS$WINDOWS
       move (SEQ_SelectOutFile("Save table definitions as","Extended file definition (*.fdx)|*.FDX")) to fn#
      #ELSE
       move (SEQ_SelectOutFile("Save table definitions as","*.FDX")) to fn#
      #ENDIF
      if fn# ne "" begin
        send fdx.wait.on
        get value item itm# to fdx#
        set psFileName of fdx# to fn#
        send entry_save itm# fn#
        send fdx.wait.off
      end
    end_procedure
    function entry_read_file integer itm# string fn# returns integer
      local integer rval# fdx# ch#
      move -1 to rval#
      if (SEQ_FileExists(fn#)) begin
        send fdx.wait.on
        get iFdxObjectID.i itm# to fdx#
        move (SEQ_DirectInput(fn#)) to ch#
        send Seq_Read to fdx# ch#
        send SEQ_CloseInput ch#
        set psFileName of fdx# to fn#
        send fdx.wait.off
        function_return (piReadResult(fdx#))
      end
      else begin
        send obs "File not found!" ("("+fn#+")")
        function_return 0
      end
    end_function
    procedure entry_create_empty integer itm#
      local integer fdx#
      get iFdxObjectID.i itm# to fdx#
    end_procedure
    procedure entry_read_current integer itm#
      local integer fdx#
      get iFdxObjectID.i itm# to fdx#
      send fdx.wait.on
      send Read_Current_Filelist to fdx# FDX_ALL_FILES
      send fdx.wait.off
    end_procedure
  end_object

  // These three objects are used to store the current sets
  // of tables, fields and indices
  object oFdxSetOfTables is a cFdxSetOfTables no_image
  end_object
  object oFdxSetOfFields is a cFdxSetOfFields no_image
  end_object
  object oFdxSetOfIndices is a cFdxSetOfIndices no_image
  end_object

  // These three objects are used temorarily when exporting
  // on type of set to another
  object oAuxFdxSetOfTables is a cFdxSetOfTables no_image
    procedure DoTableSelector_Union
      local integer max# row# table_selector#
      get row_count to max#
      get DFMatrix_SelectorObject to table_selector#
      for row# from 0 to (max#-1)
        set File_Select_State of table_selector# (piFile.i(self,row#)) to true
      loop
      send update_select_display to table_selector#
    end_procedure
    procedure DoTableSelector_Intersection
      local integer max# row# table_selector# file#
      get DFMatrix_SelectorObject to table_selector#
      get row_count of table_selector# to max#
      for row# from 0 to (max#-1)
        if (Row_Select_State(table_selector#,row#)) begin
          get Row_File of table_selector# row# to file#
          if (iFindItem.ii(self,file#,0)) eq -1 set Row_Select_State of table_selector# row# to false
        end
      loop
    end_procedure
  end_object
  object oAuxFdxSetOfFields is a cFdxSetOfFields no_image
  end_object
  object oAuxFdxSetOfIndices is a cFdxSetOfIndices no_image
  end_object
end_desktop_section

//> Destroy all FDX objects and reset the array.
procedure fdx.reset_all global
  send reset to (oFdxObjectList(self))
end_procedure

//> Returns the object ID of fdx object associated with entry number itm#
function fdx.object_id global integer itm# returns integer
  function_return (value(oFdxObjectList(self),itm#))
end_function

//> Let's the user browse for a FDX file for loading. If a file is indeed
//> opened fdx.open_browse will returns the number of the row (not -1)
//> in which the object is placed.
function fdx.open_file_browse global integer itm# returns integer
  local integer rval#
  local string fn#
  #IFDEF IS$WINDOWS
   move (SEQ_SelectFile("Select FDX-definition file (*.fdx)","Extended file definition|*.FDX")) to fn#
  #ELSE
   move (SEQ_SelectFile("Select FDX-definition file","*.FDX")) to fn#
  #ENDIF
  if fn# ne "" begin
    get entry_read_file of (oFdxObjectList(self)) itm# fn# to rval#
    function_return rval#
  end
  function_return 0
end_function

procedure fdx.open_file global integer itm# string fn#
  local integer rval#
  get entry_read_file of (oFdxObjectList(self)) itm# fn# to rval#
end_procedure

procedure fdx.entry_create_empty global integer itm# returns integer
  send entry_create_empty to (oFdxObjectList(self)) itm#
end_procedure

//> Reads the current data definitions into a new FDX object and returns
//> the entry in which it was placed.
procedure fdx.entry_read_current global integer itm#
  send entry_read_current to (oFdxObjectList(self)) itm#
end_procedure


//> Destroy FDX object associated with entry number itm#
procedure fdx.entry_reset global integer itm#
  send entry_delete to (oFdxObjectList(self)) itm#
end_procedure

//> Saves FDX object number itm# in file name fn#.
procedure fdx.entry_save global integer itm# string fn#
  send entry_save to (oFdxObjectList(self)) itm# fn#
end_procedure

//> Saves FDX object number itm# in a file name supplied by the
//> operator.
procedure fdx.entry_save_as global integer itm#
  send entry_save_as to (oFdxObjectList(self)) itm#
end_procedure