// Use App.utl      // Character Mode classes

Use AllEntry
Use Buttons.utl  // Button texts
Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes

define c.button               for 112
define c.button_shadowed      for 120
define c.button_highlight     for 122 // 114
define c.button_shd_highlight for 244 // 252

if DFFALSE begin
  object oKeepItOffTheDesktop is an array
    make_button_nice_label:
      procedure set shadow_state integer liItem integer liValue
        forward set shadow_state item liItem to liValue
        if (shadow_state(self,liItem)) set window_color item liItem to c.button_shadowed
        else set window_color item liItem to c.button
      end_procedure
      procedure set highlight_state integer lbSelectCursorOn
        local integer lbShadowState liItem
        forward set highlight_state to lbSelectCursorOn
        get current_item to liItem
        get shadow_state item liItem to lbShadowState
        if lbShadowState set window_color item liItem to (if(lbSelectCursorOn,c.button_shd_highlight,c.button_shadowed))
        else set window_color item liItem to (if(lbSelectCursorOn,c.button_highlight,c.button))
      end_procedure
    return
  end_object
end

procedure app_make_button_nice for button
  local integer liMax liItem
  on_key kswitch send switch
  on_key kswitch_back send switch_back
  get item_count to liMax
  for liItem from 0 to (liMax-1)
    set center_state item liItem to true
    set window_color item liItem to c.button
  loop
  gosub make_button_nice_label // If you found this line, you are digging to deep.
end_procedure

//Use hilitemx

class app.Button is a Button // Color & Center
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer pCenter_State public 1
    on_key kswitch send switch
    on_key kswitch_back send switch_back
  end_procedure
  procedure item_change integer liItem1 integer liItem2 returns integer
    local integer liRval
    forward get msg_item_change liItem1 liItem2 to liRval
    procedure_return liRval
  end_procedure
  procedure end_construct_object
    local integer liMax liItem lbCenter
    get pCenter_State to lbCenter
    get item_count to liMax
    for liItem from 0 to (liMax-1)
      ifnot (checkbox_item_state(self,liItem)) begin
        if lbCenter set center_state item liItem to true
        set window_color item liItem to c.button
      end
    loop
    forward send end_construct_object
  end_procedure
  procedure set shadow_state integer liItem integer liValue
    forward set shadow_state item liItem to liValue
    ifnot (checkbox_item_state(self,liItem)) begin
      if (shadow_state(self,liItem)) set window_color item liItem to c.button_shadowed
      else set window_color item liItem to c.button
    end
  end_procedure
  procedure set highlight_state integer lbSelectCursorOn
    local integer lbShadowState liItem
    forward set highlight_state to lbSelectCursorOn
    get current_item to liItem
    ifnot (checkbox_item_state(self,liItem)) begin
      get shadow_state item liItem to lbShadowState
      if lbShadowState set window_color item liItem to (if(lbSelectCursorOn,c.button_shd_highlight,c.button_shadowed))
      else set window_color item liItem to (if(lbSelectCursorOn,c.button_highlight,c.button))
    end
  end_procedure
end_class

class app.Entry_View_Client is a Entry_View_Client
  procedure construct_object integer liImage
    forward send construct_object liImage
    set allow_move_state to true
    on_key kcancel send close_panel
  end_procedure
  procedure close_panel
    send request_cancel
  end_procedure
end_class

class app.Client is a app.Entry_View_Client
  procedure construct_object integer liImage
    forward send construct_object liImage
    on_key kcancel send close_panel
  end_procedure
  procedure close_panel
    send deactivate
  end_procedure
end_class

class app.ModalClient is a Client
  procedure construct_object integer liImage
    forward send construct_object liImage
    send Define_Movable_Client_Support
    send Define_Auto_Locate
    set auto_locate_state to true
    set allow_move_state to true
    on_key kcancel send cancel
    on_key kexit_application send cancel
    on_key ksave_record send ok
    set scope_state to true
  end_procedure
  import_class_protocol Movable_Client_Mixin
  import_class_protocol Auto_Locate_Mixin
  procedure close_panel
    send cancel
  end_procedure
  procedure popup
    local integer liGrb
    ui_accept self to liGrb
  end_procedure
end_class

class app.List is a List
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer highlight_row_state private 0
  end_procedure
  function iColumns returns integer
    local integer liMatrixSize
    get matrix_size to liMatrixSize
    function_return (low(liMatrixSize))
  end_function
  function row_count returns integer
    function_return (item_count(self)/iColumns(self))
  end_function
  function row_base_item integer liRow returns integer
    local integer liWidth
    get iColumns to liWidth
    function_return (liRow*liWidth)
  end_function
  function base_item returns integer
    local integer liWidth
    get iColumns to liWidth
    function_return ((current_item(self)/liWidth)*liWidth)
  end_function
  function current_row returns integer
    function_return (current_item(self)/iColumns(self))
  end_function
  function current_column returns integer
    function_return (current_item(self)-base_item(self))
  end_function
  procedure set highlight_row_state integer lbState
    set !$.highlight_row_state to lbSTate
    if lbState set select_mode to MULTI_SELECT
  end_procedure
  function highlight_row_state returns integer
    function_return (!$.highlight_row_state(self))
  end_function
  procedure row_change integer old# integer new#
    local integer liBase liItem liWidth cbs#
    if (highlight_row_state(self)) begin
      get iColumns to liWidth
      move (old#*liWidth) to liBase
      for liItem from liBase to (liBase+liWidth-1)
        get checkbox_item_state item liItem to cbs#
        ifnot cbs# set select_state item liItem to false
      loop
      move (new#*liWidth) to liBase
      for liItem from liBase to (liBase+liWidth-1)
        get checkbox_item_state item liItem to cbs#
        ifnot cbs# set select_state item liItem to true
      loop
    end
  end_procedure
  procedure column_entry integer column# integer liItem returns integer
  end_procedure
  procedure column_exit integer column# integer liItem returns integer
  end_procedure
  procedure highlight_current_row
    local integer row#
    get current_row to row#
    if (item_count(self)) send row_change row# row#
  end_procedure
  procedure activate
    forward send activate
    if (highlight_row_state(self)) send highlight_current_row
  end_procedure
  procedure item_change integer liItem1 integer liItem2 returns integer
    local integer rval# liWidth prevent#
    forward get msg_item_change liItem1 liItem2 to rval#
    get iColumns to liWidth
    if (item_count(self)>liItem1) begin
      get msg_column_exit (mod(liItem1,liWidth)) liItem1 to prevent#
      ifnot prevent# get msg_column_entry (mod(liItem2,liWidth)) liItem2 to prevent#
    end
    if (liItem1/liWidth ne rval#/liWidth) send row_change (liItem1/liWidth) (rval#/liWidth)
    procedure_return rval#
  end_procedure
  procedure select_toggling integer liItem integer i#
    local integer cbs# hrs#
    get highlight_row_state to hrs#
    get checkbox_item_state item liItem to cbs#
    if (cbs# or not(hrs#)) forward send select_toggling liItem i#
    else if hrs# begin
      get base_item to liItem
      get checkbox_item_state item liItem to cbs#
      if cbs# forward send select_toggling liItem i#
    end
  end_procedure
  procedure row_delete integer row#
    local integer liMax liItem liBase
    set dynamic_update_state to false
    get iColumns to liMax
    move (row#*liMax) to liBase
    for liItem from 1 to liMax
      send delete_item liBase
    loop
    set dynamic_update_state to true
  end_procedure
  procedure row_insert integer row#
    local integer liMax liItem liBase
    set dynamic_update_state to false
    get iColumns to liMax
    move (row#*liMax) to liBase
    for liItem from 1 to liMax
      send insert_item msg_none "" liBase
    loop
    set dynamic_update_state to true
  end_procedure
  procedure row_add
    local integer liMax liItem
    set dynamic_update_state to false
    get iColumns to liMax
    for liItem from 1 to liMax
      send add_item msg_none ""
    loop
    send row_format (row_count(self)-1)
    set dynamic_update_state to true
  end_procedure
  procedure row_format integer row#
    local integer liMax liItem liBase
    get iColumns to liMax
    move (row#*liMax) to liBase
    for liItem from liBase to (liBase+liMax-1)
      set entry_state item liItem to true
    loop
  end_procedure
  procedure request_row_insert
    send row_insert (current_row(self))
  end_procedure
  procedure request_row_delete
    send row_delete (current_row(self))
  end_procedure
  procedure request_row_add
    send row_add
    set current_item to (item_count(self)-iColumns(self))
  end_procedure
end_class // app.List

class cComboDropDown is a Edit
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer piInvokingObjectID public 0
    property integer piInvokingItem     public 0
    send Define_Auto_Locate
    set auto_locate_state to true
    set read_only_state to true
    on_key kcancel send deactivate
    on_key kenter  send select
    property integer piExiting public 0
    set row_offset to 1
    set column_offset to 0
    set popup_state to true
    set size to 5 25
    set object_color to 112 122
  end_procedure
  procedure next
    send deactivate
    send next to (piInvokingObjectID(self))
  end_procedure
  procedure previous
    send deactivate
    send previous to (piInvokingObjectID(self))
  end_procedure
  function allow_move integer row# integer column# integer xxx# returns integer
  end_function
  procedure mouse_down integer line# integer column#
    forward send mouse_down line# column#
    send line_mark
  end_procedure
  procedure popup
    local integer liPos
    local integer liWidth
    get position to liPos
    get item_window_length of (piInvokingObjectID(self)) (piInvokingItem(self)) to liWidth
    set right_margin to (if(liWidth,liWidth,25))
    set size to (5 min line_count(self)) (if(liWidth,liWidth,25)+1)
    forward send popup
    send move_absolute (hi(liPos)) 0
    send line_mark
  end_procedure
  register_function pbDD_Aware returns integer
  procedure select
    local integer pos# lhObj
    local string str#
    get position to pos#
    get value item (hi(pos#)) to str#
    get piInvokingObjectID to lhObj
    if (pbDD_Aware(lhObj)) set changed_value of lhObj item (piInvokingItem(self)) to str#
    else set value of lhObj item (piInvokingItem(self)) to str#
    send deactivate
    send OnComboChange to (piInvokingObjectID(self)) (piInvokingItem(self)) DFFALSE
  end_procedure
  procedure line_mark
    local integer pos#
    get position to pos#
    send move_absolute (hi(pos#)) 0
    send mark_on
    send move_absolute (hi(pos#)) 80
  end_procedure
  procedure key integer key#
    forward send key key#
    send line_mark
  end_procedure
  import_class_protocol Auto_Locate_Mixin
  procedure exiting integer obj#
    forward send exiting obj#
    ifnot (piExiting(self)) begin
      set piExiting to true
      send deactivate
      set piExiting to false
    end
  end_procedure
end_class // cComboDropDown

object oGlobalCombo is an cComboDropDown
end_object

class cComboValueArray is a cArray
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer piInvokingObjectID public 0
    property integer piInvokingItem     public 0
  end_procedure
  item_property_list
    item_property string  psValue.i
    item_property integer piAuxValue.i
  end_item_property_list cComboValueArray
  procedure add_value.si string str# integer aux#
    local integer row#
    get row_count to row#
    set psValue.i    row# to str#
    set piAuxValue.i row# to aux#
  end_procedure
  function sFindValue.i integer liAux returns string
    local integer row# liMax
    get row_count to liMax
    for row# from 0 to (liMax-1)
      if liAux eq (piAuxValue.i(self,row#)) function_return (psValue.i(self,row#))
    loop
    function_return ""
  end_function
  function iFindValue.s string str# returns integer
    // Trim function has been inserted in order to make the CM mode
    // file selector function
    local integer row# liMax
    get row_count to liMax
    move (trim(str#)) to str#
    for row# from 0 to (liMax-1)
      if str# eq (trim(psValue.i(self,row#))) function_return row#
//      if str# eq (psValue.i(self,row#)) function_return row#
    loop
    function_return -1
  end_function
  procedure popup_list
    local integer row# liMax edit# liItem liWidth
    local string value# cval#
    get value of (piInvokingObjectID(self)) item (piInvokingItem(self)) to value#
    get item_window_length of (piInvokingObjectID(self)) item (piInvokingItem(self)) to liWidth
    get row_count to liMax
    move (oGlobalCombo(self)) to edit#
    send delete_data to Edit#
    set size of Edit# to 5 40
    set max_lines of edit# to 32000
    set right_margin of edit# to 8192
    move -1 to liItem
    for row# from 0 to (liMax-1)
      if value# ne "" if value# eq (psValue.i(self,row#)) move row# to liItem
      move (psValue.i(self,row#)) to cval#
      if (length(cval#)) gt liWidth move (left(cval#,liWidth)) to cval#
      set value of edit# item row# to cval#
    loop
    set max_lines of edit# to liMax
    set dynamic_update_state of edit# to true
    send auto_locate to edit# (parent(self))
    set piInvokingObjectID of edit# to (piInvokingObjectID(self))
    set piInvokingItem     of edit# to (piInvokingItem(self))
    if liItem ne -1 send move_absolute to edit# liItem 0
    send popup to edit#
  end_procedure
end_class // cComboValueArray

class cCM_ComboArrays is a cArray
  item_property_list
    item_property integer piArrayID.i
    item_property integer piComboWidth.i
  end_item_property_list cCM_ComboArrays
end_class // cCM_ComboArrays

class app.PassWord_and_Combo_Mixin is a message
  procedure Define_PassWord_and_Combo_Mixin
    object oCM_ComboArrays is a cCM_ComboArrays NO_IMAGE
    end_object
    object oPassword_States is a cArray NO_IMAGE
    end_object
    object oPassword_Values is a cArray NO_IMAGE
    end_object
    on_key kprompt send prompt
  end_procedure
  // PASSWORD_STATE HANDLING
  procedure set password_state integer liItem integer st#
    set value of (oPassword_States(self)) item liItem to st#
    set entry_state item liItem to st#
  end_procedure
  function password_state integer liItem returns integer
    function_return (value(oPassword_States(self),liItem))
  end_function
  procedure set password_value integer liItem string value#
    set value of (oPassword_Values(self)) item liItem to value#
    set value item liItem to (replaces(" ",pad("",length(value#)),"*"))
  end_procedure
  function password_value integer liItem returns string
    function_return (value(oPassword_Values(self),liItem))
  end_function
  procedure key integer key#
    local integer liItem st#
    local string str#
    get current_item to liItem
    get password_state liItem to st#
    if st# begin
      get password_value liItem to str#
      set value item 0 to (replaces(" ",pad("",length(str#)),"*"))
      if key# le 255 begin
        if (length(str#)) lt 16 if key# ne (ascii("*")) move (str#+character(key#)) to str#
        else send bell
      end
      else begin
        if key# eq KBACK_SPACE move (left(str#,length(str#)-1)) to str#
        else forward send key key#
      end
      set value item 0 to (replaces(" ",pad("",length(str#)),"*"))
      set password_value liItem to str#
    end
    else forward send key key#
  end_procedure
  function entry returns integer
    local integer liItem liPwState liKbdState liKey
    get current_item to liItem
    get password_state liItem to liPwState
    get kbd_input_mode to liKbdState
    set kbd_input_mode to liPwState
    forward get entry to liKey
    set kbd_input_mode to liKbdState
    function_return liKey
  end_function
//procedure item_change integer liItem1 integer liItem2 returns integer
//  local integer rval# st#
//  forward get msg_item_change liItem1 liItem2 to rval#
//  get password_state rval# to st#
//  if st# set kbd_input_mode to true
//  else set kbd_input_mode to false
//  procedure_return rval#
//end_procedure
  // END OF PASSWORD_STATE HANDLING

  function prv.iComboValueArray.i integer liItem returns integer
    local integer rval#
    get piArrayID.i of (oCM_ComboArrays(self)) item liItem to rval#
    if rval# eq 0 begin
      object oComboValueArray is a cComboValueArray no_image
        move self to rval#
      end_object
      set piInvokingObjectID of rval# to self
      set piInvokingItem     of rval# to liItem
      set piArrayID.i of (oCM_ComboArrays(self)) item liItem to rval#
    end
    function_return rval#
  end_function
  function item_window_length integer liItem returns integer
    local integer rval#
    get piComboWidth.i of (oCM_ComboArrays(self)) liItem to rval#
    function_return rval#
  end_function
  procedure Item_Combo_Add_Item integer liItem string str# integer aux_tmp#
    local integer aux# arr# set_value#
    if num_arguments gt 2 move aux_tmp# to aux#
    else move 0 to aux#
    get prv.iComboValueArray.i liItem to arr#
    move (item_count(arr#)=0) to set_value#
    send add_value.si to arr# str# aux#
    if set_value# begin
      set value item liItem to (trim(str#))
//    send OnComboChange liItem
    end
  end_procedure
  procedure set Item_Combo_Width integer liItem integer liWidth
    local integer arr#
    get prv.iComboValueArray.i liItem to arr#
    set piComboWidth.i of (oCM_ComboArrays(self)) liItem to liWidth
  end_procedure
  function Item_Combo_Current_Aux_Value integer liItem returns integer
    local integer arr# rval#
    local string value#
    get piArrayID.i of (oCM_ComboArrays(self)) item liItem to arr#
    if arr# begin
      get value item liItem to value#
      get iFindValue.s of arr# value# to rval#
      if rval# ne -1 function_return (piAuxValue.i(arr#,rval#))
    end
    function_return -1
  end_function

  procedure set Item_Combo_Current_Aux_Value integer liItem integer liValue
    local integer arr#
    local string lsValue
    get piArrayID.i of (oCM_ComboArrays(self)) item liItem to arr#
    if arr# begin
      get sFindValue.i of arr# liValue to lsValue
//      set value item liItem to lsValue
      set ComboDisplayValue liItem to lsValue
    end
  end_procedure

  procedure Item_Combo_Delete_Data integer liItem
    local integer arr#
    get piArrayID.i of (oCM_ComboArrays(self)) item liItem to arr#
    if arr# send delete_data to arr#
  end_procedure
  procedure prompt
    local integer arr# ci#
    get current_item to ci#
    get piArrayID.i of (oCM_ComboArrays(self)) item ci# to arr#
    if arr# send popup_list to arr#
    else forward send prompt
  end_procedure
  procedure OnComboChange integer liItem integer lbInit
  end_procedure
  procedure set ComboDisplayValue integer liItem string lsValue
    set value item liItem to lsValue
  end_procedure
  // Procedure Item_Combo_Make_Valid will set the item value to the first
  // of the combo values, if it does not already contain a legal value.
  procedure Item_Combo_Make_Valid integer liItem
    local integer arr#
    if (Item_Combo_Current_Aux_Value(self,liItem)) eq -1 begin
      get piArrayID.i of (oCM_ComboArrays(self)) liItem to arr#
      if arr# begin
        //set value item liItem to (psValue.i(arr#,0))
        set ComboDisplayValue liItem to (psValue.i(arr#,0))
        send OnComboChange liItem DFTRUE
      end
    end
  end_procedure
end_class // app.PassWord_and_Combo_Mixin

class app.Form is a Form
  procedure construct_object integer liImage
    forward send construct_object liImage
    send Define_PassWord_and_Combo_Mixin
    on_key kswitch send switch
    on_key kswitch_back send switch_back
    property integer pbDD_Aware public DFFALSE
  end_procedure
  import_class_protocol app.PassWord_and_Combo_Mixin
end_class // app.Form

class app.Entry_Form is a Entry_Form
  procedure construct_object integer liImage
    forward send construct_object liImage
    send Define_PassWord_and_Combo_Mixin
    property integer pbDD_Aware public DFTRUE
  end_procedure
  import_class_protocol app.PassWord_and_Combo_Mixin
end_class // app.Entry_Form