Say What You Mean September 19th, 2015
Patrick Stein

There is a scene in the movie The Birdcage where the son tells his father that he (the son) has met a girl and is going to get married. The father begins gulping down the glass of wine that he has in hand. The son asks, Are you upset? The father finishes the glass of wine and says, Let me tell you why.

Here is a function that I wrote several years ago.

(sheeple:defreply mouse-move ((item =draggable=) xx yy)
  (let ((dragging (dragging item)))
    (when dragging
      (let ((dx (- xx (car dragging)))
            (dy (- yy (cdr dragging))))
        (incf (offset-x item) dx)
        (incf (offset-y item) dy))
      (let ((pp (parent item)))
        (when pp
          (when (< (width pp) (+ (offset-x item) (width item)))
            (setf (offset-x item) (- (width pp) (width item))))
          (when (< (height pp) (+ (offset-y item) (height item)))
            (setf (offset-y item) (- (height pp) (height item))))))
      (when (< (offset-x item) 0) (setf (offset-x item) 0))
      (when (< (offset-y item) 0) (setf (offset-y item) 0))

This is awful! Am I upset? Let me tell you why.

Is it the Single Responsibility Principle (SRP)? No.

Is it Don’t Repeat Yourself (DRY)? No.

Is it Mixing Levels of Abstraction? Closer, but not quite.

Those are all clearly violated by this code. But, that’s not really the problem. The problem is Why. Nothing about this code tells you why it is here or what is doing.

There is no way to glance at that function and have any idea what’s going on. You have to read it carefully. You have to understand things that aren’t even in this source file to make head nor tail of it. Once you understand the second LET block, you will have nine more lines of code without the least inkling of why there should be nine more lines of code. Anyone care to hazard a guess as to why this function returns T (only) when we’re dragging?


Two years ago, a colleague and I were tasked with providing docstrings for every function in all of the code we’d written in the last year. We’d done well on providing docstrings to the outward-facing functions, but now we had to do the rest. He started at one end of the directory (in alphabetical order), and I started at the other end. This gave me a good opportunity to look closely at a boat-load of code he’d written that I’d never really delved into before.

He was absolutely religious about encapsulating containers. If he had a hash-table or a p-list or a flat list in a DEFVAR, there was one and only one function that retrieved items from it and at most one function that added items to it. Those functions were one or two lines each (two if they needed a mutex). Those functions were named after what the collection was storing not what mechanism was used to store them.

A lot of times when people talk about the value of encapsulating, they talk about shielding the rest of the code from the implementation details so that if you need to replace how it’s actually implemented on the back end you can do it without breaking any existing code. You are protecting your precious implementation from how people will use it so that you can someday replace the implementation with an even more precious implementation next year (when your language finally gets first-class functions).

I’ve been coding for a good long time now. I’m going to let you in on a little secret. Code almost never gets replaced. When code does get replaced, it almost never continues to adhere to the old API (there was always a semantic leak). If there is a business justification strong enough to let you replace the code, it’s because the old code has become an unmaintainable mess of people subverting the interface or the code as it is didn’t scale and now synchronous things need to happen asynchronously or local things have to happen remotely and hiding that under your old API isn’t going to relieve the bottlenecks.

Trying to insulate your code so that it’s easy to replace is looking down the wrong end of the telescope. The real benefit of encapsulation is that the people who read your code later can be half-asleep and still get everything—your code will scream its meaning. The real benefit of encapsulation is that the person debugging your code can set a break-point in a place that means something—not in the seventeen places the state might have changed but in the only place it could change.

Making It Better

Any ideas what the body in this function does?

(sheeple:defreply mouse-move ((item =draggable=) xx yy)
  (if (being-dragged-p item)
      (handle-event ()
         (let ((dx (- xx (drag-starting-x item)))
               (dy (- yy (drag-starting-y item))))
           (translate-widget item dx dy)
           (keep-widget-inside-parent item)))
      (ignore-event ())))

The new functions BEING-DRAGGED-P, DRAG-STARTING-X, and DRAG-STARTING-Y are just wrappers around what had been explicitly treated as an (OR NULL (CONS INTEGER INTEGER)).

(defun being-dragged-p (item)
  (dragging item))

(defun drag-starting-x (item)
  (car (dragging item)))
(defun drag-starting-y (item)
  (cdr (dragging item)))

It is still an (OR NULL (CONS INTEGER INTEGER)) but nobody ever has to care. Nobody ever has to try to remember what the integers mean. Sure, you could replace it with a structure or a complex number, but why would you ever bother? Why would you ever look at it again?

The new macros HANDLE-EVENT and IGNORE-EVENT encapsulate the return value of this function into something with meaning.

(defmacro handle-event (() &body body)
       (values t)

(defmacro ignore-event (() &body body)
       (values nil)

It might still be too easy to write an event-handler with a path which doesn’t end in one of these two macros, but it is way better than that dangling T was. It looks like it’s really supposed to be there, and it looks like what it means rather than what it is.

The TRANSLATE-WIDGET and KEEP-WIDGET-INSIDE-PARENT functions can benefit greatly with some further helper functions (and analogous functions for top and bottom):

(defun left (item)
  (offset-x item))
(defun (setf left) (x item)
  (setf (offset-x item) x))
(defun right (item)
  (+ (left item) (width item)))
(defun (setf right) (x item)
  (setf (offset-x item) (- x (width item))))

Some Rules of Thumb

If you find that when you want to check (PRED1 ...) you instead have to check:

(and (PRED0 ...)
     (PRED1 ...))

Then you should consider making a function that does them both. Consider the difference between these two blocks of code:

(when (and (connectedp (player1 g))
           (connectedp (player2 g))
           (not (pausedp g)))

(when (game-active-p g)

If you find that you are depending on the NULL-ness or positiveness or some other property of some number of state variables to decide which course of action to take, then you should consider making predicates named after your state. In many OO scenarios, you may even want to explicitly track (or calculate) which state you are in at all times.

(defmacro state-case (g &body clauses)
  `(ecase (calculate-or-fetch-state-of g)

(state-case g

In more imperative languages, it may even be beneficial to keep a STATE member variable in your class. When doing that, make sure that there is one and only one function which actually mutates the value of that STATE member. This will let you:

  1. Log all state transitions without having to hunt for all of them.
  2. Quickly hunt for all of them if you want to do that
  3. Set a break point on all state changes.
  4. Enforce the validity of transitions (or at least scream loudly when something transitions from STOPPED to PAUSED without having passed through PLAYING first).

If you have to check whether some resource is being used by some instance, don’t ask it which resource it is using, ask it whether it is using the one you want.

;;; Common: Reader is forced to know each player has one socket and
;;;    that sockets are comparable with #'=
(loop :for player :in all-networked-players
      :until (= socket-with-something-happening
                (player-socket player))
      :finally (return player))

;;; Better: All I wanted to know is, "Is this yours?"
(loop :for player :in all-networked-players
      :until (player-using-socket-p player
      :finally (return player))

Encapsulation is about protecting the person who has to read your code. It’s not about protecting your code.

Woolly Application Underway December 14th, 2009
Patrick Stein

I started building an application on top my Sheeple/CL-OpenGL library Woolly.

I coach a volleyball team. I often sit down with a piece of paper and try to determine new serve-receive and defensive positions for my team. This is quite tedious because I can’t just move the players around on the page. Additionall, I have to figure this out for all six rotations while keeping the overlap requirements in mind the whole time.

I tried once doing it with cut-out players. This worked better, but still suffered from having to track the rotations and overlap requirements all myself.

rotations After adding checkboxes to Woolly, I had a usable application for doing these rotations in 300 lines of code. Yellow are front-row players, blue are back-row players, and green are sidelined players. It still needs some work so that I can change player identifiers, substitute players in off the bench, save/load the rotations, and make print-outs.

I’m not sure yet whether I’m going to print just by slurping the OpenGL buffer into ZPNG, or if I am going to make a separate callback hierarchy for printing with Vecto or CL-PDF so that I can print at higher than screen resolution.

I’m also having trouble getting SBCL’s save-lisp-and-die function happy with the whole CL-OpenGL setup under MacOSX. I thought I had figured this out before. Alas, my own hacked version of CL-OpenGL isn’t working any better for me than the current CL-OpenGL release is when I try to run the saved image. *shrug* I’ll fight with that later.

Rendering Text in CL-OpenGL with ZPB-TTF December 9th, 2009
Patrick Stein

I promised in an earlier post that I would share my code for rendering anti-aliased text in CL-OpenGL using ZPB-TTF to load the fonts.


I use a three step process to render a string. First, I render the outline of the string using anti-alised lines. Then, I render the string as solid polygons into the stencil buffer. Then, I fill a rectangle having OpenGL only fill where the stencil buffer is set.

Why the three-step process? OpenGL can draw polygons. In fact, it can draw anti-aliased polygons. However, it can only draw convex polygons. Most of the polygons involved in fonts are non-convex. The stencil buffer, however, has a drawing mode where you can flip the bits of the value in the stencil buffer each time OpenGL goes to write to it.

Imagine for a moment the letter O. It is made of two separate contours… one for the exterior of the circle and one for the interior of the circle. If I rendered each of these to the color buffer in OpenGL, I would end up with one big filled in circle. However, if I render each of these to the stencil buffer with the invert operation, then I end up setting all of the bits in the filled circle area when I draw the exterior contour and turning the middle bits off again when I render the internal contour. I am left with only the bits in the letter itself filled in.

The same sort of thing works even for more complicated letters like the letter C. As I am progressing along the outer edge, I am inadvertently filling the interior region. But, as I progress along the inner edge, I am inadvertently erasing that region again.

Once I am done, I use the stencil buffer as a stencil, draw a rectangle over it, and Bob’s your uncle.

The problem with the stencil buffer is that it has no subtlety. Bits are either set in it or not. So, I cannot anti-alias in the stencil buffer. I am left to draw the outline with anti-aliased lines.

Here are the relevant files:

  • draw.lisp: The code which actually draws strings in a given font.
  • gl.lisp: The code that makes a basic OpenGL window and invokes the font rendering on a given font and string.
  • test.lisp: Some simple code that loads the required libraries and opens a window.

The test program assumes that okolaksRegular.ttf is in your current directory. Tweak it to some TTF you do have. Or, get Okolaks itself.

Drawing a string

Here is the basic outline of the string drawing function. I am centering the string at the origin. I first calculate the bounding box. Then, I determine the scaling factor needed to get from the font-units into my own units and I scale the universe accordingly. Then, I translate the universe to center the bounding box. Then, I draw the anti-aliased outline of the text. If desired, I then draw the filled text to the stencil buffer and paint in the stencil.

(defun draw-string (font-loader string &key (size 48) (filled t))
    (let* ((box (zpb-ttf:string-bounding-box string font-loader :kerning t))
           (bx1 (aref box 0))
           (by1 (aref box 1))
           (bx2 (aref box 2))
           (by2 (aref box 3)))

      (let ((ss (/ size (zpb-ttf:units/em font-loader))))
        (gl:scale ss ss 1))

      (gl:translate (/ (- bx1 bx2) 2) (/ (- by1 by2) 2) 0)
      (gl:with-pushed-attrib (:current-bit :color-buffer-bit :line-bit
                                           :hint-bit :stencil-buffer-bit)
      <<draw antialiased lines>>
      (when filled
        <<fill stencil buffer with filled-in-glyph>>
        <<fill in area subject to stencil>>)))))

To draw antialiased lines, I turn on blending. I tell it to blend the color in according to the alpha value of the portion of line it is trying to draw. I tell it to draw smooth lines in the nicest way it knows how. Then, I save the transformation-state so that I can move around inside the actual string rendering and still get back to this exact same place later. When I am done, I no longer need blending.

(gl:enable :blend)
(gl:blend-func :src-alpha :one-minus-src-alpha)
(gl:enable :line-smooth)
(gl:hint :line-smooth-hint :nicest)
    (render-string string font-loader nil))

To fill stencil buffer with filled-in-glyph, I turn off writing to the color buffer. I turn on the stencil testing. I set myself up to use a 1-bit stencil buffer. I set the buffer up so that when I clear it, it will all be zero-ed. I clear the stencil buffer. I set the stencil test to always write one bit. And, I set the stencil buffer to always write in invert mode. Then, I draw the string filled.

(gl:color-mask nil nil nil nil)
(gl:enable :stencil-test)
(gl:stencil-mask 1)
(gl:clear-stencil 0)
(gl:clear :stencil-buffer-bit)
(gl:stencil-func :always 1 1)
(gl:stencil-op :invert :invert :invert)
    (render-string string font-loader t))

To fill in area subject to stencil, I set myself up again to write to the color buffer. I set up the stencil test to let me write to my buffers only where the stencil is set to one. Then, I draw a filled rectangle over the whole bounding box.

(gl:color-mask t t t t)
(gl:stencil-func :equal 1 1)
(gl:with-primitives :quads
  (gl:vertex bx1 by1)
  (gl:vertex bx2 by1)
  (gl:vertex bx2 by2)
  (gl:vertex bx1 by2))

Rendering the string

To render the string, I loop through each character in it. For characters other than the first one, I adjust their position based on the kerning offset. Then, I render the character glyph and adjust the position so that I am ready to start the next character.

(defun render-string (string font-loader fill)
  (loop :for pos :from 0 :below (length string)
     :for cur = (zpb-ttf:find-glyph (aref string pos) font-loader)
     :for prev = nil :then cur
     :do (when prev
           (gl:translate (- (zpb-ttf:kerning-offset prev cur font-loader)
                            (zpb-ttf:left-side-bearing cur))
                         0 0))
         (render-glyph cur (if fill :polygon :line-strip))
         (gl:translate (zpb-ttf:advance-width cur) 0 0)))

Rendering a glyph

Here’s where the rubber really meets the road. My render-glyph function takes two arguments: a glyph and the mode in which to render it. The mode is :polygon for filled polygons and :line-strip for just the outline.

I loop through each contour in the glyph. With each contour, I tell OpenGL that I am going to render either a single polygon or a single line strip (according to the mode). To render the contour then, I loop through each contour segment. Each contour segment is either a straight line or a quadratic spline. If it is a straight line, then I have it easy. I just have to render the end points. If it is a spline, I have to render the starting point, create some interpolators to interpolate points along the spline, use those interpolators, and then render the end point.

(defun render-glyph (glyph mode)
  (zpb-ttf:do-contours (contour glyph)
    (gl:with-primitives mode
      (zpb-ttf:do-contour-segments (start ctrl end) contour
        (let ((sx (zpb-ttf:x start))
              (sy (zpb-ttf:y start))
              (cx (when ctrl (zpb-ttf:x ctrl)))
              (cy (when ctrl (zpb-ttf:y ctrl)))
              (ex (zpb-ttf:x end))
              (ey (zpb-ttf:y end)))
          (gl:vertex sx sy)
          (when ctrl
            (let ((int-x (make-interpolator sx cx ex))
                  (int-y (make-interpolator sy cy ey)))
              (interpolate sx sy ex ey int-x int-y)))
          (gl:vertex ex ey))))))

The starting point of one contour segment is always the ending point of the previous contour segment. So, if I wanted to bother, I could save myself a few OpenGL calls by remembering the first starting point of the first segment of the contour, not rendering the end points of any contour segment, and then rendering the starting point of the first segment again at the end (when I’m in outline mode). Instead, for clarity, I just always render the end point.

Making spline interpolators

If I want to make an quadratic spline that goes from x_0 to x_1 with control point c as time t goes from zero to one, I would use the polynomial (x_0 - 2c + x_1) t^2 + 2( c - x_0 ) t + x_0. So, given the parameters of a contour segment, I’m going to create interpolators for the x and y coordinates independently like so:

(defun make-interpolator (ss cc ee)
  (let ((xx (+ ss (* -2 cc) ee))
        (yy (* 2 (- cc ss)))
        (zz ss))
    #'(lambda (tt)
        (+ (* xx tt tt) (* yy tt) zz))))

Interpolating the spline

To interpolate the spline, I use a recursive function. It is given the x and y coordinates of the starting and ending points for the current portion of the spline, the starting and ending time coordinates of the current portion of the spline, and the interpolators created above. From there, it calculates the midpoint of a line segment from the start to the end and the x and y coordinates that the midpoint should be at based on the spline interpolator functions. If the calculated spline midpoint is really close to the line-segment midpoint, we just break off the recursion. If it is not really close, then we interpolate the first half of the current portion, render the calculated spline portion midpoint, and interpolate the second half of the current portion.

(defun interpolate (sx sy ex ey int-x int-y &optional (st 0) (et 1))
  (let ((mx (/ (+ sx ex) 2.0))
        (my (/ (+ sy ey) 2.0))
        (mt (/ (+ st et) 2.0)))
    (let ((nx (funcall int-x mt))
          (ny (funcall int-y mt)))
      (let ((dx (- mx nx))
            (dy (- my ny)))
        (when (< 1 (+ (* dx dx) (* dy dy)))
          (interpolate sx sy nx ny int-x int-y st mt)
          (gl:vertex nx ny)
          (interpolate nx ny ex ey int-x int-y mt et))))))

Technically, that check with the squared distance from the calculated midpoint to the segment midpoint shouldn’t just compare against the number one. It should be dynamic based on the current OpenGL transformation. I should project the origin and the points (1,0) and (0,1) through the current OpenGL projections, then use the reciprocal of the maximum distance those projected points are from the projected origin in place of the one. Right now, I am probably rendering many vertexes inside each screen pixel.


So, there you have it. Should you ever need to render text in CL-OpenGL, I hope this saves you many hours of trial-and-error and keeps you from resorting to rendering the glyphs to a texture map and dealing with how poorly they scale.

GUI Discussion — TC Lispers November Meeting December 9th, 2009
Patrick Stein

Cross-posted from

Lisp GUI Discussion on Vimeo.

Robert Goldman, Paul Krueger, and Patrick Stein gave short presentations on different approaches to Graphical User Interfaces with Common Lisp.

Cross-Platform Development November 25th, 2009
Patrick Stein

In preparation for the upcoming TC Lispers meeting, I was testing my Sheeple-based CL-OpenGL GUI code on all of the different systems that I use. This was important because part of my goal in starting from bare-bones OpenGL was to make something that was pretty easy to port. The OpenGL libraries are the only non-Lisp dependencies, and they are pretty standard.

I run Mac OS X 10.6.2 as my primary development machine. I knew everything I had so far worked there under SBCL 1.0.30 and CMU-CL 20a. It took a little tweaking to get Sheeple built under Allegro CL 8.1 (Trial Edition), but after that I was five-by-five under Allegro, too. Unfortunately, I cannot get CL-OpenGL to run under Clozure 1.3-r11936 on Mac OS X. Also, ECL 9.10.2 doesn’t support weak key hashtables which Sheeple needs. And, my install of clisp broke somewhere along the lines, so I haven’t tried it.

I have an Ubuntu Linux box. There, I am using SBCL 1.0.11.debian (eeps). Everything ran perfectly over there (even displaying through X Windows back to my Mac).

I also run Windows Vista under VMWare Fusion on my Mac. I hadn’t done any development on it for months and months. Fortunately, in Google-ing to find out how to fix it, I stumbled upon what I had written about how I got things set up originally. Over the last two hours, I got SBCL upgraded to 1.0.29 under Vista. I got ASDF-Install set up with a bunch of help from this article. And, from there, I got CFFI and cl-opengl and ZPB-TTF and Sheeple installed.

ZPB-TTF and Sheeple both used some tar format options that archive_0.7.0 didn’t like. For those, I had to jump through some hoops to untar and retar them to get them to install.

Here was my final /Users/Patrick/.sbclrc file:

(require :asdf)

;; from Zach Beane
(defmethod asdf:perform :around ((o asdf:load-op)
                                (c asdf:cl-source-file))
  (handler-case (call-next-method o c)
    (#+sbcl sb-ext:invalid-fasl
     #+allegro excl::file-incompatible-fasl-error
     #+lispworks conditions:fasl-error
     #+cmu ext:invalid-fasl
     #-(or sbcl allegor lispworks cmu) error ()
     (asdf:perform (make-instance 'asdf:compile-op) c)

(dolist (pkg  '("alexandria/"
                "zpb-ttf-1.0/") )
  (pushnew (merge-pathnames pkg
                            (merge-pathnames "ASDF-Systems/"

(asdf:oos 'asdf:load-op 'asdf-install)

;; for my sanity
(setf asdf-install:*locations*
      (list (list (merge-pathnames "ASDF-Systems/" (user-homedir-pathname))
                  (merge-pathnames "ASDF-Systems/" (user-homedir-pathname))
                  "My install spot")))

;; via
(asdf:oos 'asdf:load-op 'gzip-stream)

(asdf:oos 'asdf:load-op 'archive)

(defun asdf-install-extractor (to-dir tarball)
  (let ((name nil))
    (gzip-stream:with-open-gzip-file (ins tarball)
      (archive:with-open-archive (archive ins)
        (let ((*default-pathname-defaults* (pathname to-dir)))
          (archive:do-archive-entries (entry archive name)
            (archive:extract-entry archive entry)
            (unless name (setf name (archive:name entry)))))))
    (string name)))

(push 'asdf-install-extractor asdf-install:*tar-extractors*)

The list of packages in the middle were about half installed manually to get the archive extraction code working and half installed through ASDF-Install. If I recall correctly, I had to manually install: archive_0.7.0, flexi-streams-1.0.7, gzip-stream_0.2.8, salza2-2.0.7, trivial-gray-streams-2008-11-02, and a fresh copy of asdf-install. I also had to download a compiled version of freeglut.dll and tuck it into my Windows\system32 directory.

Getting SBCL to use the fresh copy of asdf-install was annoying. I ended up starting up a Command Prompt as Administrator (right click on the “command.exe” icon or menu-item and select “Run as Administrator”). Then, I went to the SBCL directory (“C:\Program Files\Steel Bank Common Lisp\1.0.29\”) and did the following:

% rename asdf-install asdf-install.old
% mklink /d asdf-install "C:\Users\Patrick\ASDF-Systems\asdf-install\asdf-install"

I had extracted the tar-ball from the ASDF-Install distribution into my ASDF-Systems directory.

Then, I went back and made my GUI code use double-buffered OpenGL windows because running Lisp to OpenGL to Windows Vista to VMWare to Quartz had some wicked flickering going on.

Two hours is a long time for something that’s supposed to be easily portable. But, I would have spent at least 95% of that time even if I were using an all-Lisp solution. And, this is far less time than I ever spent porting anything else to Windows.