// Use Mapper.pkg   // Dialog for mapping (fields)
Use Mapper.nui   // Classes for (field) mapping
Use GridUtil.utl // Grid and List utilities (not for dbGrid's or Table's)
Use aps.pkg

class cMapperListLeft is a aps.Grid
  procedure construct_object integer img#
    forward send construct_object img#
    send GridPrepare_AddColumn "Fields in input file" AFT_ASCII25
    send GridPrepare_Apply self
    set select_mode to NO_SELECT
    on_key KNEXT_ITEM send switch
    on_key KPREVIOUS_ITEM send switch_back
    property integer phMapper       public 0
    property integer pbUnmappedOnly public DFFALSE
  end_procedure
  procedure AddRow integer liAux string lsName string lsExtra
    integer liBase
    get item_count to liBase
    send add_item MSG_NONE lsName
    set aux_value item liBase to liAux
  end_procedure
  procedure fill_list
    integer lhSelf
    move self to lhSelf
    set dynamic_update_state to DFFALSE
    send delete_data
    if (pbUnmappedOnly(self)) send DoCallback_UnmappedItems1 to (phMapper(self)) msg_AddRow lhSelf
    else send DoCallback_AllItems1 to (phMapper(self)) msg_AddRow lhSelf
    send Grid_SetEntryState self DFFALSE
    set dynamic_update_state to DFTRUE
  end_procedure
  function iCurrentAux returns integer
    integer liBase
    get Grid_BaseItem self to liBase
    function_return (aux_value(self,liBase))
  end_function
  procedure GotoAux integer liAux
    integer liBase liRow liMax
    get Grid_RowCount self to liMax
    decrement liMax
    for liRow from 0 to liMax
      get Grid_RowBaseItem self liRow to liBase
      if (aux_value(self,liBase)=liAux) set current_item to liBase
    loop
  end_procedure
end_class // cMapperListLeft

class cMapperListRight is a aps.Grid
  procedure construct_object integer img#
    forward send construct_object img#
    property integer phMapper public 0
    send GridPrepare_AddColumn "Field in table" AFT_ASCII25
    send GridPrepare_AddColumn "Reads data from this column in file"  AFT_ASCII25
    send GridPrepare_Apply self
    set select_mode to NO_SELECT
    on_key KNEXT_ITEM send switch
    on_key KPREVIOUS_ITEM send switch_back
  end_procedure
  procedure AddRow integer liAux string lsName string lsExtra integer lbMapped integer liMapAux string lsMapName string lsMapExtra
    integer liBase
    get item_count to liBase
    send add_item MSG_NONE lsName
    send add_item MSG_NONE lsMapName
    set aux_value item liBase     to liAux
    set aux_value item (liBase+1) to liMapAux
  end_procedure
  procedure prepare_list
    integer lhSelf
    move self to lhSelf
    set dynamic_update_state to DFFALSE
    send delete_data
    send DoCallback_AllItems2 to (phMapper(self)) msg_AddRow lhSelf
    set dynamic_update_state to DFTRUE
    send Grid_SetEntryState self DFFALSE
  end_procedure

  function iFindAux integer liAux returns integer
    integer liBase liRow liMax
    get Grid_RowCount self to liMax
    decrement liMax
    for liRow from 0 to liMax
      get Grid_RowBaseItem self liRow to liBase
      if (aux_value(self,liBase)=liAux) function_return liBase
    loop
    function_return -1
  end_function

  procedure AddUpdate integer liAux string lsName string lsExtra integer lbMapped integer liMapAux string lsMapName string lsMapExtra
    integer liBase
    get iFindAux liAux to liBase
    set value item (liBase+1) to lsMapName
    set aux_value item (liBase+1) to liMapAux
  end_procedure

  procedure fill_list
    integer lhSelf
    move self to lhSelf
    send DoCallback_AllItems2 to (phMapper(self)) msg_AddUpdate lhSelf
  end_procedure

  procedure GotoAux integer liAux
    integer liBase liRow liMax
    get Grid_RowCount self to liMax
    decrement liMax
    for liRow from 0 to liMax
      get Grid_RowBaseItem self liRow to liBase
      if (aux_value(self,liBase)=liAux) set current_item to liBase
    loop
  end_procedure

  function iCurrentAux returns integer
    integer liBase
    get Grid_BaseItem self to liBase
    function_return (aux_value(self,liBase))
  end_function
end_class // cMapperListRight

class cMapperGridController is a cArray
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer phGridLeft  public 0
    property integer phGridRight public 0
    property integer phMapper    public 0
  end_procedure
  procedure DoInitialize
    set phMapper of (phGridLeft(self))  to (phMapper(self))
    set phMapper of (phGridRight(self)) to (phMapper(self))
    send fill_list    to (phGridLeft(self))
    send prepare_list to (phGridRight(self))
    send fill_list    to (phGridRight(self))
  end_procedure
  procedure DoMap
    integer liFileIdent liTableIdent
    get iCurrentAux of (phGridLeft(self)) to liFileIdent
    get iCurrentAux of (phGridRight(self)) to liTableIdent
    send DoAddMap to (phMapper(self)) liFileIdent liTableIdent
    send fill_list    to (phGridLeft(self))
    send fill_list    to (phGridRight(self))
    send key to (phGridRight(self)) kdownarrow
  end_procedure
  procedure DoMapClear
    integer liFileIdent liTableIdent
    get iCurrentAux of (phGridRight(self)) to liTableIdent
    send DoClearMap to (phMapper(self)) liTableIdent
    send fill_list    to (phGridLeft(self))
    send fill_list    to (phGridRight(self))
  end_procedure
  procedure DoMapClearAll
    send DoReset   to (phMapper(self))
    send fill_list to (phGridLeft(self))
    send fill_list to (phGridRight(self))
  end_procedure
  procedure DoAutoMap
    send DoAutoMapName to (phMapper(self))
    send fill_list to (phGridLeft(self))
    send fill_list to (phGridRight(self))
  end_procedure
end_class

object oMapperPanel is a aps.ModalPanel label "Map fields"
  set locate_mode to CENTER_ON_SCREEN
  on_key ksave_record send close_panel_ok
  on_key kcancel send close_panel
  property integer piResult public 0
  register_object oMapperGridController

  on_key kClear send DoMapClear to (oMapperGridController(self))
  on_key kClear_All send DoMapClearAll to (oMapperGridController(self))

  procedure close_panel_ok
    set piResult to 1
    send close_panel
  end_procedure

  object oUnmappedGrid is a cMapperListLeft
    set size to 140 0
    on_key kEnter send DoMap to (oMapperGridController(self))
    set Horz_Scroll_Bar_Visible_State to false
  end_object

  object oRadio is a aps.RadioContainer
    object oRad1 is a aps.Radio label "Unmapped only" snap SL_DOWN
    end_object
    object oRad2 is a aps.Radio label "All" snap SL_RIGHT_SPACE
    end_object
    procedure notify_select_state integer liTo integer liFrom
      set pbUnmappedOnly of (oUnmappedGrid(self)) to (not(liTo))
      send fill_list to (oUnmappedGrid(self))
    end_procedure
  end_object

  set p_cur_row to (p_top_margin(self))

  object oBtnClearAll is a aps.Button snap SL_RIGHT relative_to (oUnmappedGrid(self))
    set size to 14 30
    on_item ">" send DoMap to (oMapperGridController(self))
  end_object
  send aps_relocate (oBtnClearAll(self)) 20 0
  object oBtnClearOne is a aps.Button snap SL_DOWN
    set size to 14 30
    on_item "<" send DoMapClear to (oMapperGridController(self))
  end_object
  object oBtnAddOne is a aps.Button snap SL_DOWN
    set size to 14 30
    on_item "<<" send DoMapClearAll to (oMapperGridController(self))
  end_object

  set p_cur_row to (p_top_margin(self))

  object oMapGrid is a cMapperListRight
    set size to 150 0
  end_object

  object oMapperGridController is a cMapperGridController
    set phGridLeft  to (oUnmappedGrid(self))
    set phGridRight to (oMapGrid(self))
  end_object

  object oBtn1 is a aps.multi_button
    on_item "OK" send close_panel_ok
  end_object
  object oBtn2 is a aps.multi_button
    on_item "Auto map" send DoAutoMap to (oMapperGridController(self))
  end_object
  object oBtn3 is a aps.multi_button
    on_item "Clear map" send DoMapClearAll to (oMapperGridController(self))
  end_object
  object oBtn4 is a aps.multi_button
    on_item "Cancel" send close_panel
  end_object
  send aps_locate_multi_buttons
  set Border_Style to BORDER_THICK   // Make panel resizeable
  procedure aps_onResize integer delta_rw# integer delta_cl#
    send aps_resize (oMapGrid(self)) delta_rw# 0 // delta_cl#
    send aps_resize (oUnmappedGrid(self)) delta_rw# 0 // delta_cl#
    send aps_auto_locate_control (oRad1(oRadio(self))) SL_DOWN (oUnmappedGrid(self))
    send aps_auto_locate_control (oRad2(oRadio(self))) SL_RIGHT_SPACE (oRad1(oRadio(self)))
    send aps_register_multi_button (oBtn1(self))
    send aps_register_multi_button (oBtn2(self))
    send aps_register_multi_button (oBtn3(self))
    send aps_register_multi_button (oBtn4(self))
    send aps_locate_multi_buttons
    send aps_auto_size_container
  end_procedure
  set pMinimumSize to 150 0
  procedure popup.shsss string lsTitle integer lhMapper string lsHeader1 string lsHeader2 string lsHeader3
    set piResult to 0
    send DoPushStatus to lhMapper
    set phMapper of (oMapperGridController(self)) to lhMapper
    send DoInitialize to (oMapperGridController(self))
    send popup
    ifnot (piResult(self)) send DoPopStatus to lhMapper
  end_procedure
end_object

procedure DoMapperDialog global string lsTitle integer lhMapper string lsHeader1 string lsHeader2 string lsHeader3
  send popup.shsss to (oMapperPanel(self)) lsTitle lhMapper lsHeader1 lsHeader2 lsHeader3
end_procedure