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

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 812
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:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
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

  • Swamp Rat
  • Posts: 812
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.  :-)
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

MSTG007

  • Gator
  • Posts: 2598
  • 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.
Civil3D 2020

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Prompt With Matrix Buttons
« Reply #4 on: November 05, 2017, 06:53:00 AM »
 :idea: Heres some more fun with this, guys:

Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / s r )
  2.   (setq s "")
  3.   (while (setq r (PromptWithMatrixButtons "Pseudo Virtual Keyboard" nil (List->SquareMatrixList 10 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ -+=1234567890*/.'")))))
  4.     (princ "\n") (princ (setq s (strcat s r)))
  5.   )
  6.   (alert s) (princ)
  7. )
  8.  
  9.  
  10. ; (PromptWithMatrixButtons "Your favourite letter" nil (List->SquareMatrixList 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
  11. _$ (List->SquareMatrixList 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  12. (("A" "B" "C" "D")
  13.   ("E" "F" "G" "H")
  14.   ("I" "J" "K" "L")
  15.   ("M" "N" "O" "P")
  16.   ("Q" "R" "S" "T")
  17.   ("U" "V" "W" "X")
  18.   ("Y" "Z" nil nil)
  19. )
  20. ; (List->SquareMatrixList 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  21. ; L - input list
  22. ; n - square's size (in items)
  23. ; Returns a matrix list NxN ( the empty items are filled with nil's )
  24. (defun List->SquareMatrixList ( n L / tmp rtn )
  25.   (while L
  26.     (setq tmp nil)
  27.     (repeat n (progn (setq tmp (cons (car L) tmp)) (setq L (cdr L))))
  28.     (setq rtn (cons (reverse tmp) rtn))
  29.   )
  30.   (reverse rtn)
  31. ); defun List->SquareMatrixList
  32.  
  33. ; (PromptWithMatrixButtons "Your favourite letter" nil (List->SquareMatrixList2 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
  34. _$ (List->SquareMatrixList2 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  35. (("A" "E" "I" "M" "Q" "U" "Y")
  36.   ("B" "F" "J" "N" "R" "V" "Z")
  37.   ("C" "G" "K" "O" "S" "W" nil)
  38.   ("D" "H" "L" "P" "T" "X" nil)
  39. )
  40. ; (List->SquareMatrixList2 4 (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  41. ; L - input list
  42. ; n - square's size (in items)
  43. ; Returns a matrix list NxN ( the empty items are filled with nil's )
  44. (defun List->SquareMatrixList2 ( n L / tmp rtn )
  45.   (while L
  46.     (setq tmp nil)
  47.     (repeat n (progn (setq tmp (cons (car L) tmp)) (setq L (cdr L))))
  48.     (setq rtn (cons (reverse tmp) rtn))
  49.   )
  50.   (if rtn (apply 'mapcar (cons 'list (reverse rtn))))
  51. ); defun List->SquareMatrixList2

EDIT:
Sorry - this one should actually 'square' the list:

Code - Auto/Visual Lisp: [Select]
  1. ; (PromptWithMatrixButtons nil nil (SquareList (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
  2. ; _$ (SquareList (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  3. ; (("A" "B" "C" "D" "E") ("F" "G" "H" "I" "J") ("K" "L" "M" "N" "O") ("P" "Q" "R" "S" "T") ("U" "V" "W" "X" "Y") ("Z" nil nil nil nil))
  4. ; _$ (SquareList (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789")))
  5. ; (("A" "B" "C" "D" "E") ("F" "G" "H" "I" "J") ("K" "L" "M" "N" "O") ("P" "Q" "R" "S" "T") ("U" "V" "W" "X" "Y") ("Z" "1" "2" "3" "4") ("5" "6" "7" "8" "9"))
  6. ; _$ (SquareList (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890")))
  7. ; (("A" "B" "C" "D" "E" "F") ("G" "H" "I" "J" "K" "L") ("M" "N" "O" "P" "Q" "R") ("S" "T" "U" "V" "W" "X") ("Y" "Z" "1" "2" "3" "4") ("5" "6" "7" "8" "9" "0"))
  8. ; (SquareList (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
  9. (defun SquareList ( L / n tmp rtn )
  10.   (setq n (fix (sqrt (length L))))
  11.   (while L
  12.     (setq tmp nil)
  13.     (repeat n (progn (setq tmp (cons (car L) tmp)) (setq L (cdr L))))
  14.     (setq rtn (cons (reverse tmp) rtn))
  15.   )
  16.   (reverse rtn)
  17. ); defun SquareList

Tests:
Code: [Select]
(PromptWithMatrixButtons nil nil (mapcar '(lambda (x / i b ) (setq i 10) (repeat i (setq b (cons (strcat x (itoa (setq i (1- i)))) b))) b) (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))) ; not squared
(PromptWithMatrixButtons nil nil (SquareList (apply 'append (mapcar '(lambda (x / i b ) (setq i 10) (repeat i (setq b (cons (strcat x (itoa (setq i (1- i)))) b))) b) (mapcar 'chr (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))))) ; squared
« Last Edit: November 05, 2017, 07:03:49 AM by Grrr1337 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Prompt With Matrix Buttons
« Reply #5 on: November 05, 2017, 09:01:20 PM »
That's pretty cool. I wonder what type off applications would you use this? I am sure there are many.
You can build you own Pop up calculator.  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.

dubb

  • Swamp Rat
  • Posts: 1105
Re: Prompt With Matrix Buttons
« Reply #6 on: January 02, 2018, 06:51:15 PM »
Looks really cool, I might use this.

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Prompt With Matrix Buttons
« Reply #7 on: January 02, 2018, 07:35:37 PM »
Looks really cool, I might use this.

Thanks!
Some purpose might be to prompt for a quadrant or for justification - my original idea was just to call commands from a certain category.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg