ccalder
2017-02-18, 03:20 AM
So I have a routine and dcl file I've been tinkering with. It's all basically working as intended, but I have a conundrum with one function. The routine is basically a way to take the big batch files from our surveys and finagle the text so that it can be copy/pasted directly into our drawings... a full explanation is not really important, lets just say it changes an hours long job with lots of human error to a minutes long job with minimum human error.
The function that's causing me grief is one that's used to do some quick line sorting. It works just fine, but when I click one of the up or down buttons a second time, the tile value for the previous selection is applied in addition to the new value. It never happens on the first click and it never happens on the 3rd through however many clicks, just the second. It's not a huge deal, but it just doesn't feel tidy to me so if someone has any ideas on how to get it to stop I'd appreciate any input.
Instead of the whole shebang I've sniped out the particular function and wrapped it in a shell for testing:
;lisp code
(defun c:reo-test ( / tx )
(setq tx "file path from full routine")
(reo_dia_sort tx)
(princ)
)
(defun reo_dia_sort (file:in / uclick dcl:id list:box box:tile list:tmp tmp1 tmp2 tmp3 list:back list:fore)
(setq dcl:id (load_dialog "reo-test.dcl"))
(if (not (new_dialog "REO_UI_SORT" dcl:id))
(exit)
)
(setq list:box (list "Line 1" "Line 2" "Line 3" "Line 4" "Line 5"))
;(setq list:box (read_sort file:in))
(setq uclick nil)
(start_list "SORT_BOX")
(mapcar 'add_list list:box)
(end_list)
;up button
(action_tile "SORT_UP"
"(setq box:tile (get_tile \"SORT_BOX\"))
(setq list:box (reo_sort_up list:box box:tile))"
);action_tile
;down button
(action_tile "SORT_DOWN"
"(setq box:tile (get_tile \"SORT_BOX\"))
(setq list:box (reo_sort_down list:box box:tile))"
);action_tile
;cancel
(action_tile "SORT_CANCEL" "(done_dialog)")
;OK
(action_tile "SORT_ACCEPT"
"(setq uclick T)
(done_dialog)"
);action tile
(start_dialog)
(unload_dialog dcl:id)
(if (= uclick T)
(princ list:box)
;(write_sort list:box file:in)
)
(princ)
);end defun
(defun reo_sort_up ( list:box box:tile / list:tmp tmp1 tmp2 tmp3 list:back list:fore )
(setq box:tile (LM:str->lst box:tile " "))
;if not first
(if (> (length box:tile) 0)
(progn
(if (not (= (car box:tile) "0"))
(progn
(setq list:tmp list:box)
(foreach tmp1 box:tile
;temp store member and previous
(setq tmp2 (nth (atoi tmp1) list:tmp))
(setq list:back (cdr (member tmp2 list:tmp)))
(setq list:fore (cdr (member tmp2 (reverse list:tmp))))
(setq tmp3 (car list:fore))
(setq list:fore (reverse (cdr list:fore)))
;sub member for prev and prev for member
(setq list:tmp (append list:fore (list tmp2) (list tmp3) list:back))
);foreach
;recreate list
(setq list:box list:tmp)
;re-pop box
(start_list "SORT_BOX" 3)
(mapcar 'add_list list:box)
(end_list)
;-find new poss and default highlight
(setq box:tile (mapcar '(lambda (a) (itoa (- (atoi a) 1))) box:tile))
(setq box:tile (LM:lst->str box:tile " "))
(set_tile "SORT_BOX" box:tile)
);end progn
);end if
);end progn
);end if
list:box
);end defun
(defun reo_sort_down ( list:box box:tile / list:tmp tmp1 tmp2 tmp3 list:back list:fore )
(setq box:tile (LM:str->lst box:tile " "))
;if not last
(if (> (length box:tile) 0)
(progn
(if (not (= (last box:tile) (itoa (- (length list:box) 1))))
(progn
(setq box:tile (reverse box:tile))
(setq list:tmp list:box)
(foreach tmp1 box:tile
;temp store member and next
(setq tmp2 (nth (atoi tmp1) list:tmp))
(setq list:back (cdr (member tmp2 list:tmp)))
(setq list:fore (cdr (member tmp2 (reverse list:tmp))))
(setq list:fore (reverse list:fore))
(setq tmp3 (car list:back))
(setq list:back (cdr list:back))
;sub member for next and next for member
(setq list:tmp (append list:fore (list tmp3) (list tmp2) list:back))
);foreach
;recreate list
(setq list:box list:tmp)
;re-pop box
(start_list "SORT_BOX" 3)
(mapcar 'add_list list:box)
(end_list)
;-find new poss and default highlight
(setq box:tile (mapcar '(lambda (a) (itoa (+ (atoi a) 1))) box:tile))
(setq box:tile (LM:lst->str box:tile " "))
(set_tile "SORT_BOX" box:tile)
);end progn
);end if
);end progn
);end if
list:box
);end defun
;string to list and list to string functions by Lee Mac
;http://www.lee-mac.com/stringtolist.html
;http://www.lee-mac.com/listtostring.html
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
(defun LM:lst->str ( lst del / str )
(setq str (car lst))
(foreach itm (cdr lst) (setq str (strcat str del itm)))
str
)
//dcl code
REO_UI_SORT
: dialog
{
: row
{
fixed_height = true;
fixed_width = true;
: column
{
fixed_height = true;
fixed_width = true;
alignment = top;
: button
{
key = "SORT_UP";
label = "^";
fixed_width = true;
fixed_height = true;
alignment = centered;
}
: button
{
key = "SORT_DOWN";
label = "v";
fixed_width = true;
fixed_height = true;
alignment = centered;
}
}
: column
{
fixed_height = true;
fixed_width = true;
: list_box
{
key = "SORT_BOX";
width = 80;
height = 60;
multiple_select = true;
value = "";
fixed_width = true;
fixed_height = true;
}
}
}
: row
{
fixed_height = true;
fixed_width = true;
alignment = left;
: button
{
key = "SORT_ACCEPT";
label = "OK";
is_default = true;
fixed_width = true;
alignment = left;
}
: button
{
key = "SORT_CANCEL";
label = "Cancel";
fixed_width = true;
alignment = left;
}
}
}
The function that's causing me grief is one that's used to do some quick line sorting. It works just fine, but when I click one of the up or down buttons a second time, the tile value for the previous selection is applied in addition to the new value. It never happens on the first click and it never happens on the 3rd through however many clicks, just the second. It's not a huge deal, but it just doesn't feel tidy to me so if someone has any ideas on how to get it to stop I'd appreciate any input.
Instead of the whole shebang I've sniped out the particular function and wrapped it in a shell for testing:
;lisp code
(defun c:reo-test ( / tx )
(setq tx "file path from full routine")
(reo_dia_sort tx)
(princ)
)
(defun reo_dia_sort (file:in / uclick dcl:id list:box box:tile list:tmp tmp1 tmp2 tmp3 list:back list:fore)
(setq dcl:id (load_dialog "reo-test.dcl"))
(if (not (new_dialog "REO_UI_SORT" dcl:id))
(exit)
)
(setq list:box (list "Line 1" "Line 2" "Line 3" "Line 4" "Line 5"))
;(setq list:box (read_sort file:in))
(setq uclick nil)
(start_list "SORT_BOX")
(mapcar 'add_list list:box)
(end_list)
;up button
(action_tile "SORT_UP"
"(setq box:tile (get_tile \"SORT_BOX\"))
(setq list:box (reo_sort_up list:box box:tile))"
);action_tile
;down button
(action_tile "SORT_DOWN"
"(setq box:tile (get_tile \"SORT_BOX\"))
(setq list:box (reo_sort_down list:box box:tile))"
);action_tile
;cancel
(action_tile "SORT_CANCEL" "(done_dialog)")
;OK
(action_tile "SORT_ACCEPT"
"(setq uclick T)
(done_dialog)"
);action tile
(start_dialog)
(unload_dialog dcl:id)
(if (= uclick T)
(princ list:box)
;(write_sort list:box file:in)
)
(princ)
);end defun
(defun reo_sort_up ( list:box box:tile / list:tmp tmp1 tmp2 tmp3 list:back list:fore )
(setq box:tile (LM:str->lst box:tile " "))
;if not first
(if (> (length box:tile) 0)
(progn
(if (not (= (car box:tile) "0"))
(progn
(setq list:tmp list:box)
(foreach tmp1 box:tile
;temp store member and previous
(setq tmp2 (nth (atoi tmp1) list:tmp))
(setq list:back (cdr (member tmp2 list:tmp)))
(setq list:fore (cdr (member tmp2 (reverse list:tmp))))
(setq tmp3 (car list:fore))
(setq list:fore (reverse (cdr list:fore)))
;sub member for prev and prev for member
(setq list:tmp (append list:fore (list tmp2) (list tmp3) list:back))
);foreach
;recreate list
(setq list:box list:tmp)
;re-pop box
(start_list "SORT_BOX" 3)
(mapcar 'add_list list:box)
(end_list)
;-find new poss and default highlight
(setq box:tile (mapcar '(lambda (a) (itoa (- (atoi a) 1))) box:tile))
(setq box:tile (LM:lst->str box:tile " "))
(set_tile "SORT_BOX" box:tile)
);end progn
);end if
);end progn
);end if
list:box
);end defun
(defun reo_sort_down ( list:box box:tile / list:tmp tmp1 tmp2 tmp3 list:back list:fore )
(setq box:tile (LM:str->lst box:tile " "))
;if not last
(if (> (length box:tile) 0)
(progn
(if (not (= (last box:tile) (itoa (- (length list:box) 1))))
(progn
(setq box:tile (reverse box:tile))
(setq list:tmp list:box)
(foreach tmp1 box:tile
;temp store member and next
(setq tmp2 (nth (atoi tmp1) list:tmp))
(setq list:back (cdr (member tmp2 list:tmp)))
(setq list:fore (cdr (member tmp2 (reverse list:tmp))))
(setq list:fore (reverse list:fore))
(setq tmp3 (car list:back))
(setq list:back (cdr list:back))
;sub member for next and next for member
(setq list:tmp (append list:fore (list tmp3) (list tmp2) list:back))
);foreach
;recreate list
(setq list:box list:tmp)
;re-pop box
(start_list "SORT_BOX" 3)
(mapcar 'add_list list:box)
(end_list)
;-find new poss and default highlight
(setq box:tile (mapcar '(lambda (a) (itoa (+ (atoi a) 1))) box:tile))
(setq box:tile (LM:lst->str box:tile " "))
(set_tile "SORT_BOX" box:tile)
);end progn
);end if
);end progn
);end if
list:box
);end defun
;string to list and list to string functions by Lee Mac
;http://www.lee-mac.com/stringtolist.html
;http://www.lee-mac.com/listtostring.html
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
(defun LM:lst->str ( lst del / str )
(setq str (car lst))
(foreach itm (cdr lst) (setq str (strcat str del itm)))
str
)
//dcl code
REO_UI_SORT
: dialog
{
: row
{
fixed_height = true;
fixed_width = true;
: column
{
fixed_height = true;
fixed_width = true;
alignment = top;
: button
{
key = "SORT_UP";
label = "^";
fixed_width = true;
fixed_height = true;
alignment = centered;
}
: button
{
key = "SORT_DOWN";
label = "v";
fixed_width = true;
fixed_height = true;
alignment = centered;
}
}
: column
{
fixed_height = true;
fixed_width = true;
: list_box
{
key = "SORT_BOX";
width = 80;
height = 60;
multiple_select = true;
value = "";
fixed_width = true;
fixed_height = true;
}
}
}
: row
{
fixed_height = true;
fixed_width = true;
alignment = left;
: button
{
key = "SORT_ACCEPT";
label = "OK";
is_default = true;
fixed_width = true;
alignment = left;
}
: button
{
key = "SORT_CANCEL";
label = "Cancel";
fixed_width = true;
alignment = left;
}
}
}