Racket code for drawing mildly interesting, spirally nested circles

spiral.rkt

#lang racket

(require pict)

;;;; The original code (it works alright)

#|
(define faces '(N S E W))

(define (next-face f)
  (cond [(symbol=? f 'N) 'E]
        [(symbol=? f 'E) 'S]
        [(symbol=? f 'S) 'W]
        [(symbol=? f 'W) 'N]))

(define (prev-face f)
  (cond [(symbol=? f 'N) 'W]
        [(symbol=? f 'E) 'N]
        [(symbol=? f 'S) 'E]
        [(symbol=? f 'W) 'S]))

(define (circle-me size count)
  (add-next-circle (circle size) 
                   'N 
                   (sub1 count)))

(define (add-next-circle base face count)
  (if (<= count 0)
      base
      (let* {[base-width (pict-width base)]
             [new-circle-width (next-diameter base-width)]
             [new-circle (circle new-circle-width)]
             [filled-circle (add-next-circle new-circle
                                             (prev-face face)
                                             (sub1 count))]
             [dx (next-dx base-width 
                          new-circle-width
                          face)]
             [dy (next-dy base-width 
                          new-circle-width
                          face)]
             }
        (pin-over base dx dy filled-circle))))

(define (next-diameter base-width)
  (* 2 
     (sqrt (/ (sqr (/ base-width
                      2)) 
              1.618))))

(define (next-dx base-size new-size face)
  (cond [(symbol=? face 'N) (/ (- base-size new-size) 2)]
        [(symbol=? face 'S) (/ (- base-size new-size) 2)]
        [(symbol=? face 'E) (- base-size new-size)]
        [(symbol=? face 'W) 0]))

(define (next-dy base-size new-size face)
  (cond [(symbol=? face 'N) 0]
        [(symbol=? face 'S) (- base-size new-size)]
        [(symbol=? face 'E) (/ (- base-size new-size) 2)]
        [(symbol=? face 'W) (/ (- base-size new-size) 2)]))
|#


; Here's the cleaned up version: still < 100 LoC

; scanl :: ((a, b) -> b), b, [a] -> b
; straight from Haskell source... EXCEPT the order of f's arguments is flipped
; to be consistent with Racket foldl
(define (scanl f q ls)
  (cons q (if (empty? ls)
              null
              (scanl f 
                     (f (first ls) q)
                     (rest ls)))))

(define (next-face f)
  (cond [(symbol=? f 'N) 'E]
        [(symbol=? f 'E) 'S]
        [(symbol=? f 'S) 'W]
        [(symbol=? f 'W) 'N]))

(define (next-dx base-size new-size face)
  (cond [(symbol=? face 'N) (/ (- base-size new-size) 2)]
        [(symbol=? face 'S) (/ (- base-size new-size) 2)]
        [(symbol=? face 'E) (- base-size new-size)]
        [(symbol=? face 'W) 0]))

(define (next-dy base-size new-size face)
  (cond [(symbol=? face 'N) 0]
        [(symbol=? face 'S) (- base-size new-size)]
        [(symbol=? face 'E) (/ (- base-size new-size) 2)]
        [(symbol=? face 'W) (/ (- base-size new-size) 2)]))

; circle-help :: (Pict, Face)
(struct circle-help (pic next-face))

; combine-circle :: Pict, Circle-Help -> Circle-Help
(define (combine-circle next-circle intermediate)
  (let* {[face (circle-help-next-face intermediate)]
         [front-circle (circle-help-pic intermediate)]
         [dx (next-dx (pict-width next-circle) 
                      (pict-width front-circle) 
                      face)]
         [dy (next-dy (pict-width next-circle) 
                      (pict-width front-circle) 
                      face)]
         } 
    (circle-help (pin-over next-circle dx dy front-circle) 
                 (next-face face))))

; build-spirals :: Natural, Natural -> [Pict]
; preserves intermediates by using a scan instead of a fold
; The very last pict in the list is the same as result of `build-spiral`
(define (build-spirals largest count)
  (let* {[circles (build-circles largest count)]
         [results (scanl combine-circle
                         (circle-help (first circles) 'N)
                         (rest circles))]
         }
    (map circle-help-pic results)))

; build-spiral :: Natural, Natural -> Pict
; This could be reduced to:
; `(first (reverse (build-spirals largest count)))`
; but this was written first and avoid a bit of extra computation when
; you don't need it for the result
(define (build-spiral largest count)
  (let* {[circles (build-circles largest count)]
         [result (foldl combine-circle 
                        (circle-help (first circles) 'N) 
                        (rest circles))]
        }
    (circle-help-pic result)))

;; build-circles :: Natural, Natural -> [Pict]
(define (build-circles largest count)
  (map circle (build-diameters largest count)))

;; build-diameters :: Natural, Natural -> [Real]
(define (build-diameters largest count)
  (map ((curry *) 2)
       (build-radii (/ largest 2) count)))

;; build-radii :: Natural, Natural -> [Real]
(define (build-radii largest count)
  (build-radii-helper largest count null))

;; build-radii-helper :: Real, Natural, [Real] -> [Real]
;; Tail-recursive-ish helper function for `build-radii`
(define (build-radii-helper base-radius remaining-count result-list)
  (if (zero? remaining-count)
      result-list
      (build-radii-helper (next-radius base-radius)
                          (sub1 remaining-count)
                          (cons base-radius result-list))))

;; next-radius :: Real -> Real
(define (next-radius r)
  (sqrt (/ (sqr r) 1.618)))

(define (save-pict pic path)
  (send (pict->bitmap pic)
        save-file
        path
        'png))