2.2.4 · Picture language · painters and frames

A painter maps a frame to a finite set of segments.

Vectors, segments, and frames form a geometric data language. A painter maps its unit-square endpoints through the frame supplied at application time.

Guiding question

How can one painter describe the same picture inside square, skewed, or scaled frames?

Represent vectors and segments with constructor-selector interfaces
Represent a frame with an origin and two edge vectors
Map unit-square coordinates into one concrete frame
Construct a painter as a procedure from frames to segment lists
Print machine-readable SEG lines without replacing the returned value
Read the monochrome SVG as a rendering of actual Lispex output

The segment data is written in unit-square coordinates. frame-coordinate-map takes a vector whose x and y components are relative positions and combines the frame origin with scaled copies of its two edge vectors. segments->painter captures a finite segment list and returns a procedure that maps every endpoint through the frame supplied later.

The first run places one outline-and-cross painter inside a square frame. The second applies a diamond painter to a skewed frame. The painter definitions do not contain the final page coordinates. Each run prints one SEG line per mapped segment, and the app-local visualizer parses those transcript lines into a monochrome SVG. The returned (segments n) value remains a separate observation.

SICP code2,452 of 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 (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 (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 p00 (make-vect 0.0 0.0))
  (define p10 (make-vect 1.0 0.0))
  (define p11 (make-vect 1.0 1.0))
  (define p01 (make-vect 0.0 1.0))
  (define outline-and-cross
    (segments->painter
      (list
        (make-segment p00 p10)
        (make-segment p10 p11)
        (make-segment p11 p01)
        (make-segment p01 p00)
        (make-segment p00 p11)
        (make-segment p01 p10))))
  (paint outline-and-cross
         (make-frame (make-vect 0.08 0.08)
                     (make-vect 0.84 0.0)
                     (make-vect 0.0 0.84))))

(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 (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 (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 p00 (make-vect 0.0 0.0))
  (define p10 (make-vect 1.0 0.0))
  (define p11 (make-vect 1.0 1.0))
  (define p01 (make-vect 0.0 1.0))
  (define outline-and-cross
    (segments->painter
      (list
        (make-segment p00 p10)
        (make-segment p10 p11)
        (make-segment p11 p01)
        (make-segment p01 p00)
        (make-segment p00 p11)
        (make-segment p01 p10))))
  (paint outline-and-cross
         (make-frame (make-vect 0.08 0.08)
                     (make-vect 0.84 0.0)
                     (make-vect 0.0 0.84))))

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Picture languageRender the segments produced by the program.

Loading runtime

No valid SEG lines were produced by this run.

0 segments rendered from program output.

Expected result

The first program prints six SEG lines and returns (segments 6). The second prints four transformed SEG lines and returns (segments 4). The SVG beside the workbench is parsed from those transcript lines.

Trace focus

Follow the painter application into frame-coordinate-map, then inspect each endpoint as the frame origin plus an x-scaled first edge and a y-scaled second edge. The transcript output and returned segment count remain separate observations.

Try it yourself

Change the program and compare the result.

Add the four midpoint-to-midpoint segments that form an inner diamond inside the first painter. Predict the new segment count, then confirm that the visualizer renders the additional shape from the SEG output.

Show hint

The side midpoints are (0.5, 0.0), (1.0, 0.5), (0.5, 1.0), and (0.0, 0.5). The painter remains independent of the final frame.

Complete this lesson

0 of 20 lessons complete in this chapter0%