Building a Common Lisp GUI with CommonQt


Commertial Common Lisp development platforms include modules to build graphical user interfaces (GUI’s). Free Common Lisp ebvironments have several choices for GUI library (see for options), some of them are platform/lisp implementation dependent while others are long not supported. In this article I will study a GUI builder -> GUI bindings -> Common Lisp workflow. I will develop a Kepler Laws demonstration application using SBCL and CommonQt with QtDesigner-generated GUI xml file. CommonQt is still in early development, its documentation is very basic.

1. Kepler’s laws

The first Kepler’s Law states that every planet moves along an ellipse with the sun at one of its foci. If we place the origin at the center of the ellipse and direct the coordinate axes along the ellipse’s axes then the Cartesian coordinates x and y satisfy equation


It is equivalent to a system x=a\cdot \cos E, y=b\cdot \sin E where a is the semi-major axis, b=a\cdot\sqrt{1-e^2} is the semi-minor axis, e is the excentricity, and E is called the excentric anomaly. The the sun has coordinates (a\cdot e, 0). Let’s choose the unit length such that a=1. This part is taught at schools. More enlightening is the second Kepler’s Law which gives the excentric anomaly, E , as a function of time: A line joining a planet and the Sun sweeps out equal areas during equal intervals of time. Denote by P the orbiting period of the planet, let n=2\pi/P be the mean rotation speed (angular). Let the planet be at its right-most position (closest to the sun) at time zero. Then from the second Kepler’s Law,

\dfrac{Q}{\pi ab}=\dfrac{t}{P},

where Q denotes the area swept by the line during time t. Famous Kepler’s equation

E=n\cdot t+e\cdot \sin E

relates the excentric anomaly and the mean anomaly M=n\cdot t. So, the computation scheme is as follows: for a given time instant t solve the Kepler’s equation for the excentric anomaly E, and then find the Cartesian coordinates of the planet on its elliptical orbit. In Section 2 we will solve the Kepler’s equation by successive iterations.

2. Implementation

I assume that commonqt is already installed both as a .deb package and as a quicklisp library. Let’s write some code. I assume that the lisp code is in a file (kepler.lisp in my case) and the file is reloaded into running SBCL every time  it’s changed. Slime is a tool of choice.

First, add lines to load the qt support automatically …

(require 'qt)

and then define a new package:

(defpackage #:qt-kepler
 (:use :cl #:qt)
 (:export #:kepler-main))

Since commonqt introduce a macro #_ to reach object’s Qt methods, we add a qt-aware read-table necessary to use the macro.

(in-package #:qt-kepler)
(named-readtables:in-readtable :qt)

Next, let us create a new class for the output widget. It will show the position of the planet on its elliptical orbit. The class has two members: excentricity and excentric anomaly. Each of the two variables can be set through corresponding signals. The class also reimplements the paintEvent method from Qt’ QWidget. Basically, the class declaration follows the lines of commonqt documentation page.

(defclass orbit-view ()
 ((excentricity :initform 0.0d0 :accessor excentr)
 (excenttric-anomaly :initform 0.0d0 :accessor anomaly))
 (:metaclass qt-class)
 (:qt-superclass "QWidget")
 ("setExcAnomaly(double)" (lambda (instance newval)
 (setf (anomaly instance) newval)
 (#_update instance)))
 ("setExcentricity(double)" (lambda (instance newval)
 (setf (excentr instance) newval)
 (#_update instance))))
 (:override ("paintEvent" paint-event)))

In the constructor we set the window title:

(defmethod initialize-instance :after ((instance orbit-view) &key)
 (new instance)
 (#_setWindowTitle instance "Kepler's Orbit View"))

Now, the painting fun. While developing this function I felt the differences between lisp and c++. I’d like to highlight the following:

  • commonqt doesn’t put restrictions on qt function arguments, no argument type check is done at compile-time. I spent some time trying to gess what the lisp debugger wants from me before I add explicit type conversion (calls to truncate below)
  • lisp knows nothing about c++’s ability to find a fit constructor: in C++ code, the painter.setBrush(gradient) was a proper call  since setBrush(QBrush&) is expected and QBrush(QGradient&) constructor exists. In Lisp, you build everything explicitly.
(defmethod paint-event((instance orbit-view) paint-event)
 (let* ((wd (#_width instance))
        (ht (#_height instance))
        (e (excentr instance))
        (EE (anomaly instance))
        (b (sqrt (- 1.0d0 (* e e)))))
      (with-objects ((painter (#_new QPainter instance))
                     (gradient (#_new QRadialGradient 
                                0d0 0d0 400d0 (* 200d0 e) 0d0))
                     (black (#_new QColor 0 10 20))
                     (blue (#_new QColor 0 0 100))
                     (green (#_new QColor 0 200 0))
                     (yellow (#_new QColor 200 200 0))
                     (white (#_new QColor 200 200 200)))
               (#_setWindow painter (- (ash wd -1)) (- (ash ht -1)) wd ht)
               (#_setColorAt gradient 1.0d0 black)
               (#_setColorAt gradient 0.5d0 blue)
               (#_setColorAt gradient 0.0d0 white)
               (#_setBrush painter (#_new QBrush gradient))
               (#_drawEllipse painter -200 
                          (- (truncate (* 200 b))) 400 (truncate (* 400 b)))
               (#_setBrush painter (#_new QBrush yellow))
               (#_drawEllipse painter (- (truncate (* 200 e)) 20) 20 40 -40)
               (#_setBrush painter (#_new QBrush green))
               (#_drawEllipse painter 
                     (- (truncate (* 200 (cos EE))) 10)
                     (- 10 (truncate (* 200 b (sin EE)))) 20 -20))))

Now it’s time to test this widget:

(defun kepler-main()
 (with-objects ((ov (make-instance 'orbit-view)))
        (#_resize ov 460 430)
        (#_show ov) 
        (#_exec *qapplication*)))

You can load the file into lisp (C-c C-l in Slime) and execute (qt-kepler:kepler-main) at the prompt. If everything goes well you should see the following:


Next create an input form using Qt Designer. Assume the form contains three QTextLabel’s, a QLineEdit, a QSlider, and  QPushButton. Essential objects’ names are shown in the Figure below. The names are important, because we will search for them to hook them up to our custom widget’s class members.


Normally, you create a .ui file with XML description of your form then you let moc, the MetaObject Compiler process the .ui file to generate .h and .cc files representing your form as a new Qt Widget class. The form setup code is generated automatically, user controls can be accesses through proper variables created by moc. In Lisp+CommonQt you must do much of the work by hand. We will use the QUiLoader from Qt Ui Tools extension to create an instance of a QWidget from the .ui file directly. Then we’ll search for and save the references to important user control widgets in member variables of our new class.

The form we create controls the orbit-vew object. It will contain a timer which will emit signals to update the planet’s position. Also, changes in parameters at run-time will also trigger repainting the orbit-view window.

(defclass orbit-form () 
 ((running :initform nil :accessor running)
 (timerId :initform 0 :accessor timerId)
 (anomalySlider :accessor anomaly)
 (excentLineEdit :accessor excentLineEdit)
 (pushButton :accessor pushButton)
 (label3 :accessor label3)
 (label2 :accessor label2))
 (:signals ("eAnomalyChanged(double)")
 ("on_anomalySlider_changed(int)" on-anomalySlider-changed)
 ("on_excentLineEdit_changed()" on-excentLineEdit-changed)
 ("on_button_clicked()" on-button-clicked))
 (:override ("timerEvent" timer-event)
 ("closeEvent" orbit-form-close))
 (:metaclass qt-class)
 (:qt-superclass "QWidget"))

You can see the class the class members with same names as the control on the form. Now let’s setup the form and initialize the variables:

(defmethod initialize-instance :after ((instance orbit-form) &key)
 (new instance)
 (#_setWindowTitle instance "Orbit Paramaters")
 (with-objects ((file (#_new QFile "orbitform.ui"))
                (loader (#_new QUiLoader)))
       (if (#_open file 1)
         (let ((win (#_load loader file instance))
               (layout (#_new QVBoxLayout)))
          (#_addWidget layout win)
          (#_setLayout instance layout)
          (#_close file)
          (with-slots (label3 label2 anomalySlider excentLineEdit pushButton) 
               (setf label3 (find-child win "label_3")
                     label2 (find-child win "label_2")
                     anomalySlider (find-child win "anomalySlider")
                     pushButton (find-child win "pushButton")
                     excentLineEdit (find-child win "excentLineEdit"))
               (connect anomalySlider "valueChanged(int)" 
                        instance "on_anomalySlider_changed(int)")
               (connect excentLineEdit "textChanged(QString)" 
                        instance "on_excentLineEdit_changed()")
               (connect pushButton "pressed()" 
                        instance "on_button_clicked()")))
         (error "Couldn't open .ui file!"))))

This function depends on another function, find-child, which traverses the tree of children of a window and find one with given name. In plain Qt, there’s a template function for this purpose, but c++ templates are not supported by CommonQt in Lisp. Instead, one can write a lisp function with the same functionality (I borrowed it from Internet, original hyperlink lost):

(defun find-child (object name)
 (let ((children (#_children object)))
         (loop for child in children
               when (equal name (#_objectName child))
               return child)
         (loop for child in children
               thereis (find-child child name)))))

Now we’re ready to see both windows, change the kepler-main as follows:

(defun kepler-main()
  (qt:ensure-smoke "qtuitools")
  (with-objects ((ov (make-instance 'orbit-view))
		 (of (make-instance 'orbit-form)))
    (#_resize ov 460 430)
    (#_show ov) (#_show of)
    (connect of "eAnomalyChanged(double)"
	     ov "setExcAnomaly(double)")
    (connect of "excentricityChanged(double)"
	     ov "setExcentricity(double)")
    (connect of "orbitFormClosed()" ov "close()")
    (#_exec *qapplication*)))

If you call qt-kepler:kepler-main now, you will see the two widgets, but any activity on orbit-form causes a fallback into debugger, since the slots are not defined yet. If you want to feel the taste of Slime+Lisp power, add the slot function bodyes one by one and compile them while the kepler application is still running and see how the events get caught and processed by the new functions.

(defun on-anomalySlider-changed(instance val)
  (declare (optimize debug))
  (let ((M (* val 1.7453292519943295769d-2)) ;; 2*PI/360
	(e (with-input-from-string 
	       (in (substitute #\. #\, 
			       (#_text (excentLineEdit instance)))) 
	     (read in))))    
    (multiple-value-bind (EE acc)
	(kepler-solve M e)
      (with-output-to-string (s)
	(format s "Mean anomaly = ~8,6f (~6,4f years)" M (/ val 360.0))
	(#_setText (label3 instance) (get-output-stream-string s)))
      (with-output-to-string (s)
	(format s "Excentric anomaly = ~8,6f (error = ~6,4e)" EE acc)
	(#_setText (label2 instance) (get-output-stream-string s)))
      (emit-signal instance "eAnomalyChanged(double)" EE))))

(defun on-excentLineEdit-changed (instance)
  (emit-signal instance "excentricityChanged(double)" 
		   (in (substitute #\. #\, (#_text (excentLineEdit instance))))
		 (read in))))

(defun on-button-clicked (instance)
  (if (running instance)
      (progn ;;(print "Button clicked t")
	     (#_setText (pushButton instance) "Start simulation")
	     (setf (running instance) nil)
	     (#_killTimer instance (timerId instance)))
      (progn ;;(print "Button clicked nil")
	     (#_setText (pushButton instance) "Stop simulation")
	     (setf (running instance) t)
	     (setf (timerId instance) (#_startTimer instance 40)))))

(defmethod timer-event ((instance orbit-form) event)
  (if (eql (#_timerId event) (timerId instance))
      (with-slots (anomalySlider) instance
	(#_setValue anomalySlider (mod (1+ (#_value anomalySlider)) 1440)))))

(defmethod orbit-form-close ((instance orbit-form) event)
  (emit-signal instance "orbitFormClosed()")
  (print "close event occured")
  (#_accept event))

This piece of code required some mind effort too. The fact is, CommonQt in lisp doesn’t use QString class at all! So, all string and number formatting and reading should be done by means of Common Lisp (with-output-to-string, with-input-from-string, etc)

Finally, the Kepler’s equation solver returning bothe the solution and the error:

(defun kepler-solve(M e)
  (do* ((eee M E1)
	(E1 (+ M (* e (sin eee))) (+ M (* e (sin eee))))
	(i 0 (1+ i)))
       ((or (> i 1000)
	     (< (abs (- E1 eee)) 1d-8))
	(values E1 (abs (- E1 eee))))))


#lisp #commonlisp #gui #qt #commonqt

1 Comment

Filed under Uncategorized

One response to “Building a Common Lisp GUI with CommonQt

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s