Topic: Determine Quadrant (with some list manipulation and math)

[Grrr1337]

Hi guys,
My question is related to DCL, but its not so DCLish:

I was surprised by a subfunction from Lee Mac, inside his Justify Block Base Point program:

Code - Auto/Visual Lisp: [Select]

1. (defun jbp:pixel->justification ( cpx )
2.   (vl-some '(lambda ( a b ) (if (apply 'and (mapcar '< a cpx (mapcar '+ a '(16 16)))) b))
3.    '( (012 009) (092 009) (172 009) (012 067) (092 067) (172 067) (012 125) (092 125) (172 125) )
4.    '("TL" "TC" "TR" "ML" "MC" "MR" "BL" "BC" "BR")
5.   )
6. )

And I thought about creating a general subfunction that splits an image by XN x YN (so n amount of quadrants are generated), so that same subfunction must determine in which quadrant the user clicked. Check the following (not finished) code to understand better what I'm trying to say:

Code - Auto/Visual Lisp: [Select]

1. ; p - picked point i.e.: ($x $y)
2. ; k - tile's key i.e.: $key
3. ; xn - x divisior [INT] (amount of X quadrants)
4. ; yn - y divisor [INT] (amount of Y quadrants)
5. ; Should return the picked quadrant (zero-based), i.e.: (1 3) (0 4) ...
6. (defun PickedQuadrant ( p k xn yn / valid xs ys xm ym xd yd )
7.   (setq valid (lambda (L) (and (vl-consp L) (vl-every '(lambda (x) (and (eq 'INT (type x)) (> 0 x))) L))))
8.   (cond
9.     ( (not (valid p)) (princ "\nInvalid 2D point.") )
10.     ( (not (valid (list xn yn))) (princ "\nInvalid amount of quadrants.") )
11.     (T
12.       (setq xs (dimx_tile k)) ; total X size
13.       (setq ys (dimy_tile k)) ; total Y size
14.       (setq xm (/ xs xn)) ; module X
15.       (setq ym (/ ys yn)) ; module Y
16.       ; Construct the increment lists for X and Y:
17.       (setq xd 0) (repeat (1- xn) (setq xL (cons (setq xd (+ xd xm)) xL))) (setq xL (cons 0 (reverse xL)))
18.       (setq yd 0) (repeat (1- yn) (setq yL (cons (setq yd (+ yd ym)) yL))) (setq yL (cons 0 (reverse yL)))
19.       ; Determine the picked quadrant ??
20.       ; (setq rtn ... )
21.     ); T
22.   ); cond
23.   rtn
24. ); defun PickedQuadrant

So when lets say we use:

Code: [Select]

(PickedQuadrant '(23 44) "imgkey" 3 4)then the generated quadrants list should look like [ items of '(row column) ] :

Code: [Select]

'(
  (0 0) (0 1) (0 2)
  (1 0) (1 1) (1 2)
  (2 0) (2 1) (2 2)
  (3 0) (3 1) (3 2)
)And depending on the picked point and the size of the image the correct quadrant is returned, i.e.: '(1 1)

The end result should be that: one would able to define how to split his image (2x2, 3x2, 2x3 5x4... ), and at which location its selected.
Ofcourse the most known is the 3x3 splitting (to get the justification).
I guess that the required skill to achieve such subfunction is very good list manipulation and math.
Also I have no idea what should be a proper test-function to visualise the result, sorry!

[roy_043]

Determining the picked cell is easy:

Code - Auto/Visual Lisp: [Select]

1. (list (/ pickedY moduleY) (/ pickedX moduleX))

[Grrr1337]

Thanks for the input, Roy and sorry for my late reply!

I was coding bit by bit daily and managed to produce the desired results:

Code - Auto/Visual Lisp: [Select]

1. ; (action_tile "imgkey" (vl-prin1-to-string '(alert (vl-prin1-to-string (PickedQuadrant (list $x $y) $key 3 3)))))
2. ; p - picked point i.e.: ($x $y)
3. ; k - tile's key i.e.: $key
4. ; xn - x divisior [INT] (amount of X quadrants)
5. ; yn - y divisor [INT] (amount of Y quadrants)
6. ; Should return the picked quadrant (zero-based), i.e.: (1 3) (0 4) ...
7. (defun PickedQuadrant ( p k xn yn / SegmentPosition valid TileDimXY )
8.  
9.   ; _$ (mapcar (function (lambda (x) (SegmentPosition x 20 100))) (list -3 5 20 21 45 79 81 100 101)) -> (nil 0 0 1 2 3 4 4 nil)
10.   (defun SegmentPosition ( num inc lim / L )
11.    
12.     ; Construct increment list, given a increment and a limit
13.     ; _$ (ConsIncL 20 100) -> (0 20 40 60 80 100)
14.     (defun ConsIncL ( inc lim / n L ) (setq n 0) (while (<= n lim) (setq L (cons n L)) (setq n (+ n inc)) ) (reverse L) )
15.    
16.     ; Create list of indexes from a given list
17.     ; _$ (L->idxs '("A" "B" "C" "D" "E")) -> (0 1 2 3 4)
18.     (defun L->idxs ( L / i nL ) (cond ( (vl-consp L) (repeat (setq i (length L)) (setq nL (cons (setq i (1- i)) nL))) nL)))
19.    
20.     (vl-some
21.       (function (lambda ( x / mn mx pos ) (setq mn (caar x)) (setq mx (cadar x)) (setq pos (cadr x)) (if (and mn mx (<= mn num mx)) pos) ) )
22.       (setq L (mapcar 'list (mapcar 'list (setq L (ConsIncL inc lim)) (cdr L)) (L->idxs L) ) )
23.     ); vl-some
24.   ); defun SegmentPosition
25.  
26.   (setq valid (lambda (L) (and (vl-consp L) (vl-every '(lambda (x) (and (eq 'INT (type x)) (< 0 x))) L))))
27.  
28.   (cond
29.     ( (not (valid p)) (princ "\nInvalid 2D point.") )
30.     ( (not (valid (list xn yn))) (princ "\nInvalid amount of quadrants.") )
31.     (T
32.       (setq TileDimXY (mapcar (function (lambda (x) (x k))) (list dimx_tile dimy_tile)))
33.       (list ; (SegmentPosition $x ModuleX LimitX)
34.         (SegmentPosition (car p) (/ (car TileDimXY) xn) (car TileDimXY)) ; Xpos
35.         (SegmentPosition (cadr p) (/ (cadr TileDimXY) yn) (cadr TileDimXY)) ; Ypos
36.       ); list
37.     ); T
38.   ); cond
39. ); defun PickedQuadrant

So heres a test function to visualise the results:

Code - Auto/Visual Lisp: [Select]

1. ; Test function for (PickedQuadrant) :
2. ; About Handling Image Buttons (assign action depending on the clicked portion of an image)
3. (defun C:test ( / PutImgVal *error* dcl des dch )
4.  
5.   (setq PutImgVal ; the tile can be visually splited on: 4x4, 2x4, 4x2, 2x2, 1x2, 2x1 (2/4/8/16 quadrants)
6.     (lambda (a b) (or b (setq b 250)) (or a (setq a -15))
7.       (list ; BackGround = 250 ; Empty = -15
8.         b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b
9.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
10.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
11.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
12.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
13.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
14.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
15.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
16.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
17.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
18.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
19.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
20.         b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b
21.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
22.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
23.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
24.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
25.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
26.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
27.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
28.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
29.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
30.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
31.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
32.         b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b
33.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
34.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
35.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
36.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
37.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
38.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
39.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
40.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
41.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
42.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
43.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
44.         b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b
45.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
46.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
47.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
48.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
49.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
50.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
51.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
52.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
53.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
54.         b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a a b a a a a a a a a a a b
55.         b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b
56.       ); list
57.     ); lambda
58.   ); setq PutImgVal
59.  
60.   (defun *error* ( msg )
61.     (and (< 0 dch) (unload_dialog dch))
62.     (and (eq 'FILE (type des)) (close des))
63.     (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
64.     (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
65.     (princ)
66.   ); defun *error*
67.  
68.   (cond
69.     (
70.       (not
71.         (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
72.           (mapcar (function (lambda (x) (princ x des)))
73.             '("imgtest : dialog"
74.               "{ label = \"Image Test\";"
75.               "  : column"
76.               "  { : image_button { key = \"img\"; fixed_width = true; fixed_height = true; width = 6.25; aspect_ratio = 1.0; alignment = centered; } " ; 48x48 image
77.               "    : edit_box { key = \"eb\"; label = \"Quadrant\"; alignment = centered; edit_width = 12; fixed_width = true; is_enabled = false; value = \"\"; }" ; info
78.               "  }"
79.               "  spacer; ok_cancel; : text { key = \"error\"; }"
80.               "}"
81.             )
82.           ); mapcar
83.           (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
84.         ); and
85.       ); not
86.       (princ "\nUnable to write or load the DCL file.")
87.     )
88.     ( (not (new_dialog "imgtest" dch)) (princ "\nUnable to display the dialog") )
89.     (T (LM:DisplayBitmap "img" (PutImgVal nil nil))
90.       (action_tile "img"
91.         (vl-prin1-to-string
92.           '(progn ; the tile can be visually splited on: 4x4, 2x4, 4x2, 2x2, 1x2, 2x1 (2/4/8/16 quadrants)
93.             (set_tile "eb" (vl-prin1-to-string (PickedQuadrant (list $x $y) $key 4 4))) ; display the info
94.             ; (set_tile "eb" (vl-prin1-to-string (PickedQuadrant (list $x $y) $key 2 2))) ; display the info
95.             (LM:DisplayBitmap "img" (PutImgVal (+ $x $y) nil)) ; assign some custom calculated colour for the image
96.           ); progn
97.         ); vl-prin1-to-string
98.       ); action_tile "img"
99.       (start_dialog)
100.     ); T
101.   ); cond
102.   (*error* nil) (princ)
103. ); defun
104.  
105.  
106. ;;--------------------=={ Display Bitmap }==------------------;;
107. ;;                                                            ;;
108. ;;  Renders the supplied ACI colour list representation of a  ;;
109. ;;  Bitmap image on the DCL image tile or image_button tile   ;;
110. ;;  with the given key.                                       ;;
111. ;;------------------------------------------------------------;;
112. ;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
113. ;;------------------------------------------------------------;;
114. ;;  Arguments:                                                ;;
115. ;;  key - key of DCL image tile or image_button tile          ;;
116. ;;  lst - ACI colour list                                     ;;
117. ;;------------------------------------------------------------;;
118. ;;  Returns:  nil                                             ;;
119. ;;------------------------------------------------------------;;
120.  
121. (defun LM:DisplayBitmap ( key lst / i j s x y )
122.   (setq s (fix (sqrt (length lst))))
123.   (repeat (setq i s)
124.     (setq j 1)
125.     (repeat s
126.       (setq x (cons j x)
127.         y (cons i y)
128.         j (1+ j)
129.       )
130.     )
131.     (setq i (1- i))
132.   )
133.   (start_image key)
134.   (fill_image 0 0 (dimx_tile key) (dimy_tile key) -15)
135.   (mapcar 'vector_image x y x y lst)
136.   (end_image)
137. )

I used 4x4 mini-squares image so the tile can be visually splited on: 4x4, 2x4, 4x2, 2x2, 1x2, 2x1 (2/4/8/16 quadrants) - to test that same subfunction under different values for "xn" and "yn", demos:

xn = 4 ; yn = 4:


xn = 2 ; yn = 2:


xn = 1 ; yn = 2:


The quadrant results are displayed in the edit_box ( sorry for the color confusion of the 2x2 and 1x2 demos ) .
Basically that was the thing i was talking about. 

[Stefan]

Grr

This should be enough

Code - Auto/Visual Lisp: [Select]

1. (list
2.   (/ (* xn (car  p)) (dimx_tile k))
3.   (/ (* yn (cadr p)) (dimy_tile k))
4. )