Left Right Up & Down DCL

June 27, 2018

I just did this for some one else and thought would post here, its an example of using a simple radio button to make choices rather than initget. In this case a simple up down left or right. It would be a library routine much like a number of others out there, next version would be generic removing the hard code options so could be any input desired.

; Input  Dialog box for left right up down
; By Alan H May 2018
(vl-load-com)

(defun AH:UDLR (/ fo fname val1 val2 val3 val4)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line  "U_D_L_R : dialog 	{" fo)
(write-line  (strcat "	label =" (chr 34) "Please choose L R U D" (chr 34) " ;" )fo)
(write-line "	: row	{" fo)
(write-line "	: boxed_radio_column 	{" fo)
(write-line "	: radio_button	{" fo)
(write-line  (strcat "key = "  (chr 34) "rb1" (chr 34) ";") fo)
(write-line  (strcat "label = " (chr 34) "Left" (chr 34) ";") fo)
(write-line "	}" fo)
(write-line "    : radio_button	{" fo)
(write-line (strcat "	key = "  (chr 34) "rb2" (chr 34) ";") fo)
(write-line (strcat "	label = "(chr 34)"Right" (chr 34) ";") fo)
(write-line "	}" fo)
(write-line "    : radio_button	{" fo)
(write-line (strcat "	key = "  (chr 34) "rb3" (chr 34) ";") fo)
(write-line (strcat "	label = "(chr 34)"Up" (chr 34) ";") fo)
(write-line "	}" fo)
(write-line "    : radio_button	{" fo)
(write-line (strcat "	key = "  (chr 34) "rb4" (chr 34) ";") fo)
(write-line (strcat "	label = "(chr 34)"Down" (chr 34) ";") fo)
(write-line "	}" fo)
(write-line "	}" fo)
(write-line "	}" fo)
(write-line "	ok_only;" fo)
(write-line "	}" fo)
(close fo)
(setq dcl_id (load_dialog fname))
(if (not (new_dialog "U_D_L_R" dcl_id) )
(exit)
)
(action_tile "rb1" 	"(setq val1  $value )")
(action_tile "rb2" 	"(setq val2  $value )")
(action_tile "rb3" 	"(setq val3 $value)")
(action_tile "rb4" 	"(setq val4  $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)

(cond
((= val1 "1")(setq dir "L"))
((= val2 "1")(setq dir "R"))
((= val3 "1")(setq dir "U"))
((= val4 "1")(setq dir "D"))
((and(= val1 nil)(= val2 nil)(= val3 nil)(= val4 nil))(setq dir "No"))
)

(if (= dir "No")(progn (alert "You did not pick anything\n\nPlease start again")(exit)))

(alert (strcat "You picked " dir)) ;; return to main program
(princ)
)

June 27, 2018

something like this? :

; lst list of strings , def default (int) to set
(defun RlxBLK_ChooseFromColumn (lst def / fn fp dcl-id inp drv)
 (if (and (setq fn (vl-filename-mktemp ".dcl")) (setq fp (open  fn "w")))
   (progn
     (write-line "cfrc : dialog { label = \"Choose From Column\"; : boxed_radio_column {" fp)
     (mapcar '(lambda (x) (write-line (strcat " : radio_button { key = \"" x "\"; label = \"" x "\";}") fp)) lst)
     (write-line "} spacer;ok_cancel;}" fp)(close fp)(gc)
     (if (and (setq dcl-id (load_dialog fn)) (new_dialog "cfrc" dcl-id))
(progn
  (mapcar '(lambda (x)(action_tile x "(setq inp $key)")) lst)
  (if (not (void (nth def lst)))(set_tile (nth def lst) "1"))
  (action_tile "accept" "(done_dialog 1)")
  (setq drv (start_dialog))(unload_dialog dcl-id)))))
 ;(if (and (not (void inp)) (= drv 1)) inp nil)
 (cond ((not (void inp)) inp) ((not (void (nth def lst))) (nth def lst)) (t nil))
)
(defun c:cfc (); * * testing * *
 (RlxBLK_ChooseFromColumn '("1 2" "a b" "3 4" "c d" "5 6" "e f" "7 8" "g h" "9 10" "i j") 5 ))
   ;(list "Rename Old Block" "Rename New Block" "Overwrite Old Block Definition")))


;did it again forgot this one
(defun void (x) (if (member x (list "" " " "  " "   " "    " "     " nil '())) t nil))

June 27, 2018

I think your 'void' function would be better written as -

(defun void ( x ) (or (null x) (= "" (vl-string-trim " \t\r\n" x))))

June 27, 2018

I think your 'void' function would be better written as -
(defun void ( x ) (or (null x) (= "" (vl-string-trim " \t\r\n" x))))

yes you're quite right Lee , Grrr pointed this out to me earlier too. And I have done so in my main library , this was just (too) quickly pasted from one of my programs, saw I forgot to include it and pasted the first one I found (lazy). Downside of libraries is you get so used to them you sometimes forget you have them. But as always , thanx for the advise , spot on , as usual. (well , at the moment green tea actually)

Edited June 27, 2018 by rlx

June 27, 2018

think I'm gonna write a 'find-&-replace-defun'

June 28, 2018

rlx my reply post is gone, have been having some funny things happening lately will post seperately, but will take your mapcar part and look at redoing my getvals.lisps so I only need one lisp rather than coding for 1,2 3 or more etc. Me personally I have moved to using dcl's for multi input rather than line by line input. Just need to add a little bit of error checking into the procedures.

There is a increasing number of library DCl's now starting to appear which are very useful if taking the library approach to company code. You don't need to autoload just use a (if (not defunname and demand load.

June 28, 2018

rlx my reply post is gone, have been having some funny things happening lately will post seperately, but will take your mapcar part and look at redoing my getvals.lisps so I only need one lisp rather than coding for 1,2 3 or more etc. Me personally I have moved to using dcl's for multi input rather than line by line input. Just need to add a little bit of error checking into the procedures.

There is a increasing number of library DCl's now starting to appear which are very useful if taking the library approach to company code. You don't need to autoload just use a (if (not defunname and demand load.

Did the same with toggles (RlxTokkie) and not long after I had the idea of doing the same with radio buttons. Looking back I don't really need the void function here , null will do nicely and also a cancel button is not really needed because with radio buttons the number of choices is a fixed one and not changing the default is also a choice. Also , you could put a limit on the length of the list you pass to say 10 or so because more radio buttons would be silly. Updated all void defun's in my lisp files but kept the old one just in case I want to run a script using the core console which only works with vanilla lisp.

Edited June 28, 2018 by rlx

June 28, 2018

BIGAL, you could write it in some Lee-Mac-ish style:

(defun AH:ULDR ( / *error* dcl des dch dcf keys rtn )
 ; http://www.cadtutor.net/forum/showthread.php?104592-Left-Right-Up-amp-Down-DCL
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
 ); defun *error*
 
 (setq keys '(left right up down))
 (cond
   (
     (not
       (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
         (mapcar (function (lambda (x) (princ (strcat "\n" x) des))) 
           (list
             (strcat
               "u_d_l_r : dialog 	"
               "{ label = \" please choose l r u d \"; "
               "  : row	"
               "  { "
               "    : boxed_radio_column "
               "    { "
             ); strcat
             (apply 'strcat
               (mapcar 
                 '(lambda (k / s) 
                   (setq k (strcase (vl-prin1-to-string k) t))
                   (strcat "\n : radio_button { key = \"" k "\"; label = \"" (setq s (strcase (substr k 1 1))) (substr k 2) "\"; mnemonic = \"" s "\";} ")
                 ); lambda
                 keys 
               ); mapcar
             ); apply 'strcat
             (strcat
               "    } "
               "  } "
               "  spacer; ok_cancel; : text { key = \"error\"; } "
               "}"
             ); strcat
           ); list
         ); mapcar
         (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
       ); and
     ); not
     (prompt "\nUnable to write or load the DCL file.")
   )
   ( (not (new_dialog "u_d_l_r" dch)) (prompt "\nUnable to display the dialog") )
   (
     (progn 
       (action_tile "accept"
         (vl-prin1-to-string
           (quote
             (or
               (and
                 (setq rtn (vl-some (function (lambda (k) (setq k (strcase (vl-prin1-to-string k) t)) (if (= "1" (get_tile k)) (strcase (substr k 1 1))))) keys))
                 (done_dialog 1)
               ); and
               (set_tile "error" "You did not pick anything\n\nPlease start again")
             ); or
           ); quote
         ); vl-prin1-to-string
       ); action_tile "accept"
       (/= 1 (setq dcf (start_dialog)))
     ); progn
     (prompt "\nUser cancelled or terminated the dialog.")
   )
   ( (alert (strcat "You picked: \"" rtn "\".")) )
 ); cond
 (*error* nil) (princ) (cond ( rtn ) ( "No" ) )
); defun 
; (AH:ULDR)

I would use the matrix buttons prompt in this case, due the easier visual orientation.

June 28, 2018

Thanks Grr I knew about your array dcl just needed to find the time to double check it was yours.

Really the post here is about showing examples of how to use DCL rather than repeated input line by line. Starting simple and getting smarter as you understand whats going on.

The UDLR could accept pick a arrow key as input by looking at keycode that has been pressed or U L D R. Another day.

I will still redo my getvals as we use it everyday generally for 1, 2 or 3 inputs with predefined values.

June 28, 2018

I will still redo my getvals as we use it everyday generally for 1, 2 or 3 inputs with predefined values.

I have some dissection of your AH:getval3 from the last year -

; Rewriting BIGAL's (AH:getval3)
; (foo "Get Point" nil 3 3 '(("X" "")("Y" "")("Z" "")))
; (foo "Get Some Stuff" nil 3 3 (mapcar '(lambda (x) (list x "")) (mapcar 'chr (vl-string->list "ABCDEF"))))
; (foo "Get All Stuff" T 3 3 (mapcar '(lambda (x) (list x "")) (mapcar 'chr (vl-string->list "ABCDEF"))))
; (foo "Rectangle" T 12 5 '(("Width" "600")("Height" "300")("Thickness" "15")("Fillet" "6")))
(defun foo ( title getevery w lim L / fillstrL ValidStr SetNth *error* tmp dcl des dch dcf keys rL )
 
 ; _$ (fillstrL '("Width" "Height" "Thickness" "Fillet")) -> ("Width    " "Height   " "Thickness" "Fillet   ")
 ; (fillstrL '("E" "Some" "Spacing" "" "Atleast its something") )
 ; Should return: 
 ; '(
 ; "E                    "
 ; "Some                 "
 ; "Spacing              "
 ; "                     "
 ; "Atleast its something"
 ; )
 (setq fillstrL
   (lambda ( L / fillstr n )
     (setq fillstr ; add spaces to the string in the end, to match the strlen criteria 
       (lambda ( str n / sL i s )
         (cond
           ( (and (eq 'STR (type str)) (eq 'INT (type n)) (setq sL (strlen str)) (> n sL) (setq i (- n sL)))
             (repeat i (setq s (cons " " s))) (strcat str (apply 'strcat s))
           )
           ( str )
         ); cond 
       ); lambda 
     ); setq fillstr
     (setq n (apply 'max (mapcar 'strlen L)))
     (mapcar '(lambda (x) (fillstr x n)) L)
   ); lambda
 ); setq fillstrL
 
 ; Checks if string is not a void, i.e.: '("" " " "  " "   " "    " ...)
 (defun ValidStr ( s ) (and (eq 'STR (type s)) (/= "" s) (vl-some (function (lambda (x) (/= " " x))) (mapcar 'chr (vl-string->list s)))) )
 
 ; (SetNth $key $value rL)
 (defun SetNth ( n itm L / i ) (setq i -1) (mapcar (function (lambda (x) (if (= n (setq i (1+ i))) itm x))) L) )
 
 (defun *error* ( m )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and m (or (wcmatch (strcase m) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " m)))) (princ)
 ); defun *error*
 
 ; (setq tmp (mapcar 'list (fillstrL (mapcar 'car L)) (mapcar 'cadr L)))
 ; (setq L tmp)
 ; (alert (apply 'strcat (mapcar 'vl-prin1-to-string L)))
 (cond
   (
     (not
       (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
         (mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
           (list 
             (strcat "eb : edit_box { fixed_width = true; width = \"" (itoa w) "\"; edit_width = \"" (itoa w) "\"; edit_limit = \"" (itoa lim) "\";  is_enabled = true; }")
             "test : dialog "
             (strcat "{ label = \"" title "\"; spacer_1; ")
             " : column "
             " { children_alignment = right; "
             (apply 'strcat
               (
                 (lambda ( / i sL ) (setq i -1) 
                   (setq sL
                     (mapcar 
                       (function 
                         (lambda (x / k) (setq rL (cons nil rL)) (setq keys (cons (setq k (itoa (setq i (1+ i)))) keys))
                           (strcat "\n" "   : eb { key = \"" k "\"; label = \"" (car x) "\"; value = \"" (cadr x) "\"; } ") ; spacer;
                         )
                       )
                       L ; list of '(label defval)
                     ); mapcar
                   ); setq sL
                   (setq keys (reverse keys)) sL
                 ); lambda ( / i )
               )
             ); apply 'strcat 
             " }"
             " spacer_1; ok_cancel; : text { key = \"error\"; }"
             "}"
           ); list 
         ); mapcar 
         (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
       ); and
     ); not
     (princ "\nUnable to write or load the DCL file.")
   )
   ( (not (new_dialog "test" dch)) (princ "\nUnable to display the dialog") )
   ( 
     (progn
       (setq rL (mapcar 'get_tile keys)) ; obtain the default values
       (mapcar 
         (function 
           (lambda (k)
             (action_tile k (strcat "(setq rL (SetNth (read $key) $value rL))"))
           ); lambda 
         ); function 
         keys
       ); mapcar 
       (action_tile "accept"
         (vl-prin1-to-string
           '(cond 
             ( (not rL) (set_tile "error" "Input something!") )
             ( (not (vl-some (function (lambda (x) (ValidStr x))) rL)) (set_tile "error" "Ivalid inputs!") )
             ( (and getevery (not (vl-every (function (lambda (x) (ValidStr x))) rL))) (set_tile "error" "Fill all inputs!") )
             ( (done_dialog 1) )
           ); cond
         ); vl-prin1-to-string
       ); action_tile "accept"
       (/= 1 (setq dcf (start_dialog)))
     ); progn 
     (princ "\nUser cancelled or terminated the dialog.") (setq rL nil)
   )
   (T (setq rL (mapcar (function (lambda (x) (if (ValidStr x) x))) rL)) ); T
 ); cond 
 (*error* nil) (princ) rL
); defun foo

Tought before about PM-ing it to you, but every day till today I have so many things on my head.

June 28, 2018

Grrr I am glad its the weekend soon and not glad its going to rain but will have time to digest.

June 28, 2018

No worries BIGAL -

If the coding seems too complex for you, its enough just to focus on the required inputs and the return - I do this with LM's subfunctions

Sign In

Left Right Up & Down DCL

Recommended Posts

BIGAL

rlx

Lee Mac

rlx

rlx

BIGAL

rlx

Grrr

BIGAL

Grrr

BIGAL

Grrr

Join the conversation

Tutorials

Forums

Activity