;;;-*- Mode: Lisp; Package: MLX -*-
(in-package mlx)



#|________________________________________________________________________________
(def. "¥¥¥¥ Thresholders"
________________________________________________________________________________|#




#|________________________________________________________________________________
(def. "   ¥ Documentation"

;; tc_ara x 1 = color
;; tc_ara x 0 = position - 0-255



t0= 0                                                  255
|-----t1-------t2-------------------------------------|
   c0     c1                 c2
                ^
                |... tend




user-pick-color wheel is a good model for a rainbow palette, but I don't have time
to duplicate it at the moment, and there don't seem to be any traps built in that access the
HSI or HSV conversion codes.

(apropos-list "-color*" :cl-user)

________________________________________________________________________________|#







#|________________________________________________________________________________
(def. "   ¥ Drawing"
________________________________________________________________________________|#


(defun draw_thresholder_strips (tv)
  "Called by threshold_image_window, the top level menu function.
   tv is the thresholder_window. "
  (let ((ta (tc_ara tv))
        (tend (tc_end tv))
        (top 10)(bottom 25))
    (with-focused-view tv
      (dotimes (i tend)
        (with-fore-color (aref ta i 1)
          (rlet ((r :rect :top top :left (lsh (aref ta i 0) 1) 
                    :bottom bottom :right (lsh (aref ta (1+ i) 0) 1)))
            (#_paintrect r))))
      (let ((i tend))
        (with-fore-color (aref ta i 1)
          (rlet ((r :rect :top top :left (lsh (aref ta i 0) 1) 
                    :bottom bottom :right (lsh 255 1)))
            (#_paintrect r)))))))





(defun apply_thresholds_to_biw_menu ()
  (optional_message_dialog
   (format nil "Makes a new mask image (array).~%~
                Result is similar to NIH Image 'apply threshold':~%~
                The values are equal to the number (or index) of the band~%~
                in other words, this is a way of setting multiple thresholds.")
   :function_name 'apply_thresholds_to_biw_menu
   :function_info "apply_thresholds"
   :more '("ccl:MLx Docs;MLx menuÉ" "+           thresholds->array"))
  (apply_thresholds_to_biw))

(defun apply_thresholds_to_biw ()
  (if (front-window :class 'thresholder :include-windoids t)
    (array->window 
     (apply_thresholds (tc_ara (front-window :class 'thresholder :include-windoids t))
                       (im_scaled_array (front-window :class 'byte_image)))
     (format nil "apply_thresholds ~a" 
             (window-title (front-window :class 'byte_image))))
    (message-dialog "Thresholder window needs to stay around for this operation.")))

(defun apply_thresholds (thresh_ara sc_im_ara)
  "Used by apply_thresholds_to_biw.
   Makes a copy of the scaled image array, with values mapped using the threshold array."
  (let* ((out_ara (make-array (array-dimensions sc_im_ara) :element-type '(unsigned-byte 8))))
    (multiple-value-bind (im_v offset) (ccl::array-data-and-offset sc_im_ara)
      (declare (ignore offset))
      (multiple-value-bind (out_v offset) (ccl::array-data-and-offset out_ara)
        (declare (ignore offset))
        (let ((asiz (array-total-size im_v))
              (th_lim (first (array-dimensions thresh_ara))))
          (declare (simple-array im_v out_v))
          (dotimes (i asiz)
            (let ((pv (aref im_v i))
                  (thidx 0)) 
              (if (zerop pv) (setq thidx 0)
                  (do ((idx 1 (1+ idx)))((or (= idx th_lim)
                                             (< pv (aref thresh_ara idx 0)))
                                         (setq thidx idx)))) 
              (setf (aref out_v i) thidx))))))
    out_ara))



(defun thresholder_threshold ()
  (let ((ara (make-array '(2 2) :initial-element 0)))
    (setf (aref ara 0 0) 0)
    (setf (aref ara 0 1) *blue-color*)
    (setf (aref ara 1 0) 128)
    (setf (aref ara 1 1) *red-color*)
    ara))

(defclass thresholder (windoid)
  ((tc_ara :initarg :tc_ara :initform (make-array '(10 2) :initial-element 0) :accessor tc_ara)
   (im_wdow :initarg :im_wdow :initform 0 :accessor im_wdow)
   (tc_end :initarg :tc_end :initform 0 :accessor tc_end)
   (last_key :initarg :last_key :initform nil :accessor last_key))
  (:default-initargs :color-p t  
    :view-size #@(550 35)
    :window-title "=Thresholder="
    :view-position #@(80 440)))

(defun threshold_image_window (tc_ara)
  " Flexible false color tool using color bands.
    Top level function called by the menu.
    tc_ara is the initial configuration of slider."
  (optional_message_dialog
   (format nil "Use shift, option, control and command keys ~%~
                (press and look at color bar for action)~%~
                Press caps-lock & wait to see (closest) original image array values.~%~
                ~%~%~
                To get rid of the color bar, click on it then cmd-w or File - close menu.")
   :function_name 'threshold_image_window
   :function_info "do_thresholder"
   :more '("ccl:MLx Docs;MLx menuÉ" "+           thresholds"))
  (let* ((wdow (front-window :class 'byte_image))
         (t_wdow (make-instance 'thresholder)))
    (setf (im_wdow t_wdow) wdow)
    (setf (tc_ara t_wdow) tc_ara)
    (setf (tc_end t_wdow) (1- (first (array-dimensions tc_ara))))))




(defun thresholder_colors_random (num)
  "number (of colors)
   Initializer for threshold menu item.
   "
  (let* ((colors (apropos-list "-color*" :cl-user))
         (n_steps (min num (length colors)))
         (ara (make-array `(,n_steps 2) :initial-element 0))
         (i_step (floor 256 n_steps)))
    (do ((i 0 (1+ i))
         (pv 0 (+ pv i_step))
         (cl colors (rest cl)))
        ((= i (min num (length colors))))
      (setf (aref ara i 0) pv)
      (setf (aref ara i 1) (eval (first cl))))
    ara))




(defun thresholder_thermal (n_steps)
  "number of steps or colors
   Initializer for threshold menu item."
  (let* ((ara (make-array `(,n_steps 2) :initial-element 0))
         (i_step (floor 256 n_steps)))
    (do ((i 0 (1+ i))(pv 0 (+ pv i_step)))((= i n_steps))
      (setf (aref ara i 0) pv)
      (setf (aref ara i 1) (apply #'rgb_color (thermal_rgb pv))))
    ara))

(defun thermal_rgb (level)
  "level {0-255}  -->  r level, g level, b level 
   all levels {0-255}"
  (let (r g b)
    (cond ((<= 0 level 85)
           (setq r (/ (* 255 level) 85) g 0 b 0))
          ((<= 85 level 170)
           (setq r 255 g (/ (* 255 (- level 85)) 85) b 0))
          ((<= 170 level 255)
           (setq r 255 g 255 b (/ (* 255 (- level 170)) 85)))
          (t (break "thermal rgb got level out of range: ~a" level)))
    `(,r ,g ,b)))

(defun rgb_color (r g b)
  "mimics make-color.  r,b and b are truncated 0-255"
  (let ((mask (byte 8 0)))
    (logior (lsh (logand mask r) 16)
            (lsh (logand mask g) 8) 
            (logand mask b))))




(defun thresholder_paint1 ()
  (let ((ara (make-array '(6 2) :initial-element 0)))
    (setf (aref ara 0 0) 0)
    (setf (aref ara 0 1) *blue-color*)
    (setf (aref ara 1 0) 43)
    (setf (aref ara 1 1) *red-color*)
    (setf (aref ara 2 0) 86)
    (setf (aref ara 2 1) *green-color*)
    (setf (aref ara 3 0) 130)
    (setf (aref ara 3 1) (rgb_color 0 255 255))
    (setf (aref ara 4 0) 172)
    (setf (aref ara 4 1) (rgb_color 255 0 255))
    (setf (aref ara 5 0) 225)
    (setf (aref ara 5 1) (rgb_color 255 255 0))
    ara))




(defun thermal_n_false_color_menu ()
  (let ((n (get_val "Number of levels: " 8)))
    (Threshold_Image_Window (thresholder_thermal n))))




(defun gray_n_false_color_menu ()
  (let ((n (get_val "Number of levels: " 8)))
    (Threshold_Image_Window (thresholder_gray n))))

(defun thresholder_gray (n_steps)
  "number of steps or colors
   Initializer for threshold menu item."
  (let* ((ara (make-array `(,n_steps 2) :initial-element 0))
         (i_step (floor 256 n_steps)))
    (do ((i 0 (1+ i))(pv 0 (+ pv i_step)))((= i n_steps))
      (setf (aref ara i 0) pv)
      (setf (aref ara i 1) (apply #'rgb_color `(,pv ,pv ,pv))))
    ara))


(defun thresholder_colors_ordered (num)
  "number (of colors)
   Initializer for threshold menu item.
   "
  (let* ((colors '(*PURPLE-COLOR*  *BLUE-COLOR* *BROWN-COLOR*  *TAN-COLOR*
                     *GREEN-COLOR* *LIGHT-BLUE-COLOR* 
                   *LIGHT-GRAY-COLOR* *ORANGE-COLOR*   
                   *RED-COLOR* *PINK-COLOR*   *YELLOW-COLOR*))
         ;(colors (apropos-list "-color*" :cl-user))
         (n_steps (min num (length colors)))
         (ara (make-array `(,n_steps 2) :initial-element 0))
         (i_step (floor 256 n_steps)))
    (do ((i 0 (1+ i))
         (pv 0 (+ pv i_step))
         (cl colors (rest cl)))
        ((= i (min num (length colors))))
      (setf (aref ara i 0) pv)
      (setf (aref ara i 1) (eval (first cl))))
    ara))


#|________________________________________________________________________________
(def. "   ¥ Utility"
________________________________________________________________________________|#

(defun find_pixel_coords (value array)
  "value array
   Finds an instance of value in the array and returns the coordinates
   of a value, or of pixel with closest value as a list.  Second value is actual value.
   Similar to faster_limits."
  (multiple-value-bind (ara offset) (ccl::array-data-and-offset array)
    (declare (ignore offset) (simple-array av) (optimize (speed 3) (safety 0)))
    (let* ((asiz (array-total-size ara))
           (index 0)
           (ind_val (aref ara 0))
           (ind_err (abs (- ind_val value)))
           (yd (second (array-dimensions array))))
      (tagbody
        (do ((i 0 (1+ i)))((= i asiz))
          (let* ((tval (aref ara i))
                 (terr (abs (- tval value)) ))
            (if (< terr ind_err)
              (progn
                (setq index i)
                (setq ind_val tval)
                (setq ind_err terr)))
            (if (zerop terr)(go done))))
        done)
      ;(format t "~% find_pixel_coords ~a  ~a, index: ~a, siz:~a" value array index asiz)
      (values
       `(,(floor index yd) ,(mod index yd))
       ind_val))))

(defun find_corresponding_pixel_value (val scaled_ara orig_ara)
  (multiple-value-bind (coord value) (find_pixel_coords val scaled_ara)
    (values 
     (aref  orig_ara (first coord) (second coord))
     (= val value))))




(defun print_thresh_values (tv)
  "Called by threshold_image_window."
  (let* ((imw (front-window :class 'byte_image))
         (im_ara (im_array imw))
         (s_im_ara (im_scaled_array imw))
         (ta (tc_ara tv))
         (tend (tc_end tv))
         (top 34))
    (with-focused-view tv
      (with-back-color  *white-color*
        (rlet ((r :rect :top 26 :right 0 
                  :bottomright (view-size tv)))
          (#_eraserect r)))
      (dotimes (i tend)
        (let* ((spv (aref ta (1+ i) 0))
               (lpos (lsh (aref ta (1+ i) 0) 1))
               (pv (if (caps-lock-key-p) (find_corresponding_pixel_value spv s_im_ara im_ara) spv)))
          ;(format t "~%i:~a  coord:~a  pv:~a" i spv_coord pv)
          (with-fore-color *black-color*
            (with-pstrs ((s (format nil "~5f" pv)))
              (#_moveTo :long (make-point lpos top))
              (#_drawstring s)))))
      (let* ((spv 255)
             (lpos (lsh 255 1))
             (pv (if (caps-lock-key-p) (find_corresponding_pixel_value spv s_im_ara im_ara) spv)))
        ;(format t "~%i:~a  coord:~a  pv:~a" 'end spv_coord pv)
        (with-pstrs ((s (format nil "~5f" pv)))
          (#_moveTo :long (make-point lpos top))
          (#_drawstring s))))))





           
(defmethod key_message ((w thresholder))
  (with-focused-view w
    (#_moveto :long #@(5 7))
    (with-pstrs ((s "Control: pick color, Option: add thresh point, Shift: remove thresh point"))
      (#_drawstring s))))



(defun pick_threshold_color (swdow x)
  (let ((tara (tc_ara swdow))
        (tend (tc_end swdow))
        (tcur nil))
    (tagbody
      (dotimes (i (1+ tend))
        ;(format t "~%     dotimes i ~a aref x ~a" i (aref tara i 0))
        (cond ((> (aref tara i 0) x)
               (setq tcur (1- i))
               (go pick))))
      (setq tcur tend)
      pick
      ;(format t "~% pick thresh color tcur: ~a" tcur)
      (setf (aref tara tcur 1) 
            (user-pick-color :color (aref tara tcur 1))
            ))))

#|________________________________________________________________________________
(def. "   ¥ Control"
________________________________________________________________________________|#




(defmethod view-draw-contents ((w thresholder))
  (draw_thresholder_strips w)
  (print_thresh_values w)
  (key_message w))

#|
(defmethod window-close-event-handler :before ((w thresholder))
  "Restores the gray level image palette on closing."
  (let ((imw (im_wdow w)))
    (scaled_gray_palette_to_window 0 255 imw) ;--> undefined function.
    ;(setf (sliders imw) (remove w (sliders imw)))
    (redraw_window_lut imw)
    (view-draw-contents imw)))
|#

(defmethod view-click-event-handler ((t_wdow thresholder) where)
  (declare (ignore where))
  (let* ((wdow (im_wdow t_wdow))
         (lut_array (palette_array wdow)))
    (tagbody
      (window-select wdow)
      loop
      (do_thresholder t_wdow) ;24MAY93 pass along orig array data
      (thresholds_to_lut t_wdow lut_array)
      (redraw_window_lut wdow)
      (view-draw-contents wdow)
      (if (mouse-down-p) (go loop)))))

(defun clipped_view_mouse_position (view)
  (let* ((pos (view-mouse-position view))
         (x (point-h pos))
         (y (point-v pos))
         (siz (view-size view))
         (h (point-h siz))
         (v (point-v siz))
         (clp_x (max 0 (min h x)))
         (clp_y (max 0 (min v y))))
    (make-point clp_x clp_y)))


(defun do_thresholder (slider_wdow)
  "Called by threshold_image_window, the top level fn."
  (let* ((tara (tc_ara slider_wdow))
         (tend (tc_end slider_wdow))
         (xtol 2)
         (pos nil)(x nil)(tcur nil))
    (tagbody 
      (window-select slider_wdow)
      (view-draw-contents slider_wdow)
      wait_for_mouse
      ;(key_message slider_wdow)
      ;(if (not (mouse-down-p)) (go wait_for_mouse))
      (if (not (mouse-down-p)) (go draw))
      have_mouse
      ;(if (command-key-p) (throw :quit_thresholder nil))
      (setq pos (clipped_view_mouse_position slider_wdow))
      (setq x (lsh (point-h pos) -1))
      (if (option-key-p)(go add_tpoint))
      (if (control-key-p)(go pick_color))
      (if (shift-key-p)(go delete_point))
      color_line_test
      (dotimes (i (1+ tend))
        (cond ((< (abs (- x (aref tara i 0))) xtol) 
               (setq tcur i)   ;--> have tpoint
               (go t_loop))))
      (go wait_for_mouse)
      t_loop
      (if (not (mouse-down-p)) (go draw))
      (setq pos (clipped_view_mouse_position slider_wdow))
      (setq x (lsh (point-h pos) -1))
      (if (= x (aref tara tcur 0)) (go t_loop))
      (setf (aref tara tcur 0) x) 
      (view-draw-contents slider_wdow) 
      (go t_loop)
      pick_color
      (pick_threshold_color slider_wdow x)
      (go draw)
      add_tpoint
      (add_threshold_point slider_wdow x)
      (go draw)
      delete_point
      (dotimes (i (1+ tend))
        (cond ((< (abs (- x (aref tara i 0))) xtol) 
               (setq tcur i)   ;--> have tpoint
               (go delete_point_1))))
      (go wait_for_mouse)
      delete_point_1
      (delete_threshold_point slider_wdow tcur)
      (go draw)
      draw
      (view-draw-contents slider_wdow)) ;--> returns to refresh clut, etc.
    (values)))


#|________________________________________________________________________________
(def. "   ¥ Utility - threshold points"
________________________________________________________________________________|#



(defun incf_tc_ara (ara)
  (let* ((x (first (array-dimensions ara)))
         (y (second (array-dimensions ara)))
         (new_tc_ara (make-array (list (1+ x) y) :initial-element 0
                                 :element-type (array-element-type ara))))
    (dotimes (j y)
      (dotimes (i x)
        (setf (aref new_tc_ara i j)(aref ara i j))))
    new_tc_ara))

(defun add_threshold_point (swdow x)
  (setf (tc_ara swdow) (incf_tc_ara (tc_ara swdow)))
  (let ((tara (tc_ara swdow))
        (tend (tc_end swdow))
        (tcur nil))
    (tagbody
      (dotimes (i (1+ tend))
        (cond ((> (aref tara i 0) x)
               (setq tcur i)
               (go shift))))
      (go add)
      add
      (incf tend)
      (setf (tc_end swdow) tend)
      (setf (aref (tc_ara swdow) tend 0) x)
      (setf (aref (tc_ara swdow) tend 1) *pink-color*)
      (go done)
      shift
      (do ((i tend (1- i)))((< i tcur))
        (setf (aref (tc_ara swdow) (1+ i) 0) (aref (tc_ara swdow) i 0))
        (setf (aref (tc_ara swdow) (1+ i) 1) (aref (tc_ara swdow) i 1)))
      (incf tend)
      (setf (tc_end swdow) tend)
      (setf (aref (tc_ara swdow)  tcur 0) x)
      (setf (aref (tc_ara swdow)  tcur 1) *pink-color*)
      done
      (values))))



(defun delete_threshold_point (sw pt)
    (let ((tara (tc_ara sw))
          (tend (tc_end sw)))
      (do ((i pt (1+ i)))((= i tend))
        (setf (aref tara i 0)(aref tara (1+ i) 0))
        (setf (aref tara i 1)(aref tara (1+ i) 1)))
      (decf (tc_end sw))))




(defun thresholds_to_lut (sw lut)
  (let ((tara (tc_ara sw))
        (tend (tc_end sw)))
    (dotimes (th tend)
      (do ((i (aref tara th 0)(1+ i)))((= i (aref tara (1+ th) 0)))
        (setf (aref lut i 0)(color_red (aref tara th 1)))
        (setf (aref lut i 1)(color_green (aref tara th 1)))     
        (setf (aref lut i 2)(color_blue (aref tara th 1)))))
    (do ((i (aref tara tend 0)(1+ i)))((> i 255))
      (setf (aref lut i 0)(color_red (aref tara tend 1)))
      (setf (aref lut i 1)(color_green (aref tara tend 1)))     
      (setf (aref lut i 2)(color_blue (aref tara tend 1))))))

      

(defun mask_threshold ()
  (optional_message_dialog 
   (format nil "This is particularly for thresholding images.  Values set to 1 in the~%~
                binary mask array are red in this false color rendition.  ~%~
                Very last top intensity level not included - see More.")
   :function_name 'mask_threshold
   :function_info "threshold_image_window"
   :more '("ccl:MLx Docs;MLx menuÉ"  " ¥        Threshold"))
  (let ((ara (make-array '(3 2) :initial-element 0)))
    (setf (aref ara 0 0) 0)
    (setf (aref ara 0 1) *blue-color*)
    (setf (aref ara 1 0) 60)
    (setf (aref ara 1 1) *red-color*)
    (setf (aref ara 2 0) 120)
    (setf (aref ara 2 1) *light-blue-color*)
    ara))

#|________________________________________________________________________________
(def. "   ¥ Utility - threshold inits"


These functions are to initialize the thresholder color array.  The array has
n rows of 2 collums each.  1st collumn is the level, the second is the color.

The functions return the array, which is used as the input arguement to 
threshold_image_window, from which the example below was extracted.

________________________________________________________________________________|#



#|________________________________________________________________________________
(def. "¥¥¥¥ masks"
________________________________________________________________________________|#





(defun mask_from_thresh_lut_menu ()
  (optional_message_dialog
   (format nil "Red areas are 1's in the mask.~%~
                Cmd-W to make color bar go away.~%~%~
                Note:  the threshold taken uses the limits of the red band, INCLUSIVE.~%~
                The coloring on the image uses the limits of the red band, EXCLUDING the~%~
                top bin.  Therefore there may be a few pixels not colored red which will be ~%~
                in the mask.  This is due to the inclusive definition for the threshold being  ~%~
                slightly different from the definition of the false color bands.~%~%~
                If this is a problem, please see me.  DSB.")
   :function_info "mask_from_thresh_lut"
   :more '("ccl:MLx Docs;MLx menuÉ"  " ¥        Threshold image")
   :function_name 'mask_from_thresh_lut_menu)
  (let ((thresh_wdow (Threshold_Image_Window (mask_threshold))))
    (mask_from_thresh_lut)
    (window-close thresh_wdow)))


(defun mask_from_thresh_lut ()
  (let* ((th_wdow (front-window :class 'thresholder))
         (im_wdow (im_wdow th_wdow))
         (lut_ara (tc_ara th_wdow))
         (im_array (array im_wdow))
         (s_im_ara (im_scaled_array im_wdow))
         (cut_pt1 (aref lut_ara  1 0))
         (cut_pt2 (aref lut_ara 2 0)) 
         (cut_val1 (find_corresponding_pixel_value cut_pt1 s_im_ara im_array))
         (cut_val2 (find_corresponding_pixel_value cut_pt2 s_im_ara im_array))
         (mask_name (get-string-from-user 
                     "name for mask: " 
                     :initial-string 
                     (format nil "~a-~a-~a-mask" (window-title im_wdow) cut_val1 cut_val2)))) 
    (setf (get '*mlx* 'threshold) `(,cut_val1 ,cut_val2))
    (array->window  (thresh_ara im_array mask_name cut_val1 cut_val2) "xx") ))
         

(defun mask_from_limits_menu ()
  (optional_message_dialog
   (format nil "Make a mask from typed in limits.")
   :function_name 'mask_from_limits_menu
   :function_info "thresh_ara"
   :more '("ccl:MLx Docs;MLx menuÉ"  " ¥        From Limits"))
  (let ((w (select_an_image "array to mask")))
    (let ((im_ara (array w)))
      (multiple-value-bind (min max) (array_limits im_ara) 
        (let ((mask_nam (get_val "name for mask" (format nil "~a_msk~ ~a ~a" (window-title w) min max))))
          (array->window (thresh_ara im_ara  mask_nam min max  )))))))




#|________________________________________________________________________________
(def. "----- menus -----"   29Jan98 
________________________________________________________________________________|#

(add-menu-items *mlx_menu*
 (make-instance 'menu
                  :menu-item-title "bands"
                  :menu-colors '(:item-title #.*black-color*)))

(add-menu-items *mlx_menu*
  (make-instance 'menu-item
   :menu-item-title "bands->mask"
   :menu-item-colors '(:item-title #.*black-color*)
   :menu-item-action #'(lambda () 
                      (eval-enqueue '(apply_thresholds_to_biw_menu)))))


(add-menu-items (find-menu-item *mlx_menu* "bands")
                (make-instance 'menu-item
                  :menu-item-title "blue/red"
                  :menu-item-colors '(:item-title #.*red-color*)
                  :menu-item-action
                  #'(lambda () 
                      (eval-enqueue '(Threshold_Image_Window (thresholder_threshold))))))

(add-menu-items (find-menu-item *mlx_menu* "bands")
                (make-instance 'menu-item
                  :menu-item-title "8 random colors"
                  :menu-item-colors '(:item-title #.*blue-color*)
                  :menu-item-action
                  #'(lambda () 
                      (eval-enqueue '(Threshold_Image_Window (thresholder_colors_random 8))))))

(add-menu-items (find-menu-item *mlx_menu* "bands")
                (make-instance 'menu-item
                  :menu-item-title "8 level thermal"
                  :menu-item-colors '(:item-title #.*blue-color*)
                  :menu-item-action
                  #'(lambda () 
                      (eval-enqueue '(Threshold_Image_Window (thresholder_thermal 8))))))

(add-menu-items (find-menu-item *mlx_menu* "bands")
                (make-instance 'menu-item
                  :menu-item-title "6 paint colors"
                  :menu-item-colors '(:item-title #.*purple-color*)
                  :menu-item-action
                  #'(lambda () 
                      (eval-enqueue '(Threshold_Image_Window (thresholder_paint1))))))


(add-menu-items (find-menu-item *mlx_menu* "bands")
                  (make-instance 'menu-item
                    :menu-item-title "n level thermal"
                    :menu-item-colors '(:item-title #.*blue-color*)
                    :menu-item-action
                    #'(lambda () 
                        (eval-enqueue '(thermal_n_false_color_menu)))))

(add-menu-items (find-menu-item *mlx_menu* "bands")
                  (make-instance 'menu-item
                    :menu-item-title "n level gray"
                    :menu-item-colors '(:item-title #.*blue-color*)
                    :menu-item-action
                    #'(lambda () 
                        (eval-enqueue '(gray_n_false_color_menu)))))