2.2.5 · Язык изображений · преобразования и композиция

Композиция рисователей через преобразование кадра

Преобразование рисователя меняет переданный кадр, поэтому beside, below, повороты и разбиения комбинируют процедуры, а запуск дает список отрезков.

Вопрос для размышления

Как всего несколько преобразований кадра позволяют создать язык повторно используемых комбинаций изображений?

Преобразование рисователя путем построения вложенного кадра
Определение beside и below как комбинаторов процедур
Выражение отражений и поворотов через один и тот же примитив преобразования
Построение композиции из четырех частей без изменения базового рисователя
Создание рекурсивного разбиения с ростом числа отрезков по мере увеличения глубины
Связывание отрисованного SVG с трассой отрезков выбранного запуска

Процедура transform-painter не переписывает данные отрезков рисователя. Она отображает три опорные точки единичного квадрата через внешний кадр и строит новый вложенный кадр. Исходный рисователь затем выполняется внутри этого вложенного кадра. Процедуры beside и below создают двух преобразованных рисователей и объединяют их списки отрезков, тогда как отражения и повороты представляют собой лишь разный выбор трех опорных точек.

Первый запуск размещает четыре преобразованных шеврона в квадрате. Второй запуск рекурсивно определяет right-split: левая половина сохраняет исходный рисователь, а правая половина объединяет по вертикали две уменьшенные копии. На глубине 3 базовый рисователь из трех отрезков порождает 45 отображенных отрезков. Средство визуализации отрисовывает в точности те строки SEG, которые выводит Lispex, и ограничивает только рендеринг в браузере, а не собственные пределы выполнения среды.

Код SICP4,491 из 1,048,576 байт UTF-8

(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)))
)

(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)))
)

Примеры

Результат—

Вывод: —
Значение: —
Диагностика: —

Трасса выполнения0 / 0 событий

Язык изображенийОтрисовка отрезков, созданных программой.

Загрузка среды выполнения

При этом запуске не было получено корректных строк SEG.

Отрисовано 0 отрезков из вывода программы.

Ожидаемый результат

Композиция из четырех частей выводит двенадцать строк SEG и возвращает (segments 12). Рекурсивное разбиение right-split глубины 3 выводит сорок пять строк SEG и возвращает (segments 45). Оба изображения SVG формируются из выбранной трассы Lispex.

На что обратить внимание в трассе

Найдите каждый вызов transform-painter, создающий вложенный кадр перед тем, как базовый рисователь отобразит свои отрезки. В right-split проследите за возвращаемыми процедурами рисователей по всей глубине рекурсии, затем проведите различие между композицией процедур и последующим созданием конечного списка отрезков во время отрисовки.

Попробуйте сами

Измените программу и сравните результат.

Определите up-split, разместив исходный рисователь под двумя уменьшенными копиями, расположенными рядом друг с другом. Отрисуйте глубину 3 и определите количество отрезков перед запуском.

Показать подсказку

Используйте вызов below painter (beside smaller smaller). Рекуррентная формула для числа отрезков совпадает с right-split, поскольку на каждой положительной глубине создаются одна текущая копия и две уменьшенные копии.

Завершить этот урок

В этой главе пройдено 0 из 20 уроков0%