Author Topic: Prompt With Matrix Buttons  (Read 86 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Bull Frog
  • Posts: 380
Prompt With Matrix Buttons
« on: October 01, 2017, 09:05:58 am »
Hi guys,
Just wanted to share this 'old' (maybe 1 year?) routine I wrote:

Code - Auto/Visual Lisp: [Select]
  1. ; Buttons from assoc list (matrix):
  2. ; dlglbl - dialog's label
  3. ; size - list of '(width height) - must be numerical
  4. ; aL - assoc list of strings, each item defines a row, the strings must be unique (they are used as keys)
  5. (defun PromptWithMatrixButtons ( dlglbl size aL / LM:Unique-p *error* dcl des dch dcf r )
  6.  
  7.  ;; Unique-p  -  Lee Mac ;; Returns T if the supplied list contains distinct items.
  8.  (defun LM:Unique-p ( l ) (vl-every (function (lambda ( x ) (not (member x (setq l (cdr l)))))) l) )
  9.  
  10.  (defun *error* ( msg )
  11.    (and (< 0 dch) (unload_dialog dch))
  12.    (and (eq 'FILE (type des)) (close des))
  13.    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
  14.    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
  15.    (princ)
  16.  ); defun *error*
  17.  
  18.  (cond
  19.    ( (not (vl-consp aL)) (princ "\nInvalid input - aL is not a list.") )
  20.    ( (not (vl-every '(lambda (x) (and (vl-consp x) (vl-every '(lambda (s) (or (not s) (eq 'STR (type s)))) x))) aL))
  21.      (princ "\nInvalid list, the format must be assoc list of strings")
  22.    )
  23.    ( (not (LM:Unique-p (mapcar '(lambda (x) (strcase x)) (vl-remove-if 'null (apply 'append aL)))))
  24.      (princ "\nInvalid list, it contains duplicate keys.")
  25.    )
  26.    (
  27.      (not
  28.        (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
  29.          (mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
  30.            (list
  31.              "PromptWithMatrixButtons : dialog"
  32.              (strcat "{ label = \"" (if (eq 'STR (type dlglbl)) dlglbl "") "\"; children_alignment = centered; spacer;")
  33.              (apply 'strcat
  34.                (mapcar
  35.                  '(lambda (x)
  36.                    (strcat
  37.                      "\n: row"
  38.                      "\n{"
  39.                      (apply 'strcat
  40.                        (mapcar
  41.                          (function
  42.                            (lambda ( keylbl )
  43.                              (if keylbl
  44.                                (strcat
  45.                                  "\n: button"
  46.                                  "{ label = \"" keylbl "\"; key = \"" keylbl "\"; "
  47.                                  (if (and (vl-consp size) (= 2 (length size)))
  48.                                    (strcat
  49.                                      (if (numberp (car size)) (strcat "width = "(vl-princ-to-string (car size))";") "")
  50.                                      (if (numberp (cadr size)) (strcat "height = "(vl-princ-to-string (cadr size))";") "")
  51.                                    ); strcat
  52.                                    ""
  53.                                  ); if
  54.                                  "}"
  55.                                ); strcat
  56.                                (strcat
  57.                                  "\n : button"
  58.                                  "{"
  59.                                  "is_enabled = false;"
  60.                                  (if (and (vl-consp size) (= 2 (length size)))
  61.                                    (strcat
  62.                                      (if (numberp (car size)) (strcat "width = "(vl-princ-to-string (car size))";") "")
  63.                                      (if (numberp (cadr size)) (strcat "height = "(vl-princ-to-string (cadr size))";") "")
  64.                                    ); strcat
  65.                                    ""
  66.                                  ); if
  67.                                  "}"
  68.                                ); strcat
  69.                              ); if keylbl
  70.                            ); lambda (keylbl)
  71.                          )
  72.                          x
  73.                        ); mapcar
  74.                      ); apply 'strcat
  75.                      "\n}"
  76.                    ); strcat
  77.                  ); lambda (x)
  78.                  aL
  79.                ); mapcar
  80.              ); apply 'strcat
  81.              "  spacer; ok_only;"
  82.              "}"
  83.            ); list
  84.          ); mapcar
  85.          (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
  86.        ); and
  87.      ); not
  88.      (princ "\nUnable to write or load the DCL file.")
  89.    )
  90.    ( (not (new_dialog "PromptWithMatrixButtons" dch)) (princ "\nUnable to display the dialog") )
  91.    (
  92.      (progn
  93.        (mapcar '(lambda (k) (action_tile k (vl-prin1-to-string '(progn (setq r $key) (done_dialog 1))))) (vl-remove 'nil (apply 'append aL)))
  94.        (action_tile "accept" (vl-prin1-to-string '(done_dialog 0)))
  95.        (/= 1 (setq dcf (start_dialog)))
  96.      ); progn
  97.      (princ "\nUser cancelled the dialog.")
  98.    )
  99.  ); cond
  100.  (*error* nil) r
  101. ); defun PromptWithMatrixButtons



Example1:

Code - Auto/Visual Lisp: [Select]
  1. ; Example1:
  2. (PromptWithMatrixButtons "Push the button" nil
  3.  '(("A1" "B1" "C1") ; <- row
  4.    ("A2" "B2" "C2")
  5.    ("A3" "B3" "C3")
  6.  );  ^ column
  7. )

Should display:




Example2:

Code - Auto/Visual Lisp: [Select]
  1. ; Example2:
  2. (PromptWithMatrixButtons "Matrix Buttons Prompt" '(8 3)
  3.  '((nil "B1" "C1" "D1" "E1" "F1" "G1") ; <- row
  4.    ("A2" nil "C2" "D2" "E2" "F2" "G2")
  5.    ("A3" "B3" nil "D3" "E3" "F3" "G3")
  6.    ("A4" "B4" "C4" nil "E4" "F4" "G4")
  7.    ("A5" "B5" "C5" "D5" nil "F5" nil)
  8.    ("A6" "B6" "C6" "D6" "E6" nil "G6")
  9.  );  ^ column
  10. )

Should display:


NOTE: Each key (item in the matrix list) must be unique, and the function returns the chosen item.
Might be handy for collecting command-calls.

Also you could nest it, by reinvoking the same subfunction but with different args, not the best example:
Code - Auto/Visual Lisp: [Select]
  1. (
  2.  (lambda ( / L ok i r )
  3.    ; Lee Mac ; https://www.theswamp.org/index.php?topic=52935.msg577618#msg577618
  4.    (defun mapncar ( n f l ) (if (< 0 n) (mapcar '(lambda ( x ) (mapncar (1- n) f x)) l) (mapcar 'f l) ) )
  5.  
  6.    (setq L
  7.      '(("A1" "B1" "C1") ; <- row
  8.        ("A2" "B2" "C2")
  9.        ("A3" "B3" "C3")
  10.      );  ^ column
  11.    ); setq L
  12.    (setq i 0)
  13.    (while
  14.      (setq ok (PromptWithMatrixButtons (cond ((last r)) ("test")) nil (mapncar 1 (lambda (x) (strcat x "_" (itoa i))) L)))
  15.      (setq i (1+ i))
  16.      (setq r (append r (list ok)))
  17.    )
  18.    r
  19.  )
  20. )

Cheers!  :gum:

CAB

  • Global Moderator
  • Seagull
  • Posts: 10228
Re: Prompt With Matrix Buttons
« Reply #1 on: October 01, 2017, 09:39:15 am »
Thanks for sharing.   8)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Grrr1337

  • Bull Frog
  • Posts: 380
Re: Prompt With Matrix Buttons
« Reply #2 on: October 01, 2017, 03:32:26 pm »
Thanks for sharing.   8)

Appreciate your post - it shows that it would be useful even for some oldschool lispers.  :-)

MSTG007

  • Water Moccasin
  • Posts: 2026
  • I can't remeber what I already asked! I need help!
Re: Prompt With Matrix Buttons
« Reply #3 on: October 02, 2017, 07:35:52 am »
That's pretty cool. I wonder what type off applications would you use this? I am sure there are many.
Autodesk Infrastructure Design Suite 2017