DEV Community: Matthew D. Miller

Encrypt an Existing Linux Installation Online with the Magic of LVM

Matthew D. Miller — Tue, 14 Jun 2022 22:02:28 +0000

So you have an existing Linux installation and your disks aren’t encrypted? You want to encrypt the entire disk including your root partition, and you’d like to do it without taking the server offline. If the server already uses LVM, which is the default for many popular enterprise distros, then you’re in luck.

Because of the awesomeness of LVM, an existing installation can be encrypted with LUKS completely online. This does require a spare disk of equal or greater size to the existing disk. In a virtual environment, this can be achieved by adding an extra virtual disk to the VM. For a desktop or workstation, this can be achieved with an external drive.

What we want to do is:

Add the spare disk to the volume group.
Move the data over to the spare disk.
Remove the original disk from the volume group.
Encrypt the original disk with LUKS.
Add it back to the volume group and move the data back over.
Remove the spare disk from the volume group.

To get started:

Get the name of the existing physical volume with sudo pvdisplay.
Get the name of the existing volume group with sudo vgdisplay.
Determine the name of the spare disk with sudo fdisk -l.

I’m encrypting a VM with a virtual disk (/dev/sda). It has two partitions: a small /boot partition (/dev/sda1) and an LVM physical volume (/dev/sda2). The name of the volume group used in this example is vgpool. I added a second virtual disk. It is unpartitioned and called /dev/sdb. Substitute the values for your environment.

I highly recommend taking a snapshot or backup before continuing. Any time you are messing with storage, there is the possibility for things to go very wrong.

Add the spare disk to the volume group.

$ sudo pvcreate /dev/sdb
  Physical volume "/dev/sdb" successfully created.
$ sudo vgextend vgpool /dev/sdb
  Volume group "vgpool" successfully extended

Move the physical extents from the current physical volume to the spare physical volume. This will take a long time. It will periodically print progress to the screen.
```
$ sudo pvmove /dev/sda2 /dev/sdb
```

Remove the original physical volume from the volume group.

$ sudo vgreduce vgpool /dev/sda2
  Removed "/dev/sda2" from volume group "vgpool"
$ sudo pvremove /dev/sda2
 Labels on physical volume "/dev/sda2" successfully wiped.

Wipe the original disk. Because the disk already had data on it, it is important to securely erase the disk to prevent file recovery of unencrypted data.

$ sudo yum install cryptsetup
$ sudo cryptsetup open --type plain -d /dev/urandom /dev/sda2 to_be_wiped
$ sudo dd if=/dev/zero of=/dev/mapper/to_be_wiped bs=1M status=progress
dd: error writing '/dev/mapper/to_be_wiped': No space left on device
$ sudo cryptsetup close to_be_wiped

The default cipher for plain dm-crypt encryption is aes-cbc. It might be worth changing the cipher to aes-xts, as it might be significantly faster (verify with cryptsetup benchmark).

$ sudo cryptsetup open --type plain -d /dev/urandom --cipher aes-xts-plain64 /dev/sda2 to_be_wiped

Use of /dev/urandom with dd is not required as the encryption cipher is used for randomness.

Encrypt the original disk with LUKS using a detached LUKS header stored on the /boot partition.

The cryptsetup default is to store the LUKS header at the beginning of the partition or disk. If the LUKS header is stored on the original, the volume group will no longer fit when we go to move it back to the original disk from the spare disk, and you’ll get an error like this:

$ sudo pvmove /dev/sdb /dev/mapper/lvmcrypt
  Insufficient free space: 261887 extents needed, but only 261883 available
  Unable to allocate mirror extents for ol_ods/pvmove0.
  Failed to convert pvmove LV to mirrored.

LUKS has the ability to use a detached header. Since you probably already have an unencrypted /boot, the header can be stored there.

$ sudo cryptsetup -y luksFormat /dev/sda2 --header /boot/luksheader.img

WARNING!
========
Header file does not exist, do you want to create it?

Are you sure? (Type 'yes' in capital letters): YES
Enter passphrase for /boot/luksheader.img:
Verify passphrase:
$ sudo cryptsetup luksOpen /dev/sda2 lvmcrypt --header /boot/luksheader.img
Enter passphrase for /dev/sda2:

Add the now encrypted disk back to the volume group.

$ sudo pvcreate /dev/mapper/lvmcrypt
  Physical volume "/dev/mapper/lvmcrypt" successfully created.
$ sudo vgextend vgpool /dev/mapper/lvmcrypt
  Volume group "vgpool" successfully extended

Move the physical extents from the spare physical volume to the encrypted physical volume. Like before, this will take a long time.
```
$ sudo pvmove /dev/sdb /dev/mapper/lvmcrypt
```
Remove the spare physical volume from the volume group.
```
$ sudo vgreduce vgpool /dev/sdb
  Removed "/dev/sdb" from volume group "vgpool"
$ sudo pvremove /dev/sdb
  Labels on physical volume "/dev/sdb" successfully wiped.
```
The data is now entirely on the original physical volume but this time encrypted. You can now delete the spare virtual disk in the case of a VM or remove the external drive.

Configure Initramfs

We’ve accomplished what we set out to do: we’ve encrypted a live system without requiring a reboot. But whenever you do reboot, you want your system to come back up. Since we encrypted the root partition, the decryption needs to happen in the initramfs. There are various tools to regenerate the initramfs depending on your distro. Red Hat-derived distros like Oracle Linux usually use Dracut.

Since we used a detached header, configuring the initramfs is a little more complicated. “A LUKS volume with a detached header, at least using udev/blkid, does not have a UUID.” However, unlike in the linked article, there is a PARTUUID since partitioning is used on the disk (assuming /dev/sda1 is /boot and /dev/sda2 is LVM because the Red Hat installer requires /boot on a separate partition when using LVM).

Get the PARTUUID of the LUKS device with (sudo blkid /dev/sda2).
Add it to /etc/crypttab in the form:
```
volume-name encrypted-device key-file options
```
- volume-name is the device mapper name (e.g. if the volume-name is lvmcrypt, it will mount the LUKS device as /dev/mapper/lvmcrypt).
- encrypted-device is the specification of the encrypted device via UUID=, PARTUUID=, or ID=.
- key-file is the absolute path to a file with the encryption key. If there is no key file, use none.
- options is a comma-delimited list of options.
Since we used a detached header, we need to include the header option and force to force the inclusion of the entry in the initramfs (the only place I found where this option is documented is in the pull request that added it), so our crypttab will look something like:
```
lvmcrypt PARTUUID=<PARTUUID-identifier> none header=/boot/luksheader.img,force
```
where <PARTUUID-identifer> is the PARTUUID of the LUKS device.

If this is for a laptop or workstation where you are OK with being prompted for a password during boot, you can skip to the last step and regenerate initramfs. The following steps will set up Network-Bound Disk Encryption (NBDE) with Clevis.

Bind LUKS volume to Clevis.

$ sudo yum install clevis clevis-luks clevis-dracut
$ sudo clevis luks bind -d /dev/sda2 tang '{"url": "http://tang.example.com"}'
/dev/sda2 is not a LUKS device!

Unfortunately, Clevis does not currently support detached headers. Clevis mostly consists of shell scripts, so this can be easily hacked. These modifications will have to be remerged whenever updating Clevis, so it would be ideal to get the modifications necessary to support detached headers merged upstream like the author of this post did to get detached headers supported by Dracut. I’m going to start by opening an issue on the Clevis GitHub to see if they are open to a pull request adding this and update this with the results.

Navigate to /usr/bin and make a backup copy of clevis-luks-bind.

$ cd /usr/bin
$ sudo cp clevis-luks-bind clevis-luks-bind.original

Edit clevis-luks-bind. Locate where the command line arguments are parsed with getopts and make the following additions:

while getopts ":hfyd:s:k:t:o:" o; do (1)
    case "$o" in
    f) FRC+=(-f);;
    d) DEV="$OPTARG";;
    s) SLT="$OPTARG";;
    k) KEY="$OPTARG";;
    t) TOKEN_ID="$OPTARG";;
    o) HEADER="$OPTARG";; (2)
    y) FRC+=(-f)
       YES+=(-y);;
    *) usage;;
    esac
done

if [ ! -z "$HEADER" ]; then (3)
    LUKSOPTS="--header=$HEADER"
fi

# Alias cryptsetup to insert options:
cryptsetup() {
    /usr/sbin/cryptsetup "$LUKSOPTS" "$@"
}

1	Modify the `getopts` spec adding `o:` to the end. Since `h` for header wasn’t available, and `d` for detached is already used for device, I chose `o` for option.
2	Add an entry to the `case` statement to set a `$HEADER` variable to the value of the `o` argument.
3	Add this and the following lines. The syntax for the `cryptsetup` utility is `cryptsetup <options> <action> <action args>`. Clevis uses `cryptsetup` to bind to a LUKS volume. What we want to do is insert the `header` option into `<options>` whenever Clevis calls `cryptsetup`. A quick-and-dirty hack to accomplish this with minimal changes to the code (especially since we’ll have to remerge our changes whenever updating Clevis) is to alias `cryptsetup` with a function that calls the absolute path to the `cryptsetup` executable with the `header` option and then appends the rest of the arguments Clevis originally called `cryptsetup` with.

Now you can include the -o argument we just added to Clevis to bind it to the LUKS volume.

$ sudo clevis luks bind -o /boot/luksheader.img -d /dev/sda2 tang '{"url": "http://tang.example.com"}'
The advertisement contains the following signing keys:

-Y7MtTJlw8rGGVgXRBhFtumJIqk

Do you wish to trust these keys? [ynYN] y
You are about to initialize a LUKS device for metadata storage.
Attempting to initialize it may result in data loss if data was
already written into the LUKS header gap in a different format.
A backup is advised before initialization is performed.

Do you wish to initialize /dev/sda2? [yn] y
Enter existing LUKS password:

Modify /usr/libexec/clevis-luks-askpass to support detached headers. Modifying Clevis to bind to a LUKS volume with a deatched header is only one half of the equation. The Clevis Dracut module also needs to be able to unlock the volume at boot.

while read -r line; do (1)
  case "$line" in
      Id=cryptsetup:*) d="${line##Id=cryptsetup:}";;
      Socket=*) s="${line##Socket=}";;
  esac
done < "$question"

[ -b "${d}" ] || continue
[ -S "${s}" ] || continue

# Detached header hack (2)
if [ "${d}" = "/dev/disk/by-partuuid/<PARTUUID-identifier>" ]; then (3)
  cryptsetup() {
      /usr/sbin/cryptsetup --header=/boot/luksheader.img "$@" (4)
  }
fi

1	Locate the `while` loop that reads the `ask.*` files in `/run/systemd/ask-password`.
2	Add this and the following lines.
3	This is an ugly hack to get something that works with minimal changes to the code. All the `ask.*` file contains is the device, not any of the options. If upstream Clevis supports detached headers in the future, ideally it would do something like look up the device in `crypttab` to get the header, but I’m not familiar enough with the inner workings of Clevis and Dracut to try and implement that in a quick hack. For now since we know which device we want to unlock and where the header is located for that device, we’ll hardcode it into `clevis-luks-askpass`. Replace `<PARTUUID-identifier>` with the PARTUUID of the LUKS volume obtained above.
4	Like we did to get Clevis to bind to a LUKS volume with a detached header, alias `cryptsetup` with a function that calls the absolute path to the `cryptsetup` executable with the `header` option and then appends the rest of the arguments Clevis originally called `cryptsetup` with.

Set the rd.neednet Dracut kernel command line parameter to make sure network is available in the initramfs for Clevis to be able to contact the Tang server. Create /etc/dracut.conf.d/clevis-nbde.conf:

kernel_cmdline="rd.neednet=1"

This step might not be necessary depending on your distro, version of Clevis, and/or version of Dracut. Without it, Clevis failed to unlock the LUKS volume, and I had to type the passphrase in at the prompt. After boot, I checked what the issue was with sudo journalctl | grep clevis and saw a whole bunch of messages like this:

Jun 14 10:31:45 example clevis-luks-askpass[869]: Error communicating with the server http://tang.example.com

Adding the above Dracut configuration parameter resolved the issue. It appears this issue may not exist in versions of Clevis included with recent versions of Fedora, but at least for the version of Dracut included with Oracle Linux 8.5, the above workaround was still needed.

Regenerate initramfs. Include the LUKS detached header in the initramfs.

$ sudo dracut --install /boot/luksheader.img -f

If it fails to automatically unlock at boot, you can troubleshoot the issue with sudo journalctl | grep clevis. If it fails to boot at all, you can manually unlock the LUKS volume from the Dracut Emergency Shell, and then it should proceed to boot. Then you can troubleshoot the issue by greping the output of journalctl.

Running Tomcat on Privileged Ports

Matthew D. Miller — Mon, 06 Jun 2022 20:11:12 +0000

By default, Tomcat listens on port 8080 for HTTP and 8443 for HTTPS. If you want Tomcat to listen on the standard HTTP (80) and HTTPS (443) ports, it’s not easy, because ports below 1024 are considered privileged ports on Linux and only available to processes running as root. It’s a very (very!) bad idea to run Tomcat as root.

Reverse Proxy

You can configure a reverse proxy or load balancer like HAProxy to proxy port 443 to 8443.

Install HAProxy (sudo yum install haproxy on Red Hat-derived distros and sudo apt install haproxy on Debian-derived distros).

Start HAProxy and configure it to restart at boot.

$ sudo systemctl start haproxy
$ sudo systemctl enable haproxy

Edit /etc/haproxy/haproxy.cfg and add:

# Enable Access on 443 (SSL Passthrough)
frontend tomcat-proxy
    mode            tcp
    bind            :443
    timeout client  5s
    default_backend tomcat

backend tomcat
    mode            tcp
    timeout connect 5s
    timeout server  5s
    server          tomcat server.example.com:8443

Modify the Tomcat server.xml and add proxyPort=443 to the <Connector>. The proxyPort attribute is used when Tomcat is run behind a proxy server. This attribute modifies the value returned to web applications that call the request.getServerPort() method, which is often used to construct absolute URLs for redirects. Without configuring this attribute, the value returned would reflect the port on which the connection from the proxy server was received, rather than the port to whom the client directed the original request. See Proxy Support in the Tomcat documentation for more info.

Authbind

The authbind utility allows a program that would normally require superuser privileges to access privileged ports to run as a non-privileged user. It allows a system administrator to permit specific users and groups access to bind to TCP and UDP ports below 1024.

Install authbind. On Debian-derived distros, you can do this with sudo apt install authbind. It's not available in the repos of Red Hat-derived distros, but there is a pre-rolled RPM available. Download it and install with sudo yum *.rpm.
Authorize the non-privileged user to access port 443. If you installed Tomcat from your distro's repos, it is probably run by the tomcat user.
```
$ sudo touch /etc/authbind/byport/443
$ sudo chmod 500 /etc/authbind/byport/443
$ sudo chown tomcat /etc/authbind/byport/443
```
Modify the Tomcat server.xml and configure Tomcat to listen to port 443.
Prefix the command to start Tomcat with /usr/bin/authbind --deep. If you are using systemd to start Tomcat, your ExecStart would look something like this:
```
ExecStart=/usr/bin/authbind --deep /opt/apache-tomcat-8.5.30/bin/startup.sh
```
Normally authbind arranges for only the program which it directly invokes to be affected by its special version of bind. If you specify --deep, then all programs which that program invokes directly or indirectly will be affected, so long as they do not unset the environment variables set up by authbind.

Jsvc

Jsvc is a set of libraries and applications for making Java applications run on Unix more easily. According to the documentation, "Jsvc allows the application (e.g. Tomcat) to perform some privileged operations as root (e.g. bind to a port < 1024), and then switch identity to a non-privileged user." I tried it but was never able to get it to work, and documentation and examples online seem sparse, so I abandoned it.

Learn Scheme by Example: IUP GUI with Chicken Scheme

Matthew D. Miller — Mon, 02 May 2022 04:41:04 +0000

IUP is a cross-platform GUI toolkit that uses native controls. It uses GTK on Linux and, well, GTK on macOS too. According to the roadmap, there is a macOS native driver in the works, but it looks like one of those perpetually "coming soon" features. There are bindings for various programming languages including a Chicken egg. Instead of building yet another calculator, let's build a GUI for generating a tone.

You'll need Chicken Scheme installed. It's available in the repositories of most Linux distros. You'll also need the IUP libraries installed before you can install the IUP egg. Unfortunately, IUP doesn't appear to be packaged for many Linux distros. Fortunately, there are pre-compiled binaries available for download on the IUP website. They are packaged as a tarball. Each tarball includes shell scripts for installing the libraries (moving them to system-wide locations for which sudo may be required depending on your distro). In addition to IUP, you also need to download two other libraries also developed by Tecgraf Institute at PUC-Rio called IM and CD. For Linux, there are different downloads for different kernel versions. These appear to correspond to versions of the Linux kernel that came with different Ubuntu releases. I use Debian Sid, which has a newer kernel than any Ubuntu release, so I just downloaded the package for the most recent kernel available, and it worked fine. Position yourself in the directory where you downloaded the tarballs and:

$ mkdir iup
$ tar -xpvf iup-*_lib.tar.gz -C iup
$ sudo iup/install
$ sudo iup/install_dev
$ sudo cp iup/ftgl/lib/Linux*/* /usr/lib64
$ mkdir im
$ tar -xpvf im-*_lib.tar.gz -C im
$ sudo im/install
$ sudo im/install_dev
$ mkdir cd
$ tar -xpvf cd-*_lib.tar.gz -C cd
$ sudo cd/install
$ sudo cd/install_dev

The above scripts install the libraries in non-standard paths on Debian, and chicken-install is unable to find them. You can use the CSC_OPTIONS environment variable to tell chicken-install where to find these files.

$ CSC_OPTIONS='-I/usr/include/iup -I/usr/include/im -I/usr/include/cd -L/usr/lib64' chicken-install -sudo iup

You'll also need to specify the dynamic library path when executing the program with Chicken.

$ LD_LIBRARY_PATH=/usr/lib64 csi bleep.scm

If using IUP from its native C, attribute setting is a separate step from object construction. The Scheme bindings add a little syntactic sugar that allow specifying your entire UI as an S-expression. Attribute names are keywords which can be passed directly to widget constructors along with child widgets. The attributes have a trailing colon. You can look up what attributes a widget accepts in the original C documentation.

(import iup)

; Main window
(define dlg
  (dialog
    title: "Bleep"
    (vbox
      alignment: 'ACENTER
      gap: 25
      margin: '25x25)))

(show dlg)
(main-loop)
(destroy! dlg)
(exit 0)

The vbox is an invisible widget that helps with layout. Let's start by placing a slider within this vbox.

(define slider
  (valuator
    min: 20
    max: 20000
    value: 440
    expand: 'Yes))

; Main window
(define dlg
  (dialog
    title: "Bleep"
    (vbox
      alignment: 'ACENTER
      gap: 25
      margin: '25x25
      slider)))

In IUP parlance, a slider is a valuator. IUP convention is to use "Yes" and "No" as boolean values. In Scheme you can use the 'Yes and 'No symbols. To help with organization, you can store the widget in a variable. You can add child widgets to the vbox by passing them to the vbox constructor after any other attributes (actually, the child widgets can be passed before other attributes or even mixed in with the other attributes, but I find it clearest to keep them grouped at the end).

The range of frequencies audible by humans is typically between 20 Hz and 20 KHz (we lose the ability to hear some of those higher frequencies as we age). The musical note A above middle C is 440 Hz. Since A4 serves as a general tuning standard, it seems like a sensible default, but if you run the above in Chicken, this is what you'll see:

The scale of 20 to 20,000 is so large that 440 doesn't appear to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript, but it was easy enough to port to Scheme.

; Scale used by slider
(define *min-position* 0)
(define *max-position* 2000)
; Range of frequencies
(define *min-frequency* 20)
(define *max-frequency* 20000)

; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(define min-freq (log *min-frequency*))
(define max-freq (log *max-frequency*))
(define frequency-scale (/ (- max-freq min-freq) (- *max-position* *min-position*)))
; Convert slider position to frequency
(define (position->frequency position)
  (round (exp (+ min-freq (* frequency-scale (- position *min-position*))))))
; Convert frequency to slider position
(define (frequency->position freq)
  (round (/ (- (log freq) min-freq) (+ frequency-scale *min-position*))))

Then we create two functions: one that takes the position on the slider and returns the frequency (position->frequency) and another that takes a frequency and returns the position on the slider (frequency-position). Now let's set the initial position of our slider with the frequency->position function:

(define slider
  (valuator
    min: *min-position*
    max: *max-position*
    value: (frequency->position 440)
    expand: 'Yes))

Underneath the slider is a spin box showing the current frequency and buttons to increase/decrease the frequency by one octave.

(define frequency-field
  (textbox
    spin: 'Yes
    spinmin: *min-frequency*
    spinmax: *max-frequency*
    spinvalue: 440))
(define frequency-controls
  (hbox
    alignment: 'ACENTER
    gap: 25
    margin: '0x0
    (button title: '<)
    (hbox
      alignment: 'ACENTER
      gap: 5
      frequency-field
      (label "Hz"))
    (button title: '>)))

; Main window
(define dlg
  (dialog
    title: "Bleep"
    (vbox
      alignment: 'ACENTER
      gap: 25
      margin: '25x25
      slider
      frequency-controls)))

In IUP a spin box is just a text box that has the spin attribute set to "Yes." At this point, we are starting to have a nice looking interface, but it doesn't do anything. If you click the buttons or slide the slider, nothing happens. Widgets also take callbacks. Callbacks are specified just like attributes and are functions that take one or more arguments, usually self, which is the widget to which the callback belongs, and return a symbol: usually 'default but also 'close to close a dialog or others such as 'ignore and 'continue. The names of callbacks that a widget accepts and their arguments can be looked up in the original C documentation. Both the slider/valuator and the spin box have a valuechanged-cb callback (converted from valuechanged_cb in the original C API).

(define slider
  (valuator
    min: *min-position*
    max: *max-position*
    value: (frequency->position 440)
    expand: 'Yes
    valuechanged-cb: (lambda (self)
      (attribute-set! frequency-field spinvalue:
        (position->frequency (string->number (attribute self value:))))
      'default)))
(define frequency-field
  (textbox
    spin: 'Yes
    spinmin: *min-frequency*
    spinmax: *max-frequency*
    spinvalue: 440
    valuechanged-cb: (lambda (self)
      (attribute-set! slider value:
        (frequency->position (string->number (attribute self spinvalue:)))))))

The attribute and attribute-set functions get the value of an attribute and set the value of an attribute, respectively. The first argument to each function is a widget, the second an attribute. When setting an attribute, you also provide an additional argument with the new value for the attribute. Attribute values are always returned as strings. Our logarithmic conversion functions take numbers, so we have to convert the attribute string to a number with string->number.

Wire the action callbacks of the buttons up to functions called decrease-octave and increase-octave. An octave is "the interval between one musical pitch and another with double its frequency."

; Set frequency slider and display
(define (set-frequency freq)
  (when (and (>= freq *min-frequency*) (<= freq *max-frequency*))
    (attribute-set! slider value: (frequency->position freq))
    (attribute-set! frequency-field value: freq)))
; Buttons increase and decrease frequency by one octave
(define (adjust-octave modifier)
  (set-frequency (* (string->number (attribute frequency-field spinvalue:)) modifier)))
(define (decrease-octave self) (adjust-octave 0.5))
(define (increase-octave self) (adjust-octave 2))

Let's use another spin box to specify the duration of the beep in milliseconds.:

(define duration-field
  (textbox
    spin: 'Yes
    spinmin: 1
    spinmax: 600000 ; 10 minutes
    spinvalue: 200))
(define general-controls
  (hbox
    alignment: 'ACENTER
    gap: 25
    margin: '0x0
    (hbox
      alignment: 'ACENTER
      gap: 5
      duration-field
      (label "ms"))))

; Main window
(define dlg
  (dialog
    title: "Bleep"
    (vbox
      alignment: 'ACENTER
      gap: 25
      margin: '25x25
      slider
      frequency-controls
      general-controls)))

Frequency is rather abstract. Let's also give the user the ability to select a musical note. We can store the corresponding frequencies for A4-G4 in an association list.

; Notes -> frequency (middle A-G [A4-G4])
; http://pages.mtu.edu/~suits/notefreqs.html
(define notes '(("A" 440.00)
                ("B" 493.88)
                ("C" 261.63)
                ("D" 293.66)
                ("E" 329.63)
                ("F" 349.23)
                ("G" 292.00)))

We'll give the user a drop-down menu. Whenever a note is selected from the drop-down menu, we'll look up the frequency in the association list and set it using the set-frequency helper function we created for the octave buttons.

(define general-controls
  (hbox
    alignment: 'ACENTER
    gap: 25
    margin: '0x0
    (hbox
      alignment: 'ACENTER
      gap: 5
      duration-field
      (label "ms"))
    (hbox
      alignment: 'ACENTER
      gap: 5
      (label "♪")
      (listbox
        #:1 "A" #:2 "B" #:3 "C" #:4 "D" #:5 "E" #:6 "F" #:7 "G"
        value: 1
        dropdown: 'Yes
        action: (lambda (self text item state)
          (set-frequency (cadr (assoc text notes))))))))

Now, let's make some noise. There are Chicken Scheme bindings to the Allegro library. Allegro is a library primarily used by games for cross-platform graphics, input devices, and more. What we're interested in is the audio addon that can be used to generate a tone with a sine wave. You'll need to install the Allegro library. Make sure you also install the header files. In some Linux distros, these are split into a separate package (e.g. liballegro5-dev on Debian). Also, install the Allegro egg (chicken-install -sudo allegro). I added the following lines near the top to import the Allegro bindings (and the chicken memory module, which we'll also use).

(import (prefix allegro "al:"))
(import (chicken memory))

(define +pi+ 3.141592)

You must place the code to initialize Allegro between the function to show the main IUP dialog and starting the IUP main-loop. If it comes before show, the program will die with a segmentation violation, and it can't come after the main-loop, because it would never get executed until the window closed.

; Display GUI
(show dlg)

; Initialize Allegro and audio addon
; Must be initialized afer showing the main dialog but before starting the main
; loop or else program will die with a segmentation violation.
(unless (al:init) (print "Could not initialize Allegro."))
(unless (al:audio-addon-install) (print "Could not initialize sound."))
(al:reserve-samples 0)

; Start IUP main loop
(main-loop)
(destroy! dlg)
(exit 0)

The Allegro egg is accompanied by a couple of examples but no examples showing the use of the audio addon. The Allegro library itself comes with an example showing how to generate a saw wave, but being a C library, the example is, of course, in C. I ported that example to Scheme. I would have contributed the example back to the Allegro egg, but the repo is marked as "archived by the owner" and read-only on GitHub. I've included the example in the repo alongside the rest of the code for this tutorial in case someone finds it useful.

Allegro is very low-level. You create an audio stream. In this case, the stream buffers eight fragments of 1,024 samples each at a frequency (often called sampling rate) of 44,100 Hz (the sampling rate of an audio CD), which means there are 44,100 samples per second. Each sample is a 32-bit float (what is called the bit depth of the audio), and we only have one channel to keep things as simple as possible.

; Generate a tone using Allegro
(define (generate-tone frequency duration)
  (let* ((samples-per-buffer 1024)
         (stream-frequency 44100)
         (amplitude 0.5)
         (stream (al:make-audio-stream 8 samples-per-buffer stream-frequency 'float32 'one))
         (queue (al:make-event-queue))
         (event (al:make-event)))

    (unless (al:audio-stream-attach-to-mixer! stream (al:default-mixer))
      (print "Could not attach stream to mixer."))
    (al:event-queue-register-source! queue (al:audio-stream-event-source stream))

    (let event-loop ((n 0))
      ; Grab and handle events
      (when (and (< n (/ (* (/ duration 1000) stream-frequency) samples-per-buffer))
                 (al:event-queue-wait! queue event))
        (case (al:event-type event) ('audio-stream-fragment
          (let ((buffer (al:audio-stream-fragment stream)))
            ; If the stream is not ready for new data, buffer will be null.
            (if (not buffer) (event-loop n) (begin
              (fill-buffer buffer n) ; Placeholder
              ; Repeat
              (event-loop (+ n 1)))))))))

    (al:audio-stream-drain stream)))

An event loop waits for the audio stream to ask for another buffer. Our job is to fill that buffer with 1,024 32-bit floats at a time. In the code listing above, this is done by fill-buffer. That was just a placeholder, so I could break the code up into shorter, more easily explainable chunks. This is what goes in the place of (fill-buffer buffer n):

(let ((adr (pointer->address buffer)))
  (let loop ((i 0))
    (when (< i samples-per-buffer)
      (let ((time (/ (+ (* samples-per-buffer n) i) stream-frequency)))
        ; al:audio-stream-fragment returns a C pointer. Use (chicken
        ; memory) module to operate on foreign pointer objects.
        ; Iterate over array four bytes at a time since 32-bit depth.
        (pointer-f32-set! (address->pointer (+ adr (* i 4)))
          (* amplitude (sin (* 2 +pi+ frequency time))))
        (loop (+ i 1)))))
  (unless (al:audio-stream-fragment-set! stream buffer)
    (print "Error setting stream fragment")))

The Allegro egg is a pretty thin wrapper of the Allegro library. The audio-stream-fragment procedure in the egg just passes along the C pointer that the corresponding al_get_audio_stream_fragment function from the C library returns. It would have been nice if the egg had offered some Scheme conveniences atop Allegro like allowing us to pass a Scheme list or array to Allegro to provide the buffer of samples. Since it doesn't, we'll use the chicken memory module to fill the C array starting at the C pointer returned by audio-stream-fragment. We use pointer->address to get the address of the pointer. A pointer references a byte of memory. We can reference the preceding or following byte by subtracting or adding 1 to the address. Since we are filling the array with 32-bit floats, and 32 bits is 4 bytes, we want to increment the address by 4 each time. Then we can set the value of the current location with pointer-f32-set!.

Then you just need to feed Allegro buffers of 1,024 samples at a time. The basic formula for a sine wave is A sin(2πft) where A is amplitude, f is frequency, and t is time.

(* amplitude (sin (* 2 +pi+ frequency time)))

Wire this up to a play button, and you're ready to make some noise.

(button
  title: "Play"
  action: (lambda (self)
    (generate-tone (attribute frequency-field spinvalue:)
                   (attribute duration-field spinvalue:))))

The documentation for the iup egg is pretty sparse, but this tutorial on using the iup egg was indispensable in writing the above tutorial.

You can check out the entire example on GitHub. This started as a personal learning project to explore the state of GUI programming in Lisp and has become a series of tutorials on building GUIs with various dialects of Lisp.

Introduction to the Sam Text Editor

Matthew D. Miller — Fri, 24 Dec 2021 18:42:37 +0000

Programmers are passionate about their tools, and if there is one tool they are especially passionate about, it is their text editor. An editor war has raged between Emacs and vi for decades, and new challengers such as VS Code and Sublime Text vie for superiority. I decided to try out an editor that isn't near as popular as these others but has no less a distinguished pedigree.

Sam was one of two text editors included in the Plan 9 operating system. It was originally designed by Rob Pike for the Blit windowing terminal in the early 1980s.

Sam for modern Linux and BSD can be obtained from two different sources. One is Plan 9 from User Space that ports Plan 9 programs to other Unix-like operating systems, and the other is Deadpixi Sam that has continued development of the 1990s Unix port of Sam. I installed and reviewed Deadpixi Sam. If you install a different version of Sam, some of the configuration details might differ, but most of the information here should apply to all versions of Sam.

A Brief Tutorial

Vi is notorious for trapping novice programmers who don't even know how to exit it. I plead guilty here: The first time I was dropped into a vi session on an HP-UX server, I couldn't get it to do anything and was too afraid to ask someone thinking I had broken something. The learning curve for Sam isn't quite as steep, but it also isn't obvious what to do when you first launch Sam and are presented with this:

You could, of course, read the man page, but the man page being a reference source isn't really laid out in a way that introduces you to Sam. It starts out by detailing a whole bunch of editing commands you can't even use yet, because it's not clear how to even load a text file to edit. You have to read through over half of the man page before you get to that. Despite Sam being around since the 1980s, I couldn't find any quick tutorial to get you up and running in a couple minutes to experiment with Sam, so I'll try to do that here.

When you first launch Sam, it is divided into top and bottom areas or "windows." The top window is the command window. This is where you type commands to manipulate text and control Sam. The bottom is a text window. You start out with one text window, but you can open as many text windows as you want. The text windows display the contents of the files being edited.

Deadpixi Sam can be configured with a .samrc file in your home directory. I recommend copying the example that comes packaged with Deadpixi Sam in doc/samrc to ~/.samrc, because it comes with some helpful defaults. To edit this file with Sam, you would load it by typing B .samrc in the command window followed by Enter. The cursor will change. Point at the text window. Select it to display the file by right clicking anywhere inside it.

You can left click within the text window to move the text cursor around. You can left click and drag to select text or double click to select a word. If you double click just inside brackets, parentheses, quotes, etc., it will select all the text within the brackets. By default, you can navigate with the keyboard using Ctrl+e,x,d,s to move the text cursor up, down, right, and left. The reason I highly recommended copying over the samrc that comes with Deadpixi Sam is because it enables moving the text cursor with the arrow keys and the more familiar (at least to those coming from Vim) Ctrl+k,j,l,h. You can edit files directly in the text window.

Right click and hold (with most modern operating systems, we are used to right clicking and releasing to access context menus, but you have to keep the right mouse button held down to access the menu in Sam) to access a menu with commands to manipulate windows. Some of the commands give you a crosshairs cursor to select the size and position of windows. Below the window operators is a list of available files starting with ~~sam~~, the command window. Selecting a file from the list makes the most recently used window on that file current. If no windows are open on the file, you are prompted to open one.

Middle click and hold (just like above but hold down on your mouse wheel) to access a menu with editing commands. With this menu you can do things like copy (called snarf in Sam for some reason), cut, and paste. If you copied the samrc over that comes with Deadpixi Sam, it binds the familiar Ctrl+x,c,v,q with cut, snarf, paste, and exchange.

Sam doesn't use the system clipboard, but you can swap Sam's snarf with the system with <exch> from the editing menu. This allows you to copy and paste into other apps and vice versa. By default, it swaps snarf with the system selection. In Linux, this is what pastes when you middle click. This didn't integrate with the clipboard manager I use, so I added a line to .samrc to tell Sam to use the system clipboard instead of the system selection.

$
a/\n# Make work with system clipboard manager\n/
a/snarfselection clipboard/

The dollar sign tells Sam to jump to the end of the file. The a/text/ command appends text at the current location (there is also i to insert and c to replace). I did this to demonstrate some of the commands you can use in Sam, but for the above example, it probably would have been easier to type the above directly into the text window. You can also type regular expressions like /font/ into the command window to locate strings in the text window. Consult the man file that comes with Sam for a complete list of available commands.

Now we're ready to save our changes and exit Sam. Type w in the command window to write the changes to the file. Then type q to quit. If you type q when there are unsaved changes, instead of closing, Sam will print ?changed files. To force it to close with unsaved changes, just type q a second time. If you copied the samrc over that comes with Deadpixi Sam, it binds the familiar Ctrl+s with write (and also Ctrl+z to undo).

Review of Sam

Sam does a lot of things different than the conventions used by most modern operating systems. For example, the scrollbar is on the left instead of the right. You can grab the scrollbar by left clicking and drag to scroll up and down, but moving your mouse up scrolls down, and moving your mouse down scrolls up. As mentioned in my review, you must hold down the right and middle mouse button to select from the menus (you can't just click and release). These would be fine if they followed the conventions of the operating system, but they will be the opposite of what most new users expect. This is because Sam is almost 40 years old and was created before many of these conventions were established.

It's obvious from projects like Plan 9 from User Space and posts on Hacker News and Reddit that Plan 9 still has a number of ardent followers. Sam is also reportedly the preferred editor of Ken Thompson, Bjarne Stroustrup, and Brian Kernighan. A project like Deadpixi has to tread a fine line between preserving Sam as it was to satisfy users who have built up muscle memory and modernizing it to attract new users. Copying the samrc over that comes with Deadpixi goes a long way toward configuring key bindings that make Sam mostly behave like other text entry in modern operating systems. What I still miss is being able to hold Shift while using the arrow keys to select text, and I don't think there's any way to do this just using .samrc. I made a couple additional tweaks to my .samrc during the couple of days I played around with Sam.

bind * Home command bol
bind * End command eol

This makes the Home and End key behave as you would expect. The maintainer of Deadpixi sets 12 pt. Go Regular as the font in the example, samrc; I changed this to 13 pt. Inconsolata. The Deadpixi example samrc also adds a list of background colors for new windows, but I decided to stick with just white. I set tabs to 2 spaces and the aforementioned snarfselection to clipboard.

Sam was created before desktop environments and window managers were common. The original Sam was designed to run on a terminal (not a terminal emulator like you have on your computer but an actual terminal). Instead of using more modern metaphors such as tabs, Sam includes its own rudimentary window management. You can have multiple text windows open and make Sam look something like this (the screenshot from the Deadpixi REAMDE):

The only way to create and position windows is using the mouse to sweep an area for the window. This is awkward, and during the couple of days I experimented with Sam, I primarily used the right-click menu to switch between which file occupied the single text window that was created upon launch. Key bindings for window tiling or even Acme-like tiling is listed as a development goal in the Deadpixi README but not yet implemented.

The Sam GUI is built with Xt, a library that provides primitives to create widgets for the X Window System used by widget toolkits like Motif (whereas GTK and Qt draw their own widgets). This gives it a decidedly dated look and feel. It's telling the the screenshots in Rob Pike's original 1987 paper describing Sam look exactly like Sam does today. Removing the Xt dependency is listed as a stretch goal in the Deadpixi README, but continued development seems slow. At the time of this writing, it has been over a year since the last commit.

It also doesn't support other features most user's probably expect from a modern text editor. It doesn't do syntax highlighting, and that is listed under "Things That Won't Ever Happen (Sorry)" in the README. In a GitHub issue, the maintainer clarifies it's not that he'll never implement syntax highlighting but just that it would be almost impossible in the current 30-year-old codebase. If he rewrites the GUI in Tcl to get rid of the Xt dependency, syntax highlighting might become a possibility.

While I enjoyed playing around with Sam for a couple of days, I don't see it becoming my main text editor. It was a nice peek at computing history, and I might keep it around to edit a configuration file now and again, but I'll continue using Geany when programming. The structural regular expressions and being able to pipe the current selection to a shell command and replace the selection with the result are neat but not compelling enough to do without things like syntax highlighting (plus most modern text editors can do those other things too).

Are you a Sam fan? Do you use it as your daily driver? I'd love to hear from you. How long have you used it? What is it about Sam that makes you prefer it to other text editors? Is there something I missed? Any tips or tricks to share?

Learn Common Lisp by Example: GTK GUI with SBCL

Matthew D. Miller — Sat, 20 Nov 2021 05:38:52 +0000

The cl-cffi-gtk library provides Common Lisp bindings to GTK. The library is developed with SBCL but should also work with Clozure CL and CLISP. For this tutorial, I'll be using SBCL. Instead of building yet another calculator, let's build a GUI for generating a tone.

You'll need SBCL installed. It's available in the repositories of most Linux distros, so just install it from your distro's repo. Depending on your destkop environment, you probably already have GTK installed (even if you use KDE, it's highly likely you already have GTK installed). If you're on Windows or macOS, you'll probably have to install GTK in addition to SBCL.

The Common Lisp bindings to GTK can be installed with Quicklisp. If you don't already have Quicklisp installed, it's painless. See the Quicklisp website for more details, but here's an example of installing Quicklisp on Debian and configuring SBCL. The steps should be the same for any Linux distro and macOS.

$ curl -O https://beta.quicklisp.org/quicklisp.lisp
$ sbcl --load quicklisp.lisp
> (quicklisp-quickstart:install)
> (ql:add-to-init-file)

The "proper" way to include a dependency would be to use ASDF and create a .asd file for the project. Since this is a quick tutorial, I'll use with ql:quickload.

(ql:quickload :cl-cffi-gtk)

The first time you run bleep.lisp, it will take awhile as Quicklisp downloads cl-cffi-gtk (by default it will be downloaded to ~/quicklisp).

; Main window
(defvar window (make-instance 'gtk:gtk-window :type :toplevel :title "Bleep"))
(defvar vbox (make-instance 'gtk:gtk-box :orientation :vertical
                                                      :spacing 25
                                                      :margin 25))

(gtk:within-main-loop
  ; Quit program when window closed
  (gobject:g-signal-connect window "destroy" (lambda (widget)
    (declare (ignore widget))
    (gtk:leave-gtk-main)))
  ; Display GUI
  (gtk:gtk-container-add window vbox)
  (gtk:gtk-widget-show-all window))

Although written in C, GTK is object oriented. It uses a portable object system called GObject. GObject classes are wrapped with corresponding Lisp classes. You create a window by instantiating the gtk:gtk-window class.

The gtk:gtk-box is a packing widget. A gtk:gtk-window can only contain one widget at a time. Packing widgets are you used to pack widgets together and arrange them.

The gtk:within-main-loop macro does the work of setting up a GTK main loop. The macro does some additional bookkeeping to run the GUI in a separate thread. This is cool, because even after the window appears, you can still type commands into the REPL to interact with the program (e.g. query the properties of a widget). With most of the Lisp GUI libraries I've tried out, the GUI takes over completely once it is launched, and you have to close the window before being able to type commands into the REPL again.

Then add our packing widget to the window, and we're ready to launch our window. Now let's add some more widgets to it.

(defvar slider (make-instance 'gtk:gtk-scale
                              :orientation :horizontal
                              :draw-value nil
                              :width-request 200
                              :adjustment
                              (make-instance 'gtk:gtk-adjustment
                                             :value 440
                                             :lower 20
                                             :upper 20000
                                             :step-increment 1)))
(gtk:gtk-box-pack-start vbox slider)

The scale of 20 to 20,000 is so large that 440 doesn't appear to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript, but it was easy enough to port to Common Lisp.

; Scale used by slider
(defparameter *min-position* 0)
(defparameter *max-position* 2000)
; Range of frequencies
(defparameter *min-frequency* 20)
(defparameter *max-frequency* 20000)

; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(defvar min-freq (log *min-frequency*))
(defvar max-freq (log *max-frequency*))
(defvar frequency-scale (/ (- max-freq min-freq) (- *max-position* *min-position*)))
; Convert slider position to frequency
(defun position->frequency (position)
  (round (exp (+ min-freq (* frequency-scale (- position *min-position*))))))
; Convert frequency to slider position
(defun frequency->position (freq)
  (round (/ (- (log freq) min-freq) (+ frequency-scale *min-position*))))

Then we create two functions: one that takes the position on the slider and returns the frequency (position->frequency) and another that takes a frequency and returns the position on the slider (frequency-position). Now let's modify our slider to use frequency->position to convert the initial value to a slider position using our logarithmic scale.

(defvar slider (make-instance 'gtk:gtk-scale
                              :orientation :horizontal
                              :draw-value nil
                              :adjustment
                              (make-instance 'gtk:gtk-adjustment
                                             :value (frequency->position 440)
                                             :lower *min-position*
                                             :upper *max-position*
                                             :step-increment 1)))

Underneath the slider is a spin button showing the current frequency and buttons to increase/decrease the frequency by one octave.

; Create a spin button with a units label
; Arguments: from - number, lower bound of range),
;            to - number, upper bound of range
;            initial - number, initial value of spin button
;            units - string, label after spin button
; Optional Arguments: digits - number <= 20, number of decimal places to show
; Return value: The gtk-spin-button instance inside the container
(defun units-spin-button (from to initial units &key (digits 0))
  (let ((container (make-instance 'gtk:gtk-box :orientation :horizontal :spacing 10))
        (spin-button (make-instance 'gtk:gtk-spin-button
                                    :digits digits
                                    :adjustment
                                    (make-instance 'gtk:gtk-adjustment
                                                   :value initial
                                                   :lower from
                                                   :upper to
                                                   :step-increment 1)))
        (label (make-instance 'gtk:gtk-label :label units)))
    (gtk:gtk-box-pack-start container spin-button :fill nil)
    (gtk:gtk-box-pack-start container label :fill nil)
    ; Return the container holding the spin button and label
    spin-button))

(defvar frequency-field (units-spin-button *min-frequency* *max-frequency* 440 "Hz" :digits 2))

(defvar lower-button (make-instance 'gtk:gtk-button :label "<"))
(defvar higher-button (make-instance 'gtk:gtk-button :label ">"))

(defvar frequency-box (make-instance 'gtk:gtk-box :orientation :horizontal :spacing 25))
(gtk:gtk-box-pack-start frequency-box lower-button :fill nil)
(gtk:gtk-box-pack-start frequency-box (gtk:gtk-widget-parent frequency-field) :fill nil)
(gtk:gtk-box-pack-start frequency-box higher-button :fill nil)
(gtk:gtk-box-pack-start vbox frequency-box)

We can also use boxes to help with layout. I created a function that I can reuse later to generate the spin button and label and pack them together in a box.

At this point, we are starting to have a nice looking interface, but it doesn't do anything. If you click the buttons or slide the slider, nothing happens. Widgets emit signals, and callback functions can be connected to these signals. If we connect a callback function to the change-value signal of the slider, that function will be called whenever the slider is moved. The arguments a callback function takes are dependent on the signal being handled. The adjustment object of the spin button has a value-changed signal.

; Link slider to text field display of frequency
(gobject:g-signal-connect slider "change-value"
  ; Connect to change-value signal of slider instead of value-changed signal of
  ; its corresponding adjustment object so that frequency will only be updated
  ; when interactively moved avoiding rounding differences between slider and
  ; sping button.
  (lambda (range scroll value)
    (declare (ignore range scroll))
    (setf (gtk:gtk-adjustment-value (gtk:gtk-spin-button-adjustment frequency-field))
          (position->frequency value))))
(gobject:g-signal-connect (gtk:gtk-spin-button-adjustment frequency-field) "value-changed"
  (lambda (adjustment)
    (setf (gtk:gtk-adjustment-value (gtk:gtk-range-adjustment slider))
          (frequency->position (gtk:gtk-adjustment-value adjustment)))))

Wire the buttons up to callback functions called decrease-octave and increase-octave. An octave is "the interval between one musical pitch and another with double its frequency."

; Buttons increase and decrease frequency by one octave
(defun set-frequency (freq)
  (setf (gtk:gtk-adjustment-value (gtk:gtk-spin-button-adjustment frequency-field)) freq))
(defun adjust-octave (modifier)
  (set-frequency (* (gtk:gtk-adjustment-value (gtk:gtk-spin-button-adjustment frequency-field)) modifier)))
(defun decrease-octave (widget) (declare (ignore widget)) (adjust-octave 0.5))
(defun increase-octave (widget) (declare (ignore widget)) (adjust-octave 2))

(gobject:g-signal-connect lower-button "clicked" #'decrease-octave)
(gobject:g-signal-connect higher-button "clicked" #'increase-octave)

We'll reuse the units-spin-button function we created to create a field to specify the duration of the beep in millseconds:

(defvar control-box (make-instance 'gtk:gtk-box :orientation :horizontal :spacing 25))
(defvar duration-field (units-spin-button 1 600000 200 "ms"))
(gtk:gtk-box-pack-start control-box (gtk:gtk-widget-parent duration-field) :fill nil)
(gtk:gtk-box-pack-start vbox control-box)

Frequency is rather abstract. Let's also give the user the ability to select a musical note. We can store the corresponding frequencies for A4-G4 in an association list.

; Notes -> frequency (middle A-G [A4-G4])
; http://pages.mtu.edu/~suits/notefreqs.html
(defvar notes '(("A" . 440.00)
                ("B" . 493.88)
                ("C" . 261.63)
                ("D" . 293.66)
                ("E" . 329.63)
                ("F" . 349.23)
                ("G" . 292.00)))

; Create combo box and label
(defvar note-box (make-instance 'gtk:gtk-box :orientation :horizontal :spacing 10))
(defvar note-label (make-instance 'gtk:gtk-label :label "♪"))
(gtk:gtk-box-pack-start note-box note-label :fill nil)
(defvar note (make-instance 'gtk:gtk-combo-box-text))
(gtk:gtk-box-pack-start note-box note :fill nil)
; Populate combo box
(gtk:gtk-combo-box-text-append-text note "A")
(gtk:gtk-combo-box-text-append-text note "B")
(gtk:gtk-combo-box-text-append-text note "C")
(gtk:gtk-combo-box-text-append-text note "D")
(gtk:gtk-combo-box-text-append-text note "E")
(gtk:gtk-combo-box-text-append-text note "F")
(gtk:gtk-combo-box-text-append-text note "G")
; Set frequency to specific note
(gobject:g-signal-connect note "changed"
  (lambda (object)
    (let ((value (gtk:gtk-combo-box-text-get-active-text object)))
      (set-frequency (cdr (assoc value notes :test 'equal))))))
; Pack the combo box
(gtk:gtk-box-pack-start control-box note-box :fill nil)
(gtk:gtk-box-pack-start vbox control-box)

Finally, let's make some noise.

(ql:quickload :cl-portaudio)

; Generate a tone using CL-PortAudio
(defun generate-tone (frequency duration)
  (let ((frames-per-buffer 1024)
        (sample-rate 44100d0)
        (amplitude 0.5))
    ; Initialize PortAudio environment
    (portaudio:with-audio
      ; Open and start audio stream
      (portaudio:with-default-audio-stream (astream 1 1
                                            :sample-format :float
                                            :sample-rate sample-rate
                                            :frames-per-buffer frames-per-buffer)
        (dotimes (i (round (/ (* (/ duration 1000) sample-rate) frames-per-buffer)))
          ; Write buffer to output stream
          (portaudio:write-stream astream
            ; portaudio:write-stream requires an array as input, not a list
            (make-array frames-per-buffer :element-type 'single-float :initial-contents
              (loop for j from (+ (* frames-per-buffer i) 1) to (* frames-per-buffer (+ i 1)) collect
                (let ((time (/ j sample-rate)))
                  ; Since sample-rate and pi are double-float, they make result
                  ; double-float. PortAudio expects single-float, and will warn
                  ; when run with SBCL if not given single-float.
                  (coerce (* amplitude (sin (* 2 pi frequency time))) 'single-float))))))))))

We'll use Common Lisp bindings to PortAudio to generate the tone. This can be loaded with Quicklisp.

CL-PortAudio comes with a couple of helpful macros that makes initializing PortAudio and starting a stream simple. The with-audio macro executes body within a PortAudio initialize/terminate environment. The with-default-audio-stream macro executes body with an opened and started stream and shuts down the stream after it is done.

Then you just feed PortAudio arrays of samples, :frames-per-buffer at a time. I initiated with-default-audio-stream with one channel, so the array is just a single-dimensional array of floating point numbers. If you were producing stereo sound, you would generate a two-dimensional array. The basic formula for a sine wave is A sin(2πft) where A is amplitude, f is frequency, and t is time:

(* amplitude (sin (* 2 pi frequency time)))

Wire this up to a button between the duration and note selector, and you're ready to make some noise.

(defvar play-button (make-instance 'gtk:gtk-button :label "Play"))
(gobject:g-signal-connect play-button "clicked" (lambda (widget)
  (declare (ignore widget))
  (generate-tone (gtk:gtk-adjustment-value (gtk:gtk-spin-button-adjustment frequency-field))
                 (gtk:gtk-adjustment-value (gtk:gtk-spin-button-adjustment duration-field)))))
(gtk:gtk-box-pack-start control-box play-button :fill nil)

Learn Scheme by Example: Tk GUI with Chicken Scheme

Matthew D. Miller — Fri, 12 Nov 2021 21:51:55 +0000

PS/Tk stands for a portable Scheme interface to the Tk GUI toolkit. It has a rich history going all the way back to Scheme_wish by Sven Hartrumpf in 1997. Wolf-Dieter Busch created a Chicken port called Chicken/Tk in 2004. It took on its current name when Nils M Holm stripped it of Chicken-isms to make it portable amongst Scheme implementations in 2006.

If you've ever tried to write portable Scheme, you know that, except for the most trivial of programs, it is much easier said than done. Holm's pstk.scm had a configurable section titled NON-PORTABLE that you had to configure for your chosen implementation. It came full circle and was repackaged as a Chicken egg.

Chicken is a popular Scheme implementation that compiles Scheme to C. Eggs are Chicken-specific extenstion libraries that are stored in a centralized repository (like CPAN but for Chicken Scheme). Instead of building yet another calculator, let's build a GUI for generating a tone.

You'll need Chicken installed. It's available in the repositories of most Linux distros. PS/Tk interfaces with Tk, not with C library bindings, but with a named pipe to tclsh8.6. The TCL package in most Linux distros will provide this. For Debian, I did sudo apt install chicken-bin tcl tk. Once Chicken is installed, you can use the chicken-install utility that comes with it to install the PS/Tk egg.

$ chicken-install -sudo pstk

When you think of Tk, you may think of something that looks like this:

Tk has come a long way in recent years. Tcl/Tk 8.5 and later comes with a new set of widgets built in called Tile or Ttk that can be themed. These widgets are available alongside the classic widgets, so you have to explicitly tell your app to use Ttk or else it will end up looking like it was designed for a 1980s Unix workstation.

(import pstk)

(tk-start)
(ttk-map-widgets 'all) ; Use the Ttk widget set

(tk/wm 'title tk "Bleep")

(tk-event-loop)

All PS/Tk function names begin with tk/ or tk- (or ttk/ and ttk- for the few Ttk-specific functions). The doc directory in the PS/Tk GitHub repo unfortunately has not been updated since this convention was adopted. One example from the docs is start-tk which is now tk-start.

The ttk-map-widgets function is what tells Tk to use the Ttk widgets instead of the classic widgets. Tk comes with a few built-in themes. The default themes on Windows and macOS supposedly do a decent job of approximating the look of native widgets on those platforms. I don't use either of those platforms, so I can't verify this first hand. For some reason, the default theme on Linux is vaguely Windows 95ish. It comes with a built-in theme called clam that is supposed to provide "a look somewhat like a Linux application". You can set this theme with (ttk/set-theme "clam"), but it's really not that much of an improvement.

Ideally, something like gtkTtk that has GTK do the actual drawing would be integrated into Tcl/Tk and become the default on Linux. In the meantime, there are third party themes that imitate the look and feel of the most popular GTK and Qt themes. I use MATE with the Arc GTK theme, so I went with the Arc theme. There was even a Debian package for it (sudo apt install tcl-ttkthemes). We can then apply the theme system wide (echo '*TkTheme: arc' | xrdb -merge -), so that all Tk apps such as git-gui also inherit the theme. It is probably better to give your Linux users instructions on how to install their own theme instead of hard coding one with ttk/set-theme, so they can choose one that matches their system theme (KDE users might pick Breeze while Ubuntu users might opt for Yaru). The screenshots in this tutorial use the Arc theme.

We set the window title with tk/wm and start the event loop with tk-event-loop. We now have an empty window. Now let's add some widgets to this window.

(define slider (tk 'create-widget 'scale 'from: 20 'to: 20000))
(slider 'set 440)
(tk/grid slider 'row: 0 'columnspan: 3 'sticky: 'ew 'padx: 20 'pady: 20)

Widgets are organized hierarchically. This is done by invoking a parent widget with the sub-command create-widget. PS/Tk associates a widget named tk with the top-level window, so most widgets will start as a call to tk (e.g. (tk 'create-widget 'label 'text: "Hello, World!")). Options are quoted and get a trailing colon (e.g. 'text: "Hello, World!").

Creating a widget returns a Scheme function. If you give this function a name, you can call it with sub-commands such as configure, get, and set. Just creating a widget doesn't make it appear on screen. For that you need a geometry manager, of which Tk has three: the packer, the gridder, and the placer (tk/pack, tk/grid, and tk/place in Scheme, respectively).

The scale of 20 to 20,000 is so large that 440 doesn't appear to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript, but it was easy enough to port to Scheme.

; Scale used by slider
(define *min-position* 0)
(define *max-position* 2000)
; Range of frequencies
(define *min-frequency* 20)
(define *max-frequency* 20000)

; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(define min-freq (log *min-frequency*))
(define max-freq (log *max-frequency*))
(define frequency-scale (/ (- max-freq min-freq) (- *max-position* *min-position*)))
; Convert slider position to frequency
(define (position->frequency position)
  (round (exp (+ min-freq (* frequency-scale (- position *min-position*))))))
; Convert frequency to slider position
(define (frequency->position freq)
  (round (/ (- (log freq) min-freq) (+ frequency-scale *min-position*))))

(define slider (tk 'create-widget 'scale 'from: *min-position* 'to: *max-position*))
(slider 'configure 'value: (frequency->position 440))

Underneath the slider is a spin box showing the current frequency and buttons to increase/decrease the frequency by one octave.

; Create a spin box with a units label
; Returns frame widget encompassing both spin box and label and the spin box
; widget itself. This way you can access the value of the spin box.
; e.g. (define-values (box-with-label just-box) (units-spinbox 1 12 6 "inches"))
(define (units-spinbox from to initial units)
  (let* ((container (tk 'create-widget 'frame))
         (spinbox (container 'create-widget 'spinbox 'from: from 'to: to
                             'width: (+ 4 (string-length (number->string to)))))
         (label (container 'create-widget 'label 'text: units)))
    (spinbox 'set initial)
    (tk/pack spinbox label 'side: 'left 'padx: 2)
    (values container spinbox)))

(define lower-button (tk 'create-widget 'button 'text: "<"))
(define-values (frequency-ext frequency-int)
  (units-spinbox *min-frequency* *max-frequency* 440 "Hz"))
(define higher-button (tk 'create-widget 'button 'text: ">"))

(tk/grid lower-button 'row: 1 'column: 0 'padx: 20 'pady: 20)
(tk/grid frequency-ext 'row: 1 'column: 1 'padx: 20 'pady: 20)
(tk/grid higher-button 'row: 1 'column: 2 'padx: 20 'pady: 20)

The frame widget is an invisible widget that helps with layout. Since all I need to arrange within the frame is a spin box and a label, I used tk/pack to pack them side by side. The frame is then organized in a grid with the rest of the widgets. I created a function that I can reuse later to generate the spin box, label, and frame all together. At this point, we are starting to have a nice looking interface, but it doesn't do anything. If you click the buttons or slide the slider, nothing happens. The widgets have a command option that wires the widget up to a function. If we add a command to the slider, that command will be called each time the slider is moved.

(define slider (tk 'create-widget 'scale 'from: *min-position* 'to: *max-position*
                   'command: (lambda (x) (frequency-int 'set (position->frequency x)))))

The command for the slider takes one argument that indicates the new value of the slider. The spin box does have a command option, but the command is only called when the value is changed by clicking the up or down arrow, not when the value is changed by other means such as typing a frequency into the field. Tk has a bind command (the Scheme tk/bind function) that allows binding functions to an event on a widget. We'll bind our callback to the KeyRelase event. The tk/bind function takes up to three arguments. The first is the widget to bind to (or a tag created with tk/bindtags to apply the binding to multiple widgets). The second is the event pattern. The event pattern is surrounded by angle brackets and can specify modifiers, event types, and more. You can find detailed documentation on the event pattern in the Tcl/Tk documentation. The third is a lambda expression to associate with the event.

(tk/bind frequency-int '<KeyRelease> (lambda ()
  ; If frequency value is a valid number, set slider to current value
  (let ((numified (string->number (frequency-int 'get))))
    (when numified
      (slider 'configure 'value: (frequency->position numified))))))

Wire the buttons up to callback functions called decrease-octave and increase-octave. An octave is "the interval between one musical pitch and another with double its frequency."

; Set frequency slider and display
(define (set-frequency freq)
  (when (and (>= freq *min-frequency*) (<= freq *max-frequency*))
    (slider 'configure 'value: (frequency->position freq))
    (frequency-int 'set freq)))

; Buttons increase and decrease frequency by one octave
(define (adjust-octave modifier)
  (set-frequency (* (string->number (frequency-int 'get)) modifier)))
(define (decrease-octave) (adjust-octave 0.5))
(define (increase-octave) (adjust-octave 2))

If you slide the slider, the text field updates accordingly. If you type a number in the text field, the slider updates accordingly. All good, right? What if a user (and you know they will) enters a number higher than 20,000 or a letter?

Let's extend the function that returns our labeled spin box to bind a validation function to the FocusOut event on the spin box. The spin box does have a validatecommand option, but I wasn't able to get it working. I looked through the examples that have come with the various variations of PS/Tk and couldn't find a single example of a spin box with a validatecommand. I even looked at the source code for Bintracker, a chiptune audio workstation written in Chicken Scheme with a PS/Tk GUI and developed by the current maintainer of the PS/Tk egg. Even it binds a validate-new-value function to the Return and FocusOut events of the spin box rather than using validatecommand.

; Create a spin box with a units label
; Returns frame widget encompassing both spin box and label and the spin box
; widget itself. This way you can access the value of the spin box.
; e.g. (define-values (box-with-label just-box) (units-spinbox 1 12 6 "inches"))
(define (units-spinbox from to initial units)
  (let* ((container (tk 'create-widget 'frame))
         (spinbox (container 'create-widget 'spinbox 'from: from 'to: to
                             'width: (+ 4 (string-length (number->string to)))))
         (label (container 'create-widget 'label 'text: units)))
    (spinbox 'set initial)
    (tk/bind spinbox '<FocusOut> (lambda ()
      (let ((current-value (string->number (spinbox 'get))))
        (unless (and current-value
                     (>= current-value from)
                     (<= current-value to))
          (spinbox 'set from)
          ; Also reset slider position to make sure it still matches display
          (slider 'configure 'value: (frequency->position (string->number (frequency-int 'get))))))))
    (tk/pack spinbox label 'side: 'left 'padx: 2)
    (values container spinbox)))

We'll also use this function to create a field to specify the duration of the beep in milliseconds:

(define-values (duration-ext duration-int) (units-spinbox 1 600000 200 "ms"))
(tk/grid duration-ext 'row: 2 'column: 0 'padx: 20 'pady: 20)

Frequency is rather abstract. Let's also give the user the ability to select a musical note. We can store the corresponding frequencies for A4-G4 in an association list.

; Notes -> frequency (middle A-G [A4-G4])
; http://pages.mtu.edu/~suits/notefreqs.html
(define notes '(("A" 440.00)
                ("B" 493.88)
                ("C" 261.63)
                ("D" 293.66)
                ("E" 329.63)
                ("F" 349.23)
                ("G" 292.00)))

(define note-frame (tk 'create-widget 'frame))
(define note (note-frame 'create-widget 'combobox 'width: 2 'values: '("A" "B" "C" "D" "E" "F" "G")))
(tk/bind note '<<ComboboxSelected>> (lambda () (set-frequency (cadr (assoc (note 'get) notes)))))
(define note-label (note-frame 'create-widget 'label 'text: "♪"))
(tk/pack note-label note 'side: 'left 'padx: 2)
(tk/grid note-frame 'row: 2 'column: 2 'padx: 20 'pady: 20)

(import (prefix allegro "al:"))
(import (chicken memory))

(define +pi+ 3.141592)

; Initialize Allegro and audio addon
(unless (al:init) (print "Could not initialize Allegro."))
(unless (al:audio-addon-install) (print "Could not initialize sound."))
(al:reserve-samples 0)

; Generate a tone using Allegro
(define (generate-tone frequency duration)
  (let* ((samples-per-buffer 1024)
         (stream-frequency 44100)
         (amplitude 0.5)
         (stream (al:make-audio-stream 8 samples-per-buffer stream-frequency 'float32 'one))
         (queue (al:make-event-queue))
         (event (al:make-event)))

    (unless (al:audio-stream-attach-to-mixer! stream (al:default-mixer))
      (print "Could not attach stream to mixer."))
    (al:event-queue-register-source! queue (al:audio-stream-event-source stream))

    (let event-loop ((n 0))
      ; Grab and handle events
      (when (and (< n (/ (* (/ duration 1000) stream-frequency) samples-per-buffer))
                 (al:event-queue-wait! queue event))
        (case (al:event-type event) ('audio-stream-fragment
          (let ((buffer (al:audio-stream-fragment stream)))
            ; If the stream is not ready for new data, buffer will be null.
            (if (not buffer) (event-loop n) (begin
              (fill-buffer buffer n) ; Placeholder
              ; Repeat
              (event-loop (+ n 1)))))))))

    (al:audio-stream-drain stream)))

(let ((adr (pointer->address buffer)))
  (let loop ((i 0))
    (when (< i samples-per-buffer)
      (let ((time (/ (+ (* samples-per-buffer n) i) stream-frequency)))
        ; al:audio-stream-fragment returns a C pointer. Use (chicken
        ; memory) module to operate on foreign pointer objects.
        ; Iterate over array four bytes at a time since 32-bit depth.
        (pointer-f32-set! (address->pointer (+ adr (* i 4)))
          (* amplitude (sin (* 2 +pi+ frequency time))))
        (loop (+ i 1)))))
  (unless (al:audio-stream-fragment-set! stream buffer)
    (print "Error setting stream fragment")))

The Allegro egg is a pretty thin wrapper of the Allegro library. The audio-stream-fragment procedure in the egg just passes along the C pointer that the corresponding al_get_audio_stream_fragment function from the C library returns. It would have been nice if the egg had offered some Scheme conveniences atop Allegro like allowing us to pass a Scheme list or array to Allegro to provide the buffer of samples. Since it doesn't, we'll use the chicken memory module to fill the C array starting at the C pointer returned by audio-stream-fragment. We use pointer->address to get the address of the pointer. A pointer refrences a byte of memory. We can reference the preceding or following byte by subtracting or adding 1 to the address. Since we are filling the array with 32-bit floats, and 32 bits is 4 bytes, we want to increment the address by 4 each time. Then we can set the value of the current location with pointer-f32-set!.

Then you just need to feed Allegro buffers of 1,024 samples at a time. The basic formula for a sine wave is A sin(2πft) where A is amplitude, f is frequency, and t is time.

(* amplitude (sin (* 2 +pi+ frequency time)))

Wire this up to a play button, and you're ready to make some noise.

(define play-button (tk 'create-widget 'button 'text: "Play" 'command: (lambda ()
  (generate-tone (string->number (frequency-int 'get)) (string->number (duration-int 'get))))))
(tk/grid play-button 'row: 2 'column: 1 'padx: 20 'pady: 20)

Tk has been around a long time, and it shows. While it is stable and highly portable, even with recent improvements, it just looks a little dated. At least on Linux, none of the themes I tried really fit in. There were always differences that made the Tk GUI stick out like a sore thumb. If you're building an internal tool where it doesn't really matter how pretty it is, you can get Tk to work with a variety of Schemes in a variety of places.

Learn Common Lisp by Example: Qt GUI with EQL5

Matthew D. Miller — Fri, 19 Feb 2021 20:36:48 +0000

Embedded Qt5 Lisp (EQL5) is a Qt5 binding for Embedded Common Lisp (ECL). EQL5 is a bit different than most bindings. Instead of executing your Lisp source with ecl and importing the bindings, you compile a new interpreter (eql5) that combines both ECL and Qt5 bindings. Instead of building yet another calculator, let's build a GUI for generating a tone.

There are ports of EQL5 to Android and iOS, and a work-in-progress port to Sailfish OS, so EQL5 can also be used to develop mobile apps. The "Embedded" part of the name (of both ECL and EQL5) refers to the fact that it can be embedded in existing C++ projects. For this tutorial, we'll be building a standalone desktop app.

Compiling EQL5

EQL5 doesn't appear to be in the repos of any major Linux distro. It is available from AUR on Arch, but since I use Debian, I compiled it from source. Don't worry. It's not as scary as it sounds.

Clone the EQL5 Git repo. EQL5 doesn't appear to have releases or tags, so I guess you just clone master and hope that it's in a workable state.

$ git clone https://gitlab.com/eql/EQL5.git

Install dependencies. This was actually the hardest part. Not the installing. That's just apt install whatever (or the package manager of your preferred distro). There are hundreds of Qt packages on Debian, and it's not always clear what Qt module corresponds to what Debian package (here's a list I found useful). If I got an unknown module error during the make step, I would look the Qt module up in the list on Ask Ubuntu and install the corresponding dev package. I ended up needing to install libqt5svg5-dev, qml-module-qtquick2, qtbase5-dev, qtdeclarative5-dev, qtmultimedia5-dev, qttools5-dev, and qtwebengine5-dev. This will get EQL5 compiled, but if you choose to build your GUI with QML, depending on what import statements you use in your QML file, you'll need some additional packages. To follow this tutorial, you'll also need qml-module-qtquick-controls2, qml-module-qtquick-layouts, qml-module-qtquick-window2. The other dependency you'll need is ECL, and I also recommend installing qml (it is helpful if building your GUI with QML). You can install all the dependencies needed on Debian/Ubuntu with:

$ sudo apt install ecl libqt5svg5-dev qml-module-qtquick2 qtbase5-dev qtdeclarative5-dev qtmultimedia5-dev qttools5-dev qtwebengine5-dev qml-module-qtquick-controls2 qml-module-qtquick-layouts qml-module-qtquick-window2 qml

Navigate into the src subdirectory of the cloned EQL5 Git repo, compile, and install. The -qt5 flag was necessary on Debian, because qmake is a symlink to qtchooser. On other distros, this flag may not be required.

$ cd EQL5/src
$ ecl -shell make
$ qmake -qt5 eql5.pro
$ make
$ sudo make install

Now eql5 should be available to run. Verify it with eql5 -qgui, which will launch a GUI REPL. This also gives you access to some documentation on the EQL5 functions. Go the the Help tab for a searchable list of functions.

Building the GUI with QML

EQL5 supports both Qt Widgets and Qt Quick. They primarily differ in how you define your UI. With Qt Widgets, you declare it procedurally. With Qt Quick, you use a declarative language called QML to define your UI. The underlying implementation of the widgets also differ. Qt Widgets has been around a lot longer and has a broader range of available widgets, but many of these widgets are more desktop-oriented without touch components and not easily adapted for touch. Qt Quick, on the other hand, has been developed from the beginning to work well on touch screens (tablets, smartphones, etc.).

Qt is essentially maintaining two sets of widgets. It would make more sense to me if QML was just an alternative way of specifying which widgets to use instead of a completely new set of widgets, but I'm not a Qt maintainer or even a C++ developer. I guess creating new widgets was easier than adapting the old widgets to be touch friendly.

Qt Quick is sometimes criticized for having a foreign look on the desktop (neither Qt Quick or Qt Widgets use native widgets, but Qt Widgets look more native on the desktop). It also has a smaller set of available widgets. Native look and feel is not important to me, and Qt Quick has plenty of widgets to implement the example in this tutorial. Given a choice between defining a GUI procedurally and declaratively, I'm going to choose the declarative option.

The syntax of QML looks like a cross between JSON and CSS. Objects are specified followed by a pair of braces. Properties of the object are specified with key-value colon-separated pairs. You can create white text on a blue background like this:

import QtQuick 2.0

Rectangle {
  width: 200
  height: 100
  color: "blue"

  Text {
    anchors.centerIn: parent
    color: "white"
    text: "Hello, world!"
  }
}

You can build custom GUI elements out of rectangles and other drawing primitives, but it would be nice to have some pre-defined widgets to use. Let's also import Qt Quick Controls and Qt Quick Layouts. You will need to have both modules installed on your system. They are probably available in your distro's package manager (see above for installing them on Debian).

import QtQuick 2.0
import QtQuick.Controls 2.2
import QtQuick.Layouts 1.2

For maximum compatibility, I recommend specifying the minimum version of modules. You might have Qt Quick Controls 2.15 on the machine your developing on, but one of your users might have an earlier version. Only bump the version if a later version has features you need to use. For example, Layout.margins wasn't introduced until Qt Quick Layouts 1.2. We'll be setting margins in the example we're building with this tutorial, so I imported version 1.2 of Qt Quick Layouts.

We arrange items in our UI using ColumnLayout and RowLayout from Qt Quick Layouts. ColumnLayout arranges its children vertically, and RowLayout arranged its children horizontally. At the top, there will be a slider, so we'll put a Slider within a ColumnLayout.

ColumnLayout {
  id: root

  Slider {
    id: frequencySlider
    from: 20
    value: 440
    to: 20000
    Layout.fillWidth: true
    Layout.margins: 25
  }
}

The range of frequencies audible by humans is typically between 20 Hz and 20 KHz (we lose the ability to hear some of those higher frequencies as we age). The musical note A above middle C is 440 Hz. Since A4 serves as a general tuning standard, it seems like a sensible default. Layout.fillWidth makes the slider take up the full width of the window.

Under the slider, there will be a row (a great use for RowLayout) with two buttons and a spin box (a widget for entering a number within a fixed range).

RowLayout {
  spacing: 25
  Layout.alignment: Qt.AlignHCenter
  Layout.margins: 25

  Button {
    text: "<"
  }

  RowLayout {
    SpinBox {
      id: frequencyField
      editable: true
      from: 20
      value: frequencySlider.value
      to: 20000
    }
    Label { text: "Hz" }
  }

  Button {
    text: ">"
  }
}

Under that is another row of controls: another spin box, a button, and a drop-down menu to select notes from. Frequency is rather abstract. The drop-down gives the user the ability to select a musical note.

RowLayout {
  spacing: 25
  Layout.margins: 25

  RowLayout {
    SpinBox {
      id: durationField
      editable:true
      from: 1
      value: 200
      to: 600000
    }
    Label { text: "ms" }
  }

  Button {
    text: "Play"
  }

  RowLayout {
    Label { text: "♪" }
    ComboBox {
      model: ["A", "B", "C", "D", "E", "F", "G"]
    }
  }
}

I started this project with zero knowledge of QML. I went from Googling "qml" to the complete mockup above in about 30 minutes. I haven't written any of the application logic (in fact, we haven't even touched Common Lisp yet), but you can see how powerful a declarative syntax like QML is for defining GUIs. On big teams, you could even have a designer write the QML while a backend programmer wrote the logic. If you installed the QML viewer above (the qml package on Debian), you can preview your GUI with:

qml bleep.qml

Writing the Logic in Common Lisp

Copy qml-lisp.lisp from the EQL5 example directory (EQL5/examples/M-modules/quick/qml-lisp/qml-lisp.lisp) to your working directory. This enables QML to call Lisp functions and vice versa. I'm not sure why this isn't built into EQL5, but it's easy enough to copy it from the Qt Quick examples that come with EQL5. Also, create a bleep.lisp for the program logic.

(qrequire :quick) ; Have EQL5 use Qt Quick module from Qt
(require :qml-lisp "qml-lisp") ; Load qml-lisp.lisp package copied from example
(use-package :qml) ; Import all external symbols from above package

The qrequire function is part of the EQL5 bindings. It loads a specified Qt module. In our case, we want to load the Qt Quick module. Then we load the Lisp package we copied from the EQL5 examples that enables communication between Lisp and QML. We'll use these two imports to run the QML UI we created above.

(defun run ()
  ; QQuickView provides a window for displaying a Qt Quick user interface:
  ; https://doc.qt.io/qt-5/qquickview.html
  (setf qml:*quick-view* (qnew "QQuickView"))
  (x:do-with qml:*quick-view*
    (|setSource| (|fromLocalFile.QUrl| "bleep.qml"))
    (|setTitle| "Bleep")
    (|show|)))

(run)

The *quick-view* variable is supplied by the qml-lisp.lisp file we copied over (hence the qml namespace). It can be either a QQuickView or QQuickWidget Qt object. We use qnew from EQL5 to create a QQuickView object. The qnew function creates a Qt object of a given class.

The x namespace includes utility functions and macros that come with EQL5. Since this namespace is built into EQL5, I would have thought the qml namespace could have been too. The x namespace does not appear to be documented anywhere. I copied the usage of do-with from the Qt Quick examples that come with EQL5. It basically let's us chain together a bunch of Qt methods on the *quick-view* object.

EQL5 comes with qfun for calling Qt methods on objects. For example, (qfun qml:*quick-view* "show") would call the show method on the qml:*quick-view* object. EQL5 also comes with a shorthand for this: (|show| qml:*quick-view*). We can use this shorthand to set the source of the QQuickView to the QML file we created above, set a title for the window, and finally call the show method to display the window. Execute this with eql5, and you should get a window that looks just like the window you previewed above with qml.

$ eql5 bleep.lisp

You can tell that the default style has been designed to be touch friendly. The handle on the slider is extra big so that it can be dragged with a finger. All the buttons have plenty of padding to make them easy targets. Qt Quick also comes with a platform-agnostic style called Fusion that offers a desktop-oriented look and feel.

There are four ways to set the style. The first is using the QQuickStyle class, but this class is not wrapped by EQL5. The second is to pass a -style command line argument. Asking our user to include a command line argument to get the desired styling seems a bit much. The next option is to set a QT_QUICK_CONTROLS_STYLE environment variable. ECL has ext:setenv for setting environment variables. We'll set the environment variable before defining run and then execute our code again:

; Use the desktop-oriented style Fusion instead of the default
; https://doc.qt.io/QT-5/qtquickcontrols2-styles.html
; EQL5 doesn't wrap the QQuickStyle class so using environment variable
(ext:setenv "QT_QUICK_CONTROLS_STYLE" "fusion")

The scale of 20 to 20,000 is so large that 440 barely appears to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript. We can embed JavaScript directly into our QML, so we could use the JavaScript example. This being a Lisp tutorial, we are going to port it to Common Lisp.

; Scale used by slider
(defparameter *min-position* 0)
(defparameter *max-position* 2000)
; Range of frequencies
(defparameter *min-frequency* 20)
(defparameter *max-frequency* 20000)

; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(defvar min-freq (log *min-frequency*))
(defvar max-freq (log *max-frequency*))
(defvar frequency-scale (/ (- max-freq min-freq) (- *max-position* *min-position*)))
; Convert slider position to frequency
(defun position->frequency (position)
  (round (exp (+ min-freq (* frequency-scale (- position *min-position*))))))
; Convert frequency to slider position
(defun frequency->position (freq)
  (round (/ (- (log freq) min-freq) (+ frequency-scale *min-position*))))

I added some global parameters to the top of the script. The variable name *min-position* is just a Lisp naming convention for global parameters. I came up with the range of 0-2,000 by trial and error. It seemed to strike the best balance between each step of the slider making a noticeable change to the frequency while still allowing the user to narrow in on a specific frequency with just the slider. Then we create two functions: one that takes the position on the slider and returns the frequency (position->frequency) and another that takes a frequency and returns the position on the slider (frequency-position).

It would be useful if these global parameters were available both to Lisp and QML. Qt has a way to embed C++ Objects into QML by setting a context property on the root context. We could pass the string "Bugs Bunny" from C++ to QML this way:

// C++
QString fictionalRabbit = "Bugs Bunny";
view.rootContext()->setContextProperty("fictionalRabbit", fictionalRabbit);

// QML
Text { text: fictionalRabbit }

Using EQL5 and Lisp, it would look like this:

(|setContextProperty| (|rootContext| qml:*quick-view*)
  "fictionalRabbit" (qvariant-from-value "Bugs Bunny" "QString"))

The order is reversed in Lisp compared to C++. Whereas in C++ you have view.rootContext(), in Lisp you do (|rootContext| qml:*quick-view*). The method to call comes first. Then the object to call that method on followed by any additional arguments. The value passed must be a C++ object. EQL5 comes with qvariant-from-value that makes it easy to construct a QVariant of a specified type. That's more than I want to type for every variable I want to export from Lisp into QML, so I whipped up a little helper function:

; Helper function to make Lisp data available in QML
; Allows writing (set-context-property variable-in-lisp "variableInLisp" "QString")
; instead of (|setContextProperty| (|rootContext| qml:*quick-view*)
;   "variableInLisp" (qvariant-from-value variable-in-lisp "QString"))
(defun set-context-property (lisp-var qml-name type-name)
  (let ((root-context (|rootContext| qml:*quick-view*))
        (objectified (qvariant-from-value lisp-var type-name)))
    (|setContextProperty| root-context qml-name objectified)))

Then I added this to my run function:

; Make data available in QML
(set-context-property *min-position* "minPosition" "int")
(set-context-property *max-position* "maxPosition" "int")
(set-context-property *min-frequency* "minFrequency" "int")
(set-context-property *max-frequency* "maxFrequency" "int")

We now need to modify our QML to use these Lisp functions and variables. The first thing we need to do is add another import statement at the top.

import QtQuick 2.0
import QtQuick.Controls 2.2
import QtQuick.Layouts 1.2
import EQL5 1.0

This imports everything we need to call Lisp functions from QML.

If you played around with the QML mockup above, you may have noticed moving the slider automatically updated the spin box underneath it. This was done with a property binding. The value of the spin box was set to frequencySlider.value. Whenever the slider value changes, the spin box value automatically updates. This was fine for a quick mockup, but we'd like for it to work both ways. When you change the value of the spin box, the slider should also automatically update. Unfortunately, QML doesn't support bi-directional property bindings. What we'll do is create a property that we'll bind both the slider and spin box to. Then we'll create handlers in both to update this property.

ColumnLayout {
  id: root

  property real frequency: 440

  Slider {
    id: frequencySlider
    from: minPosition
    value: Lisp.call("frequency->position", root.frequency)
    to: maxPosition
    onValueChanged: root.frequency = Lisp.call("position->frequency", value)
    Layout.fillWidth: true
    Layout.margins: 25
  }

...

    RowLayout {
      SpinBox {
        id: frequencyField
        editable: true
        from: minFrequency
        value: root.frequency
        to: maxFrequency
      }
      Label { text: "Hz" }
    }
...
}

The range for the slider and spin box is now defined using the context properties set in Lisp. To call Lisp functions, use Lisp.call(). It's not pretty (the function name must be quoted and the list comma separated), but it gets the job done. If you run the code with EQL5 from a terminal, you can move the slider, and the spin box will update accordingly, but you'll get a whole bunch of these warnings in your terminal:

QML Slider: Binding loop detected for property "value"

Whenever you move the slider, onValueChanged updates the frequency property. When frequency changes this triggers another update of the slider, which in turn, updates frequency again, creating a loop. Qt Quick Controls 2.2 and later have onMoved in addition to onValueChanged. If you swap onValueChanged out for onMoved, it breaks the loop. With onMoved, the slider only updates the frequency property when interactively moved. When a change to frequency triggers a value change of the slider, it will not be propogated back to frequency avoiding the binding loop.

The other problem with our quick QML mockup upon closer inspection is that the QML spin box only works on integers. We want more precision than that to represent notes. For example, middle C is 261.63. Qt Widgets has QDoubleSpinBox, but Qt Quick doesn't have an equivalent.

There is an example in the Qt documentation of the QML SpinBox on how it can be customized to accept floating point numbers. The example as-is truncates digits after 2 decimal places, thus 500.157 would become 500.15. This is probably contrary to what users expect, so I added Math.round to value and valueFromText.

SpinBox {
  id: frequencyField
  editable: true
  from: minFrequency * 100
  value: Math.round(root.frequency * 100)
  to: maxFrequency * 100
  stepSize: 100
  onValueChanged: root.frequency = value / 100

  property int decimals: 2
  property real realValue: value / 100

  validator: DoubleValidator {
    bottom: Math.min(frequencyField.from, frequencyField.to)
    top: Math.max(frequencyField.from, frequencyField.to)
  }

  textFromValue: function(value, locale) {
    return Number(value / 100).toLocaleString(locale, 'f', decimals)
  }

  valueFromText: function(text, locale) {
    return Math.round(Number.fromLocaleString(locale, text) * 100)
  }
}

On either side of the spin box underneath the slider are buttons to increase/decrease the frequency by one octave. This could be done with a little JavaScript right in the QML, but since this is a Lisp tutorial, we're going to do it with Common Lisp. You can access QML properties from Lisp, but it needs objectName to be set. To have uniform access to QML items from both QML and Lisp, it is convenient to set both id and objectName to the same name.

ColumnLayout {
  id: root
  objectName: "root"

  property real frequency: 440

  ...
}

Note the double quotes around the objectName. It can't be a bare keyword. It must be a string. We can then access properties of this item from Lisp with q< and q> (both from qml-lisp.lisp that we copied over.) They are shorthands for qml-get and qml-set, respectively.

; Buttons increase and decrease frequency by one octave
(defun adjust-octave (modifier)
  (let* ((freq (q< |frequency| "root"))
         (new-freq (* freq modifier)))
    (unless (or (< new-freq *min-frequency*) (> new-freq *max-frequency*))
      (q> |frequency| "root" new-freq))))
(defun decrease-octave () (adjust-octave 0.5))
(defun increase-octave () (adjust-octave 2))

Wire the QML buttons up to these functions. An octave is "the interval between one musical pitch and another with double its frequency."

Button {
  text: "<"
  onClicked: Lisp.call("decrease-octave")
}

...

Button {
  text: ">"
  onClicked: Lisp.call("increase-octave")
}

We gave the user a drop-down menu (combo box) in our QML mockup. Whenever a note is selected from the drop-down menu, we'll look up the frequency in a model and update the frequency property.

ComboBox {
  textRole: "note"
  // Notes -> frequency (middle A-G [A4-G4])
  // http://pages.mtu.edu/~suits/notefreqs.html
  model: [
    { note: "A", freq: 440.00 },
    { note: "B", freq: 493.88 },
    { note: "C", freq: 261.63 },
    { note: "D", freq: 293.66 },
    { note: "E", freq: 329.63 },
    { note: "F", freq: 349.23 },
    { note: "G", freq: 392.00 }
  ]
  onActivated: root.frequency = model[index]["freq"]
}

I also had to add (si::trap-fpe t nil) to the top of my Lisp file. If not, I got a Condition of type: DIVISION-BY-ZERO error whenever trying to expand the combo box. I'm not sure exactly why. I just copied it from one of the Qt Quick examples bundled with EQL5. There were no comments or documentation explaining its purpose.

Now, let's make some noise.

(ql:quickload "cl-portaudio") ; Use Quicklisp to load CL-PortAudio

; Generate a tone using CL-PortAudio
(defun generate-tone (frequency duration)
  (let ((frames-per-buffer 1024)
        (sample-rate 44100d0)
        (amplitude 0.5))
    ; Initialize PortAudio environment
    (portaudio:with-audio
      ; Open and start audio stream
      (portaudio:with-default-audio-stream (astream 1 1
                                            :sample-format :float
                                            :sample-rate sample-rate
                                            :frames-per-buffer frames-per-buffer)
        (dotimes (i (round (/ (* (/ duration 1000) sample-rate) frames-per-buffer)))
          ; Write buffer to output stream
          (portaudio:write-stream astream
            ; portaudio:write-stream requires an array as input, not a list
            (make-array frames-per-buffer :initial-contents
              (loop for j from (+ (* frames-per-buffer i) 1) to (* frames-per-buffer (+ i 1)) collect
                (let ((time (/ j sample-rate)))
                  (* amplitude (sin (* 2 pi frequency time))))))))))))

We'll use Common Lisp bindings to PortAudio to generate the tone. This can be installed with Quicklisp. If you don't already have Quicklisp installed, it's painless. See the Quicklisp website for more details, but here's an example of installing Quicklisp on Debian and configuring ECL. The steps should be the same for any Linux distro and macOS.

$ curl -O https://beta.quicklisp.org/quicklisp.lisp
$ ecl -load quicklisp.lisp
> (quicklisp-quickstart:install)
> (ql:add-to-init-file)

The first time you run bleep.lisp, it will take awhile as Quicklisp downloads CL-PortAudio (by default it will be downloaded to ~/quicklisp). The "proper" way to include this dependency would be to use ASDF and create a .asd file for the project. EQL5 includes an example of how to package an EQL5 app with ASDF. Since this is a quick tutorial, I'll stick with ql:quickload.

(* amplitude (sin (* 2 pi frequency time)))

Wire this up to the play button in the QML, and you're ready to make some noise.

Button {
  text: "Play"
  onClicked: Lisp.call("generate-tone", frequency, durationField.value)
}

Learn Clojure by Example: JavaFX GUI with Cljfx

Matthew D. Miller — Mon, 11 Jan 2021 01:11:21 +0000

Clojure is a dialect of Lisp that runs on the JVM. JavaFX is a modern GUI toolkit for the JVM. You could use JavaFX directly with Clojure's Java interop, but Cljfx provides a declarative and functional wrapper for JavaFX. Instead of building yet another calculator, we're going to use Cljfx to build a GUI for generating a tone.

You'll need Clojure installed. We also need a way to pull the Cljfx dependency into our app. It seems deps.edn would be the easiest way to accomplish this for a short tutorial example such as this, but I develop on Debian and found that the new command line tools for Clojure that enable this haven't made it into Debian yet. I could install Clojure from the Clojure website, but the point of this tutorial is to be easy to follow by someone not familiar with Clojure. It's a lot easier to direct a person to apt install clojure (or whatever package manager your preferred distro uses). This tutorial is a living document maintained on GitHub along with the example code. Whenever the Clojure command line tools become available on Debian, it's possible I'll revisit this tutorial and update it.

The Clojure build tool Leiningen is capable of managing dependencies (and a whole lot more). There is also a build tool for Clojure called Boot. I found more plentiful tutorials and beginner resources for Leiningen, plus Leiningen is available as a Debian package, so for this tutorial, Leiningen it is. Install Clojure and Leiningen from your distro's repo. Debian also has an OpenJFX package, but Leiningen was able to pull OpenJFX in as a dependency of Cljfx. The version pulled in by Leiningen is probably more up to date than whatever might be sitting in your distro's repos.

After that, we need to create a Leiningen project directory. This can be accomplished with lein new app bleep, but that created a directory full of subdirectories and files that were unnecessary for a short little example like this. I created the directory structure (mkdir -p cljfx/src/bleep) and created cljfx/project.clj and cljfx/src/bleep/core.clj with the minimum needed to create a window with Cljfx.

project.clj

(defproject bleep "0.1.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.10.0"]
                 [cljfx "1.7.12"]
                 [com.jsyn/jsyn "20170815"]]
  :main bleep.core)

core.clj

(ns bleep.core
  (:gen-class)
  (:require [cljfx.api :as fx])
  (:import [javafx.application Platform]
           [com.jsyn JSyn]
           [com.jsyn.unitgen LineOut SineOscillator]))

(defn hello-world [& args]
  {:fx/type :label
   :text "Hello, World!"})

(defn root [& args]
  {:fx/type :stage
   :showing true
   :title "Bleep"
   :scene {:fx/type :scene
           :root {:fx/type :v-box
                  :padding 25
                  :spacing 40
                  :children [{:fx/type hello-world}]}}})

(def renderer
  (fx/create-renderer))

(defn -main [& args]
  (Platform/setImplicitExit true)
  (renderer {:fx/type root}))

The project file (project.clj) is the file that tells Leiningen about your project (such as its dependencies). Typically with Leiningen, your code will live in the src subdirectory in a subdirectory that matches the top-level namespace of your project. All this can be changed with your project.clj, but we'll be sticking to convention for this example. In this subdirectory is core.clj.

Begin the file with a namespace declaration. The namespace should have a (:gen-class) declaration in the ns form at the top for Leiningen. Since we'll be using Cljfx to create our GUI, we need to require it. We'll mostly be using JavaFX via Cljfx, but you can also access JavaFX classes directly. Let's import (a way to get Java code into Clojure) the JavaFX Platform class. We'll also import the Java JSyn library for use later in generating the tone.

Leiningen needs a -main function (note the leading dash is part of the function name). This is the function that will get called when you run your app with Leiningen or when you compile it to a standalone JAR. We use the setImplicitExit method from the JavaFX Platform class to make sure the JavaFX runtime shuts down when the window is closed.

Cljfx is declarative instead of imperative or object oriented like many GUI libraries. You describe the layout with a map of key-value pairs instead of creating controls with methods or functions. The :fx/type key has a value of a kebab-cased keyword derived from a JavaFX class name. The other keys of the map are the kebab-cased properties of that class. You can refer to the JavaFX documentation for a list of classes and their properties. JavaFX is well documented and has a large number of controls available.

JavaFX defines the user interface by means of a stage and a scene. The stage is the top-level JavaFX container (the window). The scene is the container for all content. To add a JavaFX class to the map, you convert the class name to kebab-case. For example, JavaFX has a VBox pane used to lay out controls vertically. This would be written :v-box in the Cljfx map. The VBox class has a padding property. We can set this to 25 by adding a :padding key to the map with a value of 25.

Cljfx provides a renderer function created with fx/create-renderer that you pass the map describing your user interface to. You can call renderer multiple times to dynamically change the GUI. Now let's replace the Hello World label with a slider:

(defn frequency-slider [{:keys [frequency]}]
  {:fx/type :slider
   :min 20
   :max 20000
   :value frequency})

Instead of placing the definition of your entire UI into one big map, you can compose the UI from reusable functions. This also makes your code more readable, because you don't have a deeply nested map. These functions can be used just like any other JavaFX class. The :fx/type key is the function name, and the other keys of the map are the arguments to the function. We can add the frequency-slider we created above to the :children vector of the :v-box in the root map like this:

[{:fx/type frequency-slider
  :frequency 440}]

The scale of 20 to 20,000 is so large that 440 doesn't appear to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript, but it was easy enough to port to Clojure.

; Scale used by slider
(def min-position 0)
(def max-position 2000)
; Range of frequencies
(def min-frequency 20)
(def max-frequency 20000)

; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(def min-freq (Math/log min-frequency))
(def max-freq (Math/log max-frequency))
(def frequency-scale (/ (- max-freq min-freq) (- max-position min-position)))
; Convert slider position to frequency
(defn position->frequency [position]
  (int (Math/round (Math/exp (+ min-freq (* frequency-scale (- position min-position)))))))
; Convert frequency to slider position
(defn frequency->position [freq]
  (int (Math/round (/ (- (Math/log freq) min-freq) (+ frequency-scale min-position)))))

I added some global parameters to the top of the script. I came up with the range of 0-2,000 by trial and error. It seemed to strike the best balance between each step of the slider making a noticeable change to the frequency while still allowing the user to narrow in on a specific frequency with just the slider.

(defn frequency-slider [{:keys [frequency]}]
  {:fx/type :slider
   :min min-position
   :max max-position
   :value (frequency->position frequency)})

Underneath the slider is a text field showing the current frequency.

(defn frequency-controls [{:keys [frequency]}]
  {:fx/type :h-box
   :alignment :center
   :spacing 20
   :children [{:fx/type :h-box
               :alignment :center
               :spacing 5
               :children [{:fx/type :text-field
                           :text (str frequency)}
                          {:fx/type :label
                           :text "Hz"}]}]})

Add this to the :children vector of the :v-box in the root map:

[{:fx/type frequency-slider
  :frequency frequency}
 {:fx/type frequency-controls
  :frequency frequency}]

At this point, we are starting to have a nice looking interface, but it doesn't do anything. If you slide the slider, nothing happens. If your experience is mostly with object-oriented GUI libraries, the way Cljfx does things will be a little unfamiliar. If you've used the JavaScript library React, it employs a similar model. Global state is stored in an atom. When you update that atom, all the relevant controls are updated accordingly.

; Cljfx global state
(def *state
  (atom {:frequency 440}))

Add middleware to the renderer that maps incoming data from the global state atom to the component description to be rendered:

(def renderer
  (fx/create-renderer
    :middleware (fx/wrap-map-desc assoc :fx/type root)))

Then modify -main to use fx/mount-renderer instead of calling renderer directly. This will watch the global state atom for changes and rerender the GUI accordingly.

(defn -main [& args]
  (Platform/setImplicitExit true)
  (fx/mount-renderer *state renderer))

In most of the other examples, I would now write a function for each control that updates the other controls when its value changes. For example, the slider must update the text field, and the text field must update the slider. Imagine in the future I decide to add a meter to the UI that also needs to be updated whenever the frequency changes. I would have to remember to add code to update the meter to both the slider and the text field. With Cljfx, the slider just has to update the value in the global state atom. Then the text field and any controls we add in the future that depend on the frequency will automatically update. Here's a function that will update the global state atom:

; Update frequency in global state if it's a valid frequency
(defn set-frequency [freq]
  (when (and (>= freq min-frequency) (<= freq max-frequency))
    (swap! *state assoc :frequency freq)))

Then we can add an :on-value-changed property to the :slider that calls this function:

:on-value-changed #(set-frequency (position->frequency %))

and add an :on-text-changed property to the :text-field:

:on-text-changed #(set-frequency (read-string %))

And that's it. When one changes, the other does too. Once you get your head around it, it's a really elegant way to handle UI state.

It might be helpful to have a couple buttons to increase or decrease the frequency by an octave. An octave is "the interval between one musical pitch and another with double its frequency."

(defn octave-button [{:keys [frequency label modifier]}]
  {:fx/type :button
   :text label
   :on-action (fn [_] (set-frequency (* frequency modifier)))})

Now just add these buttons to the :children vector of the :h-box in the frequency-controls map:

[{:fx/type octave-button
  :frequency frequency
  :label "<"
  :modifier 0.5}
 {:fx/type :h-box
  :alignment :center
  :spacing 5
  :padding {:top 0 :bottom 0 :left 20 :right 20}
  :children [{:fx/type :text-field
              :text (str frequency)
              :on-text-changed #(set-frequency (read-string %))}
             {:fx/type :label
              :text "Hz"}]}
 {:fx/type octave-button
  :frequency frequency
  :label ">"
  :modifier 2}]

JavaFX has a TextFormatter class for this purpose. The TextFormatter uses a filter that can intercept and modify user input and a value converter that converts the value of the text field to a specified type whenever the field loses focus or the user hits Enter. The filter should be a function that accepts a Java TextFormatter.Change object and either returns that object or returns null (nil in Clojurese) to reject the change.

; Text field limited to entering numbers within range that updates specified
; key in global state atom (state-key)
(defn num-filter [change]
  (let [input (.getControlNewText change)
        numified (read-string input)]
    (if (or (= input "") (number? numified))
        change
        nil)))
(defn number-field [{:keys [min-value max-value init-value state-key label]}]
  {:fx/type :h-box
   :alignment :center
   :spacing 5
   :padding {:top 0 :bottom 0 :left 20 :right 20}
   :children [{:fx/type :text-field
               :pref-column-count (+ 1 (count (str max-value)))
               :text-formatter {:fx/type :text-formatter
                                :value-converter :number
                                :filter num-filter
                                :value init-value
                                :on-value-changed #(cond (< % min-value) (swap! *state assoc state-key min-value)
                                                         (> % max-value) (swap! *state assoc state-key max-value)
                                                         :else (swap! *state assoc state-key %))}}
              {:fx/type :label
               :text label}]})

Cljfx doesn't provide wrappers for the methods of TextFormatter.Change, but we can call the getControlNewText() method using Clojure's Java interop. This method returns the complete new text wich will be used on the control after the change. We can check this value to determine if we want to accept the change or not.

A caveat here is that the value of :filter must be a top-level️ function. I wish I could define :filter as an anonymous function. This would allow me to do something like also preventing the user from even entering a number higher than the allowed range rather than just reverting to the maximum value once the value is committed.

:filter #(let [input (.getControlNewText %])
               numified (read-string input)]
           (if (or (= input "") (and (number? numified) (<= max-value)))
               %
               nil))

If you try the above, it will throw a Replace forbidden error. That's because :filter is a constructor argument of TextFormatter that cannot be modified afterward. If you use an anonymous function, every call to number-field (whenever the UI is being rerendered due to a change of state) will try to create a new instance of the filter function, which is forbidden. But by making num-filter a top-level function, it is now out of the scope of max-value. I tried passing max-value to it by wrapping num-filter with a function that takes max-value and calling that function in :filter, but that still resulted in Replace forbidden. I also tried defining max-value at the top-level and wrapping the map inside number-field with binding to reassign the value of max-value, but since num-filter is being passed to the TextFormatter and called later it is called outside the scope of the binding and still unable to see max-value. I finally gave up and fell back on just having the field revert to max-value once the value is committed. If anyone has a solution for getting max-value to the num-filter function, I welcome pull requests.

Now let's replace the baseline :text-field and the :h-box surrounding it with our new number-field:

{:fx/type number-field
 :min-value min-frequency
 :max-value max-frequency
 :init-value frequency
 :state-key :frequency
 :label "Hz"}

Let's use this number-field again to create a field to specify the duration of the beep in milliseconds. First, let's add a key to our global state atom to track duration:

(def *state
  (atom {:frequency 440
         :duration 200}))

Then create our duration field:

(defn general-controls [{:keys [frequency duration]}]
  {:fx/type :h-box
   :spacing 20
   :children [{:fx/type number-field
               :min-value 1
               :max-value 600000 ; 10 minutes
               :init-value duration
               :state-key :duration
               :label "ms"}]})

Add this to the :children vector of the :v-box in the root map:

[{:fx/type frequency-slider
  :frequency frequency}
 {:fx/type frequency-controls
  :frequency frequency}
 {:fx/type general-controls
  :frequency frequency
  :duration duration}]

Frequency is rather abstract. Let's also give the user the ability to select a musical note. We can store the corresponding frequencies for A4-G4 in a map.

; Notes -> frequency (middle A-G [A4-G4])
; http://pages.mtu.edu/~suits/notefreqs.html
(def notes {"A" 440.00
            "B" 493.88
            "C"261.63
            "D" 293.66
            "E" 329.63
            "F" 349.23
            "G" 292.00})

We'll give the user a drop-down menu. Whenever a note is selected from the drop-down menu, we'll look up the frequency in the map and set that frequency in the global state atom. We'll add it on to general-controls:

(defn general-controls [{:keys [frequency duration]}]
  {:fx/type :h-box
   :spacing 20
   :children [{:fx/type number-field
               :min-value 1
               :max-value 600000 ; 10 minutes
               :init-value duration
               :state-key :duration
               :label "ms"}
              {:fx/type :h-box
               :alignment :center
               :spacing 5
               :children [{:fx/type :label
                           :text "♪"}
                          {:fx/type :choice-box
                           :items ["A" "B" "C" "D" "E" "F" "G"]
                           :on-value-changed #(set-frequency (notes %))}]}]})

Finally, let's make some noise.

; Generate a tone using JSyn
; Adapted from https://github.com/daveyarwood/javasynth/blob/master/src/javasynth/getting_started.clj
(defn generate-tone [frequency duration amplitude]
  (let [synth (doto (. JSyn createSynthesizer) .start)
        out (LineOut.)
        sine (SineOscillator. frequency)]
    (.set (. sine -amplitude) amplitude)
    (.add synth out)
    (.add synth sine)
    (.connect (. sine -output) (. out -input))
    (let [now (. synth getCurrentTime)]
      (.start out)
      (. synth (sleepUntil (+ now (/ duration 1000))))
      (.stop synth))))

We'll use the Java JSyn library we imported at the very beginning to generate the tone. Leiningen will pull in this dependency alongside Cljfx. Java has a standard Sound API that could be used to generate a sine tone without any external dependencies, but it's a little too low-level for what I'm trying to accomplish with this tutorial. This is a tutorial about building a GUI with Clojure and not about sound processing with Clojure. If you're interested, I did find a well-written tutorial about using Clojure's Java interop to generate a sine tone with Clojure via the Java Sound API. Wire this function up to a button between the duration and note selector, and you're ready to make some noise.

(defn general-controls [{:keys [frequency duration]}]
  {:fx/type :h-box
   :spacing 20
   :children [{:fx/type number-field
               :min-value 1
               :max-value 600000 ; 10 minutes
               :init-value duration
               :state-key :duration
               :label "ms"}
              {:fx/type :button
               :text "Play"
               :on-action (fn [_] (generate-tone frequency duration 0.5))}
              {:fx/type :h-box
               :alignment :center
               :spacing 5
               :children [{:fx/type :label
                           :text "♪"}
                          {:fx/type :choice-box
                           :items ["A" "B" "C" "D" "E" "F" "G"]
                           :on-value-changed #(set-frequency (notes %))}]}]})

SELinux Has a UI Problem

Matthew D. Miller — Tue, 09 Apr 2019 17:31:18 +0000

If you ever troubleshoot a problem on Red Hat (or closely related distros such as Fedora and CentOS), you'll come across dozens of tutorials and articles that tell you to resolve the problem by disabling SELinux. It's not just random blog posts and questionable StackOverflow answers: I've seen this advice in the documentation and knowledge base articles for enterprise software.

Don't disable SELinux. Really, don't turn off SELinux.

A post on the official CentOS blog asks "[W]hy do articles feel the need to outright deactivate SELinux rather than help readers work through any problems they might have? Is SELinux that hard? Actually, it's really not." It doesn't have anything to do with SELinux being too difficult. SELinux has a UI problem.

When you say user interface (UI) design or user experience (UX), most people immediately think about graphical user interfaces (GUIs). A good UI is just as important for a command line application. If a command requires a lot of cumbersome flags or difficult-to-remember options, a user may use another app or *gasp* a GUI to accomplish the task. A software library also has a UI. The API is the UI with which a developer interacts with the library.

While SELinux is usually invisible to the user, it does have a UI. I'm not talking about the various tools including some GUIs that allow administrators to set policy. I'm talking about how SELinux gives the user feedback when they attempt to do something that is blocked by SELinux on why it was blocked or even that it was SELinux that blocked it.

Like any good sysadmin, I periodically run yum update to make sure I'm protected from any newly discovered vulnerabilities, but it is not without some trepidation that I do this. It's not often, but sometimes it breaks something that was working perfectly fine before.

The other day I did yum update on a server running Tomcat (fortunately, I did it on the test server first). Tomcat was working fine, but the web app deployed to Tomcat had stopped working. I tried redeploying the app and restarting Tomcat. Still nothing, so I then checked the Tomcat logs:

org.apache.commons.dbcp.SQLNestedException: Cannot create PoolableConnectionFactory (IO Error: The Network Adapter could not establish the connection)
Caused by: java.sql.SQLRecoverableException: IO Error: The Network Adapter could not establish the connection
Caused by: oracle.net.ns.NetException: The Network Adapter could not establish the connection
Caused by: java.net.ConnectException: Permission denied (connect failed)

There is absolutely nothing here that indicates SELinux is even the problem. Yes, the end of the stack trace is Permission denied, but that sounds like it could mean the database account the web app is using is locked. I verified I was able to access the database over the network (I ran a simple query using SQL Developer from my workstation), I verified the server Tomcat was on in particular could access the database over the network (I ran a simple query using SQL*Plus), and I made sure the database account used by the web app was not locked.

I then turned to the web app vendor's support site. They had a knowledge base article on the error. It turns out a tomcat_can_network_connect_db SELinux boolean was added in RHEL 7.6. There is nothing special about a RHEL point release. They're basically just new installation media. All you need to do is install RHEL 7.x, and a yum update will get you to the latest point release. Setting aside that one shouldn't expect any breaking changes in a point release, it should have been made abundantly clear to the user when Tomcat couldn't connect to a database that the reason was this new SELinux boolean. This is a UI issue.

Most servers don't have a desktop environment installed. The primary way a user (here I'm talking about a user of the server such as an administrator not a user of the web app) interacts with the server is via SSH. In the case of servers, logs often are the UI.

Tomcat is where the problem was, so where am I going to look for the issue? In the Tomcat log, of course. A user-friendly UI then would put some kind of indication in the Tomcat log right alongside the database error that the database connection had been blocked by SELinux. I'm sure SELinux logged the policy violation in its own log, but that is only helpful if I know that SELinux is the issue. That's poor UI design on the part of SELinux.

Some might argue the blame is with Tomcat. Tomcat should log a more helpful error that indicates the issue is SELinux. Tomcat may not have been aware that the issue was SELinux. Tomcat runs on a variety of platforms and Linux distros, many of which do not have SELinux. The Tomcat developers may be unaware of changes to SELinux that could effect Tomcat. SELinux, on the other hand, knew this change would potentially break many Tomcat setups (tomcat is in the name of the boolean). I wasn't using a third-party build of Tomcat either; I was using the Tomcat straight from the Oracle Linux (based on RHEL) repo and journalctl -u tomcat to view the logs. Since everything is logged centrally via systemd, it seems SELinux should be able to log messages there as well. Why else force all logging through systemd? (I am no hater of systemd and actually think creating system services with systemd is a breeze compared to SysV-style init, but I'm not a fan of the way systemd handles logging.)

Why do so many people and vendors just recommend turning off SELinux? Because the SELinux UI is not user-friendly. In fact, the knowledge base article I found on the vendor's support site said the way to resolve the problem was to edit /etc/selinux/config and set SELINUX=disabled. I didn't do that. Since the article already identified the boolean, I turned that specific boolean on with setsebool -P tomcat_can_network_connect_db 1 (the -P flag causes the change to persist after reboots).

This isn't an isolated experience. One time I was trying to configure Apache to serve files in a home directory. There was nothing in the Apache logs to indicate SELinux was the issue. I spent hours messing with file permissions and chmoding directories before discovering the SELinux boolean httpd_enable_homedirs.

I feel the benefits of SELinux outweigh the inconvenience of the poor UI. I spent time troubleshooting the database when the problem had nothing to do with the database. I often use open source projects with a poor UI, because I feel the benefits of open source outweigh the bad design (though there are instances where I think the open source solution actually has a superior UI than its proprietary alternatives). But it would be nice if SELinux had a better UI, and if we want to win new users to open source, we need to improve our UI. SELinux needs to get better about indicating when something is blocked by SELinux in the location where the user is going to be looking for the problem (e.g. in the Tomcat log for Tomcat issues or the Apache log for Apache issues).

Monetizing Open Source on Proprietary Platforms

Matthew D. Miller — Wed, 03 Apr 2019 06:10:59 +0000

Open source has a monetization problem, but solving it is a sensitive issue. There was quite a stir over MongoDB changing their licensing. There was an uproar over Caddy charging for commercial use for binaries while this is something explicitly allowed by the Free Software Foundation: "The word 'free' has two legitimate general meanings; it can refer either to freedom or to price. When we speak of 'free software', we're talking about freedom, not price. (Think of 'free speech', not 'free beer'.)"

One interesting licensing model I've seen is that of jOOQ, a Java ORM. You can use the open source edition with open source databases (like PostgreSQL, MariaDB, and SQLite) but for proprietary databases (such as Oracle and SQL Server) you'll need one of the paid editions. In a way, this make sense: The developer has free access to develop against and test the ORM with open source databases, but the proprietary databases would require the developer have (sometimes costly) licenses for those databases.

I'm working on a couple projects in my spare time. Like all good hobbyist projects, they scratch an itch I have. I'm developing them first and foremost for myself, to solve problems I have. There may be other people out there with the same problems. If the projects pan out, I plan to upload them to GitHub under an open source license so they might benefit from them as well.

I develop on and solely use Linux, so I'm developing these projects first for Linux. What if Windows and Mac users could benefit from them as well? I don't currently have any way to test them on Windows or Mac. Even a used Mac mini is not cheap. Windows wouldn't require the purchase of any additional hardware since I could run it in VirtualBox, but unless I download a pirated copy (which I don't intend to do), I assume a Windows license would cost me something. I don't have any other use for Windows or Mac, so it would seem reasonable to charge for the Windows and Mac versions.

I guess if the projects become popular enough and there really is demand for a Windows and/or Mac version, I could just wait for Windows and Mac developers to come along and submit pull requests adding build instructions for those platforms to the README and any necessary code changes. I've never developed a cross-platform desktop app, but I've worked enough with getting JavaScript to work in different browsers to know at least some code changes will be likely.

I wouldn't push any of the code necessary to make them compatible with Windows and Mac to the public repo, but that wouldn't stop someone else submitting a pull request or just forking the project. Unless the projects do become popular, I'm unlikely to recoup my investment in the Mac hardware and Windows licensing.

I could instead offer paid consulting or support related to the software, but both of these options seem like way too much work to me. I already have a full-time job and a part-time ministry position. The whole point of these projects is something fun in my spare time, but who doesn't dream of making a little money off their side projects? Any time spent consulting or providing support would take away from what little spare time I have to work on the projects anyway. Selling Windows and Mac versions of the software would be a more passive source of extra income.

Would I be better off just keeping the projects hobbyist projects? If others want to contribute Windows and Mac compatibility, so be it. If not, no sweat. Even though Windows and Mac are themselves proprietary platforms, would charging for my software on those platforms go against the spirit of open source? Is offering compatibility with proprietary platforms only in a paid edition a legitimate way to monetize open source?

Vala Deserves a Closer Look

Matthew D. Miller — Mon, 01 Apr 2019 22:23:49 +0000

This is not really a post about Vala--though I do think Vala deserves a closer look. It is about the general philosophy of evaluating programming languages. I also wrote a post that's not really about Perl.

There are so many programming languages out there that it's difficult to determine which are worth my attention. I've recently started looking for a new language to learn in an effort to continue expanding my tool set. I have an ever growing list of programming languages I would like to learn someday. One language that was not on that list was Vala.

I had dismissed Vala as a GNOME thing with little interest to those outside the GNOME community, but recently I had seen Vala pop up in a few unexpected places, so I decided to give it a closer look.

One of the ways I evaluate a programming language is to see what cool projects are being built with it. The way I do this is by going to GitHub's trending page and selecting the language from the Languages drop-down on the right.

If all I find is the language interpreter/compiler, a web application framework, and a few assorted libraries, I'm not usually going to spend much time on that language. I'm interested in languages that people are using to build cool things. Every language (no matter how obscure) seems to have at least one web application framework these days. The trending page for Crystal this month shows no fewer than four web frameworks: Amber, Amethyst, Kemal, and Lucky. Forth has 1991. Nim has Jester. Smalltalk has Seaside.

Nor do I really care that much about module counts. Your language may have four different libraries to parse JSON and multiple ORMs, but what I want to know is what are people building with those libraries. If people are building cool projects with a language, I think a strong ecosystem and useful libraries will follow.

I realize GitHub might not host all the cool things being done in a language, but I feel it is representative. Maybe cool things are being done in a language but they are proprietary. If a language is fun to use, I think it will be used for both proprietary and open source projects, so I think open source projects sufficient to judge a language. There could also be cool projects on SourceForge, GitLab, etc. For now, GitHub has by far the largest collection of open source projects, so it serves to give a pretty good survey of what is available in a given language.

The Part about Vala

I guess since I do have Vala in the title, I should share some of the cool projects being built with Vala that convinced me to give it a closer look.

Akira. This is a UI/UX design tool for creating UI mock-ups. It hasn't even had a stable release yet, and it already has 1,526 stars on GitHub and $560/month pledged on Patreon. It has a really cool mascot too. The lead developer also has a SQL client and FTP client written in Vala.
Birdfont. Font editor. Many Linux distro's have packages in their repos, and there is a package in OpenBSD. There are also binaries for Windows and Mac. This project is evidence that Vala is not limited to GNOME. I also found it funny that GitHub thinks 11.3% of the source is written in Brainfuck because of the .bf extension used for fonts in the Birdfont format.
Peek. GIF screen recorder. Packaged for a lot of distros. Could be useful for creating animated screenshots for READMEs.
pdfpc. Presenter console with multi-monitor support for PDF files. Vala must be easy to learn or there are a lot of developers who already know it, because some of these projects are able to draw a lot of contributors. This project has 43 contributors with the latest commit 19 days ago.
Timeshift. System restore tool for Linux. This is another Vala project with a small but active community. It has 30 contributors and users submitting issues and pull requests.
Final Term. This was a terminal emulator with advanced features. It's no longer maintained, but it was very popular (it has 3,999 stars on GitHub).
Most of the default apps in elementary OS are written in Vala. I haven't used it (I won't give up my MATE desktop), but elementary OS is a popular Linux distro (currently #4 on DistroWatch). It's app store, audio player, calculator, calendar, email client, file manager, image viewer, panel, screenshot tool, terminal emulator, text editor, video player, and even it's window manager are all written in Vala. I question the necessity of needing to write so many of their own apps when there are already so many great options available for many of these, but they do have a consistent design aesthetic and ecosystem. Many third party apps written for elementary OS (but working with other distros) are also written in Vala (such as this eBook reader and focused writing app).
Deepin is a popular Linux distro in China with it's own desktop environment. Unlike elementary OS which uses GTK, it uses Qt, yet it still employs Vala for a couple things. It's terminal emulator and it's window manager (which started out as a fork of the elementary OS window manager) are both written in Vala.
There are some official GNOME apps written in Vala, but surprisingly, since Vala is a GNOME project, not very many. The GNOME disk usage analyzer, backup tool, and photo manager are written in Vala.
There's even a web application framework written in Vala.

Vala may not have developers who "rewrite all the things" like Rust or the backing of a tech giant like Go and Reason. I've been averaging a new programming language every seven years, so this is a big decision. I'm taking my time. I'm considering making Rust or D my next language, but now I'm also considering Vala.

Learn LambdaNative by Example: Desktop GUI

Matthew D. Miller — Wed, 27 Mar 2019 21:19:28 +0000

This tutorial was updated on January 10, 2021 to generate a tone using LambdaNative instead of merely wrapping a Linux-only command-line program called beep that controls the PC speaker. This should now make it possible to follow this tutorial on any OS supported by LambdaNative. This tutorial can also be found in the GitHub repo with the example code. Pull requests for improving the example and tutorial are welcome.

LambdaNative is a cross-platform framework for developing desktop and mobile apps using Scheme (built atop Gambit). Resources on LambdaNative seem to be extremely scarce. I couldn't find a single step-by-step tutorial for using LambdaNative, so hopefully my small contribution will benefit others trying to get started with LambdaNative.

LambdaNative already includes a calculator demo, and frankly, I find making a millionth calculator example to be a little dull. Instead I'll be building a GUI for generating a tone. We're only going to be building a desktop GUI, so we aren't going to be tapping into the full power of LambdaNative. Where it seems LambdaNative would really be useful is enabling you to write cross-platform mobile apps with Scheme! Unfortunately, that is outside the scope of this tutorial. Maybe in the future I'll revisit LambdaNative and use it to create a mobile app.

Installing LambdaNative

The LambdaNative wiki gives a list of dependencies that need to be installed with your distro's package manager before installing LambdaNative. They give an apt command you can copy and paste to your terminal to install all the needed dependencies on Ubuntu.

Download the most recent release.
Unzip the release to a system-wide location such as /opt or /usr/local.

sudo unzip lambdanative-*.zip -d /opt

Rename unzipped directory.

cd /opt
sudo mv lambdanative* lambdanative

Create the files SETUP and PROFILE. If you were developing a mobile app, you would need to configure these files for the respective SDKs. Since that is outside the scope of this tutorial, that is left as an exercise for the reader.

cd lambdanative
sudo cp SETUP.template SETUP
sudo cp PROFILE.template PROFILE

Edit scripts/lambdanative and populate the LAMBDANATIVE variable with /opt/lambdanative.

LAMBDANATIVE=/opt/lambdanative

Place the LambdaNative initialization script in the system path.

sudo ln -s /opt/lambdanative/scripts/lambdanative /usr/bin/lambdanative

Create and initialize a LambdaNative build directory.

mkdir ~/lambdanative
cd ~/lambdanative
lambdanative init

Creating a New GUI App

Your freshly initiated build directory will look like this:

apps/
modules/
configure
Makefile

Your app will go in its own subdirectory in apps. To create a new app:

lambdanative create <appname> <apptype>

The options for <apptype> are console, gui, and eventloop. I created a new GUI app called bleep:

lambdanative create bleep gui

This will create a directory in apps called bleep with several files in it.

Compiling the App

LambdaNative utilizes the GNU Build System.

./configure bleep
make
make install

By default, the build will target the local host. The first time you do this will take awhile, because it is downloading and compiling prerequisites. These prerequisites are cached to speed up subsequent compiles. If you get any errors during the initial build, you probably missed installing a dependency. Install it with your distro's package manager and then try compiling again.

You can also configure in debug mode. You will want to clean the cache with make scrub so everything is rebuilt. It will take awhile since everything is being rebuilt.

./configure bleep debug
make scrub
make
make install

In my experience, debug mode didn't help much. Runtime errors are logged to ~/Desktop/log/*.txt.

[SYSTEM] 2019-03-16 00:59:21: Application bleep built 2019-03-16 00:59:14
[SYSTEM] 2019-03-16 00:59:21: Git hash
[ERROR] 2019-03-16 00:59:22: primordial: (assoc 49 #f): (Argument 2) LIST expected
[ERROR] 2019-03-16 00:59:22: HALT

Not very helpful, is it? So I enabled debug mode.

[SYSTEM] 2019-03-16 01:16:44: Application bleep built 2019-03-16 01:16:34
[SYSTEM] 2019-03-16 01:16:44: Git hash
[ERROR] 2019-03-16 01:16:44: primordial: (assoc 49 #f): (Argument 2) LIST expected
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/primitives.scm line=230 col=21
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/primitives.scm line=273 col=21
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/slider.scm line=80 col=8
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/glgui.scm line=151 col=36
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/glgui.scm line=145 col=11
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/ln_glgui/glgui.scm line=183 col=3
[ERROR] 2019-03-16 01:16:44: trace: /opt/lambdanative/modules/eventloop/eventloop.scm line=151 col=9
[ERROR] 2019-03-16 01:16:44: HALT

It's definitely longer but still not very helpful. It actually includes line numbers, which appears promising, but they are all line numbers in LambdaNative modules. It doesn't actually trace the error all the way to the line in my app causing the error. I spent a lot more time reading the source of the LambdaNative modules than I would have liked.

And that's when the log file even contained an error. Sometimes the app failed with a segmentation fault and there was no error in the log at all. I often peppered my source with (log-status "reached here") and tail -f the log file to debug and isolate errors.

Errors caught at compile time, on the other hand, were much nicer. If an error occurred while compiling, the error message included the line number from my app.

The development workflow is more akin to traditional compiled languages like C. I missed the quick feedback I'm used to while developing Scheme on a REPL. After the initial compile, subsequent compiles are much quicker.

$ time make

real  0m3.877s
user  0m2.652s
sys   0m0.605s

Four seconds can seem like a long time when you are making a series of small changes or chasing down a bug. There is a module for REPL editing with Emacs. Since I don't use Emacs, I didn't give it a spin, but if I was developing a larger app, I might give it a try.

The install step will move the executable to ~/Desktop/bleep/bleep and launch it. This will launch a rectangular window.

This window looks awful lonely. Let's add some widgets!

Coding the App

If your interface will use text (such as labels on buttons), you must include a FONTS file in your application subdirectory. I just copied the FONTS file from one of the demos included with LambdaNative.

cd apps/bleep
cp /opt/lambdanative/apps/LineDrop/FONTS .

This is what the file looks like:

DejaVuSans.ttf 8 18,25 ascii

For a description of the file format, see the documentation of the file on the LambdaNative wiki.

Your application subdirectory will already contain a main.scm. This file contains the basic skeleton for a GUI app (the black rectangle above):

;; LambdaNative gui template

(define gui #f)

(main
;; initialization
  (lambda (w h)
    (make-window 320 480)
    (glgui-orientation-set! GUI_PORTRAIT)
    (set! gui (make-glgui))

    ;; initialize gui here

  )
;; events
  (lambda (t x y)
    (if (= t EVENT_KEYPRESS) (begin
      (if (= x EVENT_KEYESCAPE) (terminate))))
    (glgui-event gui t x y))
;; termination
  (lambda () #t)
;; suspend
  (lambda () (glgui-suspend) (terminate))
;; resume
  (lambda () (glgui-resume))
)

;; eof

I started by changing the comment at the top to

;; bleep - GUI for generating a tone made with LambdaNative

The bulk of the skeleton consists of the event loop. The (main p1 p2 p3 p4 p5) loop takes five functions as arguments:

Parameter	Description
p1	Function to be run before the main loop is initialized. This is where you setup the GUI.
p2	Main loop function, which is called constantly throughout the application's life. This is where you listen for events like key presses. Since most widgets take a callback, you shouldn't need to do much in this area.
p3	Function to be run when the application is to be terminated.
p4	Function, which is called when the application is suspended.
p5	Function, which is called when the application is resumed.

The functions supplied in the skeleton for p3, p4, and p5 should be sufficient for most applications. We won't need to touch them.

(make-window 540 360)
(glgui-orientation-set! GUI_LANDSCAPE)

I started by changing the dimensions and orientation of the window. Now let's add some widgets to that initialization lambda. I copy and pasted the example from the bottom of the slider documentation page.

(set! sl (glgui-slider gui 20 20 280 60 1 5 #f White White Orange Black num_25.fnt num_20.fnt #f White))
(glgui-widget-set! gui sl 'showvalue #t)

If you are familiar with Scheme, that set! probably made you pause. Too many exclamation marks in my Scheme code always make me nervous. I immediately start wondering if there is a better way to write the code. As it should. Side effects should be avoided when possible. I tried changing the set! to define and got the following error when recompiling:

*** ERROR IN "/home/matthew/lambdanative/apps/bleep/main.scm"@97.5 -- Ill-placed 'define'

Gambit (the underlying Scheme implementation used by LambdaNative) only allows defines at the beginning of a lambda body. This actually conforms with the R[5-7]RS specs, but I'm used to Scheme implementations (such as Racket, Chicken, and MIT/GNU Scheme) that allow define anywhere in a lambda body. All the LambdaNative examples and demos use set!, so I used it as well.

We must specify the color for several elements of the slider. LambdaNative doesn't use native widgets but draws its own widgets with OpenGL. I googled "color schemes" for inspiration and specified a few colors at the top of the script above the (main) loop that I could reference throughout the program.

;; UI color palette
(define *background-color* (color-rgb 26 26 29))
(define *foreground-color* (color-rgb 195 7 63))
(define *accent-color* (color-rgb 111 34 50))
(define *text-color* (color-rgb 255 255 255))
;; Scale used by slider
(define *min-position* 0)
(define *max-position* 2000)
;; Range of frequencies
(define *min-frequency* 20)
(define *max-frequency* 20000)

The variable name *background-color* is just a Lisp naming convention for global parameters. LambdaNative provides (color-rgb r g b) for creating colors. I also defined variables for the scale used by the slider and the range of frequencies accepted by beep.

We also need to specify the position and size of the slider. Both are specified in pixels. There aren't percentages or other scalable units you may be familiar with from CSS. There are functions to get the width and height of the window, so you could code the math to make a widget 80% the width of the window. Since we're dealing with a simple example with hard-coded window dimensions, I just hard-coded the position and size as well. Note that you specify the position along the y-axis as pixels from the bottom of the window. This seemed counter intuitive to me, and I continually caught myself trying to specify pixels from the top of the window.

;; Background color
(let ((w (glgui-width-get))
      (h (glgui-height-get)))
(glgui-box gui 0 0 w h *background-color*))

;; Frequency slider
(set! slider (glgui-slider gui 20 280 500 60 *min-position* *max-position* #f White *foreground-color* *accent-color* #f ascii_18.fnt ascii_18.fnt #f White))
(glgui-widget-set! gui slider 'showlabels #f)

I set a background color for the entire window. The only way I could find to do this was to create a glgui-box the size of the entire window and set the color of the box. I also renamed the variable from sl to slider. LambdaNative has the tendency to use short, non-descriptive variable names throughout its examples and documentation. I prefer to use more descriptive variable names. Replace the fonts in the example slider code with the fonts we specified in the FONTS file. I also disabled the slider labels.

The scale of 20 to 20,000 is so large that 440 wouldn't appear to move the slider at all. Ideally, 440 would fall about the middle of the slider. To achieve this, let's use a logarithmic scale.

I found a Stack Overflow answer on how to map a slider to a logarithmic scale. The code given in the answer is JavaScript, but it was easy enough to port to Scheme.

;; Logarithmic scale for frequency (so middle A [440] falls about in the middle)
;; Adapted from https://stackoverflow.com/questions/846221/logarithmic-slider

(define min-freq (log *min-frequency*))
(define max-freq (log *max-frequency*))
(define frequency-scale (/ (- max-freq min-freq) (- *max-position* *min-position*)))
;; Convert slider position to frequency
(define (position->frequency position)
  (inexact->exact (round (exp (+ min-freq (* frequency-scale (- position *min-position*)))))))
;; Convert frequency to slider position
(define (frequency->position freq) (/ (- (log freq) min-freq) (+ frequency-scale *min-position*)))

I created two functions: one that takes the position on the slider and returns the frequency (position->frequency) and another that takes a frequency and returns the position on the slider (frequency-position). Now let's set the initial position of our slider with the frequency->position function.

(glgui-widget-set! gui slider 'value (frequency->position 440))

Underneath the slider is a text field showing the current frequency, buttons to increase/decrease the frequency by one octave, and a play button.

;; Frequency display
(set! frequency-field (glgui-inputlabel gui 210 230 80 30 "440" ascii_18.fnt *text-color* *foreground-color*))
(glgui-widget-set! gui frequency-field 'align GUI_ALIGNCENTER)
(set! frequency-label (glgui-label gui 290 230 40 30 "Hz" ascii_18.fnt *foreground-color* *accent-color*))
(glgui-widget-set! gui frequency-label 'align GUI_ALIGNCENTER)

;; Octave buttons
(set! lower-button (glgui-button-string gui 140 230 50 30 "<" ascii_18.fnt (lambda (g w t x y) #t)))
(set! higher-button (glgui-button-string gui 350 230 50 30 ">" ascii_18.fnt (lambda (g w t x y) #t)))

;; Play button
(set! play-button (glgui-button-string gui 230 125 80 50 "Play" ascii_25.fnt (lambda (g w t x y) #t)))

That last argument to glgui-button-string is a callback function. This is a function that is called when the button is pressed. I'm just trying to get the widgets layed out right now. I don't yet care about the function of the button, so I used anonymous functions (lambdas) that don't do anything for now.

The buttons do come with some default styling, but you'll probably want to tweak the look to fit your color scheme and UI design. We can use glgui-widget-set! to set parameters of a widget. Buttons have various parameters that can be set such as 'button-normal-color and 'button-selected-color.

(glgui-widget-set! gui play-button 'button-normal-color *foreground-color*)
(glgui-widget-set! gui play-button 'button-selected-color *accent-color*)
(glgui-widget-set! gui play-button 'solid-color #t)
(glgui-widget-set! gui play-button 'rounded #f)

That seems like a lot to type (or copy and paste) for each button. With CSS I'm able to define a style for all buttons or apply a class to buttons. I used a for-each loop to loop through all the buttons and apply the above styling:

;; Style buttons
(for-each (lambda (button)
            (glgui-widget-set! gui button 'button-normal-color *foreground-color*)
            (glgui-widget-set! gui button 'button-selected-color *accent-color*)
            (glgui-widget-set! gui button 'solid-color #t)
            (glgui-widget-set! gui button 'rounded #f))
          (list lower-button higher-button play-button))

At this point, we are starting to have a nice looking interface, but it doesn't do anything. If you click the buttons or slide the slider, nothing happens. While the buttons take a callback function parameter, I couldn't find a way to wire up the slider to a function. I read the glgui-slider documentation page several times searching for clues.

Finally, I resorted to looking at the source code for glgui-slider. Each of the widget documentation pages link directly to their implementation in the LambdaNative GitHub repo. I already mentioned that I ended up reading the LambdaNative source more than I would have liked for debugging. Documentation is one area where LambdaNative really could stand to improve. I scanned slider.scm and discovered it had a 'callback parameter. I created a function that would set the frequency displayed in the glgui-inputlabel to the one that corresponded to the position of the glgui-slider.

;; Link slider to text field display of frequency
(define (adjust-frequency)
  (glgui-widget-set! gui frequency-field 'label (number->string
    (position->frequency (glgui-widget-get gui slider 'value)))))

and wired it up to the slider:

(glgui-widget-set! gui slider 'callback (lambda (parent widget event x y) (adjust-frequency)))

A callback function takes five arguments. In the code examples in the LambdaNative documentation, these always appeared as (lambda (g w t x y)). These one-letter variables aren't very descriptive, and the arguments of the callback functions don't appear to be documented. Through experimentation and reading the source code and examples, I worked out the following:

Parameter	Description
g	The [G]UI the widget belongs to. I used the name `parent` for this variable in my callback functions.
w	The [w]idget that triggered the callback function. I used the name `widget` for this variable in my callback functions.
t	The [t]ype of event. I used the name `event` for this variable in my callback functions.
x	First argument of event (x coordinate in pixels, keyboard character, etc.)
y	Second argument of event (y coordinate in pixels, modifier flags, etc.)

The callback function is only called once the user releases the slider handle. I want the user to get feedback as they drag the slider. You can write your own event handling code in the lambda that forms the second parameter of (main). The generated skeleton already includes code to terminate the application when the Esc key is pressed. I added some code to call adjust-frequency when the slider handle is being dragged:

;; events
  (lambda (t x y)
    (if (= t EVENT_KEYPRESS) (begin
      (if (= x EVENT_KEYESCAPE) (terminate))))
    ;; Also update frequency when dragging slider (callback is only on release)
    (if (and (glgui-widget-get gui slider 'downval) (= t EVENT_MOTION)) (adjust-frequency))
    (glgui-event gui t x y))

By looking at the implementation of glgui-slider in slider.scm, I noticed that LambdaNative was setting a 'downval parameter whenever the user was holding down the mouse button on the slider handle. Whenever that parameter is true, I listen for an EVENT_MOTION event to call adjust-frequency.

I replaced the anonymous lambdas in the octave button declarations with callback functions called decrease-octave and increase-octave. An octave is "the interval between one musical pitch and another with double its frequency."

;; Set frequency slider and display
(define (set-frequency freq)
  (glgui-widget-set! gui slider 'value (frequency->position freq))
  (glgui-widget-set! gui frequency-field 'label (number->string freq)))
;; Buttons increase and decrease frequency by one octave
(define (adjust-octave modifier)
  (let ((new-freq (* (string->number (glgui-widget-get gui frequency-field 'label)) modifier)))
    (if (and (>= new-freq *min-frequency*) (<= new-freq *max-frequency*)) (set-frequency new-freq))))
(define (decrease-octave parent widget event x y) (adjust-octave 0.5))
(define (increase-octave parent widget event x y) (adjust-octave 2))

The 'aftercharcb callback of glgui-inputlabel is called after each character is typed or deleted. We can use this to update the slider as a user enters a frequency. What if a user (and you know they will) enters a number higher than 20,000 or a letter? We need a function that will only allow numbers within a given range.

;; Only allow numbers within range of min-value and max-value
(define (num-only min-value max-value old-value)
  (lambda (parent widget)
    (let* ((current-value (glgui-widget-get parent widget 'label))
           (current-numified (string->number current-value)))
      (if (or (= (string-length current-value) 0) ; Allow field to be empty
              (and current-numified (>= current-numified min-value) (<= current-numified max-value)))
          (set! old-value current-value)
          (glgui-widget-set! parent widget 'label old-value)))))

If the user types a character that makes the value invalid, we want to revert to the last known good value. To accomplish this, I used a closure to remember the last known value. Many programming languages today have closures, but Scheme practically invented them. A closure enables variables to be associated with a function that persist through all the calls of the function.

Now we can wire the glgui-inputlabel callback up to these functions.

(set! frequency-range (num-only *min-frequency* *max-frequency* (glgui-widget-get gui frequency-field 'label)))
(glgui-widget-set! gui frequency-field 'aftercharcb (lambda (parent widget event x y)
  (frequency-range parent widget)
  (let ((freq (string->number (glgui-widget-get parent widget 'label))))
    (if freq (glgui-widget-set! parent slider 'value (frequency->position freq))))))

We call the num-only closure specifying the allowed range and initial value which returns a new function that can be used in the callback. After we make sure there are no high jinks going on with the value using the function created by the closure (frequency-range), we update the position of the slider using the current value of the text field.

We can use the num-only closure again to create a field to specify the duration of the beep in milliseconds:

;; General Controls
(glgui-label gui 20 40 80 30 "Duration" ascii_18.fnt *foreground-color*)
(set! duration-field (glgui-inputlabel gui 110 40 80 30 "200" ascii_18.fnt *text-color* *foreground-color*))
(glgui-widget-set! gui duration-field 'align GUI_ALIGNCENTER)
(set! duration-range (num-only 1 600000 (glgui-widget-get gui duration-field 'label)))
(glgui-widget-set! gui duration-field 'aftercharcb (lambda (parent widget event x y) (duration-range parent widget)))
(glgui-label gui 195 40 40 30 "ms" ascii_18.fnt *foreground-color*)

Frequency is rather abstract. Let's also give the user the ability to select a musical note. We can store the corresponding frequencies for A4-G4 in a table.

;; Notes -> frequency (middle A-G [A4-G4])
;; http://pages.mtu.edu/~suits/notefreqs.html
(define notes (list->table '((0 . 440.00)    ; A
                             (1 . 493.88)    ; B
                             (2 . 261.63)    ; C
                             (3 . 293.66)    ; D
                             (4 . 329.63)    ; E
                             (5 . 349.23)    ; F
                             (6 . 292.00)))) ; G

We'll give the user a drop-down menu. Whenever a note is selected from the drop-down menu, we'll look up the frequency in the table and set it using the set-frequency helper function we created for the octave buttons.

(glgui-label gui 410 40 60 30 "Note" ascii_18.fnt *foreground-color*)
(set! note (glgui-dropdownbox gui 470 40 50 30
  (map (lambda (str)
    (lambda (lg lw x y w h s) (if s (glgui:draw-box x y w h *foreground-color*))
      (glgui:draw-text-left (+ x 5) y (- w 10) h str ascii_18.fnt *text-color*)))
    (list "A" "B" "C" "D" "E" "F" "G"))
  *accent-color* *foreground-color* *accent-color*))
(glgui-widget-set! gui note 'scrollcolor *accent-color*)
(glgui-widget-set! gui note 'callback (lambda (parent widget event x y)
  (set-frequency (table-ref notes (glgui-widget-get parent widget 'current)))))

Now, let's make some noise. LambdaNative has a rtaudio module. We'll use that to generate a tone with a sine wave. Edit the MODULES file in your applications subdirectory and add rtaudio to the list. The Scheme API of the rtaudio module consists of essentially just two functions: rtaudio-start and rtaudio-stop. You must first register four real-time hooks (an initialization hook, input hook, output hook, and close hook) in a chunk of C code embedded within your Scheme code. I wish the rtaudio module had an API that allowed implementing these hooks in pure Scheme. Thankfully the DemoRTAudio app included with LambdaNative implements a sine wave, and I was able to copy and paste most of what I needed from there without spending a lot of time trying to figure out how to write a sine wave in C myself.

;; Register C-side real-time audio hooks
(c-declare  #<<end-of-c-declare

#include <math.h>

void rtaudio_register(void (*)(int), void (*)(float), void (*)(float*,float*), void (*)(void));

double f;
double srate=0;
float buffer;

void my_realtime_init(int samplerate) { srate=(double)samplerate; buffer=0; }
void my_realtime_input(float v) { }
void my_realtime_output(float *v1,float *v2) {
  static double t=0;
  buffer = 0.95*sin(2*M_PI*f*t);
  *v1=*v2=(float)buffer;
  t+=1/srate;
}
void my_realtime_close() { buffer=0; }

end-of-c-declare
)
(c-initialize "rtaudio_register(my_realtime_init,my_realtime_input,my_realtime_output,my_realtime_close);")

The basic formula for a sine wave is A sin(2πft) where A is amplitude, f is frequency, and t is time. We need a way to pass the frequency from our slider in the Scheme to the output hook in the C. Gambit scheme has a c-lambda special form that makes it possible to create a Scheme function that is a representative of a C function or code sequence.

(define rtaudio-frequency (c-lambda (double) void "f=___arg1;"))

This creates a Scheme function that sets the f variable in our C chunk. Now let's create a Schem function that will set the frequency and start and stop the real-time audio subsystem.

;; Generate a tone using the rtaudio module
(define (generate-tone parent widget event x y)
  ; Make sure neither frequency or duration were left blank
  (if (= (string-length (glgui-widget-get parent frequency-field 'label)) 0) (set-frequency 1))
  (if (= (string-length (glgui-widget-get parent duration-field 'label)) 0) (glgui-widget-set! parent duration-field 'label "1"))
  (rtaudio-frequency (exact->inexact (string->number (glgui-widget-get parent frequency-field 'label))))
  (rtaudio-start 44100 0.5)
  (thread-sleep! (/ (string->number (glgui-widget-get parent duration-field 'label)) 1000))
  (rtaudio-stop))

When playing a note such as B4 (493.88 Hz) that has a decimal point, the type passed from Scheme to C lines up with the C type float, but when passing an integer (such as 440), it will cause an error. The exact->inexact conversion forces Scheme to pass the value along as a float. Wire this up to the play button, and you're ready to make some noise.

(set! play-button (glgui-button-string gui 230 125 80 50 "Play" ascii_25.fnt generate-tone))

LambdaNative has a lot of rough edges, not least of which is the documentation (or lack thereof). Looking at the source code for a widget seems to be the only way to determine all the parameters available for that widget. If you're like me, being able to write mobile apps in Lisp is a dream come true! LambdaNative may not be the smoothest development experience right now, but I hope to revisit it again in the future. It is being actively developed (and has the backing of a university research team), so my hopes are high for the future of LambdaNative.