FFMPEG input/output as an abstraction

I am currently working on writing code to support the usage pattern that I have used in the past for making animations using ffmpeg to encode video. Really though, how complex does it need to be?

Well, let's put together a wish-list:

  1. It should always shut down the pipe at the end of execution
    It's really easy to leave the pipes, and that makes it really easy to end up with empty animations, or, possibly, more substantial resource leaks.
  2. It should not require thinking about ffmpeg as a process, we're writing lisp code, not shell.
  3. It shouldn't be included in the base installation since it can't reasonably install ffmpeg (I mean, it could, but, that's a lot of work that'll still leave people out in the cold in situations where none of the binaries available are appropriate)
  4. It should terminate gracefully if there's no more input

There's a bunch of problems here that make me wonder if it's worth encapsulating this functionality, as I can't think of any way to prevent the user from breaking it. Ultimately this is calling out to a shell, and thus it suffers from all the ways that shells fail in the user experience, but this one is presumed to be isolated in the semantics of common lisp, rather than shells.

The 'correct' way, would be to provide an abstraction that cannot be used to assemble incorrect commands. But at that point I might as well just get around to learning how to use sb-grovel and write the structures to interface with the library.

But that would be excessive for a simple use case, and it could easily be way less simple to use just by having to learn how to handle the structures that the library would provide.

So anyway, with the limitations that I have outlined in mind, I'm going to go with what I have so far, with-ffmpeg-input provides a way to get that png stream working from a single file parameter, handling closing down the process and the general housekeeping best kept in mind in a world with finite resources(but then I suppose we're using lisp so who am I to speak on the costs of things 😉)

But I'm not sure that I like the abstraction enough to write a corresponding with-ffmpeg-output or some combination of the two.

L-Systems with shapes

Rendering shapes is a relatively small addition to the L-System code I've been implementing over the last few weeks, it consists of a few manual dispatches to drawing code based on the first symbol in a sublist. The immediate alternative is using defgeneric and the common lisp object system, which is probably the correct thing to do.

Pending that major and obvious improvement, this is sufficient for what we have to work with.

(defparameter *line-stroker* (img-genner:static-color-stroker (img-genner:rgb 255 0 0)))
(defparameter *ellipse-stroker* (img-genner:static-color-stroker (img-genner:rgb 0 255 0)))
(defparameter *polygon-stroker* (img-genner:static-color-stroker (img-genner:rgb 200 200 0)))

(defun draw-command(item)
  (case (car item)
    ((line)
     (destructuring-bind (x1 y1 x2 y2) (cdr item)
       (img-genner:stroke-line *image* x1 y1 x2 y2 *line-stroker* ))
     )
    ((ellipse)
     (let ((el (cadr item)))
       (img-genner:fill-ellipse el *image* *ellipse-stroker*)))
    ((polygon)
     (let ((p (cadr item)))
       (img-genner:fill-shape p *image* *polygon-stroker*)))))
(defun iterate-n-then-execute(n tape)
  (loop repeat n
        with stroker = (img-genner:static-color-stroker (img-genner:rgb 255 0 0))
        for state = tape then (run-replacements state)
        do(reset-turtle)
        finally(progn
                 (execute-rules state)
                 (loop for count from 0
                       with total = (length *lines*)
                       for item in (reverse *lines*)
                       for color = (img-genner:static-color-stroker (img-genner:get-random-color))
                       do(draw-command item)
                       do(img-genner:save-image *image* (uiop:process-info-input ffmpeg))
                       do(format t "Finished frame ~a/~a~%" count total)))))

This also requires changing some of the turtle routines I wrote earlier and writing some new supporting ones. Semantically, depositing an ellipse or a polygon doesn't really map well with going forwards or rotating the heading.

(defun forward(amount line)
  (let ((sx *turtle-x*) (sy *turtle-y*))
    (setf *turtle-x* (+ *turtle-x* (* amount (cos *turtle-angle*)))
          *turtle-y* (+ *turtle-y* (* amount (sin *turtle-angle*))))
    (when line
      (push (list 'line sx sy *turtle-x* *turtle-y*) *lines*))
    )
  )
(defun deposit-ellipse(radius-x radius-y)
  (let ((el (img-genner:make-ellipse *turtle-x* *turtle-y* radius-x radius-y)))
    (img-genner:set-rotation el *turtle-angle*)
    (push (list 'ellipse el) *lines*))

  )
(defun deposit-polygon(n radius)
  (let ((p (img-genner:make-regular-polygon *turtle-x* *turtle-y* n radius)))
    (push (list 'polygon p) *lines*)))

We can demonstrate this with a simple example as below:

(define-rule #\[ (lambda() (push-turtle)) '(#\[))
(define-rule #\] (lambda() (pop-turtle)) '(#\]))
(define-rule '+ (lambda() (turn (deg2rad 25.0))) '(+))
(define-rule '- (lambda() (turn (deg2rad -25.0))) '(-))
(define-rule 'L
    (lambda() (forward 10.0 t)(deposit-polygon 5 5.0))
  '(S ))
(define-rule 'S
    (lambda() (forward 10.0 t))
  '(S #\[ + + S L #\]  #\[ S L #\] - S L))

And we get this deeply lopsided plant out:

An L-system growing lopsided into a spiral

Improving On L-Systems

The simplest implementation of L-Systems requires term-rewriting, and maybe turtle graphics. We already have arbitrary computation on the execution end, but what if we could add computation on the term rewriting phase? We can get a lot more flexibility without adding an infinite number of rules.

Also the last L-System post has had its code fixed.

We can start by copying the old L-System code over to a new file(Or not, if you don't care). But we should probably address some issues that were there before. Namely that we can do a lot better for ourselves by declaring accessor functions such as rule-name, rule-replacement and rule-execution to allow us to change the representation if we want.(I learned it from Peter Norvig and he seems to have done alright with it)

(defun define-rule(name execution replacement)
  (push `(,name . (,execution . ,replacement)) *rules*))
(defun rule-name(item)
  (if (listp item)
      (car item)
      item))
(defun rule-execution(item)
  (cadr (assoc (rule-name item) *rules*)))
(defun rule-replacement(item)
    (caddr (assoc (rule-name item) *rules*)))

And we need to change run-replacements and execute-rules to handle argument lists in the input tape.

(defun run-replacements(state)
  (loop for i in state
        for (_name . (_execution . replacement)) = (or (assoc (rule-name i) *rules* ) i)
        do(print i)
        when (functionp replacement)
          appending (apply replacement (cdr i))
        else appending replacement))

(defun execute-rules(state)
  (loop for i in state
        for (_name . (execution . _replacement)) = (assoc (rule-name i) *rules*)
        when(listp i)
          do(apply execution (cdr i))
        else
          do(funcall execution)))

So let's try a modification of the Barnsley fern rule as listed on wikipedia. In this we add a rule called A that takes two parameters and generates a certain number of tokens based on that input, as well as a call to itself.

(define-rule 'X (lambda()) '(F + #\[ #\[ X #\] - X #\] - F #\[ - F X #\] + X ))
(define-rule 'F (lambda()(forward *forward-amount* t)) '(F F))
(define-rule #\[ (lambda() (push-turtle)) '(#\[))
(define-rule #\] (lambda() (pop-turtle)) '(#\]))
(define-rule '+ (lambda() (turn (deg2rad 25.0))) '(+))
(define-rule '- (lambda() (turn (deg2rad -25.0))) '(-))
(define-rule 'A (lambda(_a _b))
  (lambda(x y) (append (make-list x :initial-element 'X) '(- #\[)
                       `((A ,(max (1- x) 0) ,(max (1- y) 0)))
                       '(#\])
                       (make-list y :initial-element 'X))))

And then we run (iterate-n-then-execute 5 '((A 3 3))) to get

A modified barnsley fern is drawn

The next step to replicating concepts from L-Lisp is the environmentally sensitive L-Systems(necessary to have procedurally generated ivy cover a wall with L-Systems, for example).

Source Listing

(require :img-genner)
(defparameter *image* (img-genner:make-image 640 480))
;; The turtle's stack
(defparameter *stack* nil)
(defparameter *lines* nil)
(defparameter *turtle-x* 320.0)
(defparameter *turtle-y* 0.0)
(defparameter *turtle-angle* (coerce (/ pi 2) 'single-float))
(defun reset-turtle()
  (loop for i from 0 below (array-total-size *image*)
        do(setf (row-major-aref *image* i) 0))
  (setf *stack* nil *lines* nil *turtle-x* 320.0 *turtle-y* 0.0
        *turtle-angle* (coerce (/ pi 2) 'single-float)))
(defun deg2rad(n)
  (* n (/ (coerce pi 'single-float) 180)))
(defun turn(d)
  (incf *turtle-angle* d))
(defun forward(amount line)
  (let ((sx *turtle-x*) (sy *turtle-y*))
    (setf *turtle-x* (+ *turtle-x* (* amount (cos *turtle-angle*)))
          *turtle-y* (+ *turtle-y* (* amount (sin *turtle-angle*))))
    (when line
      (push (list sx sy *turtle-x* *turtle-y*) *lines*))
    )
  )
(defun push-turtle()
  (push (list *turtle-x* *turtle-y* *turtle-angle*) *stack*))
(defun pop-turtle()
  (destructuring-bind (x y a) (pop *stack*)
      (setf *turtle-x* x *turtle-y* y *turtle-angle* a)))

(defun stroke-drawing(stroker)
  (loop for (x1 y1 x2 y2) in *lines*
        do(stroke-line *image* x1 y1 x2 y2 stroker)
        ))

(defparameter *rules* nil)
(defparameter *forward-amount* 10.0)
(defun define-rule(name execution replacement)
  (push `(,name . (,execution . ,replacement)) *rules*))
(defun rule-name(item)
  (if (listp item)
      (car item)
      item))
(defun rule-execution(item)
  (cadr (assoc (rule-name item) *rules*)))
(defun rule-replacement(item)
    (caddr (assoc (rule-name item) *rules*)))
(defun run-replacements(state)
  (loop for i in state
        for (_name . (_execution . replacement)) = (or (assoc (rule-name i) *rules* ) i)
        when (functionp replacement)
          appending (apply replacement (cdr i))
        else appending replacement))

(defun execute-rules(state)
  (loop for i in state
        for (_name . (execution . _replacement)) = (assoc (rule-name i) *rules*)
        when(listp i)
          do(apply execution (cdr i))
        else
          do(funcall execution)))

(define-rule 'X (lambda()) '(F + #\[ #\[ X #\] - X #\] - F #\[ - F X #\] + X ))
(define-rule 'F (lambda()(forward *forward-amount* t)) '(F F))
(define-rule #\[ (lambda() (push-turtle)) '(#\[))
(define-rule #\] (lambda() (pop-turtle)) '(#\]))
(define-rule '+ (lambda() (turn (deg2rad 25.0))) '(+))
(define-rule '- (lambda() (turn (deg2rad -25.0))) '(-))
(define-rule 'A (lambda(_a _b))
  (lambda(x y) (append (make-list x :initial-element 'X) '(- #\[)
                       `((A ,(max (1- x) 0) ,(max (1- y) 0)))
                       '(#\])
                       (make-list y :initial-element 'X))))

(defparameter ffmpeg (uiop:launch-program "ffmpeg -r 20 -f png_pipe -i - -y -vf \"minterpolate='me=umh:search_param=32:fps=30'\"   -b:v 3M -preset placebo L-system.webm" :input :stream))
(defun finish()
  (uiop:close-streams ffmpeg)
  (uiop:wait-process ffmpeg))
(defun iterate-n-then-execute(n tape)
  (loop repeat n
        with stroker = (img-genner:static-color-stroker (img-genner:rgb 255 0 0))
        for state = tape then (run-replacements state)
        do(reset-turtle)
        finally(progn
                 (execute-rules state)
                 (loop for (sx sy ex ey) in (reverse *lines*)
                       do(img-genner:stroke-line *image* sx sy ex ey stroker)
                       do(img-genner:stroke-line *image* (1+ sx) sy (1+ ex) ey stroker)
                       do(img-genner:save-image *image* (uiop:process-info-input ffmpeg))))))

Some Thoughts on Codex, a Common Lisp Documentation Tool

Codex is one of a small number of native documentation generators in lisp. It uses an unusual markdown format called Scriba. I have been using it to document img-genner since about 2 years ago.

In those two years there hasn't been an update for it(Actually for at least 7), but that's not terribly uncommon among common lisp development tools. You could claim that it's because they stay good, but honestly that argument is kinda nebulous for the same reasons they're nebulous for a c++ library from 2003(though, to be fairer, the language hasn't changed at all unlike c++), mostly because who knows if the author is still 1. Alive, or 2. cares about the project. I take what I can to work with the tools I like 🙂

It's an unusual markup language for my taste(Apparently it's based on a markup called scribe which I'd never heard of before), and there's little documentation for it, which is... frustrating to say the least, but at least it works alright.

Frankly the output is almost beautiful.

There are some choices I'm not sure about. For example, it requires you to request the inclusion of docstrings and sourcecode derived information explicitly for everything in your package. This is, to be honest, helping me find some issues in my code that I hadn't looked at for years. But it's also frustrating when you come from doxygen, which will by default show everything, even private members.

I suspect that it has that limitation because it is relying on information that needs to be retained in the memory of the interpreter, rather than having some gigantic set of parsers crawling the source code.

For a taste, here's a listing for a section that places some documentation in img-genner.

    @begin(section)
      @title(Drawing)
      @cl:with-package[name="img-genner"](
      @cl:doc(function stroke-line)
      @cl:doc(generic fill-shape)
      @cl:doc(method fill-shape (shape ellipse) image stroker)
      @cl:doc(method fill-shape (shape rectangle) image stroker)
      @cl:doc(method fill-shape (shape polygon) image stroker))
    @end(section)

From there we can build the documentation as so, assuming we're in the img-genner folder.

(ql:quickload :codex)
(codex:document :img-genner :manifest-path #P"docs/manifest.lisp")

Overall, I'm not terribly displeased with the output it makes here, and I'm looking forwards to getting back to other types of coding for tomorrow.

L-Systems

L-Systems are a type of fractal, well, that's not really true; L-systems are a formalism for constructing rules for iterated systems, such as plant growth and turning those into images. But what's interesting is that they're actually remarkably simple to implement the evaluation of.

So let's look at one of the simpler ones, the binary tree. It has two replacement rules. (I am taking these from wikipedia)

1→11
0→1[0]0
Starting with a string equal to "0" string

The first 3 iterations are equivalent to

1[0]0
11[1[0]0]1[0]0
1111[11[1[0]0]1[0]0]11[1[0]0]1[0]0 

But that doesn't really do us any justice does it? That's a nice string and all, but it's not an image as was promised. But we haven't even gone over the rules yet. In this system we assume that we have a turtle that has a position and an angle that draws lines. The turtle has a stack of positions and angles that it keeps and can return to.

Before we get to that we should probably implement the turtle code as it's fairly simple. We'll use my library because I'm the one writing the blog post

(require :img-genner)

(defparameter *image* (img-genner:make-image 640 480))
;; The turtle's stack
(defparameter *stack* nil)
(defparameter *lines* nil)
(defparameter *turtle-x* 320.0)
(defparameter *turtle-y* 0.0)
(defparameter *turtle-angle* 0.0)
(defun deg2rad(n)
  (* n (/ (coerce pi 'single-float) 180)))
(defun turn(d)
  (incf *turtle-angle* d))
(defun forward(amount line)
  (let ((sx *turtle-x*) (sy *turtle-y*))
    (setf *turtle-x* (+ *turtle-x* (* amount (cos *turtle-angle*)))
          *turtle-y* (+ *turtle-y* (* amount (sin *turtle-angle*))))
    (when line
      (push (list sx sy *turtle-x* *turtle-y*) *lines*))
    )
  )
(defun push-turtle()
  (push (list *turtle-x* *turtle-y* *turtle-angle*) *stack*))
(defun pop-turtle()
  (destructuring-bind (x y a) (pop *stack*)
      (setf *turtle-x* x *turtle-y* y *turtle-angle* a)))

(defun stroke-drawing(stroker)
  (loop for (x1 y1 x2 y2) in *lines*
        do(stroke-line *image* x1 y1 x2 y2 stroker)
        ))

As it turns out the rule handling is even simpler if we store it as a little association-list.

(defparameter *rules* nil)
(defparameter *forward-amount* 4.0)
(defun define-rule(name execution replacement)
  (push `(,name . (,execution . ,replacement)) *rules*))
(defun run-replacements(state)
  (loop for i in state
        for (_name . (_execution . replacement)) = (or (assoc i *rules* ) i)
        appending replacement))
(defun execute-rules(state)
  (loop for i in state
        for (_name . (execution . _replacement)) = (assoc i *rules*)
        do(funcall execution)))
(define-rule 0 (lambda()(forward *forward-amount* t)) '(1 #\[ 0 #\] 0 ))
(define-rule 1 (lambda()(forward *forward-amount* t)) '(1 1))
(define-rule #\[ (lambda() (push-turtle)
                   (turn (deg2rad 45.0)))
  '(#\[))
(define-rule #\] (lambda() (pop-turtle)
                   (turn (deg2rad -45.0)))
  '(#\]))

And now we can write our video generation function. Since the number of frames will be fairly small, we will turn on ffmpeg's motion interpolation to smooth it out and increase the framerate.

(defun iterate-n-then-execute(n tape)
  (loop repeat n
        with ffmpeg = (uiop:launch-program "ffmpeg -r 20 -f png_pipe -i - -y -vf \"minterpolate='me=umh:search_param=32:fps=30'\"  -c:v h264 -b:v 3M -preset placebo L-system.mp4" :input :stream)
        with stroker = (img-genner:static-color-stroker (img-genner:rgb 255 0 0))
        for state = tape then (run-replacements state)
        do(reset-turtle)
        finally(progn
                 (execute-rules state)
                 (loop for (sx sy ex ey) in (reverse *lines*)
                       do(img-genner:stroke-line *image* sx sy ex ey stroker)
                         do(img-genner:stroke-line *image* (1+ sx) sy (1+ ex) ey stroker)
                         do(img-genner:save-image *image* (uiop:process-info-input ffmpeg)))
                 (uiop:close-streams ffmpeg)
                 (uiop:wait-process ffmpeg))))

So now if we run (iterate-n-then-execute 7 '(0)) we should get the following

An animation of a binary fractal tree being drawn over a few seconds.
The generated video

There's a lot more that can be done with L-systems if you are willing to experiment with what kinds of drawing operations it encodes.

Edit: A redditor mentioned a relevant piece of software on the post I made for this, L-lisp. It also happens to show just why L-systems are still relevant to game programming, it compiles with a bit of modification.

Edit Edit: I have addressed the compilation issues that caused issues before.

Particles Tunneling Through Solid Earth

No, I'm not going to write about neutrinos, or anything else that is 'real'. Pixels are the particles of today's post. Their universe is very different than ours, it is solid in all directions, it is quantized(at a different level than ours).

At each moment, there are a countable number of choices.

To be a pixel is to be blind to all but your nearest neighbors, to be trapped in a matrix far more insidious and probably less pleasing than in the movie. Movement is always a cooperation between at least two particles here, there's no vacuum after all. So let's see what actions a pixel particle can perform:

  1. Move to any of the surrounding coordinates, swapping places with each pixel it displaces.
  2. Change Color
  3. Stop being active

Luckily, those things aren't too much of a tall order.

(require :img-genner)


(defparameter *ffmpeg-writer* (uiop:launch-program "ffmpeg -f png_pipe -i - -y  particles.webp" :input :stream))
(defparameter *image* (make-image 640 480))
(defstruct particle (x 0) (y 0))
(defparameter *particles* 
  (loop for i from 0 below 900 collect (make-particle :x (random 640) :y (random 480))))
(defun copy-pixel(x1 y1 x2 y2)
  (set-pixel *image* x1 y1 (get-pixel *image* x2 y2)))
(defun wrap(value min max)
  (if (< value min)
      (1- max)
      (if (>= value max)
          min value)))
(defun move-particle(particle dx dy)
  (incf (particle-x particle) dx)
  (setf (particle-x particle) (wrap (particle-x particle) 0 640))
  (incf (particle-y particle) dy)
  (setf (particle-y particle) (wrap (particle-y particle) 0 480))
  (swap-pixel (particle-x particle) (particle-y particle)
              (wrap (- (particle-x particle) dx) 0 640)
              (wrap (- (particle-y particle) dy) 0 480)))
(defun change-color(particle)
  (set-pixel *image* (particle-x particle) (particle-y particle) (get-random-color)))
(defun die(particle)
  (setf *particles* (remove particle *particles* :test #'eq)))

;;;; This is how we're going to choose what each particle does:
(defun perform-action(particle)
  (case (random 25)
    ((1 2 0 3 4 5 9  18 20 19 21) (move-particle particle (- (random 3) 1) (- (random 3) 1)))
    ((10 12 13 14 15 11 17 6 16 22 23 24) (change-color particle))
    ((7 ) (die particle))))
(loop while *particles*
      for count from 0
      do(loop for i in *particles*
              do(perform-action i))
      do(img-genner:save-image *image* (uiop:process-info-input *ffmpeg-writer*))
      do(print count))
(uiop:close-streams *ffmpeg-writer*)

It's mostly the same structure as before, and with this, we get the following

Kinda sparse huh? Well, we could add more particles, or we could make the particles leave streaks, so we'll do the latter, because that's what I want to write 🙂

If we replace swap-pixel with copy-pixel, then we get this:

If the first animation is a bunch of pixels tunneling through darkness, this is them devouring it.

That was generated with the following code:

(require :img-genner)


(defparameter *ffmpeg-writer* (uiop:launch-program "ffmpeg -f png_pipe -i - -y -pix_fmt yuv420p -compression_level 6  -qscale 50  particles.webm" :input :stream))
(defparameter *image* (make-image 640 480))
(defstruct particle (x 0) (y 0))
(defparameter *particles* 
  (loop for i from 0 below 60 collect (make-particle :x (random 640) :y (random 480))))
(defun copy-pixel(x1 y1 x2 y2)
  (set-pixel *image* x1 y1 (get-pixel *image* x2 y2)))
(defun wrap(value min max)
  (if (< value min)
      (1- max)
      (if (>= value max)
          min value)))
(defun move-particle(particle dx dy)
  (incf (particle-x particle) dx)
  (setf (particle-x particle) (wrap (particle-x particle) 0 640))
  (incf (particle-y particle) dy)
  (setf (particle-y particle) (wrap (particle-y particle) 0 480))
  (copy-pixel (particle-x particle) (particle-y particle)
              (wrap (- (particle-x particle) dx) 0 640)
              (wrap (- (particle-y particle) dy) 0 480)))
(defun change-color(particle)
  (set-pixel *image* (particle-x particle) (particle-y particle) (get-random-color)))
(defun die(particle)
  (setf *particles* (remove particle *particles* :test #'eq)))

;;;; This is how we're going to choose what each particle does:
(defun perform-action(particle)
  (case (random 25)
    ((1 2 0 3 4 5 9  18 20 19 21) (move-particle particle (- (random 3) 1) (- (random 3) 1)))
    ((10 12 13 14 15 11 17 6 16 22 23 24) (change-color particle))
    ;((7 ) (die particle))
    ))
(loop while *particles*
      for count from 0
      repeat 1500
      do(loop for i in *particles*
              do(perform-action i))
      do(img-genner:save-image *image* (uiop:process-info-input *ffmpeg-writer*))
      do(print count))
(uiop:close-streams *ffmpeg-writer*)

Recreating an old Visualizer I swear I saw

I have vague memories of a visualizer that I will likely never encounter without looking for it again. It was a waveform display but it had these rectangles that would ride them like boats, not really like surfing. Now, you might be wondering why I'm doing this when my library creates, at best, video.

Well, I'm not even going to recreate that much of it, doing the discrete waveform handling is always a massive pain, so instead we'll cheese it with the combined magic of img-genner, and the magic of limits.

(require :img-genner)
#|------------------------------------------------------------------------------
 | The idea here is that the rectangles ripple along a sine wave, rotating with
 | it as it moves.
 |
 | To determine the angle the derivative of the wave must be known at the
 | center of the rectangles, and that must be turned into an angle
 |----------------------------------------------------------------------------|#

(defvar *rectangles* (loop for i from 0 below 24
                           collect(make-instance 'img-genner:rectangle
                                                 :width 10 :height 10
                                                 :origin
                                                 (img-genner:point (* 30.0 i) 240.0))))

With that in mind we can implement our derivation code, and the slope to angle conversion function. Normally, I wouldn't recommend using defconstant unless you're really sure that the constant won't change.

(defconstant +epsilon+ 0.0001)
(defun derive-at-point(function x)
  (/ (-
      (funcall function (+ x +epsilon+))
      (funcall function x))
     +epsilon+))

(defun slope-to-angle(rise-over-run)
  (atan rise-over-run))

Then we have to write the wave and coordinate conversion functions. We need the coordinate conversions because trigonometric functions aren't very great over the 640.

(defun wave-1(x)
  (+ (sin (* 2.0 x))
     (sin (/ x 3))
     (sin x)))

(defun xcoord(x time)
  (+ (/ x 10.0) time))

Then we need to be able to update each rectangle for a given time and with a given wave function.

#|
 | Move the rectangles to match the wave's height at that point
 |#
(defun match-wave-height(func time rectangle)
  (let* ((origin (slot-value rectangle 'img-genner:origin))
         (x (xcoord (aref origin 0) time)))
    (setf (aref origin 1) (+ 240 (* (funcall func x) 10)))
    )
  )
#|
 | This does the same for the angles
 |#
(defun match-wave-angle(func time rectangle)
  (let* ((origin (slot-value rectangle 'img-genner:origin))
         (x (xcoord (aref origin 0) time))
         (dy (derive-at-point func x)))
    (setf (slot-value rectangle 'img-genner:rotation) (slope-to-angle dy))
    )
  )
; And this runs both
(defun update-rectangles(func time)
  (loop for i in *rectangles*
        do(match-wave-height func time i)
        do(match-wave-angle func time i))
  )

Then we need to handle the streams and the drawing of it all.

(defparameter *image* (img-genner:make-image 640 480))
(defun draw-rectangles()
  (loop for i in *rectangles*
        do(img-genner:fill-shape i *image* (img-genner:static-color-stroker (img-genner:rgb 255 0 0)))))

(defun draw-wave(func time)
  (loop for ox from 0 below 640
        for x = (+ time (/ ox 10.0))
        for y = (- 480 (+ 240 (* 10 (funcall func x))))
                ; This is a cheap way to do a thick line poorly
                do(loop for off from 0 below 2
                        do(setf (aref *image* (floor (+ y off)) ox 2) 255))
        ))

(loop for time from 0.0 by (/ 1.0 25.0)
      for frame from 0
      repeat 1000
      do(update-rectangles #'wave-1 time)
      do(reset-image *image*)
      do(draw-rectangles)
      do(draw-wave #'wave-1 time)
      do(img-genner:save-image *image* (uiop:process-info-input *ffmpeg-writer*))
      do(print frame)
      )

(uiop:close-streams *ffmpeg-writer*)
(uiop:wait-process *ffmpeg-writer*)

And with that we get the above. There's a lot of room for improvement

img-genner Switching away from cl-png

cl-png is a long lived package that mostly works, but it contains a single flaw, it relies on the presence of a library and the competence of the implementation in getting to it.

It grabs the source and tries to build it. That's one reason that I don't much care for it. As much as I don't mind C, I'd rather not force common lisp programmers to interact with that whole can of worms, and if that is its behavior in windows, then there may simply not be a suitable C compiler.

In the place of cl-png will slide pngload and zpng. zpng is a much more capable interface and pngload is actually remarkably fast. However, zpng and pngload are likely heavier than libpng, but, ultimately, the thing that takes time in this library is the rendering itself or pixel manipulation.

In the face of the immense demands of requiring a C compiler introduces, it's not unreasonable to trade a little bit of performance somewhere non-critical for ease of distribution.

The switch was remarkably painless for pngload, but zpng had a few differences that proved a tad inconvenient for me in paritcular

  1. The format was different than the one I had chosen.
    In cl-png the format used for images was a 3 dimensional array rather than a 1 dimensional array as zpng uses.

    I use a 3 dimensional array because it maps more closely to how I think about images,
  2. zpng has an accessor to obtain the 3 dimensional array, but it lacks a setter(which is probably all well and fair as the translation could be troublesome on the other end).
    What would've made this easier for me would've been if zpng had provided a conversion function(maybe it did and I missed it), but writing it myself wasn't terribly difficult in the end.

Rescaling Video Using img-genner

There's not much of a reason to do this because ffmpeg has a much faster and nicer scaler, but maybe we want to write common lisp to handle an effect. When I introduced img-genner, I wasn't sure that this was the direction to take, but now it seems appropriate, if nothing else.

You will most likely want to consult the installation instructions if you do not yet have img-genner set up.

So let's start out with the following to import the libraries we need, as well as start the ffmpeg processes.

(ql:quickload :img-genner)
(ql:quickload :pngload)
(defparameter *ffmpeg-reader* (uiop:launch-program "ffmpeg -i wander.mp4 -c:v png -pix_fmt rgb24 -f image2pipe -" :output :stream))
(defparameter *ffmpeg-writer* (uiop:launch-program "ffmpeg -f png_pipe -i - -y -b:v 1M hello4.webm" :input :stream))

We need pngload because it handles reading from the pipe correctly whereas the libpng binding I have been using does not seem to. I chose to output a webm because it can provide playback sooner, but of course there's no reason that you can't use whatever funky codec format that you prefer.

Okay, so overall, the flow should look like this:

graph LR; a(*ffmpeg-reader*) a -->scaler scaler --> b b(*ffmpeg-writer*)

Hmm, that's not very interesting though, so let's add the implicit stuff and a neat function I recently wrote.

graph LR; a(*ffmpeg-reader*) --> decode(pngload:decode) -->data(pngload:data)--> scaler; scaler --> colorizer(colorize-naive); colorizer-->b(*ffmpeg-writer*) b-->a;

There, that's an excuse to use this library!

In common lisp I couldn't remember if there was a way to check for eof explicitly, so instead I just have it handle the end-of-file condition to terminate this.

(handler-case
    (loop with i = 0
          with colors = (loop repeat 16 collect (img-genner:get-random-color))
          for input = (pngload:data (pngload:load-stream (uiop:process-output *ffmpeg-reader*)))
          for output = (img-genner:colorize-naive (img-genner:upscale-image-by-factor input 0.5 0.5) colors)
          do(img-genner:save-image output (process-input *ffmpeg-writer))
          )
  (end-of-file (c)
    )
  )

Before you run the code like this though, you'll need to add this at the end:

(uiop:close-streams *ffmpeg-reader*)
(uiop:wait-process *ffmpeg-reader*)
(uiop:close-streams *ffmpeg-writer*)
(uiop:wait-process *ffmpeg-writer*)

This closes the input stream, causing ffmpeg to close as gracefully as possible and then collecting its exit code in order to let the process be cleaned up.

Okay, but that's not very efficient. For one thing, it's fairly slow, but it's also parallelizable. You can use the pcall library that img-genner uses in order to make it faster. However, this will require some significant changes in order to make it work well. We need to turn it into tasks and then wait for them in order.

We want to load as many as possible at once, but we have a limited amount of memory and if you're using sbcl it may be a rather painful experience once you hit your heap limit, so we can't load the entire video at once unless it is very small or you have a monstrous amount of memory and have configured your lisp to use it.

(loop ...
      for jobs = (loop with memory-used = 0
                       for input = (handle-case 
                                      (pngout:data (pngload:load-stream (uiop:process-output *ffmpeg-reader*)))
                                      (end-of-file (c) '())
                       while input
                       do(incf memory-used (array-total-size input))
                       until (> memory-used 20000000)
                       collect (let ((input input) (i (incf i)))
                                    (pcall:pexec 
                                       (prog1 (img-genner:colorize-naive (img-genner:upscale-image-by-factor input 0.75 0.75) colors)
                                              (print i)))))
     while jobs
     do(loop for i in jobs
             do(img-genner:save-image (pcall:join i) (uiop:process-input *ffmpeg-writer*)))

This is a very substantial change to the control flow as you can see. A few things that are important to note, in pexec calls, you need to have made a closure of whatever variables that change that you use inside pexec, otherwise they may be modified mid use, and quite simply, that's not ideal.

This is what could be called a "Bulk Sequential Process" design, and while it uses all the processors on your system effectively, the utilization tends to have ups and downs unless it is dispatched very carefully. In this case in particular, even if we did everything perfectly, we're just communicating with ffmpeg over a pipe, and there's a lot of overhead there, and even then, it is possible to outpace the encoder ffmpeg uses, even in common lisp(This is more likely with AVIF or vp8/vp9 rather than h264/h265 in my experience), and during these times your program is sitting around doing nothing, and while ffmpeg might be keeping your computer busy at these times, it likely as not won't be able to parallelize on the images of a size that are useful, and for things with unpredictable runtimes, it very well be a bottleneck.

Now theoretically, it should be possible to also splice the audio from the first file into the second with something like a named pipe, or if that fails, just exporting the audio on its own and then using it in the encoding command, but that sounds like a project in itself.

Animating direct to mp4 with img-genner

Two posts ago I started talking about img-genner. Guiding my authorship of the library by using it. Today I made a change that allows for what I think are exciting possibilities.

One of the best uses I've found for this library has been using it to generate animations, surprisingly I've started to take a liking to my own library(oh dear, I've started warming to my own work, whatever will I do with my non-existent objectivity?).

Today, I learned something very useful from the ffmpeg-user mailing list, that it is possible to just concatenate png files and pass them to ffmpeg. This enables an easy method for img-genner to be used to generate animations directly without having to turn the png files into video.

(ql:quickload :img-genner)
(defparameter *ffmpeg-format* "ffmpeg -f png_pipe -i - ~a ~a")
(defparameter *ffmpeg-input* (uiop:launch-program (format nil *ffmpeg-format* "-deadline best" "movie.webm") :input :stream))
(defparameter *image* (img-genner:make-image 640 480))

(defparameter *circles* nil)

(defun reset-image(image)
  ;Taken from the previous post
  (loop for i from 0 below (array-total-size image)
        do(setf (row-major-aref image i) 0)))
(defun bound(pos min-x min-y max-x max-y)
  ;As is this
  (setf (aref pos 0) (if (> (aref pos 0) max-x) min-x (if (< (aref pos 0) min-x) max-x (aref pos 0)))
        (aref pos 1) (if (> (aref pos 1) max-y) min-y (if (< (aref pos 1) min-y) max-y (aref pos 1)))))
(defun tick()
  (reset-image *image*)
  (loop for (i . (dx  dy c)) in *circles*
        do(img-genner:move-by i dx dy)
        do(bound (slot-value i 'img-genner:origin) 0.0 0.0 640.0 480.0)
        do(img-genner:rotate-by i (- (random 1.5) 0.75))
        do(img-genner:fill-shape i *image* (img-genner:static-color-stroker c))))
(loop repeat 20
      do(push
         (cons (img-genner:make-ellipse (random 640.0) (random 640.0) (+ 10.0 (random 10.0)) (+ 10.0 (random 10.0)))
               (list (1- (random 2.0)) (1- (random 2.0)) (img-genner:get-random-color)))
         *circles*))
(loop repeat 1000
      do(tick)
      (img-genner:save-image *image* (uiop:process-info-input *ffmpeg-input*)))

(uiop:close-streams *ffmpeg-input*)
(uiop:wait-process *ffmpeg-input*)

You will notice the return of some code from the last one, but it avoids the usage of hashtables.

The important part is the uiop:launch-program. It creates a process which runs asynchronously, that is, that it doesn't block, and you can obtain the input stream, which is what :input :stream does. Obtaining the stream is done by calling uiop:process-info-input on the ffmpeg-input structure.

The next step will be reading from ffmpeg, but I'll leave that for my next post.