gtk:dialog, gtk:window, gtk:bin, gtk:container, gtk:widget, gtk:buildable, gtk:color-chooser, gobject:object, common-lisp:standard-object, common-lisp:t

None

The gtk:color-chooser-dialog widget is a dialog for choosing a color. It implements the gtk:color-chooser interface.

GtkColorChooser Clicking on the drawing area opens a color chooser dialog to select a background color for the drawing area. The default palettes are replaced for this color chooser dialog.

(let ((message "Click to change the background color.")
      (bg-color (gdk:rgba-parse "White"))
      ;; Color palette with 9 Red RGBA colors
      (palette1 (list (gdk:rgba-parse "IndianRed")
                      (gdk:rgba-parse "LightCoral")
                      (gdk:rgba-parse "Salmon")
                      (gdk:rgba-parse "DarkSalmon")
                      (gdk:rgba-parse "LightSalmon")
                      (gdk:rgba-parse "Crimson")
                      (gdk:rgba-parse "Red")
                      (gdk:rgba-parse "FireBrick")
                      (gdk:rgba-parse "DarkRed")))
      ;; Gray palette with 9 gray RGBA colors
      (palette2 (list (gdk:rgba-parse "Gainsboro")
                      (gdk:rgba-parse "LightGray")
                      (gdk:rgba-parse "Silver")
                      (gdk:rgba-parse "DarkGray")
                      (gdk:rgba-parse "Gray")
                      (gdk:rgba-parse "DimGray")
                      (gdk:rgba-parse "LightSlateGray")
                      (gdk:rgba-parse "SlateGray")
                      (gdk:rgba-parse "DarkSlateGray"))))


  (defun example-color-chooser-dialog (&optional application)
    (gtk:within-main-loop
      (let ((window (make-instance 'gtk:window
                                   :title "Example Color Chooser Dialog"
                                   :type :toplevel
                                   :application application
                                   :default-width 400))
            (area (make-instance 'gtk:drawing-area)))
        (g:signal-connect window "destroy"
                          (lambda (widget)
                            (declare (ignore widget))
                            (gtk:leave-gtk-main)))
        ;; Draw the background color and a hint on the drawing area
        (g:signal-connect area "draw"
            (lambda (widget cr)
              (declare (ignore widget))
              (let ((cr (glib:boxed-opaque-pointer cr))
                    (red (gdk:rgba-red bg-color))
                    (green (gdk:rgba-green bg-color))
                    (blue (gdk:rgba-blue bg-color)))
                    ;; Paint the current color on the drawing area
                    (cairo:set-source-rgb cr red green blue)
                    (cairo:paint cr)
                    ;; Print a hint on the drawing area
                    (cairo:set-source-rgb cr (- 1 red)
                                             (- 1 green) (- 1 blue))
                    (cairo:select-font-face cr "Sans")
                    (cairo:set-font-size cr 12)
                    (cairo:move-to cr 12 24)
                    (cairo:show-text cr message)
                    (cairo:destroy cr))))
        ;; Create and run a color chooser dialog to select a background color
        (g:signal-connect area "event"
            (lambda (widget event)
              (declare (ignore widget))
              (when (eq (gdk:event-type event) :button-press)
                (let ((dialog (make-instance 'gtk:color-chooser-dialog
                                             :use-alpha nil)))
                  ;; Add a custom palette to the dialog
                  (gtk:color-chooser-add-palette dialog :vertical 1 palette1)
                  ;; Add a second coustom palette to the dialog
                  (gtk:color-chooser-add-palette dialog :vertical 1 palette2)
                  ;; Set the actual background color for the color chooser
                  (setf (gtk:color-chooser-rgba dialog) bg-color)
                  ;; Run the color chooser dialog
                  (let ((response (gtk:dialog-run dialog)))
                    (when (eq response :ok)
                      ;; Change the background color for the drawing area
                      (setf bg-color (gtk:color-chooser-rgba dialog)))
                      ;; Destroy the color chooser dialog
                      (gtk:widget-destroy dialog))))))
        ;; Set the event mask for the drawing area
        (setf (gtk:widget-events area) :button-press-mask)
        ;; Add the drawing area to the window
        (gtk:container-add window area)
        (gtk:widget-show-all window)))))