;-------------------------------------------------------------------------------
; Program Name: OtherLists.lsp
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 7-20-08
; Function:     Template examples for OtherLists and EditBoxes.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   7-20-08   Initial version
;-------------------------------------------------------------------------------
; Note: This file contains template examples for OtherLists and EditBoxes. The
; template for OtherLists has examples for using popup_list tiles with Text,
; Integers, and Real Numbers. The Other option allows the user to enter another
; entry that matches the data type required. The template for EditBoxes has
; examples for using edit_box tiles with Text, Integers, and Real Numbers. The
; data entered by the user is checked to verify that it matches the data type
; required. You may combine tiles from OtherLists and EditBoxes into your own
; dialog as needed. The dialog definitions have been formatted to align with
; each other. Just copy and paste sections starting with ": row {//<" to the
; end of that section having a "}//>" at the end of that section. If you need
; to adjust the width of your text labels, popup_list, or edit_box tiles, you
; may use the DclCalcs function that is part of MyDialogs.lsp in the Tutorial
; for Getting Started with Dcl Dialogs. The required functions to run the
; OtherLists and EditBoxes functions are included in this file.
;-------------------------------------------------------------------------------
; c:OtherLists - Template example for other lists
;-------------------------------------------------------------------------------
(defun c:OtherLists (/ Dcl_Id% List1@ List2@ List3@ Return# Value1$ Value2$ Value3$)
  (princ "\nOtherLists")(princ)
  ; Set Default Variables
  (if (not *OtherLists@);Unique global variable name to store dialog info
    (setq *OtherLists@ (list nil "" "" ""))
  );if
  (setq Value1$ (nth 1 *OtherLists@)
        Value2$ (nth 2 *OtherLists@)
        Value3$ (nth 3 *OtherLists@);For list with Other add "" and "Other" to end
        List1@ (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "" "Other")
        List2@ (list "1950" "1960" "1970" "1980" "1990" "2000" "" "Other")
        List3@ (list "1.1" "2.2" "3.3" "4.4" "5.5" "6.6" "7.7" "8.8" "9.9" "" "Other")
  );setq
  (if (not (member Value1$ List1@));Add item if not a member of list
    (setq List1@ (insert_nth (- (length List1@) 2) Value1$ List1@))
  );if
  (if (not (member Value2$ List2@));Add item if not a member of list
    (setq List2@ (insert_nth (- (length List2@) 2) Value2$ List2@))
  );if
  (if (not (member Value3$ List3@));Add item if not a member of list
    (setq List3@ (insert_nth (- (length List3@) 2) Value3$ List3@))
  );if
  ; Load Dialog
  (setq Dcl_Id% (load_dialog "OtherLists.dcl"));Change filename here
  (new_dialog "OtherLists" Dcl_Id%)
  ; Set Dialog Initial Settings
  (set_tile "Title" " Other Lists")
  (set_tile "Text1" "Select Text Item")
  (set_tile_list "List1" List1@ Value1$);*Included
  (set_tile "Text2" "Select an Integer")
  (set_tile_list "List2" List2@ Value2$);*Included
  (set_tile "Text3" "Select a Real Number")
  (set_tile_list "List3" List3@ Value3$);*Included
  ; Dialog Actions
  (action_tile "List1" "(set_other_list \"List1@\" \"Value1$\")");*Included
  (action_tile "List2" "(set_other_intlist \"List2@\" \"Value2$\")");*Included
  (action_tile "List3" "(set_other_reallist \"List3@\" \"Value3$\")");*Included
  (setq Return# (start_dialog))
  ; Unload Dialog
  (unload_dialog Dcl_Id%)
  (setq *OtherLists@ (list nil Value1$ Value2$ Value3$))
  (if (= Return# 0) (exit));Cancel selected
  ;The rest of your program goes here.
  (princ)
);defun c:OtherLists
;-------------------------------------------------------------------------------
; c:EditBoxes - Template example for edit boxes
;-------------------------------------------------------------------------------
(defun c:EditBoxes (/ Dcl_Id% Edit1$ Edit2$ Edit3$ Return#)
  (princ "\nEditBoxes")(princ)
  ; Set Default Variables
  (if (not *EditBoxes@);Unique global variable name to store dialog info
    (setq *EditBoxes@ (list nil "" "" ""))
  );if
  (setq Edit1$ (nth 1 *EditBoxes@)
        Edit2$ (nth 2 *EditBoxes@)
        Edit3$ (nth 3 *EditBoxes@)
  );setq
  ; Load Dialog
  (setq Dcl_Id% (load_dialog "OtherLists.dcl"));Change filename here
  (new_dialog "EditBoxes" Dcl_Id%)
  ; Set Dialog Initial Settings
  (set_tile "Title" " Edit Boxes")
  (set_tile "Text1" "Enter Text Item")
  (set_tile "Edit1" Edit1$)
  (set_tile "Text2" "Enter an Integer")
  (set_tile "Edit2" Edit2$)
  (set_tile "Text3" "Enter a Real Number")
  (set_tile "Edit3" Edit3$)
  ; Dialog Actions
  (action_tile "Edit1" "(setq Edit1$ $value)")
  (action_tile "Edit2" "(check_editint \"Edit2$\")");*Included
  (action_tile "Edit3" "(check_editreal \"Edit3$\")");*Included
  (setq Return# (start_dialog))
  ; Unload Dialog
  (unload_dialog Dcl_Id%)
  (setq *EditBoxes@ (list nil Edit1$ Edit2$ Edit3$))
  (if (= Return# 0) (exit));Cancel selected
  ;The rest of your program goes here.
  (princ)
);defun c:EditBoxes
;-------------------------------------------------------------------------------
; edit_value - Dialog to edit a value
; Arguments: 2
;   Title$ = Dialog Title
;   Edit1$ = Edit line
; Syntax: (edit_value "Enter Other Value" "")
;-------------------------------------------------------------------------------
(defun edit_value (Title$ Edit1$ / Dcl_Id% NewText$ Return#)
  ; Set Default Variables
  (setq NewText$ Edit1$)
  ; Load Dialog
  (setq Dcl_Id% (load_dialog "OtherLists.dcl"));Change filename as required
  (new_dialog "edit_value" Dcl_Id%)
  ; Set Dialog Initial Settings
  (set_tile "Title" Title$)
  (set_tile "Value" "Value:")
  (set_tile "Edit1" Edit1$)
  ; Dialog Actions
  (action_tile "accept" "(setq NewText$ (get_tile \"Edit1\"))(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq Return# (start_dialog))
  ; Unload Dialog
  (unload_dialog Dcl_Id%)
  (if (= Return# 0) (setq NewText$ nil))
  NewText$
);defun edit_value
;-------------------------------------------------------------------------------
; set_tile_list - Sets a dialog popup_list or list_box tile to a list
; Arguments: 3
;   KeyName$ = Key name of tile
;   ListName@ = The list to set in tile
;   Selected = An item in the ListNames@ or a list of items selected
; Syntax: (set_tile_list "TileName" '("A" "B" "C") "B")
;         (set_tile_list "TileName" '("A" "B" "C") '("A" "C"))
; Returns: Sets Selected items in dialog popup_list or list_box tiles.
;-------------------------------------------------------------------------------
(defun set_tile_list (KeyName$ ListName@ Selected / Item)
  (start_list KeyName$ 3)
  (mapcar 'add_list ListName@)
  (end_list)
  (foreach Item (if (listp Selected) Selected (list Selected))
   (if (member Item ListName@)
     (set_tile KeyName$ (itoa (- (length ListName@) (length (member Item ListName@)))))
   );if
  );foreach
);defun set_tile_list
;-------------------------------------------------------------------------------
; set_list_value - Sets SentVar$ to the item selected in SentList$
; Arguments: 2
;   SentList$ = String of the list variable name
;   SentVar$ = String of the variable name
; Syntax: (set_list_value "ListName" "Variable")
;-------------------------------------------------------------------------------
(defun set_list_value (SentList$ SentVar$ / SaveVar$ SubList@)
  (setq SubList@ (eval (read SentList$)))
  (setq SaveVar$ (eval (read SentVar$)))
  (set (read SentVar$) (nth (atoi $value) SubList@))
  (if (= (eval (read SentVar$)) "")
    (progn
      (set (read SentVar$) SaveVar$)
      (set_tile_list $key SubList@ SaveVar$)
    );progn
  );if
  (princ)
);defun set_list_value
;-------------------------------------------------------------------------------
; set_other_list - Function to include other values to a list
; Arguments: 2
;   SentList$ = String of the list variable name
;   SentVar$ = String of the variable name
; Syntax: (set_other_list "ListName" "Variable")
;-------------------------------------------------------------------------------
(defun set_other_list (SentList$ SentVar$ / AddOther Other$ SubList@ SubVar$)
  (setq SubList@ (eval (read SentList$))
        SubVar$ (eval (read SentVar$))
  );setq
  (if (= (nth (atoi $value) SubList@) "")
    (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
  );if
  (if (= (nth (atoi $value) SubList@) "Other")
    (progn
      (if (setq Other$ (edit_value "Enter Other Value" SubVar$))
        (setq Other$ (NoSpaces Other$))
        (setq Other$ "")
      );if
      (if (= (strcase Other$) "OTHER") (setq Other$ ""))
      (if (/= Other$ "")
        (progn
          (setq AddOther t)
          (foreach Item SubList@
            (if (= (strcase Other$) (strcase Item))
              (setq $value (itoa (- (length SubList@)(length (member Item SubList@))))
                    AddOther nil)
            );if
          );foreach
          (if AddOther
            (setq SubList@ (insert_nth (- (length SubList@) 2) Other$ SubList@)
                  $value (itoa (- (length SubList@)(length (member Other$ SubList@)))))
          );if
        );progn
        (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
      );if
    );progn
  );if
  (setq SubVar$ (nth (atoi $value) SubList@))
  (start_list $key) (mapcar 'add_list SubList@)(end_list)
  (set_tile $key $value)
  (set (read SentList$) SubList@)
  (set (read SentVar$) SubVar$)
  (princ)
);defun set_other_list
;-------------------------------------------------------------------------------
; set_other_intlist - Function to include other integer numbers to a list
; Arguments: 2
;   SentList$ = String of the list variable name
;   SentVar$ = String of the variable name
; Syntax: (set_other_intlist "ListName" "Variable")
;-------------------------------------------------------------------------------
(defun set_other_intlist (SentList$ SentVar$ / AddOther Cnt# Mid$ Other$ Passed SubList@ SubVar$)
  (setq SubList@ (eval (read SentList$))
        SubVar$ (eval (read SentVar$))
  );setq
  (if (= (nth (atoi $value) SubList@) "")
    (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
  );if
  (if (= (nth (atoi $value) SubList@) "Other")
    (progn
      (if (setq Other$ (edit_value "Enter an Integer" SubVar$))
        (setq Other$ (NoSpaces Other$))
        (setq Other$ "")
      );if
      (if (= (strcase Other$) "OTHER") (setq Other$ ""))
      (if (/= Other$ "")
        (progn
          (setq Cnt# 1 Passed t)
          (repeat (strlen Other$)
            (setq Mid$ (substr Other$ Cnt# 1))
            (if (not (member Mid$ (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
              (setq Passed nil)
            );if
            (setq Cnt# (1+ Cnt#))
          );repeat
          (if (not Passed)
            (progn
              (alert "Value must be an integer!")
              (setq Other$ "")
            );progn
          );if
        );progn
      );if
      (if (/= Other$ "")
        (progn
          (setq Other$ (itoa (atoi Other$)))
          (setq AddOther t)
          (foreach Item SubList@
            (if (= Other$ Item)
              (setq $value (itoa (- (length SubList@)(length (member Item SubList@))))
                    AddOther nil)
            );if
          );foreach
          (if AddOther
            (setq SubList@ (insert_nth (- (length SubList@) 2) Other$ SubList@)
                  $value (itoa (- (length SubList@)(length (member Other$ SubList@)))))
          );if
        );progn
        (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
      );if
    );progn
  );if
  (setq SubVar$ (nth (atoi $value) SubList@))
  (start_list $key) (mapcar 'add_list SubList@)(end_list)
  (set_tile $key $value)
  (set (read SentList$) SubList@)
  (set (read SentVar$) SubVar$)
  (princ)
);defun set_other_intlist
;-------------------------------------------------------------------------------
; set_other_reallist - Function to include other real numbers to a list
; Arguments: 2
;   SentList$ = String of the list variable name
;   SentVar$ = String of the variable name
; Syntax: (set_other_reallist "ListName" "Variable")
;-------------------------------------------------------------------------------
(defun set_other_reallist (SentList$ SentVar$ / AddOther Cnt# Loop Mid$ Other$
  Passed Period# SubList@ SubVar$)
  (setq SubList@ (eval (read SentList$))
        SubVar$ (eval (read SentVar$))
  );setq
  (if (= (nth (atoi $value) SubList@) "")
    (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
  );if
  (if (= (nth (atoi $value) SubList@) "Other")
    (progn
      (if (setq Other$ (edit_value "Enter a Real Number" SubVar$))
        (setq Other$ (NoSpaces Other$))
        (setq Other$ "")
      );if
      (if (= (strcase Other$) "OTHER") (setq Other$ ""))
      (if (/= Other$ "")
        (progn
          (setq Cnt# 1 Passed t Period# 0)
          (repeat (strlen Other$)
            (setq Mid$ (substr Other$ Cnt# 1))
            (if (not (member Mid$ (list "." "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
              (setq Passed nil)
            );if
            (if (= Mid$ ".")(setq Period# (1+ Period#)))
            (setq Cnt# (1+ Cnt#))
          );repeat
          (if (> Period# 1)(setq Passed nil))
          (if (not Passed)
            (progn
              (alert "Value must be a real number!")
              (setq Other$ "")
            );progn
          );if
        );progn
      );if
      (if (/= Other$ "")
        (progn
          (setq Loop t Cnt# 8)
          (while Loop
            (setq Other$ (rtos (atof Other$) 2 Cnt#))
            (if (= (atof Other$) (atof (rtos (atof Other$) 2 (1- Cnt#))))
              (setq Cnt# (1- Cnt#))
              (setq Loop nil)
            );if
            (if (= Cnt# 0) (setq Loop nil))
          );while
          (setq AddOther t)
          (foreach Item SubList@
            (if (= Other$ Item)
              (setq $value (itoa (- (length SubList@)(length (member Item SubList@))))
                    AddOther nil)
            );if
          );foreach
          (if AddOther
            (setq SubList@ (insert_nth (- (length SubList@) 2) Other$ SubList@)
                  $value (itoa (- (length SubList@)(length (member Other$ SubList@)))))
          );if
        );progn
        (setq $value (itoa (- (length SubList@)(length (member SubVar$ SubList@)))))
      );if
    );progn
  );if
  (setq SubVar$ (nth (atoi $value) SubList@))
  (start_list $key) (mapcar 'add_list SubList@)(end_list)
  (set_tile $key $value)
  (set (read SentList$) SubList@)
  (set (read SentVar$) SubVar$)
  (princ)
);defun set_other_reallist
;-------------------------------------------------------------------------------
; check_editint - Function to verify if value is an integer
; Arguments: 1
;   SentVar$ = String of the variable name
; Syntax: (check_editint "Variable")
;-------------------------------------------------------------------------------
(defun check_editint (SentVar$ / Cnt# Mid$ Passed SubVar$)
  (setq SubVar$ (eval (read SentVar$)))
  (setq Cnt# 1 Passed t)
  (repeat (strlen $value)
    (setq Mid$ (substr $value Cnt# 1))
    (if (not (member Mid$ (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
      (setq Passed nil)
    );if
    (setq Cnt# (1+ Cnt#))
  );repeat
  (if (not Passed)
    (progn
      (alert "Value must be an integer!")
      (set_tile $key SubVar$)
    );progn
    (if (= $value "")
      (set (read SentVar$) $value)
      (progn
        (setq $value (itoa (atoi $value)))
        (set (read SentVar$) $value)
        (set_tile $key $value)
      );progn
    );if
  );if
  (princ)
);defun check_editint
;-------------------------------------------------------------------------------
; check_editreal - Function to verify if value is a real number
; Arguments: 1
;   SentVar$ = String of the variable name
; Syntax: (check_editreal "Variable")
;-------------------------------------------------------------------------------
(defun check_editreal (SentVar$ / Cnt# Loop Mid$ Passed Period# SubVar$)
  (setq SubVar$ (eval (read SentVar$)))
  (setq Cnt# 1 Passed t Period# 0)
  (repeat (strlen $value)
    (setq Mid$ (substr $value Cnt# 1))
    (if (not (member Mid$ (list "." "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
      (setq Passed nil)
    );if
    (if (= Mid$ ".")(setq Period# (1+ Period#)))
    (setq Cnt# (1+ Cnt#))
  );repeat
  (if (> Period# 1)(setq Passed nil))
  (if (not Passed)
    (progn
      (alert "Value must be a real number!")
      (set_tile $key SubVar$)
    );progn
    (if (= $value "")
      (set (read SentVar$) $value)
      (progn
        (setq Loop t Cnt# 8)
        (while Loop
          (setq $value (rtos (atof $value) 2 Cnt#))
          (if (= (atof $value) (atof (rtos (atof $value) 2 (1- Cnt#))))
            (setq Cnt# (1- Cnt#))
            (setq Loop nil)
          );if
          (if (= Cnt# 0) (setq Loop nil))
        );while
        (set (read SentVar$) $value)
        (set_tile $key $value)
      );progn
    );if
  );if
  (princ)
);defun check_editreal
;-------------------------------------------------------------------------------
; NoSpaces - Truncates left and right spaces from a string.
; Arguments: 1
;   Str$ = String
; Returns: String with the left and right spaces truncated.
;-------------------------------------------------------------------------------
(defun NoSpaces (Str$)
  (vl-string-trim " " Str$)
);defun NoSpaces
;-------------------------------------------------------------------------------
; Insert_nth - Inserts a new item value into the nth number in list.
; Arguments: 3
;   Num# = Nth number in list to insert item value
;   Value = Item value to insert
;   OldList@ = List to insert item value
; Returns: A list with the new item value inserted.
;-------------------------------------------------------------------------------
(defun Insert_nth (Num# Value OldList@ / Temp@)
  (if (< -1 Num# (1+ (length OldList@)))
    (progn
      (repeat Num#
        (setq Temp@ (cons (car OldList@) Temp@)
              OldList@ (cdr OldList@)
        );setq
      );repeat
      (append (reverse Temp@) (list Value) OldList@)
    );progn
    OldList@
  );if
);defun Insert_nth
;-------------------------------------------------------------------------------
(princ);End of OtherLists.lsp