Moiré Patterns: Square and Hexagon

Overlaid hexagon grids with moderate rotational offset

A square grid with a slight rotational offset gives a square or diamond zig-zag grid:

With smaller squares, the checkerboard pattern is more interesting:

Hexagonal grids give an interesting variety of overlap patterns in one image:

The new code is below:

;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define* (draw-square-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list orig-x orig-y)
                      (list (+ orig-x base-l) orig-y)
                      (list (+ orig-x base-l) (+ orig-y base-l)))))))

(define* (draw-square-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 10))
    (do ((j 0 (1+ j)))
        ((> j 80))
        (do ((i 0 (1+ i)))
            ((> i 80))
          (draw-square-block
           r
           (+ (* i base-l) offset-x)
           (+ (* j base-l) offset-y)
           base-l
           #:rotr rotr)))))

(define* (draw-hexagon-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list orig-x orig-y)
                      (list (- orig-x base-hl)
                            (+ orig-y base-h))
                      (list orig-x
                            (+ orig-y (* 2 base-h)))
                      (list (+ orig-x base-l)
                            (+ orig-y (* 2 base-h)))
                      (list (+ orig-x base-l base-hl)
                            (+ orig-y base-h))
                      (list (+ orig-x base-l)
                            orig-y))))
    (render-draw-lines
     r
     (map ccomp (list (list (- orig-x base-hl)
                            (+ orig-y base-h))
                      (list (- orig-x base-hl base-l)
                            (+ orig-y base-h)))))))

(define* (draw-hexagon-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j 0 (1+ j)))
        ((> j 40))
        (do ((i 0 (1+ i)))
            ((> i 40))
          (draw-hexagon-block
           r
           (+ offset-x
              (* i 3 base-l))
           (+ offset-y (* j 2 base-h))
           base-l
           #:rotr rotr)))))

Moiré Patterns

Moiré pattern with two overlaid triangle tilings with a slight rotation offset

An interesting thing to play around with is Moiré patterns, which are new patterns you get when you overlay two identical patterns but with some slight displacement. The above and below images are using two triangle tilings. My code displays the tilings and allows rotational and translation adjustment using some keyboard keys. The pattern for the overlaid triangle tilings seems to be generally some number of hexagons at various sizes.

Pattern with less hexagons.

This was the most interesting, however, was this dodecagon-like shape when around a 30 degree rotation offset or so.

Pattern with dodecagon-like shapes.
;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(use-modules (sdl2)
             (sdl2 video)
             (sdl2 rect)
             (sdl2 surface)
             (sdl2 render)
             (sdl2 input keyboard)
             (sdl2 events))

(define (cex coord) (list (inexact->exact (round (car coord)))
                          (inexact->exact (round (cadr coord)))))

(define (rot rad coords)
  (let* ((x (car coords))
         (y (cadr coords))
         (cpx (make-rectangular x y))
         (fact (exp (* rad 0+i)))
         (ncpx (* cpx fact)))
    (list (real-part ncpx) (imag-part ncpx))))

(define* (draw-tri-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list (+ orig-x base-l) orig-y)
                      (list (+ orig-x base-hl)
                            (+ orig-y base-h))
                      (list (+ orig-x base-hl base-l)
                            (+ orig-y base-h))
                      (list (+ orig-x base-l) (ex orig-y)))))))

(define* (draw-tri-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j 0 (1+ j)))
        ((> j 40))
        (do ((i 0 (1+ i)))
            ((> i 40))
          (draw-tri-block
           r
           (+ (* i base-l)
              (if (zero? (floor-remainder j 2)) 0 base-hl)
              offset-x)
           (+ (* j base-h) offset-y)
           base-l
           #:rotr rotr)))))

(define rot-radius 0)

(define rot-inc (/ 3.1415 5096))

(define trans-x 0)

(define trans-y 0)

(define trans-inc 1)

(define (main)
  (sdl-init)
  (let* ((mywindow (make-window
                  #:title "Super Awesome Window"
                  #:opengl? #t
                  #:size '(1024 768)))
         (glc (make-gl-context mywindow))
         (myrect (make-rect 100 100 200 100))
         (mysurface (make-rgb-surface 300 300 32))
         (myrenderer (make-renderer mywindow)))
    (set-gl-swap-interval! 'vsync)
    (while (not (key-pressed? 'q))
      (usleep 100)
      (poll-event)
      (if (key-pressed? 'r)
          (set! rot-radius (+ rot-inc rot-radius)))
      (if (key-pressed? 't)
          (set! rot-radius (- rot-radius rot-inc)))
      (if (key-pressed? 'j)
          (set! trans-x (- trans-x trans-inc)))
      (if (key-pressed? 'k)
          (set! trans-x (+ trans-x trans-inc)))
      (if (key-pressed? 'i)
          (set! trans-y (- trans-y trans-inc)))
      (if (key-pressed? 'm)
          (set! trans-y (+ trans-y trans-inc)))
      (set-render-draw-color myrenderer 0 0 0 255)
      (clear-renderer myrenderer)
      (set-render-draw-color myrenderer 0 255 255 255)
      (draw-tri-pattern myrenderer 0 0)
      (draw-tri-pattern myrenderer trans-x trans-y #:rotr rot-radius)
      (present-renderer myrenderer))
    (close-window! mywindow)
  (sdl-quit)))

Geometric Tilings with Guile-SDL2

Equilateral triangle tiling using Guile SDL2

I am trying to get back to the fun of being able to draw things on the screen using lisp. The Guile SDL2 module proved a handy tool. The code below was run using guile and guile-sdl from Guix commit 62942992831249d6d1c047c0a11c41d2ecccc4fc.

;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(use-modules (sdl2)
             (sdl2 video)
             (sdl2 rect)
             (sdl2 surface)
             (sdl2 render)
             (sdl2 input keyboard)
             (sdl2 events))

(define (ex x) (inexact->exact (round x)))

(define (draw-tri-block r orig-x orig-y base-l)
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5)))
    (render-draw-lines
     r
     (list (list (ex (+ orig-x base-l)) (ex orig-y))
           (list (ex (+ orig-x base-hl))
                 (ex (+ orig-y base-h)))
           (list (ex (+ orig-x base-hl base-l))
                 (ex (+ orig-y base-h)))
           (list (ex (+ orig-x base-l)) (ex orig-y))))))

(define (draw-tri-pattern r)
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j -4 (1+ j)))
        ((> j 40))
        (do ((i -4 (1+ i)))
            ((> i 40))
          (draw-tri-block
           r
           (+ (* i base-l) (if (zero? (floor-remainder j 2)) 0 base-hl))
           (* j base-h) base-l)))))

(define (main)
  (sdl-init)
  (display (sdl-version))
  (display "\r\n")
  (display (sdl-ticks))
  (display "\r\n")
  (let* ((mywindow (make-window
                  #:title "Super Awesome Window"
                  #:opengl? #t))
         (glc (make-gl-context mywindow))
         (myrect (make-rect 100 100 200 100))
         (mysurface (make-rgb-surface 300 300 32))
         (myrenderer (make-renderer mywindow)))
    (set-gl-swap-interval! 'vsync)
    (set-render-draw-color myrenderer 0 0 0 255)
    (clear-renderer myrenderer)
    (set-render-draw-color myrenderer 0 255 255 255)
    (draw-tri-pattern myrenderer)
    (present-renderer myrenderer)
    (while (not (key-pressed? 'q)) (usleep 100) (poll-event))
    (close-window! mywindow)
  (sdl-quit)))

Guile: (buffer repository)

In a step towards constructing my block-programming framework, I coded this (buffer repository) module:

(buffer repository)
(buffer repository tests)

(make-buffer-repository smallest-pwr largest-pwr)

 A procedure in module (buffer repository).
 Make a buffer repository instance. Parameters refer to the sizes of buffers
  stored in the repository. The smallest size is 2 to the smallest-pwr, the
  largest is 2 to the largest-pwr. 

(checkout-buffer! requested-bytes (buffer-repository) (#:spawn))

A procedure in module (buffer repository).

Checkout a buffer (bytevector) from the buffer-repository. If
 buffer-repository is not specified, parameter %buffer-repository is
 used. The default action, if a buffer is not available from the
 appropriate size bucket, is to generate a new buffer. If #:spawn #f is
 passed, checkout-buffer! will throw the 'empty-bucket exception
 instead. The buffer returned might be larger than the number of bytes
 requested. A 'no-match exception will be thrown if the size-requested
 is not in the range of buffer sizes stored by the buffer-repository.

(checkin-buffer! buffer (buffer-repository))

A procedure in module (buffer repository).

Return a buffer (bytevector) to the buffer-repository. If
 buffer-repository is not specified, parameter %buffer-repository is
 used. It is the responsibility of the calling code not to use the
 buffer after it has been checked in. Technically the buffer does not
 have to be one that was originally checked-out from the
 buffer-repository, but checkin-buffer will throw exceptions if the
 buffer is not the proper size to fit in a repository bucket.

git clone git://git.librehacker.com/pub/git/hackrf-rkt.git

Circular Bytevector Copy and Consumable Buffer

I coded a circular-bytevector-copy! function which handles the logic to copy from one vector to another, wrapping around the source and destination vectors as much as necessary.

I coded also a <consumable-buffer> class which implements a FIFO buffer of fix memory size, but implemented with circular reads and writes for efficiency.

(buffer)
(buffer tests)