2.2.4 · Язык изображений · рисователи и кадры

Рисователь как отображение кадра в отрезки

Векторы, отрезки и кадры образуют геометрический язык данных, а рисователь переносит концы отрезков из единичного квадрата через переданный кадр.

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

Как один рисователь может описывать одно и то же изображение внутри квадратного, скошенного или масштабированного кадра?

Представление векторов и отрезков через интерфейсы конструкторов и селекторов
Представление кадра с помощью начала координат и двух векторов краев
Отображение координат единичного квадрата в один конкретный кадр
Построение рисователя как процедуры, преобразующей кадры в списки отрезков
Вывод машиночитаемых строк SEG без изменения возвращаемого значения
Чтение монохромного SVG как отображения фактического вывода Lispex

Данные отрезков задаются в координатах единичного квадрата. Процедура frame-coordinate-map принимает вектор, чьи компоненты x и y выражают относительные положения, и складывает начало координат кадра с масштабированными копиями двух его векторов краев. Процедура segments->painter фиксирует конечный список отрезков и возвращает процедуру, которая отображает каждую конечную точку через кадр, переданный позже.

Первый запуск помещает рисователь рамки с диагоналями внутрь квадратного кадра. Второй запуск применяет рисователь ромба к скошенному кадру. Определения рисователей не содержат итоговых координат страницы. Каждый запуск выводит по одной строке SEG на каждый отображенный отрезок, а встроенное средство визуализации преобразует эти строки трассы в монохромный SVG. Возвращаемое значение (segments n) остается отдельным наблюдением.

Код SICP2,452 из 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 (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))))

Примеры

Результат—

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

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

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

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

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

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

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

Первая программа выводит шесть строк SEG и возвращает (segments 6). Вторая программа выводит четыре преобразованные строки SEG и возвращает (segments 4). Изображение SVG рядом с рабочим местом формируется из этих строк трассы.

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

Проследите за применением рисователя при переходе в frame-coordinate-map, затем проверьте каждую конечную точку как сумму начала координат кадра, первого края с масштабом x и второго края с масштабом y. Вывод в трассу и возвращенное количество отрезков остаются отдельными наблюдениями.

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

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

Добавьте четыре отрезка между серединами сторон, образующие внутренний ромб в первом рисователе. Определите новое число отрезков, затем убедитесь, что средство визуализации отрисовывает дополнительную фигуру по выводу SEG.

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

Середины сторон имеют координаты (0.5, 0.0), (1.0, 0.5), (0.5, 1.0) и (0.0, 0.5). Рисователь остается независимым от итогового кадра.

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

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