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

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 695
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
  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. :crazy2:
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: 1720
  • BricsCAD 18
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: 695
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.     (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. )

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.  :roll:
(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: 220
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. )