home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / comp / lang / lisp / mcl / 2084 < prev    next >
Encoding:
Text File  |  1993-01-24  |  2.2 KB  |  67 lines
  1. Path: sparky!uunet!olivea!apple!cambridge.apple.com!mdavis@media.mit.edu
  2. From: mdavis@media.mit.edu
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: Windows vs. color-dialogs and getting a cpixel value
  5. Message-ID: <9301231815.AA01030@media.mit.edu>
  6. Date: 23 Jan 93 18:15:58 GMT
  7. Sender: owner-info-mcl@cambridge.apple.com
  8. Lines: 56
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10.  
  11.  
  12. Hi,
  13.  
  14. I am really stumped on something.  I have written a simple
  15. color-dropper function which allows the user to get a color by
  16. positioning an eye-dropper cursor on a point and clicking to get its
  17. color value.  The problem I have is that this function returns the
  18. correct color when defined as the dialog-item-action of a button when
  19. that button is the subview of a window, but not when the button is the
  20. subview of a color-dialog (it just seems to return black or white).
  21. What is going on here?
  22.  
  23. Marc Davis
  24. MIT Media Lab
  25.  
  26. ******Code below (urgent help appreciated)*****
  27.  
  28. ;function to get a color value at an x y
  29. (defun getcpixelcolorvalue (x y)
  30.     (with-rgb (rgb *black-color*)
  31.               (#_getcpixel x y rgb)
  32.               (rgb-to-color rgb)))
  33.  
  34. ;Code to get a color value by clicking on a point 
  35. ;put your favorite cursor in here 
  36. ;(we took one from Studio 8, the *watch-cursor* from MCL works too.
  37.  
  38. (defvar *color-dropper-cursor* *watch-cursor*)
  39.  
  40. (defun get-color-with-color-dropper (&optional (color-dropper-cursor
  41.     *color-dropper-cursor*))
  42.     (with-cursor color-dropper-cursor
  43.          (let ((color nil))
  44.             (do () ((mouse-down-p))
  45.                 (let ((mouse-position (view-mouse-position nil)))
  46.                    (setf color (getcpixelcolorvalue (point-h mouse-position)
  47.                         (point-v mouse-position)))))
  48.             color)))
  49.  
  50. ;this works
  51.  
  52. (make-instance 'window
  53.      :view-subviews (list (make-instance 'button-dialog-item
  54.                 :dialog-item-action 
  55.         #'(lambda (item)
  56.             (declare (ignore item))
  57.             (pprint (get-color-with-color-dropper))))))
  58.  
  59. ;this does not
  60.  
  61. (make-instance 'color-dialog
  62.      :view-subviews (list (make-instance 'button-dialog-item
  63.                 :dialog-item-action
  64.                 #'(lambda (item)
  65.                         (declare (ignore item))
  66.                         (pprint (get-color-with-color-dropper))))))
  67.