### Author Topic: Determine Quadrant (with some list manipulation and math)  (Read 899 times)

0 Members and 1 Guest are viewing this topic.

#### Grrr1337

• Swamp Rat
• Posts: 765
##### Determine Quadrant (with some list manipulation and math)
« on: June 18, 2017, 02:25:13 PM »
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

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!
(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)
)
)

#### roy_043

• Water Moccasin
• Posts: 1876
##### Re: Determine Quadrant (with some list manipulation and math)
« Reply #1 on: June 18, 2017, 03:44:58 PM »
Determining the picked cell is easy:
Code - Auto/Visual Lisp: [Select]
1. (list (/ pickedY moduleY) (/ pickedX moduleX))

#### Grrr1337

• Swamp Rat
• Posts: 765
##### Re: Determine Quadrant (with some list manipulation and math)
« Reply #2 on: June 20, 2017, 03:19:39 PM »
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.       (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) ) )
21.       (setq L (mapcar 'list (mapcar 'list (setq L (ConsIncL inc lim)) (cdr L)) (L->idxs L) ) )
22.     ); vl-some
23.   ); defun SegmentPosition
24.
25.   (setq valid (lambda (L) (and (vl-consp L) (vl-every '(lambda (x) (and (eq 'INT (type x)) (< 0 x))) L))))
26.
27.   (cond
28.     ( (not (valid p)) (princ "\nInvalid 2D point.") )
29.     ( (not (valid (list xn yn))) (princ "\nInvalid amount of quadrants.") )
30.     (T
31.       (setq TileDimXY (mapcar (function (lambda (x) (x k))) (list dimx_tile dimy_tile)))
32.       (list ; (SegmentPosition \$x ModuleX LimitX)
33.         (SegmentPosition (car p) (/ (car TileDimXY) xn) (car TileDimXY)) ; Xpos
35.       ); list
36.     ); T
37.   ); cond

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.           '(progn ; the tile can be visually splited on: 4x4, 2x4, 4x2, 2x2, 1x2, 2x1 (2/4/8/16 quadrants)
92.             (set_tile "eb" (vl-prin1-to-string (PickedQuadrant (list \$x \$y) \$key 4 4))) ; display the info
93.             ; (set_tile "eb" (vl-prin1-to-string (PickedQuadrant (list \$x \$y) \$key 2 2))) ; display the info
94.             (LM:DisplayBitmap "img" (PutImgVal (+ \$x \$y) nil)) ; assign some custom calculated colour for the image
95.           ); progn
96.         ); vl-prin1-to-string
97.       ); action_tile "img"
98.     ); T
99.   ); cond
100.   (*error* nil) (princ)
101. ); defun
102.
103.
104. ;;--------------------=={ Display Bitmap }==------------------;;
105. ;;                                                            ;;
106. ;;  Renders the supplied ACI colour list representation of a  ;;
107. ;;  Bitmap image on the DCL image tile or image_button tile   ;;
108. ;;  with the given key.                                       ;;
109. ;;------------------------------------------------------------;;
111. ;;------------------------------------------------------------;;
112. ;;  Arguments:                                                ;;
113. ;;  key - key of DCL image tile or image_button tile          ;;
114. ;;  lst - ACI colour list                                     ;;
115. ;;------------------------------------------------------------;;
116. ;;  Returns:  nil                                             ;;
117. ;;------------------------------------------------------------;;
118.
119. (defun LM:DisplayBitmap ( key lst / i j s x y )
120.   (setq s (fix (sqrt (length lst))))
121.   (repeat (setq i s)
122.     (setq j 1)
123.     (repeat s
124.       (setq x (cons j x)
125.         y (cons i y)
126.         j (1+ j)
127.       )
128.     )
129.     (setq i (1- i))
130.   )
131.   (start_image key)
132.   (fill_image 0 0 (dimx_tile key) (dimy_tile key) -15)
133.   (mapcar 'vector_image x y x y lst)
134. )

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.
(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)
)
)

#### Stefan

• Bull Frog
• Posts: 255
##### Re: Determine Quadrant (with some list manipulation and math)
« Reply #3 on: June 21, 2017, 12:55:56 AM »
Grr

This should be enough
Code - Auto/Visual Lisp: [Select]
1.   (/ (* xn (car  p)) (dimx_tile k))
2.   (/ (* yn (cadr p)) (dimy_tile k))
3. )