iRODS progress report Day 2(6/2/2022)

Today I spent my time trying to get the configuration file to reload after I successfully ran the test suite.

The first approach that I tried was hooking it into the Cron system. This has failed thus far because reloading the configuration on the main server causes use-after-frees (I think) due to contention over the json objects across different threads.

Reloading the server_properties object from any thread causes the same issues.

The correct way to fix it, I believe, is to add a read-write mutex that guards against mutation in flight. This will require additional copying, but given that the reloading is going to be fairly rare it should not affect performance for long.

Once it is thread-safe the cron system should be able to be used to check for changes in the configuration file.

Tomorrow I will most likely be setting it up again on my laptop.

3D Printing

I am not new to 3d printers. In college I helped to run the 3d printing lab, fulfilling requests to make things for various classes(at the time, the most promising was how it could be used to demonstrate anatomy with relatively cheap modifiable parts). That was around 2017. At the time the printer lab consisted of a few Flashforges, a few Makerbots, and an Ultimaker that was not functioning at any point that I was working there. Before that I had a Da Vinci 3d printer that had DRM on the filament spools, which was not very welcome, so I have been using these things across the majority of the last decade.

When I was there, we used various software for slicing, including the makerbot software, Cura, and Silc3r(now prusaslicer), and Simplify3d, in order of quality(Cura is better, and I don't have a simplify3d license or a reason to use makerbot software thank god, prusaslicer has also improved a lot).

More recently, I got an Ender 3 Pro, which is relatively nice. It is a much better experience than the Da Vinci printer in all the ways I can think of, so there has been substantial progress on making this a pleasant process. However, I have not even had the printer for a full month and the board seems to be flaking out on me. Halting, juddering movement, frequent complete lockups where who knows what could happen to the thermal runaway protection.

That is to say, 3d printers are still haunted by the specter of low quality electronic components, or alternately, it was fried when a lighting bolt struck a nearby power line, causing a blackout. They claimed the PSU was higher quality on the Ender 3 pro, but I'm not sure that it has delivered completely. Either way, the new board is on the way for later today, and we'll see if we need another set of components or if we have finally shaken all the bugs out.

Recently I've been trying to design moving parts that can be manufactured by 3d printers. I've been having trouble with the bearing being impossible to dislodge without comprehensively damaging the object. My next attempt will involve using more infill and turning off the brim, so hopefully the meshes will not become entangled so strongly, but I suspect that the ultimate solution is to increase the amount of tolerance between the moving parts in the design.

In general, I'm quite happy with how things are going with the printers, one of my partners is talking about building a voron printer, which would be capable of being very fast and very accurate, and that sounds like a lot of fun.

Returning to simple-dots-game after a while

It has been a while since I worked on this game. And after being away for a while, I can't really see the sources of frustration that I felt before. They were probably residual feelings from the frustration of getting it to a functional state and figuring out the system.

But there's something that was missing. The game on the android store is far less generous, and I must assume that it weights against cycles being created by new dots. It also has a smaller board which is probably more likely to be the cause of the difference in scores and cycle prevalence.

Currently it checks a small section of the board to see if the addition allows a cycle, but it is not very smart, and it should be possible to check for any cycle. But there's a point where that just seems petty. So I added another color to the other 4, purple(and also lightened up the blue so you can see its label).

What the game looks like now

As you can see I haven't really figured out what to do to improve the overall experience.

You can find the repository here if you missed the link earlier 🙂

Initial impressions of Orbtk

I've been meaning to get into rust for a long time, but there were some pieces missing from the ecosystem(good rust bindings for GUI applications appear to be hard to come by), but rust isn't like most of those other languages, it requires a different approach because many of the gui frameworks that have worked historically have been object oriented, but maybe I've just misunderstood.

The Orbtk toolkit seemed at first to have found a sweet spot with a mixture of entity component framework patterns and a functional reactive model, it feels, well, actually not that bad to use. I wasn't prepared for all those static &strs that the examples pepper throughout.

The demands feel a bit different than other toolkits I've used. Rendering is separated from widget state, which doesn't feel particularly helpful in this case. It's probably just the friction from adjusting to a new way of structuring the application, but the mouthfeel isn't very good so far.

Part of that comes from fighting the model as I figure out how exactly this pattern is meant to work, and how the graphics are rendered(so far I'm still stumped). In the meantime I've figured out how to use buttons.

One of the problems is the styling engine. It is very much doing things I would rather it not, such as adding hover animations to the buttons that mess up the game's board and makes it look even worse. Disabling the style on the buttons worked fine however, so it wasn't of too much concern.

The performance leaves much to be desired, especially when built in debug mode, though when it's run with the release optimizations turned on, it runs acceptably. It probably doesn't like having a hundred buttons on the screen at once, but like, that's not really all that much to ask of a web browser or most mature toolkits.

But as I find myself managing to accomplish my goals with the GUI, I'm finding my criticism feels a bit less urgent, the performance isn't that bad.

But that's besides the point, while I think I might even like the toolkit, it looks very slow moving, and many of the the answers I have found to my questions were pried out of reading the source code rather than documentation, which is, where it exists, pretty alright actually.

I want to try out the other data-oriented toolkits too, especially druid, which looks quite nice.

Though, honestly, I don't think I'm going to polish this particular implementation of this project any further, it just takes a lot more code than I think should be necessary to do anything new.

Another thing I noticed was that it tends to cause my KDE Neon install's kwin to flicker when the applications terminate, which can be very frustrating, especially very early on when nothing you're trying is working and you're throwing handfuls of noodles at the wall until you find a fix.

In any case, I'm pleasantly surprised compared to the last time I tried building a GUI in rust. The frameworks I have tried have got a ways to go, but if they keep working on it, I think OrbTK could be very good with time.

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*)