2.15 · Picture language · transformations and composition

A geometric transform returns another painter.

Transforming a painter changes the frame passed to it. Beside, below, flips, rotations, and recursive splits therefore compose procedures while the final run still produces an ordinary finite segment list.

Guiding question

How can a few frame transformations create a language of reusable picture combinations?

Transform a painter by constructing a subframe
Define beside and below as procedure combinators
Express flips and rotations with the same transformation primitive
Build a four-part composition without changing the base painter
Generate a recursive split whose segment count grows with depth
Relate the rendered SVG to the segment transcript from the selected run

transform-painter does not rewrite the painter’s segment data. It maps three unit-square control points through the outer frame and constructs a new subframe. The original painter then runs inside that subframe. beside and below create two transformed painters and append their segment lists, while flips and rotation are just different choices of the three control points.

The first run places four transformed chevrons in a square. The second defines right-split recursively: the left half keeps the original painter while the right half stacks two smaller copies. At depth three, a three-segment base painter produces 45 mapped segments. The visualizer draws exactly the SEG lines produced by Lispex and caps only the browser rendering, not the runtime’s own execution limits.

Lispex · SICP sourceScheme-compatible SICP syntax executed by the Lispex SICP profile.

(begin
  (define (make-vect x y) (list x y))
  (define (xcor-vect vector) (car vector))
  (define (ycor-vect vector) (cadr vector))
  (define (add-vect left right)
    (make-vect (+ (xcor-vect left) (xcor-vect right))
               (+ (ycor-vect left) (ycor-vect right))))
  (define (sub-vect left right)
    (make-vect (- (xcor-vect left) (xcor-vect right))
               (- (ycor-vect left) (ycor-vect right))))
  (define (scale-vect factor vector)
    (make-vect (* factor (xcor-vect vector))
               (* factor (ycor-vect vector))))
  (define (make-segment start end) (list start end))
  (define (start-segment segment) (car segment))
  (define (end-segment segment) (cadr segment))
  (define (make-frame origin edge1 edge2)
    (list origin edge1 edge2))
  (define (origin-frame frame) (car frame))
  (define (edge1-frame frame) (cadr frame))
  (define (edge2-frame frame) (caddr frame))
  (define (frame-coordinate-map frame)
    (lambda (vector)
      (add-vect
        (origin-frame frame)
        (add-vect
          (scale-vect (xcor-vect vector) (edge1-frame frame))
          (scale-vect (ycor-vect vector) (edge2-frame frame))))))
  (define (map-segment coordinate-map segment)
    (make-segment
      (coordinate-map (start-segment segment))
      (coordinate-map (end-segment segment))))
  (define (segments->painter segment-list)
    (lambda (frame)
      (let ((coordinate-map (frame-coordinate-map frame)))
        (map (lambda (segment)
               (map-segment coordinate-map segment))
             segment-list))))
  (define (transform-painter painter origin corner1 corner2)
    (lambda (frame)
      (let* ((coordinate-map (frame-coordinate-map frame))
             (new-origin (coordinate-map origin))
             (mapped-corner1 (coordinate-map corner1))
             (mapped-corner2 (coordinate-map corner2)))
        (painter
          (make-frame
            new-origin
            (sub-vect mapped-corner1 new-origin)
            (sub-vect mapped-corner2 new-origin))))))
  (define (beside left right)
    (let ((paint-left
           (transform-painter
             left
             (make-vect 0.0 0.0)
             (make-vect 0.5 0.0)
             (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter
             right
             (make-vect 0.5 0.0)
             (make-vect 1.0 0.0)
             (make-vect 0.5 1.0))))
      (lambda (frame)
        (append (paint-left frame)
                (paint-right frame)))))
  (define (below bottom top)
    (let ((paint-bottom
           (transform-painter
             bottom
             (make-vect 0.0 0.0)
             (make-vect 1.0 0.0)
             (make-vect 0.0 0.5)))
          (paint-top
           (transform-painter
             top
             (make-vect 0.0 0.5)
             (make-vect 1.0 0.5)
             (make-vect 0.0 1.0))))
      (lambda (frame)
        (append (paint-bottom frame)
                (paint-top frame)))))
  (define (flip-horiz painter)
    (transform-painter
      painter
      (make-vect 1.0 0.0)
      (make-vect 0.0 0.0)
      (make-vect 1.0 1.0)))
  (define (flip-vert painter)
    (transform-painter
      painter
      (make-vect 0.0 1.0)
      (make-vect 1.0 1.0)
      (make-vect 0.0 0.0)))
  (define (rotate180 painter)
    (transform-painter
      painter
      (make-vect 1.0 1.0)
      (make-vect 0.0 1.0)
      (make-vect 1.0 0.0)))
  (define (emit-segment segment)
    (let ((start (start-segment segment))
          (end (end-segment segment)))
      (display "SEG ")
      (display (xcor-vect start))
      (display " ")
      (display (ycor-vect start))
      (display " ")
      (display (xcor-vect end))
      (display " ")
      (display (ycor-vect end))
      (newline)))
  (define (paint painter frame)
    (let ((segments (painter frame)))
      (for-each emit-segment segments)
      (list 'segments (length segments))))
  (define chevron
    (segments->painter
      (list
        (make-segment (make-vect 0.1 0.12)
                      (make-vect 0.5 0.9))
        (make-segment (make-vect 0.5 0.9)
                      (make-vect 0.9 0.12))
        (make-segment (make-vect 0.25 0.42)
                      (make-vect 0.75 0.42)))))
  (define quartet
    (below
      (beside chevron (flip-horiz chevron))
      (beside (flip-vert chevron) (rotate180 chevron))))
  (paint quartet
         (make-frame (make-vect 0.04 0.04)
                     (make-vect 0.92 0.0)
                     (make-vect 0.0 0.92)))
)

Lispex learning runtimeLispex SICP profile 1.0.0

Loading Lispex SICP runtime

Lispex · SICP source4,491 / 1,048,576 UTF-8 bytes

(begin
  (define (make-vect x y) (list x y))
  (define (xcor-vect vector) (car vector))
  (define (ycor-vect vector) (cadr vector))
  (define (add-vect left right)
    (make-vect (+ (xcor-vect left) (xcor-vect right))
               (+ (ycor-vect left) (ycor-vect right))))
  (define (sub-vect left right)
    (make-vect (- (xcor-vect left) (xcor-vect right))
               (- (ycor-vect left) (ycor-vect right))))
  (define (scale-vect factor vector)
    (make-vect (* factor (xcor-vect vector))
               (* factor (ycor-vect vector))))
  (define (make-segment start end) (list start end))
  (define (start-segment segment) (car segment))
  (define (end-segment segment) (cadr segment))
  (define (make-frame origin edge1 edge2)
    (list origin edge1 edge2))
  (define (origin-frame frame) (car frame))
  (define (edge1-frame frame) (cadr frame))
  (define (edge2-frame frame) (caddr frame))
  (define (frame-coordinate-map frame)
    (lambda (vector)
      (add-vect
        (origin-frame frame)
        (add-vect
          (scale-vect (xcor-vect vector) (edge1-frame frame))
          (scale-vect (ycor-vect vector) (edge2-frame frame))))))
  (define (map-segment coordinate-map segment)
    (make-segment
      (coordinate-map (start-segment segment))
      (coordinate-map (end-segment segment))))
  (define (segments->painter segment-list)
    (lambda (frame)
      (let ((coordinate-map (frame-coordinate-map frame)))
        (map (lambda (segment)
               (map-segment coordinate-map segment))
             segment-list))))
  (define (transform-painter painter origin corner1 corner2)
    (lambda (frame)
      (let* ((coordinate-map (frame-coordinate-map frame))
             (new-origin (coordinate-map origin))
             (mapped-corner1 (coordinate-map corner1))
             (mapped-corner2 (coordinate-map corner2)))
        (painter
          (make-frame
            new-origin
            (sub-vect mapped-corner1 new-origin)
            (sub-vect mapped-corner2 new-origin))))))
  (define (beside left right)
    (let ((paint-left
           (transform-painter
             left
             (make-vect 0.0 0.0)
             (make-vect 0.5 0.0)
             (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter
             right
             (make-vect 0.5 0.0)
             (make-vect 1.0 0.0)
             (make-vect 0.5 1.0))))
      (lambda (frame)
        (append (paint-left frame)
                (paint-right frame)))))
  (define (below bottom top)
    (let ((paint-bottom
           (transform-painter
             bottom
             (make-vect 0.0 0.0)
             (make-vect 1.0 0.0)
             (make-vect 0.0 0.5)))
          (paint-top
           (transform-painter
             top
             (make-vect 0.0 0.5)
             (make-vect 1.0 0.5)
             (make-vect 0.0 1.0))))
      (lambda (frame)
        (append (paint-bottom frame)
                (paint-top frame)))))
  (define (flip-horiz painter)
    (transform-painter
      painter
      (make-vect 1.0 0.0)
      (make-vect 0.0 0.0)
      (make-vect 1.0 1.0)))
  (define (flip-vert painter)
    (transform-painter
      painter
      (make-vect 0.0 1.0)
      (make-vect 1.0 1.0)
      (make-vect 0.0 0.0)))
  (define (rotate180 painter)
    (transform-painter
      painter
      (make-vect 1.0 1.0)
      (make-vect 0.0 1.0)
      (make-vect 1.0 0.0)))
  (define (emit-segment segment)
    (let ((start (start-segment segment))
          (end (end-segment segment)))
      (display "SEG ")
      (display (xcor-vect start))
      (display " ")
      (display (ycor-vect start))
      (display " ")
      (display (xcor-vect end))
      (display " ")
      (display (ycor-vect end))
      (newline)))
  (define (paint painter frame)
    (let ((segments (painter frame)))
      (for-each emit-segment segments)
      (list 'segments (length segments))))
  (define chevron
    (segments->painter
      (list
        (make-segment (make-vect 0.1 0.12)
                      (make-vect 0.5 0.9))
        (make-segment (make-vect 0.5 0.9)
                      (make-vect 0.9 0.12))
        (make-segment (make-vect 0.25 0.42)
                      (make-vect 0.75 0.42)))))
  (define quartet
    (below
      (beside chevron (flip-horiz chevron))
      (beside (flip-vert chevron) (rotate180 chevron))))
  (paint quartet
         (make-frame (make-vect 0.04 0.04)
                     (make-vect 0.92 0.0)
                     (make-vect 0.0 0.92)))
)

Examples

Result—

Output: —
Value: —
Diagnostic: —

Visible execution0 / 0 trace events

This browser result is not a Lispex Vouch record or authority.wasm —

Execution-linked picture languageRender the segments produced by Lispex.

loading runtime

No valid SEG lines were produced by this run.

0 segments parsed from the local Lispex transcript.

Expected observation

The four-part composition prints twelve SEG lines and returns (segments 12). The depth-three right split prints forty-five SEG lines and returns (segments 45). Both SVGs are derived from the selected Lispex transcript.

Trace focus

Find each transform-painter call constructing a subframe before the base painter maps its segments. In right-split, follow the returned painter procedures through the recursive depth, then distinguish procedure composition from the later finite segment production at paint time.

Try it yourself

Change the program before you read the hint.

Define up-split by stacking the original painter below two smaller copies placed beside each other. Render depth three and predict the segment count before running it.

Show one hint

Use below painter (beside smaller smaller). The segment-count recurrence is the same as right-split because one current copy and two smaller copies are produced at each positive depth.