Display copernicus sentinel 1 space packet headers as a table with gtkmm

I am working on a project to visualize the raw radar data of the Copernicus Sentinel 1 satellite.

The data comes in a binary format with header information. Each row in the following figure contains header information of one "space packet":

This source code parses the header information and renders the data as a table in a GTK TreeView:

 https://github.com/plops/cl-cpp-generator2/blob/b13e3afbb30a5958f8e2a6d45b35523f02d32fed/example/33_copernicus_gtk/source/vis_00_base.cpp

The column titles are quite long. In order to fit the table better on the screen I shorten the strings in the table header. The full column title is displayed as a tooltip.

 

I find it surprisingly difficult to express this in gtkmm.

 

Next I want to plot some of the data. I found a dataset that was acquired in stripmap mode and contains several good point spread functions (ships in water).

Google Protocol Buffers for serial communication with a microcontroller

For a while now I was thinking about implementing a protobuf based binary protocol in the firmware of a microcontroller.

This would have the following advantages:

proto files as specification
parser generators for many languages (python, c)
versioning/backward compatibility
speed up transfer


As a proof of concept I implemented a single message that the microcontroller will send to the host computer using the following packet.
The packet starts with 5 "U" characters and ends with 5 "0xff" bytes:

0x55 0x55 0x55 0x55 0x55 <len_lsb> <len_msb> <payload_bytes...> 0xff 0xff 0xff 0xff 0xff


This preamble looks good in the logic analyzer and I think I can eventually use it for baudrate estimation.


A 16 bit packet length is included and the payload data is encoded using a google protocol buffer file:
https://github.com/plops/cl-cpp-generator2/blob/master/example/29_stm32nucleo/source/simple.proto


syntax = "proto2";
import "nanopb.proto";
message SimpleMessage {
required uint32 id = 1;
required uint32 timestamp = 2;
required uint32 phase = 3;
repeated int32 int32value = 4;
required int32 sample00 = 5;
...
required int32 sample59 = 64;
};




The packet encoder on the MCU is using https://github.com/nanopb/nanopb. It generates encoders and parsers that are compatible with google protocol buffers but the code is C instead of C++ and the code size is small.


https://github.com/plops/cl-cpp-generator2/blob/master/example/29_stm32nucleo/source/boilerplate/main.c



The packet is generated around line 524 (search for "SimpleMessage").


Initially I couldn't figure out how to fill a variable length array. That is why have samle00..sample59 variables. Later I learned how to store an array in int32value line 531, using callback the callback encode_int32.


The python code
https://github.com/plops/cl-cpp-generator2/blob/master/example/29_stm32nucleo/source2/run_00_uart.py

feeds all received bytes into a finite state machine that searches for the five "U" character preamble, parses the packet length and decodes the payload data with code that is autogenerated by google protobuf from simple.proto.

 

Received packets look like this after decoding:


id: 1431655765
timestamp: 4281899953 
phase: 16
int32value: 42
int32value: 43
int32value: 44
int32value: 45
int32value: 46
int32value: 47
int32value: 48
int32value: 49
int32value: 50
int32value: 51
sample00: 193
sample01: 193
...
sample52: 206
sample53: 1999
sample54: 1776
sample55: 300
sample56: 205
sample57: 196
sample58: 193
sample59: 190





The MCU code itself solves a toy problem. I generate output like this:
4095 0 0 4095 0 0 0 4095 0 0 0 ...
on the DAC and read it back with the ADC. Each sample of the ADC is integrated for 2.5cycles of the 80MHz system clock


I shift the ADC trigger relative to the DAC output clock with a PWM timer.


My goal was to investigate the influence of the DAC output buffer.



With buffer the ADC samples do not change much when the ADC acquires the data with a delay after the DAC has settled:

 

 

 

 

Without DAC buffer the ADC signal gets lower the longer the duration between DAC output instance and ADC acquisition trigger.

 

ARPACK sparse eigenvalues and GPU

I am trying to learn how to find eigenvalues and eigenvectors of a sparse matrix. A good example problem are electronic orbitals of the hydrogen atom. This paper gives a good introduction:

https://www.mdpi.com/2218-2004/6/2/22/pdf
The structure of the matrix is like this:

A CUDA kernel that implements the matrix vector product looks like this: 

I use ARPACK++ with its reverse communication interface to compute the matrix vector products on the an RTX 2060 GPU.

 The results are similar to the benchmark results listed in the paper:

The radial component of the wavefunction of the ground state looks like this:

The source code is available on github:

https://github.com/plops/cl-cpp-generator2/blob/master/example/27_sparse_eigen_hydrogen/source/vis_00_cuda_main.cu

 Note that the C++ and CUDA code is generated from Common Lisp source https://github.com/plops/cl-cpp-generator2/blob/master/example/27_sparse_eigen_hydrogen/gen00.lisp.

Numerical derivative of analytic functions

I  recently learned about a neat trick to compute the derivative of an analytic function.

Others [1] have described it better than I could. So I just keep this here as a reminder.


[1] https://blogs.mathworks.com/cleve/2013/10/14/complex-step-differentiation/

Exact representation of floating point constants

C99 allows to represent the significand of floating a point value in a hexadecimal notation [2]. This format captures the exact number in a finite number of characters.


I plan to use this with my C code generator [4] to represent unique twiddle factors of the fast Fourier transform [5].

Here is Common Lisp code that will generate the C string to represent a single float:

(defun single-float-to-c-hex-string (f)
  (declare (type (single-float 0) f))
  (multiple-value-bind (a b c) (integer-decode-float f)
  (let ((significand (ash a 1)))
    (format nil "0x~x.~xp~d"
        (ldb (byte 4 (* 6 4)) significand)
        (ldb (byte (* 6 4) 0) significand)
       (+ 23 b)))))


(single-float-to-c-hex-string .1s0) ;; => "0x1.99999Ap-4"

[1] http://clhs.lisp.se/Body/f_dec_fl.htm    decode-float float => significand, exponent, sign
[2] https://www.exploringbinary.com/hexadecimal-floating-point-constants/ examples of c hex notation
[3] http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1256.pdf page 57, parsing
[4] https://github.com/plops/cl-cpp-generator
[5] https://github.com/plops/cl-gen-cuda-try/blob/master/gen-simd.lisp

Interactive programming with libvncserver using C

Here I show how you can interactively create a graphical computer program using libvncserver http://libvnc.github.io/ .

Here is a recording of the screen with the program running:

In case you can't see the above video because Blogger uses Flash, use this one instead:

A while ago, I read this post: http://nullprogram.com/blog/2014/12/23/ and learned a simple method how to interactively develop a C program. For this, one compiles code as a shared library and has it continuously reloaded after each recompilation.
Here I will show how you can very easily output images and animations with libvncserver. I plan to use this to show the Fourier transform of camera frames I acquire in a holographic setup. However, that is a longer story and I may explain that sometime later.
Now I will describe the minimal code which is necessary to call libvncserver from a shared library. First I include the appropriate header file. Then I define the data type run_state wich internally represents the VNC server with an element of type rfbScreenInfoPtr. I also declare constants that contain the dimensions of the image.

#include <rfb/rfb.h>

struct run_state{
  rfbScreenInfoPtr server;
};

const  int w=512,h=512;

The function r_init opens a VNC server and allocates memory for the framebuffer.

struct run_state * r_init()
{
  struct run_state *state = malloc(sizeof(*state));
  printf("init\n");
  state->server=rfbGetScreen(0,NULL,w,h,8,3,4);
  if(!state->server)
    return 0;
  state->server->frameBuffer=(char*)malloc(w*h*4);
  state->server->alwaysShared=(1==1);
  rfbInitServer(state->server);

  return state;
}

The following function closes the VNC server. When a modified run.c has been compiled to a new librun.so, the code in main.c (for the link to full source see the bottom of this post) will call in sequence the function r_finalize of the old library and then the r_init the new library. Frankly, it surprised me, that my vncclient nevertheless remains open during a library reload and eventually updates with frames generated by code from the updated librun.so.

void r_finalize(struct run_state *state)
{
  printf("finalize\n");
  rfbShutdownServer(state->server,TRUE);
  free(state->server->frameBuffer);
  rfbScreenCleanup(state->server);
  free(state);
}

This is the last important function r_step. It generates the image to be displayed.

static int count = 0;
int r_step(struct run_state *state)
{
  //  printf("step\n");
  if(!rfbIsActive(state->server))
    return 0;
  int i,j;
  char *b=state->server->frameBuffer;
  for(j=0;j<h;j++)
    for(i=0;i<w;i++){
      int p=4*(i+w*j);
      b[p+0]=b[p+1]=b[p+2]=i%255;
    } 
  char s[100];
  snprintf(s,100,"count: %d\n",count++);
  rfbDrawString(state->server,&radonFont,20,100,s,0xffffff);
  rfbMarkRectAsModified(state->server,0,0,w,h);
  long usec = state->server->deferUpdateTime*1000;
  rfbProcessEvents(state->server,usec);

  return 1; 
}

In the screenshot, at the beginning of this post, the left window shows the image that is generated by r_step. The double loop creates a horizontal gray gradient and in the top left corner is some text with an incrementing counter.

In this post, I only presented a few major snippets of the code. The full source with makefile is in this directory on Github: https://github.com/plops/arduino_due_lisp/tree/3c21d70a9f1b214e39fa3dfb07704c06ed1e2cb9/interactive-display-fft

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.