How to develop a GTK graphical user interface with Common Lisp and ease

Tl;dr I describe how to develop this application in Common Lisp:

If you want to run the code, you can obtain it from https://github.com/plops/cl-cffi-gtk-from-repl . There is also a german version of this article but please place comments here.

I deal mainly with computer algorithms in image processing and therefore need a simple way to display images and animations. My previous attempts with the open libraries LTK (Lisp binding for the TK library), mcclim or common qt have unfortunately failed.

Recently, I learned of cl-cffi-gtk. This is a foreign function binding to call GTK+ 3 from Common Lisp. After some experimenting I arrived at a point where I can create graphical interfaces rather efficiently. For this, I think it is important that I can incrementally replace the GUI widgets at runtime, without having to restart the Lisp image.

First of all the package cl-cffi-gtk must be loaded. Then I define the package myg for my own code. I structured my source code so that the file can be easily compiled using the keyboard shortcut C-c C-k in a SLIME session in Emacs.


(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :cl-cffi-gtk))

(defpackage :myg
  (:use :gtk :gdk :gobject :glib :pango :cairo :cffi :iterate :cl))

(in-package :myg)

While GTK+ is a C library its interface is object-oriented. In cl-cffi-gtk the widgets are CLOS classes classes and their parameters can be defined either during instantiation or later using various methods. The following function run-0 contains minimal code to create a window without any widgets.

(defun run-0 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    (gtk-widget-show-all window)))))

#+nil
(run-0)

When the user closes the application window using the window manager, the instance window emits the "destroy" signal. The lambda function in the previous code will leave the applications main loop and shut down the program (but not the lisp image).

The following function run-1 shows how to add a button to the window.

(defun run-1 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (let ((button (make-instance 'gtk-button :label "test")))
      (gtk-container-add window button))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (gtk-widget-show-all window)))))

#+nil
(run-1)

Widgets can receive different signals. Usually I get a good overview of possible signals using Glade (see bottom right corner in the screenshot).

Next, I show how to do more with this button.

(progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defparameter *button* nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun run-2 ()
    (sb-int:with-float-traps-masked (:divide-by-zero)
      (within-main-loop
    (let ((window (make-instance 'gtk-window :title "myg-window"
                     :default-width 580
                     :default-height 200
                     :border-width 12
                     :type :toplevel)))
      (g-signal-connect window "destroy"
                (lambda (widget)
                  (declare (ignorable widget))
                  (leave-gtk-main)))
      (let ((button (make-instance 'gtk-button :label "test")))
        (gtk-container-add window button)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        (setf *button* button)
        (g-signal-connect button "clicked"
                  (lambda (widget)
                (declare (ignorable widget))
                (format t "button has been clicked~%")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        )
      (gtk-widget-show-all window))))))

#+nil
(run-2)

In run-2, I save the object button in a global variable *button*. The slime Inspector (C-c C-I) shows the following when applied to this object:


#<GTK-BUTTON {100C50D883}>
--------------------
Class: #<GOBJECT-CLASS GTK-BUTTON>
--------------------
 Group slots by inheritance [ ]
 Sort slots alphabetically  [X]

All Slots:
[ ]  ACTION-NAME           = NIL
[ ]  ACTION-TARGET         = #.(SB-SYS:INT-SAP #X00000000)
[ ]  ALWAYS-SHOW-IMAGE     = NIL
[ ]  APP-PAINTABLE         = NIL
[ ]  BORDER-WIDTH          = 0
[ ]  CAN-DEFAULT           = NIL
[ ]  CAN-FOCUS             = T
[ ]  CHILD                 = #<unbound>
[ ]  COMPOSITE-CHILD       = NIL
[ ]  DOUBLE-BUFFERED       = T
[ ]  EVENTS                = NIL
[ ]  EXPAND                = NIL
[ ]  FOCUS-ON-CLICK        = T
[ ]  HALIGN                = :FILL
[ ]  HAS-DEFAULT           = NIL
[ ]  HAS-FOCUS             = NIL
[ ]  HAS-REFERENCE         = T
[ ]  HAS-TOOLTIP           = NIL
[ ]  HEIGHT-REQUEST        = -1
[ ]  HEXPAND               = NIL
[ ]  HEXPAND-SET           = NIL
[ ]  IMAGE                 = NIL
[ ]  IMAGE-POSITION        = :LEFT
[ ]  IS-FOCUS              = T
[ ]  LABEL                 = "test"
[ ]  MARGIN                = 0
[ ]  MARGIN-BOTTOM         = 0
[ ]  MARGIN-LEFT           = 0
[ ]  MARGIN-RIGHT          = 0
[ ]  MARGIN-TOP            = 0
[ ]  NAME                  = ""
[ ]  NO-SHOW-ALL           = NIL
[ ]  OPACITY               = 1.0d0
[ ]  PARENT                = #<GTK-WINDOW {100DE8AEE3}>
[ ]  POINTER               = #.(SB-SYS:INT-SAP #X7FFFE007A350)
[ ]  RECEIVES-DEFAULT      = T
[ ]  RELATED-ACTION        = NIL
[ ]  RELIEF                = :NORMAL
[ ]  RESIZE-MODE           = :PARENT
[ ]  SENSITIVE             = T
[ ]  SIGNAL-HANDLERS       = #()
[ ]  STYLE                 = #<GTK-STYLE {100DE8AF23}>
[ ]  TOOLTIP-MARKUP        = NIL
[ ]  TOOLTIP-TEXT          = NIL
[ ]  USE-ACTION-APPEARANCE = T
[ ]  USE-STOCK             = NIL
[ ]  USE-UNDERLINE         = NIL
[ ]  VALIGN                = :FILL
[ ]  VEXPAND               = NIL
[ ]  VEXPAND-SET           = NIL
[ ]  VISIBLE               = T
[ ]  WIDTH-REQUEST         = -1
[ ]  WINDOW                = #<GDK-WINDOW {100DE8AF43}>
[ ]  XALIGN                = 0.5
[ ]  YALIGN                = 0.5

[set value]  [make unbound]

In addition, I have copied the event handlers of the window and attached it to the signal 'clicked'. In the *inferior-lisp* buffer of Emacs each click of the button produces a line with the text text "button has been clicked".

Given the occasion, I would like to point out an error that was printed in the *inferior-lisp* buffer instead of the desired text output when my definition of the signal handler looked like that:

(g-signal-connect window "clicked"
              (lambda (widget)
            (declare (ignorable widget))
            (format t "button has been clicked~%")))


(sbcl:7507): GLib-GObject-WARNING **:
/var/tmp/portage/dev-libs/glib-2.40.0-r1/work/glib-2.40.0/gobject/gsignal.c:2362:
signal 'clicked' is invalid for instance '0x7fffe0005110' of type
'GtkWindow'

In this case, I accidentally wrote "window" instead of "button" "window" and the window object supports no signal 'clicked'. Therefore it is always useful to keep an eye out on the output in *inferior-lisp*.

Going back to the output of the inspector of the object button, I want to emphasize this line:
[ ] LABEL = "test"

I would like to convert the program to a dice generator, that displays a random number between 1 and 6 in the button label. To find out how to incorporate this modification I press M-. on the class definition #<GOBJECT CLASS GTK-BUTTON> in the third row of the Inspector (alternatively one can place the cursor on gtk-button in the call to make-instance). As a result emacs jumps to the definition of the gtk-button class in cl-cffi-gtk's source code at ~/quicklisp/dists/quicklisp/software/cl-cffi-GTK-20141006-git/GTK/GTK.button.Lisp This place looks like this:

(define-g-object-class "GtkButton" gtk-button
  (:superclass gtk-bin
   :export t
   :interfaces ("AtkImplementorIface"
                "GtkBuildable"
                "GtkActionable"
                "GtkActivatable")
   :type-initializer "gtk_button_get_type")
  ....
   (image-position
    gtk-button-image-position
    "image-position" "GtkPositionType" t t)
   (label
    gtk-button-label
    "label" "gchararray" t t)
   (relief
    gtk-button-relief
    "relief" "GtkReliefStyle" t t)
    ....

After some experimenting, one can realize that gtk-button-label is the name of the method to read and change the button's text label:
   
(gtk-button-label *button*) => "test"
(setf (gtk-button-label *button*) "1")  => aendert Button Label zu "1"






The function run-3 is the first reasonable GTK application of this post.


(progn
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defparameter *button* nil)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun run-3 ()
    (sb-int:with-float-traps-masked (:divide-by-zero)
      (within-main-loop
    (let ((window (make-instance 'gtk-window :title "dice"
                     :default-width 128
                     :default-height 20
                     :border-width 12
                     :type :toplevel)))
      (g-signal-connect window "destroy"
                (lambda (widget)
                  (declare (ignorable widget))
                  (leave-gtk-main)))
      (let ((button (make-instance 'gtk-button :label "click for roll")))
        (gtk-container-add window button)

        (setf *button* button)
        (g-signal-connect button "clicked"
                  (lambda (widget)
                (declare (ignorable widget))
                        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                (setf (gtk-button-label *button*) (format nil "~a"
                                      (+ 1 (random 5))))
                        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                )))
      (gtk-widget-show-all window))))))

#+nil
(run-3)




Finally, I want to build a more interesting application. As the screenshot below shows it consists of a cairo canvas on its left side. In it, I paint a circle whose of center coordinates and radius shall be controlled by GUI widgets on the right side of the window.




A gtk-paned widget splits the window using a divider that can be  adjusted by the user. I store this gtk-paned widget in a global variable *paned*, so that later I can access it and all its child widgets. Additionally I also store the cairo canvas in the global variable *canvas* so that I can force it to redraw whenever GUI input widgets change their parameters.

(defparameter *paned* nil)
(defparameter *canvas* nil)

Using the Cairo canvas is a chapter in itself and is introduced very well in the cl-cffi-gtk tutorial on:
http://www.crategus.com/books/cl-gtk/gtk-tutorial_16.html#SEC172

Essentially, you define a draw function that calls cairo functions to set up the cairo state machine and draw lines and curves with specific colors and coordinate transforms. The semantics are very similar to those in PostScript.

The following simple function paints a purple circle and one red line on the canvas:

(progn
  (defun draw-canvas (widget cr)
    (declare (ignorable widget))
    (let ((cr (pointer cr)))
      (cairo-set-source-rgb cr 1.0 1.0 1.0)
      (cairo-scale cr 1 1)
      (cairo-paint cr)    
      (let* ((radius (or (spin-button-value 'radius *paned*) 100d0))
         (angle (* (/ pi 180) (or (spin-button-value 'angle *paned*) 1d0)))
         (x (or (spin-button-value 'xpos *paned*) 100d0))
         (y (or (spin-button-value 'ypos *paned*) 80d0)))
    (cairo-arc cr x y radius 0 (* 2 pi))
    (cairo-set-source-rgb cr 1 0 1) ;; r g b => violet circle
    (cairo-stroke cr)
    (cairo-save cr)
    (cairo-set-source-rgb cr 1 0 0)
    (cairo-move-to cr x y)
    (cairo-line-to cr
               (+ x (* radius (sin angle)))
               (+ y (* radius (- (cos angle)))))
    (cairo-stroke cr)  ;; draw a red line
    (cairo-restore cr))
      (cairo-destroy cr)
      t))
  (defparameter *draw-canvas* #'draw-canvas))

First, I would like to say something about the peculiar function definition. I store the function draw-canvas in the global variable *draw-canvas*. Later in the 'draw' signal handlers for the canvas I will call the function from this global variable using funcall. This allows me to redefine the function during run-time and if there are errors while compiling draw-canvas, the call to (defparameter *draw-canvas* #' draw-canvas) will not be executed, keeping the old working function intact. Only with successful compilation the value in *draw-canvas* is replaced and the new draw function will be used. (There may still be other errors that the compilation doesn't find but in my experience this method catches quite a few unnecessary bugs which would otherwise force to restart the lisp image).

Eventually, the variables radius, angle the coordinates x and y shall be obtained from the GUI input widgets. But as I haven't yet described them, let's for now assume the following stub definition that always returns nil:

#+nil
(defun spin-button-value (name paned)
  "Return the adjustment value of the spin-button that is labeled with NAME."
  nil)

When spin-button-value returns nil, the calls to "or" in draw-canvas will evaluate to the second parameter with a numerical constant:

(let* ((radius (or (spin-button-value 'radius *paned*) 100d0))) ;; => radius = 100d0


The following function run-4 constructs a the GUI window as before. First it creates a top-level window. Then attaches a gtk-paned object to create a vertical division.  The left section is filled with a cairo canvas whose dimensions are set to 1024x1024. If the top-level window is too small, the scrolled-window objects adds scrollbars. The right side of gtk-paned is filled with a vertical box of gtk-spinboxes.

(defun run-4 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    (let ((paned (make-instance 'gtk-paned :orientation :horizontal :position 400)))
      (let ((scrolled (make-instance 'gtk-scrolled-window
                     :border-width 1
                     :hscrollbar-policy :automatic
                     :vscrollbar-policy :automatic))
        (canvas (make-instance 'gtk-drawing-area)))
        (setf *paned* paned
          *canvas* canvas)
        (g-signal-connect canvas "draw"
                  (lambda (widget cr)
                (funcall *draw-canvas* widget cr)))
        (gtk-scrolled-window-add-with-viewport scrolled canvas)
        (setf (gtk-widget-size-request canvas) (list 1024 1024))
        (gtk-container-add window paned)
        (gtk-paned-add1 paned scrolled)
       
        (let* ((vbox (make-instance 'gtk-box :orientation :vertical)))
          (add-spinbox-to-vbox vbox 'xpos 70 1024 canvas)
          (add-spinbox-to-vbox vbox 'ypos 80 1024 canvas)
          (add-spinbox-to-vbox vbox 'radius 50 500 canvas)
          (add-spinbox-to-vbox vbox 'angle 0 360 canvas)
          (gtk-paned-add2 paned vbox))))
    (gtk-widget-show-all window)))))

I believe that a spin box is the best input widget to represent my input requirements. This is how it looks like:

A spin box consists a number and next to it are up and down arrows that allow to adjust the value by mouse clicks. Alternatively, the value can be directly entered via the text input field or changed by key presses (arrows or page-up/down). The value range and that the step size are represented by the gtk-adjustment class. When the value changes, a request for a redraw is sent to the canvas using gtk-widget-queue-draw.

(defun add-spinbox-to-vbox (container name value upper canvas)
  "Make a horizontal box containing a label on the left and a spin
button right of it and add it to container. Changing a value will
signal canvas."
  (let* ((hb (make-instance 'gtk-box :orientation :horizontal))
     (lab (make-instance 'gtk-label
                 :label (symbol-name name)))
     (adj (make-instance 'gtk-adjustment
                 :value (* 1d0 value)
                 :lower 0d0
                 :upper (* 1d0 upper)
                 :step-increment 1d0
                 :page-increment 10d0
                 :page-size 0d0))
     (sb (make-instance 'gtk-spin-button :adjustment adj
                :climb-rate 0
                :digits 1
                :wrap t)))
    (gtk-spin-button-set-value sb value)
    (gtk-box-pack-start hb lab)
    (gtk-box-pack-start hb sb)
    (g-signal-connect sb "value-changed"
              (lambda (adjustment)
            (declare (ignorable adjustment))
            (gtk-widget-queue-draw canvas)))
    (gtk-box-pack-start container hb)
    hb))

If the canvas is redrawn by the function draw-canvas, then the individual widgets are asked for their values, i.e.
the call (spin-button-value 'xpos *paned*) reads the current numerical value from the widget with the label "XPOS". In order to do this, the spin-button-value function starts from the object *paned* and traverses into the (vertical) box on the right side, i.e. the second element of: (gtk-container-get-children *paned*):

=> (#<GTK-SCROLLED-WINDOW {100A865843}> #<GTK-BOX {100A9F7583}>)


Then it searches for the requested symbol name in the label text of each spin box and returns the numerical value that is stored in the adjustment.




(defun spin-button-value (name paned)
  "Return the adjustment value of the spin-button that is labeled with NAME."
  (let ((hbox-children (find-if #'(lambda (x)
                    (string= (symbol-name name) (gtk-label-get-text (first x))))
                (mapcar #'gtk-container-get-children (gtk-container-get-children
                  (second (gtk-container-get-children paned)))))))
    (when hbox-children
      (gtk-adjustment-get-value (gtk-spin-button-get-adjustment (second hbox-children))))))

An example call would be:

#+nil
(spin-button-value 'ypos *paned*) ;; => 75.0

Perhaps this is not the best programming style for a final program but from SLIME it took only a minute to come up with this working expression and I don't think I could do something similar when programming in C.

Calling the function run-4 will open a window with the cairo canvas as shown in the screenshot.

#+nil
(run-4)


Now I describe how I can interactively modify the GUI. The following call starts from the widget object *paned* and goes to its second child, which is the vertical box containing the spin boxes. It then destroys all those widgets. The window then only shows the cairo canvas.

#+nil
(gtk-widget-destroy (second (gtk-container-get-children *paned*)))

The following call can be issued to produce new spin boxes, albeit with different default values:

#+nil
(let* ((vbox (make-instance 'gtk-box :orientation :vertical)))
  (add-spinbox-to-vbox vbox 'xpos 100 1024 *canvas*)
  (add-spinbox-to-vbox vbox 'ypos 154 1024 *canvas*)
  (add-spinbox-to-vbox vbox 'radius 50 500 *canvas*)
  (add-spinbox-to-vbox vbox 'angle 30 360 *canvas*)
  (gtk-paned-add2 *paned* vbox)
  (gtk-widget-show-all *paned*))

In this way, you could easily create additional spin boxes with other label texts than XPOS, YPOS, RADIUS or ANGLE and use them to control other objects in the canvas.

(deutsch) How to develop a GTK graphical user interface with Common Lisp and ease

Der Quellcode zu diesem Artikel ist auf  https://github.com/plops/cl-cffi-gtk-from-repl
Kommentare bitte in der englischen Version dieses Artikels.

Ich beschaeftige mich hauptsaechlich mit Computeralgorithmen
zur Bildverarbeitung und brauche daher eine einfache Moeglichkeit
Bilder und Animationen anzuzeigen. Meine bisherigen Versuche mit
den offenen Bibliotheken LTK (Lisp binding fuer die Tk library),
mcclim oder common-qt sind leider gescheitert.

Vor einiger Zeit entdeckte ich cl-cffi-gtk. Das ist ein Binding um
GTK+ 3 von Common Lisp aus aufzurufen. Nach einigem Experimentieren
bin ich jetzt an einem Punkt angelangt wo ich damit effizient
graphische Oberflaechen erstellen kann. Dabei finde ich wichtig,
dass ich das GUI Widgets inkrementell zur Laufzeit ersetzen kann,
ohne das Lisp Image neu starten zu muessen.

Zunaechst einmal muss dass Packet cl-cffi-gtk geladen werden und
ich definiere ein Packet myg, in dem ich meinen Code schreibe.  Ich
strukturiere meinen Quellcode so, dass die Datei in einer Emacs
session mit laufendem Slime mit der Tastenkombination C-c C-k
compiliert werden kann.


(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :cl-cffi-gtk))

(defpackage :myg
  (:use :gtk :gdk :gobject :glib :pango :cairo :cffi :iterate :cl))

(in-package :myg)


GTK+ ist eine C library die seine Inhalte auf eine
objektorientierte Art vorhaelt. Insbesonder sind die Widgets als CLOS
Klassen instanzierbar und ihre Parameter koennen entweder bei der
Instanzierung oder spaeter gesetzt werden. Die folgende Funktion
run-0 enthaelt minimalen Code um ein Fenster ohne weitere Widgets
zu erstellen.

(defun run-0 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    (gtk-widget-show-all window)))))

#+nil
(run-0)


Die Instanz window emittiert das Signal "destroy", wenn das Fenster
vom Window manager aus geschlossen wird. Mit der hier lambda
Funktion wird das Programm in diesem Fall abgebrochen.

In run-1 wird ein Button zum Fenster window hinzugefuegt.

(defun run-1 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (let ((button (make-instance 'gtk-button :label "test")))
      (gtk-container-add window button))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (gtk-widget-show-all window)))))

#+nil
(run-1)


Widgets koennen verschiedene Signale empfangen. Den besten
Ueberblick ueber moegliche Signal bekomme ich fuer gewoehnlich mit
Glade (siehe rechte untere Ecke im Screenshot).

(progn
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defparameter *button* nil)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun run-2 ()
    (sb-int:with-float-traps-masked (:divide-by-zero)
      (within-main-loop
    (let ((window (make-instance 'gtk-window :title "myg-window"
                     :default-width 580
                     :default-height 200
                     :border-width 12
                     :type :toplevel)))
      (g-signal-connect window "destroy"
                (lambda (widget)
                  (declare (ignorable widget))
                  (leave-gtk-main)))
      (let ((button (make-instance 'gtk-button :label "test")))
        (gtk-container-add window button)
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        (setf *button* button)
        (g-signal-connect button "clicked"
                  (lambda (widget)
                (declare (ignorable widget))
                (format t "button has been clicked~%")))
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        )
      (gtk-widget-show-all window))))))

#+nil
(run-2)


In run-2 speichere ich das Objekt button in einer globalen Variable
*button*. Der Slime Inspector (C-c C-I) zeigt fuer dieses Objekt
den folgenden Inhalt an.

#<GTK-BUTTON {100C50D883}>
--------------------
Class: #<GOBJECT-CLASS GTK-BUTTON>
--------------------
 Group slots by inheritance [ ]
 Sort slots alphabetically  [X]

All Slots:
[ ]  ACTION-NAME           = NIL
[ ]  ACTION-TARGET         = #.(SB-SYS:INT-SAP #X00000000)
[ ]  ALWAYS-SHOW-IMAGE     = NIL
[ ]  APP-PAINTABLE         = NIL
[ ]  BORDER-WIDTH          = 0
[ ]  CAN-DEFAULT           = NIL
[ ]  CAN-FOCUS             = T
[ ]  CHILD                 = #<unbound>
[ ]  COMPOSITE-CHILD       = NIL
[ ]  DOUBLE-BUFFERED       = T
[ ]  EVENTS                = NIL
[ ]  EXPAND                = NIL
[ ]  FOCUS-ON-CLICK        = T
[ ]  HALIGN                = :FILL
[ ]  HAS-DEFAULT           = NIL
[ ]  HAS-FOCUS             = NIL
[ ]  HAS-REFERENCE         = T
[ ]  HAS-TOOLTIP           = NIL
[ ]  HEIGHT-REQUEST        = -1
[ ]  HEXPAND               = NIL
[ ]  HEXPAND-SET           = NIL
[ ]  IMAGE                 = NIL
[ ]  IMAGE-POSITION        = :LEFT
[ ]  IS-FOCUS              = T
[ ]  LABEL                 = "test"
[ ]  MARGIN                = 0
[ ]  MARGIN-BOTTOM         = 0
[ ]  MARGIN-LEFT           = 0
[ ]  MARGIN-RIGHT          = 0
[ ]  MARGIN-TOP            = 0
[ ]  NAME                  = ""
[ ]  NO-SHOW-ALL           = NIL
[ ]  OPACITY               = 1.0d0
[ ]  PARENT                = #<GTK-WINDOW {100DE8AEE3}>
[ ]  POINTER               = #.(SB-SYS:INT-SAP #X7FFFE007A350)
[ ]  RECEIVES-DEFAULT      = T
[ ]  RELATED-ACTION        = NIL
[ ]  RELIEF                = :NORMAL
[ ]  RESIZE-MODE           = :PARENT
[ ]  SENSITIVE             = T
[ ]  SIGNAL-HANDLERS       = #()
[ ]  STYLE                 = #<GTK-STYLE {100DE8AF23}>
[ ]  TOOLTIP-MARKUP        = NIL
[ ]  TOOLTIP-TEXT          = NIL
[ ]  USE-ACTION-APPEARANCE = T
[ ]  USE-STOCK             = NIL
[ ]  USE-UNDERLINE         = NIL
[ ]  VALIGN                = :FILL
[ ]  VEXPAND               = NIL
[ ]  VEXPAND-SET           = NIL
[ ]  VISIBLE               = T
[ ]  WIDTH-REQUEST         = -1
[ ]  WINDOW                = #<GDK-WINDOW {100DE8AF43}>
[ ]  XALIGN                = 0.5
[ ]  YALIGN                = 0.5

[set value]  [make unbound]


Ausserdem habe ich den Event Handler von window kopiert und an das
Signal "clicked" gehaengt. Im *inferior-lisp* Buffer von Emacs sehe
ich die zu erwartende Textausgabe "button has been clicked".

Aus gegebenen Anlass moechte ich auf einen Fehler im
*inferior-lisp* Buffer hinweisen, den ich statt der gewuenschten
Textausgabe erhalten hatte, als meine definition des Signal Handler
so aus sah:

(g-signal-connect window "clicked"
              (lambda (widget)
            (declare (ignorable widget))
            (format t "button has been clicked~%")))


(sbcl:7507): GLib-GObject-WARNING **:
/var/tmp/portage/dev-libs/glib-2.40.0-r1/work/glib-2.40.0/gobject/gsignal.c:2362:
signal 'clicked' is invalid for instance '0x7fffe0005110' of type
'GtkWindow'

In diesem Fall habe ich statt "button" "window" geschrieben und das
Fenster unterstuetzt eben kein signal "clicked".

An der Ausgabe des Inspectors fuer die Instanz *button* sehen wir den Slot label:
[ ]  LABEL                 = "test"

Ich moechte das Program zu einem Wuerfelprogramm umwandeln, dass
eine zufaellige Zahl zwischen 1 und 6 im Buttonlabel anzeigt.  Um
herauszufinden wie ich diese Modifikation einbauen kann druecke ich
M-. auf der Klassendefinition #<GOBJECT-CLASS GTK-BUTTON> in der
dritten Zeile im Inspector (alternativ geht auch gtk-button im
Aufruf von make-instance). Dadurch springe ich zur Definition der
Klasse im Quellcode von cl-cffi-gtk
~/quicklisp/dists/quicklisp/software/cl-cffi-gtk-20141006-git/gtk/gtk.button.lisp

Die Stelle sieht so aus:

(define-g-object-class "GtkButton" gtk-button
  (:superclass gtk-bin
   :export t
   :interfaces ("AtkImplementorIface"
                "GtkBuildable"
                "GtkActionable"
                "GtkActivatable")
   :type-initializer "gtk_button_get_type")
  ....
   (image-position
    gtk-button-image-position
    "image-position" "GtkPositionType" t t)
   (label
    gtk-button-label
    "label" "gchararray" t t)
   (relief
    gtk-button-relief
    "relief" "GtkReliefStyle" t t)
    ....

Nach einigem Experimentieren sehe ich dass gtk-button-label die
Method ist, die ich brauche um den Labeltext auszulesen und zu
aendern:
  
#+nil
(gtk-button-label *button*) ;; => "test"

#+nil
(setf (gtk-button-label *button*) "1")  ;; => aendert Button Label zu "1"

(progn
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defparameter *button* nil)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun run-3 ()
    (sb-int:with-float-traps-masked (:divide-by-zero)
      (within-main-loop
    (let ((window (make-instance 'gtk-window :title "dice"
                     :default-width 128
                     :default-height 20
                     :border-width 12
                     :type :toplevel)))
      (g-signal-connect window "destroy"
                (lambda (widget)
                  (declare (ignorable widget))
                  (leave-gtk-main)))
      (let ((button (make-instance 'gtk-button :label "click for roll")))
        (gtk-container-add window button)

        (setf *button* button)
        (g-signal-connect button "clicked"
                  (lambda (widget)
                (declare (ignorable widget))
                        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                (setf (gtk-button-label *button*) (format nil "~a"
                                      (+ 1 (random 5))))
                        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                )))
      (gtk-widget-show-all window))))))

#+nil
(run-3)

Die Funktion run-3 ist damit die erste halbwegs vernuenftige GTK Applikation.




Jetzt moechte ich eine interessantere Applikation bauen.  Wie dem
Screenshot zu entnehmen ist, soll das Fenster auf der linken Seite
einen Cairo Canvas zeigen. Darin male ich einen Kreis dessen
Mittelpunktskoordinaten und Radius durch GUI Elemente auf der
rechten Seite des Fensters eingestellt werden koennen.

Ein gtk-paned hat zwei Seiten und einen variablen schieber
dazwischen. Ich nutze dieses Element als hoechstes Element unter
dem Fenster um die Widgets anzuordnen. Damit ich spaeter auf diese
Widgets zugreifen kann. Speichere ich die Paned Instanz in der
globalen Variable *paned*. Weiterhin ist es nuetzlich eine globale
Variable mit dem Cairo Canvas zu haben, so dass neue
Kontrollwidgets sehr einfach einen redraw erzwingen koennen.

(defparameter *paned* nil)
(defparameter *canvas* nil)

Der Cairo Canvas ist ein Kapitel fuer sich und wird gut in
folgendem Tutorial zu cl-cffi-gtk erklaert:
http://www.crategus.com/books/cl-gtk/gtk-tutorial_16.html#SEC172

Im wesentlichen muss man nur eine draw Funktion definieren, die mit
einzelnen Funktionsaufrufen eine Farbe setzen und eine Kurve
malen. Die Semantik aehnelt sehr der von Postscript.

Die folgende einfache Funktion malt einen violetten Kreis und eine
rote Linie auf den Canvas.

(progn
  (defun draw-canvas (widget cr)
    (declare (ignorable widget))
    (let ((cr (pointer cr)))
      (cairo-set-source-rgb cr 1.0 1.0 1.0)
      (cairo-scale cr 1 1)
      (cairo-paint cr)   
      (let* ((radius (or (spin-button-value 'radius *paned*) 100d0))
         (angle (* (/ pi 180) (or (spin-button-value 'angle *paned*) 1d0)))
         (x (or (spin-button-value 'xpos *paned*) 100d0))
         (y (or (spin-button-value 'ypos *paned*) 80d0)))
    (cairo-arc cr x y radius 0 (* 2 pi))
    (cairo-set-source-rgb cr 1 0 1) ;; r g b => violet circle
    (cairo-stroke cr)
    (cairo-save cr)
    (cairo-set-source-rgb cr 1 0 0)
    (cairo-move-to cr x y)
    (cairo-line-to cr
               (+ x (* radius (sin angle)))
               (+ y (* radius (- (cos angle)))))
    (cairo-stroke cr)  ;; draw a red line
    (cairo-restore cr))
      (cairo-destroy cr)
      t))
  (defparameter *draw-canvas* #'draw-canvas))


Zu bemerken ist, dass ich die Funktion in einer globalen Variable
*draw-canvas* speichere. Spaeter im "draw" Signal handler fuer den
Canvas rufe ich mit funcall die darin gespeicherte Funktion
auf. Das hat den Vorteil, dass ich draw-canvas zur Laufzeit neu
definieren kann. Wenn es beim Bauen Fehler gibt, dann wird
(defparameter *draw-canvas* #'draw-canvas) nicht aufgerufen und die
alte Definition bleibt bestehen. Erst wenn die Compilation gelingt
wird *draw-canvas* ersetzt und die neue Funktion malt in den
Canvas.

Die Koordinaten radius, angle, x und y sollen von der GUI entnommen
werden. Da die aber bisher noch nicht definiert ist, schreibe ich
erstmal folgende Platzhalterfunktion.

#+nil
(defun spin-button-value (name paned)
  "Return the adjustment value of the spin-button that is labeled with NAME."
  nil)

Da spin-button-value zunaechst immer nil liefert, bewirkt dass das
"or" in draw-canvas auf die dahinterstehnden Zahlenkonstanten als
default Werte ausweicht. Ganz zum Schluss nutze ich GTK+ Methoden
um mich durch alle GUI Elemente zu den aktuellen
Werten zu hangeln. Dabei wird es sich als sehr hilfreich erweisen,
dass die Objekte interaktiv im REPL und dem Slime Inspector
analysiert werden koennen. Bei Programmierung mit C waere eine
derartige Vorgehensweise undenkbar.

Die Funktion run-4 baut nun wie vorher das GUI Fenster auf. Als
erstes wird ein Hauptfenster (top-level window) erstellt. Darin ein
Paned Objekt, dass das Fenster vertikal in zwei Teile teilt. Links
kommt der Cairo Canvas hin. Dessen Groesse wird auf 1024x1024
gesetzt und ich packe ein scrolled-window drumherum um scrollbars
zu haben. Auf die rechte Seite des Paned kommt eine Box mit
vertikal angeordneten Spinboxen.

(defun run-4 ()
  (sb-int:with-float-traps-masked (:divide-by-zero)
    (within-main-loop
      (let ((window (make-instance 'gtk-window :title "myg-window"
                   :default-width 580
                   :default-height 200
                   :border-width 12
                   :type :toplevel)))
    (g-signal-connect window "destroy"
              (lambda (widget)
                (declare (ignorable widget))
                (leave-gtk-main)))
    (let ((paned (make-instance 'gtk-paned :orientation :horizontal :position 400)))
      (let ((scrolled (make-instance 'gtk-scrolled-window
                     :border-width 1
                     :hscrollbar-policy :automatic
                     :vscrollbar-policy :automatic))
        (canvas (make-instance 'gtk-drawing-area)))
        (setf *paned* paned
          *canvas* canvas)
        (g-signal-connect canvas "draw"
                  (lambda (widget cr)
                (funcall *draw-canvas* widget cr)))
        (gtk-scrolled-window-add-with-viewport scrolled canvas)
        (setf (gtk-widget-size-request canvas) (list 1024 1024))
        (gtk-container-add window paned)
        (gtk-paned-add1 paned scrolled)
      
        (let* ((vbox (make-instance 'gtk-box :orientation :vertical)))
          (add-spinbox-to-vbox vbox 'xpos 70 1024 canvas)
          (add-spinbox-to-vbox vbox 'ypos 80 1024 canvas)
          (add-spinbox-to-vbox vbox 'radius 50 500 canvas)
          (add-spinbox-to-vbox vbox 'angle 0 360 canvas)
          (gtk-paned-add2 paned vbox))))
    (gtk-widget-show-all window)))))

Die Spinbox ist meineserachtens das beste Widget um mein
Benutzerinterface zu repraesentiern. Sie bestehen aus einer Zahl
und rechts daneben sind ein Pfeil hoch und runter, um den Wert per
Mausklick anzupassen. Alternativ kann der Wert direkt per
Texteingabe, durch Tastatendruck (Pfeil- oder Bildtasten)
veraendert werden. Der Wertebereich und die den Tastendruecken
entsprechenden diskreten Stufen werden durch die Klasse GTK
Adjustment repraesentiert. Wenn sich der im Adjustment gespeicherte
Wert aendert, sende ich mit gtk-widget-queue-draw einen Nachricht
an den Canvas, dass dieser sich neu zeichnen soll.

(defun add-spinbox-to-vbox (container name value upper canvas)
  "Make a horizontal box containing a label on the left and a spin
button right of it and add it to container. Changing a value will
signal canvas."
  (let* ((hb (make-instance 'gtk-box :orientation :horizontal))
     (lab (make-instance 'gtk-label
                 :label (symbol-name name)))
     (adj (make-instance 'gtk-adjustment
                 :value (* 1d0 value)
                 :lower 0d0
                 :upper (* 1d0 upper)
                 :step-increment 1d0
                 :page-increment 10d0
                 :page-size 0d0))
     (sb (make-instance 'gtk-spin-button :adjustment adj
                :climb-rate 0
                :digits 1
                :wrap t)))
    (gtk-spin-button-set-value sb value)
    (gtk-box-pack-start hb lab)
    (gtk-box-pack-start hb sb)
    (g-signal-connect sb "value-changed"
              (lambda (adjustment)
            (declare (ignorable adjustment))
            (gtk-widget-queue-draw canvas)))
    (gtk-box-pack-start container hb)
    hb))

Wenn sich der Canvas mit der Funktion draw-canvas neu zeichnet wird
zum Beispiel die Funktion (spin-button-value 'xpos *paned*)
aufgerufen um den aktuellen Wert des Widgets mit dem Label "XPOS"
zu erhalten. Die Funktion spin-button-value hangelt sich dabei
ausgehend von *paned* zunaechst in die (vertikale) Box auf dessen
rechter Seite, also das zweite Element von:
(gtk-container-get-children *paned*):

=> (#<GTK-SCROLLED-WINDOW {100A865843}> #<GTK-BOX {100A9F7583}>)

Danach suche ich den Symbolnamen im Labeltext der links von jeder
Spinbox steht, greife auf das Adjustment der entsprechenden Spinbox
zu und gebe dessen aktuellen Wert aus.

(defun spin-button-value (name paned)
  "Return the adjustment value of the spin-button that is labeled with NAME."
  (let ((hbox-children (find-if #'(lambda (x)
                    (string= (symbol-name name) (gtk-label-get-text (first x))))
                (mapcar #'gtk-container-get-children (gtk-container-get-children
                  (second (gtk-container-get-children paned)))))))
    (when hbox-children
      (gtk-adjustment-get-value (gtk-spin-button-get-adjustment (second hbox-children))))))


Ein Beispielaufruf ist der Folgende:

#+nil
(spin-button-value 'ypos *paned*) ;; => 75.0

Durch Aufruf von run-4 wird das Fenster mit dem Cairo Canvas
geoeffnet, das im Screenshot dargestellt ist.

#+nil
(run-4)
Der folgende Aufruf hangelt sich von *paned* zur vertikalen Box und
loescht alle darin enthaltenen Widgets. Uebrig bleibt nur der
Cairo Canvas.

#+nil
(gtk-widget-destroy (second (gtk-container-get-children *paned*)))
Durch den folgenden Aufruf werden in der laufenden GTK Applikation
wieder Spinboxen erzeugt. Die jedoch mit anderen Defaultwerten
initialisiert sind:

#+nil
(let* ((vbox (make-instance 'gtk-box :orientation :vertical)))
  (add-spinbox-to-vbox vbox 'xpos 100 1024 *canvas*)
  (add-spinbox-to-vbox vbox 'ypos 154 1024 *canvas*)
  (add-spinbox-to-vbox vbox 'radius 50 500 *canvas*)
  (add-spinbox-to-vbox vbox 'angle 30 360 *canvas*)
  (gtk-paned-add2 *paned* vbox)
  (gtk-widget-show-all *paned*))


Auf diese Weise kann man zum Beispiel auch zusaetzliche Spinboxen
mit anderen Labeltexten als XPOS, YPOS, RADIUS oder ANGLE erzeugen
und damit neue Objekte in draw-canvas zeichnen.