Adjusting bounding boxes and aligning hexagonal picts

First, all the pict-related stuff is awesome. I've been using it a lot lately, and I probably haven't said thank you. So thank you, Racketeers.

I need to build pictures out of hexagons for a project I'm working on. (If an admin adds svg to the allowed filetypes, I'll include SVGs.)

You'll notice there's some difficulty aligning the hexagons properly… in this case, with weird overlaps and edges not quite lining up the way I would hope.

I've spent some time doing some math, and I know exactly how I would like the bounding boxes for the hexagons to work (SVG available here, too):

Essentially, the bounding box should be the yellow rectangle, I think. Based on the rotate docs, it comes out instead as a centered rectangle with height and width the sum of the colored lines (the "axes" in the bottom right that intersect the colored lines and rotated box are equivalent in height and width).

I think I can fix the box with inset, but testing so far has shown that there are some slight irregularities on the right and top sides of the bounding box, and my naïve difference-between-old-and-new hasn't worked. Before I waste time changing it to use the precise code like in the diagram, I want to ask:

Regardless of whether it's through bounding boxes or something else, what's an easy way can I get my hexagons to line up as if they were on a hexagonal grid? (Perhaps there's a trick to put the bounding box inside the hexagon, and then center the bounding boxes on a normal XY grid? Some sketches don't show a way this works though, since I want the diagonal edges to touch.)

And, yes, for the time being it's important that the hexagon corners are north-south.

Prototypical code, including that for both diagrams:

#lang racket

(require (only-in 2htdp/image regular-polygon)

(define old (regular-polygon 20 6 'outline 'black))
(define old-width (pict-width old))
(define old-height (pict-height old))
(define new (rotate (regular-polygon 20 6 'outline 'black) (/ pi 6)))
(define new-height (pict-height new))
(define new-width (pict-width new))
(define h-amt (- (/ (- new-width old-height) 2)))
(define v-amt (- (/ (- new-height old-width) 2)))
(define (hex mode color [size 20])
  (inset (rotate (regular-polygon size 6 mode color)
                 (/ pi 6))
         h-amt (sub1 v-amt) (sub1 h-amt) v-amt))

(define x
   (hex "solid" "red")
   (hex "outline" "black")
   (colorize (text "X") "white")))

(define o
   (hex "solid" "blue")
   (hex "outline" "black")
   (hex "outline" "cyan" 15)))

(define m
   (hex "solid" "grey")
   (hex "outline" "black")))

(define s
   (hex "outline" "black")))

(cc-superimpose (filled-rectangle 400 400 #:color "white")
                 (translate (hc-append x x (ghost s)) (* 2 h-amt) (* -2 v-amt))
                 (hc-append x x o)
                 (translate (hc-append x x (ghost s)) (* 2 h-amt) (* 2 v-amt)))
                (disk 2 #:color "black"))

(cc-superimpose (filled-rectangle 400 400 #:color "white")
                 (translate (hc-append x x (ghost s) (ghost s) (ghost s)) 0 (* -2 v-amt))
                 (translate (hc-append x x x m o) (* 2 (add1 h-amt)) 0)
                 (translate (hc-append x x (ghost s) (ghost s) (ghost s)) 0 (* 2 v-amt)))
                (disk 2 #:color "black"))

#;(explain o)
#;(explain old)

#;(explain (inset new h-amt (sub1 v-amt) (sub1 h-amt) v-amt))
#;(explain (scale-to-fit new old-height old-width #:mode 'distort))

;; old width = 2s
;; old height = sqrt(3) * s
;; new height = 5/2 * s
;; new width = 3/2 * sqrt(3) * s
;; where s is side length of hexagon

;; diagram with s = 6

(require rackunit)
(define (diagram s*)
  (define s (* 15 s*))
  (define w (* 2 s))
  (define h (* (sqrt 3) s))
  (define h* (* 5/2 s))
  (define w* (* 3/2 (sqrt 3) s))

  (define w*-a (/ (* 4 s) (sqrt 3)))
  (define w*-b (/ s 2 (sqrt 3)))
  (define htl (* -3/2 s))

  (define h*-a w)
  (define h*-b (/ s 2))
  (define wtr (* 1/2 s (sqrt 3)))

  (check-equal? (+ w*-a w*-b) w*)
  (check-equal? (+ h*-a h*-b) h*)

   ;; bg
   (filled-rectangle (* s 3) (* s 3) #:color "white")
   ;; desired bounding box for rotated hex
   (filled-rectangle h w #:color "yellow")
     ;; hex + bounding box, rotated
     (rotate (cc-superimpose (filled-rectangle w h #:color "white")
                             (regular-polygon s 6 'outline 'black))
             (/ pi 6))
     ;; parts of width of new bounding box
     (translate (colorize (hline w*-a 1) "blue") 0 htl)
     (translate (colorize (hline w*-b 1) "green") w*-a htl)
     (hline w* 1))
    ;; parts of height of new bounding box
    (translate (colorize (vline 1 h*-a) "red") (- wtr) 0)
    (translate (colorize (vline 1 h*-b) "purple") (- wtr) h*-a)
    (vline 1 h*))
   ;; dead-center of picture
   (disk s*)))

(diagram 6)

(with-output-to-file (expand-user-path "~/Desktop/hexagon.svg")
   (write-bytes (convert (diagram 6) 'svg-bytes))))

One idea to try (if inset and other bb adjusters aren't working out) is to write a new hexagon constructor directly using dc. You can draw wherever you want inside the proc that you supply to dc; the drawing will be based on the bounding box in the sense that the dx and dy arguments passed to the drawing procedure will tell you the upper--left corner of it, but there's no requirement for you to draw inside it. Then you might find it easier to compose the results of that function.

1 Like

And because the API gets a little complicated, here's some starter code that draws a wrong hexagon but maybe illustrates what I was suggesting?

#lang racket
(require pict)
(define (hex side-len)
   (λ (dc dx dy)
     (define x1 0)
     (define y1 0)
     (define (draw-to x2 y2)
       (send dc draw-line
             (+ x1 dx) (+ y1 dy)
             (+ x2 dx) (+ y2 dy))
       (set! x1 x2)
       (set! y1 y2))
     (draw-to 0 side-len)
     (draw-to (* side-len 1/2) (* side-len 3/2))
     (draw-to side-len side-len)
     (draw-to side-len 0)
     (draw-to (* side-len 1/2) (* side-len -1/2))
     (draw-to 0 0))

 (rectangle 300 300)
 (hex 100))

I like the bounding box idea! Using beside and above to construct a tiling of hexagons is pretty neat.

FWIW I had some hexagon code lying around - I intend to use it for the Metapict blog at some point.
The resource I used was Red Blob Games which has a fantastic page on hexagonal tilings:

Hexagonal Grids

The code below draws edges twice. This is fine for svgs, but can be troublesome for bitmaps.
Making the width and height odd helped in my example.

#lang racket
(require metapict metapict/crop)

;; Pointy top orientation

(define size   10)
(define height (* 2        size))
(define width  (* (sqrt 3) size))

(define 180deg 3.141592653589793)
(define  90deg (/ 180deg 2.))
(define  60deg (/ 180deg 3.))
(define  30deg (/ 180deg 6.))

(define (hexagon center)
  (define pts
    (for/list ([i (in-range 6)])
      (pt+ (pt (* size (cos (+ (* 60deg i) 30deg)))
               (* size (sin (+ (* 60deg i) 30deg))))
  (curve* (append (add-between pts --)
                  (list -- cycle))))

(define (draw-hexagon center)
  (draw (hexagon center)
        (penwidth 4 (color "blue" (draw center)))))

(define g (vec width 0))                ; vector from center of tile (0,0) to tile (1,0)
(define h (vec (* width (cos 60deg))    ; vector from center of tile (0,0) to tile (0,1)
               (* width (sin 60deg))))

(define (center i j)
  (pt+ origo (vec+ (vec* i g)
                   (vec* j h))))

(define (vec->hex v)
  ; Convert the vector into hex coordinates.
  ; That is, find i and h such that:
  ;    v = i g + j h
  ; To isolate j, we take the dot product with g^ on both sides:
  ;    v*g^ = i g*g^ + j h*g^
  ;    v*g^ = j h*g^
  ; Thus
  ;    j = v*g^ / h*g^
  ; Similarly
  ;    i = v*h^ / g*h^

  (def g^ (rot90 g))
  (def h^ (rot90 h))

  (def i (/ (dot v h^) (dot g h^)))
  (def j (/ (dot v g^) (dot h g^)))
  (vec i j))

"vec->hex test"
 (vec= (vec->hex (vec 0 0))                     (vec 0 0))
 (vec= (vec->hex (vec (* 1.5 width) 0))         (vec 1.5 0))
 (vec= (vec->hex (vec+ (vec* 1 g) (vec* 0 h)))  (vec 1 0))
 (vec= (vec->hex (vec+ (vec* 0 g) (vec* 1 h)))  (vec 0 1)))

(define (vec-round v)
  ; round down
  (define (r x) (inexact->exact (ceiling (- x 0.5))))
  (defm (vec x y) v)
  (vec (r x) (r y)))

;(vec-round (vec->hex (vec+ (vec* 0 g) (vec* 0.6 h)))) ; = (vec 0 1)

(set-curve-pict-size 401 401)
(with-window (window -30 130 -30 130)
  (draw (draw-hexagon (center 0 0))
        (draw-hexagon (center 1 0))
        (draw-hexagon (center 2 0))
        (color "red"  (draw-hexagon (center 0 1)))
        (color "blue" (draw-hexagon (center 2 0)))
        (color "blue" (draw-hexagon (center 2 1)))
        (penwidth 4 (color "black" (draw (pt+ origo (vec+ (vec* 0 g) (vec* 0.6 h))))))

(set-curve-pict-size 401 401)
(with-window (window -10 120 -10 120)
   (for*/draw ([i (in-range 0 5)] 
               [j (in-range 0 5)])
     (draw (hexagon (center i j))
           (label-cnt (~a "(" i "," j ")")
                      (center i j))))))
1 Like

Btw - if your are lucky, your existing code might work if you set the smoothing mode to 'smoothed or unsmoothed.

I initially resisted the dc idea, but having already done most of the math it was straightforward. The resulting code now feels like magic :slight_smile:

I original wrote the code with the dc's bounding box based on the rectangle inscribed in the hexagon (i.e., what is now the box described by the ascent and descent); this required some extra spacing when using vl-append to concatenate the rows. I realized I could take this extra-dy and make it part of the bounding box, if I was careful to account for it in the path I was drawing. Fortunately it only required a small adjustment to the dy (top-left corner) for the start of the path. I was able to end up including the ascent and descent, also.

Pictures first:

New code:

;; mostly similar requires, etc., except really only pict is needed now.
(define (custom-hex s)
  (define h (* (sqrt 3) s))
  (define r (* 1/2 h))
  (define extra-dy (* 1/2 s))

  (define path
    (let ([p (new dc-path%)])
      (begin0 p
        (send* p
               (move-to 0 0)
               (line-to 0 s)
               (line-to r (* 3/2 s))
               (line-to (* 2 r) s)
               (line-to (* 2 r) 0)
               (line-to r (* -1/2 s))

  (dc (λ (dc dx dy)
        (define old-pen (send dc get-pen))
        (send* dc
               (set-pen "black" 1 'solid)
               (draw-path path dx (+ dy (* 1/2 extra-dy)))
               (set-pen old-pen)))
      h (+ s extra-dy)
      (* 1/2 extra-dy) (* 1/2 extra-dy)))

(define size 30)
(define r (* 1/2 (sqrt 3) size))
(define S (custom-hex size))
(define X (cc-superimpose (colorize S "red")
                          (colorize (text "X" null (* 2/3 size)) "white")))
(define O (cc-superimpose (colorize S "cyan")
                          (colorize (custom-hex (* 2/3 size)) "blue")))
(define M (colorize S "gray"))
(define top (hc-append X X))
(define middle (translate (hc-append X X X M O) (- r) 0))
(define bottom (hc-append X X))
(define extra (translate (hc-append X (ghost S) X) (- r) 0))
(explain-child (cc-superimpose (rectangle 400 400)
                               (vl-append top middle bottom extra))
               top middle bottom extra
               #:scale 1)

Awesome!!! I think that dc is great for very limited shapes like this and then compose stuff on top of it (the little itnterpreter thingy that's in the would be better as dc if we were doing it over I suspect).

Did you find the contract checking of dc useful (ie the check that, in this case, the pen was restored)? That is, did you know to do that on your own or because of the contract system? (Asking for a friend ....:stuck_out_tongue_winking_eye:)


Not sure I follow this; I'll take your word for it :slight_smile:

I knew about it ahead of time, because I remembered reading it once and so checked the dc docs.