Библиотека функций к Script-fu

Функциональный подход.

Подготовка к созданию языка Питера Хендерсона, языка функциональной геометрии.

Создав функции отображения фигур(fig, figs) и изображений(img) в заданные рамки(rect), мы практически подошли к созданию языка функциональной геометрии. Но базовые возможности языка созданного на лекциях SICP, немного отличаются от языка Питера Хендерсона. Дело в том что на лекциях SICP в целях облегчения усвоения материала, лектор упростил возможности отображения изображений в рамку. На лекциях осуществлялось точное отображение, из полных габаритов рисунка в полные габариты рамки. Но язык Питера Хендерсона предусматривает расширенное отображение исходного изображения в предоставленную рамку, его примитивы как бы "проникают" друг в друга, при этом в саму ограничивающую рамку может отображаться только специально выделяемая часть изображения, остальная же часть изображения может размещаться ВНЕ пределов заполняемой рамки.

Проще всего это продемонстрировать на примере "рыбы".

загрузка библиотек

(define path-home (getenv "HOME"))
(define path-lib (string-append path-home "/work/gimp/lib/"))
(define path-work (string-append path-home "/work/gimp/"))
(load (string-append path-lib "util.scm"))
(load (string-append path-lib "defun.scm"))
(load (string-append path-lib "struct.scm"))
(load (string-append path-lib "point.scm"))
(load (string-append path-lib "tr2d.scm"))
(load (string-append path-lib "contour.scm"))
(load (string-append path-lib "img.scm"))
(load (string-append path-lib "rect.scm"))
(load (string-append path-lib "vect.scm"))
(load (string-append path-lib "brush.scm"))
(load (string-append path-lib "fig.scm"))
(load (string-append path-lib "pic.scm"))

Отображаем изображение рыбы и рамки жёлтым фоном.

(define i1 (create-1-layer-img 640 480)) ;; создаём изображение
;;загружаем изображение рыбы
(define isource4 (car (file-png-load 1
                                     (string-append path-work "fish2.png") "t2")))

(define fish-min-x 51)  ;;граница изображения рыбы с которой необходимо размещать рыбу в рамке
(define fish-width  (car (gimp-image-width    isource4))) ;;размеры рыбы
(define fish-height (car (gimp-image-height   isource4)))

;;контур для визуализации рамки
(define c1 (make-rect-contour 0 0 (- fish-width fish-min-x) fish-height))

;;кисти для рисования визуализации рамки
(define bsh1 (make-brush1 :name  "2. Hardness 075"  :size 5  :opacity 100))
(define bsh2 (make-brush1 :name  "2. Hardness 075"  :size 20 :opacity 30))

;;составная фигура
(define fs1
   (list
    (make-shape-fig  c1 :color '(255 255 0) :brush bsh2)
    (make-brush-fig  c1 :color '(0 255 0) :brush bsh1)
    ))

;;рамки в начале координат
(define r1   (rect! (p! 0 0) (p! fish-width 0) (p! 0 fish-height)))
(define r1r  (rect! (p! fish-min-x 0) (p! (- fish-width fish-min-x) 0) (p! 0 fish-height)))

;; отображение рыбы и визуализация рамки
(draw-from-image-rect i1 isource4  r1)
(draw-figs  i1 fs1 r1r)

;; второе отображение рыбы и рамки
(define r3  (rect! (p! 300 300) (p! fish-width 0) (p! 0 (- fish-height))))
(define r3r (rect! (p! (+ 300 fish-min-x) 300) 
                   (p! (- fish-width fish-min-x) 0) (p! 0 (- fish-height))))

(draw-from-image-rect i1 isource4  r3)
(draw-figs  i1 fs1 r3r)

"Рисование фигуры рыбы. выходящей за пределы рамки "

Рамка в пределах которой надо рисовать изображение обозначена жёлтым цветом.

Для выполнения этого рисунка я немного изменил функцию рисования фигур. Ранее я игнорировал установку кисти для заполняемых цветом фигур(shape). Я добавил в функцию make-brush1 возможность устанавливать прозрачность кисти:

(defun (make-brush1  &key name size angle aspect-ratio
                    hardness spacing force opacity)
         ...
         (if opacity
             (gimp-context-set-opacity opacity))
         ))

(define (draw-fig img fig tr)
      ....
       ((eq? (fig-type fig) 'shape)
        ((fig-brush fig))
      ....

Теперь мы можем рисовать фигуры и установкой кисти управлять прозрачностью и прозрачностью цвета заполнения. К сожалению эта возможность доступна только для версии 2.10, где для заполнения используется функция gimp-drawable-edit-fill, в 2.6 доступна только функция gimp-edit-fill игнорирующая прозрачность.

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

;;рисовать фигуру будем задавая габариты рамки фигуры, а если они не будут заданы
;;то габаритами будут считаться габариты фигуры. поэтому фигура может быть как
;; быть в рамках габаритов, так и выходить за них. тоже самое и с изображением.
(defun (draw-figs-ext3 img list-fig r &key min-x min-y max-x max-y)
   (let* ((delta      0.00001)
          (p-min      (min-pos-figs list-fig))
          (p-max      (max-pos-figs list-fig))
          (min-gab-x  (if min-x min-x (p-x p-min)));;габариты формир. отображение фигуры
          (min-gab-y  (if min-y min-y (p-y p-min)))
          (max-gab-x  (if max-x max-x (p-x p-max)))
          (max-gab-y  (if max-y max-y (p-y p-max)))
          (tr         (make-tr2d-from-rect r
                                           (- max-gab-x min-gab-x)
                                           (- max-gab-y min-gab-y)))
          (dw         (car (gimp-image-get-active-drawable img))))
      (if (or (> (abs min-gab-x) delta)
              (> (abs min-gab-y) delta));;начало фигуры сдвинуто относительно
          (set! tr (comb-tr2d           ;;начала координат надо подвинуть туда!
                    (make-tr2d-move (- min-gab-x) (- min-gab-y))
                    tr)))
      (do ((cur list-fig (cdr cur)))
            ((null? cur) list-fig)
         (let ((cur-fig (car cur)))
            (draw-fig img cur-fig tr)
            ))
      ))

;;рисование изображения в заданном rect (условном прямоугольнике заданном векторами)
;;на исходном изображении заданы границы в рамках которых и проецируется исходное
;;изображение
(defun (draw-from-image-rect-ext img src dest-r &key min-x min-y max-x max-y)
   (let* ((width      (car (gimp-image-width  src)))
          (height     (car (gimp-image-height src)))
          ;;(width      (- (p-x max-pos) (p-x min-pos)))
          ;;(height     (- (p-y max-pos) (p-y min-pos)))
          (min-gab-x  (if min-x min-x 0)) ;;габариты формирующие отображение фигуры
          (min-gab-y  (if min-y min-y 0))
          (max-gab-x  (if max-x max-x width))
          (max-gab-y  (if max-y max-y height))
          (tr         (comb-tr2d
                       (make-tr2d-move (- min-gab-x)
                                       (- min-gab-y))
                       (make-tr2d-from-rect dest-r
                                            (- max-gab-x min-gab-x)
                                            (- max-gab-y min-gab-y)))))
      (draw-from-image-trans img src tr)
      ))

Проведём тест, рисуя рыбу и фигуру со сложным контуром, части которого могут отображаться вне заданной рамки:

Код теста

(define i1 (create-1-layer-img 640 480)) ;; создаём изображение
;;загружаем изображение рыбы
(define isource4 (car (file-png-load 1
                                     (string-append path-work "fish2.png") "t2")))

(define fish-min-x 51)  ;;граница изображения рыбы с которой необходимо размещать рыбу в рамке
(define fish-width  (car (gimp-image-width    isource4))) ;;размеры рыбы
(define fish-height (car (gimp-image-height   isource4)))

(define c1 (make-rect-contour 0 0 10 10)) ;;это контур для обозначения рамки.

;;составная фигура обозначающая рамку
(define fs1
   (list
    (make-shape-fig  c1 :color '(255 255 0) :brush bsh2)
    (make-brush-fig  c1 :color '(0 255 0) :brush bsh1)
    ))

;;кисти для рисования визуализации рамки
(define bsh1 (make-brush1 :name  "2. Hardness 075"  :size 5  :opacity 100))
(define bsh2 (make-brush1 :name  "2. Hardness 075"  :size 20 :opacity 30))

;;определим рамки.
(define r1  (rect! (p! 0 0) (p! 100 0) (p! 0 100))) ;;рамка в начале координат
(define r2  (rect! (p! 50 300) (p! 100 0) (p! 0 (- 100))))  ;;рамка для рыбы
(define r3  (rect! (p! 300 300) (p! 100 0) (p! 0 (- 100)))) ;;рамка для сложной фигуры.

;;рисуем в рамке предназначенной для отображения рыбы
(draw-from-image-rect-ext i1 isource4  r3 :min-x fish-min-x) ;;часть изображения может быть вне рамки.
(draw-figs  i1 fs1 r3) ;; фигура размещается в габаритах рамки.

;; создадим сложный контур
(define c2 (list (p! 40 20) (p! 100 20) (p! 100 0) (p! 120 0) (p! 120 20) (p! 140 20) 
                 (p! 140 60) (p! 160 60) (p! 160 80) (p! 100 80) 
                 (p! 100 100) (p! 0 100) (p! 0 60) (p! 40 60) (p! 40 20)))
;; на его основе создадим фигуру
(define fs2
   (list
    (make-shape-fig  c2 :color '(0 0 255)   :brush bsh2)
    (make-brush-fig  c2 :color '(0 255 127) :brush bsh1)
    ))

;;нарисуем фигуру в рамке в начале координат
(draw-figs  i1 fs2 r1)

;; рисуем фигуру с возомжностью выхода за границы рамки
(draw-figs-ext3  i1 fs2 r2 :min-x 20 :min-y 20 :max-x 140) ;;сложная фигура имеет три ограничения.

;; обозначим рамку жёлтым цветом с зелёной каймой.
;;(draw-figs-ext3  i1 fs1 r2)
(draw-figs       i1 fs1 r2) ;; эти два вызова дают эквивалентный результат(т.к фигура не имеет частей выходящих за пределы рамки)

Теперь не важно какой размер имеет фигура или изображение, в рамку попадёт только та часть, которая отсекается ограничениями задаваемыми при вызове функции.

"Рисование фигуры рыбы и сложного контура. выходящей за пределы рамки "

Теперь, имея в наличии функции расширенного отображения фигур и изображений мы можем приступать к реализации языка функциональной геометрии.

И в принципе, на этом данная статья и должна была бы и закончиться, основные моменты я здесь указал. Но поскольку ранее я рассказал об объектном подходе при реализации фигур, я счёл возможным продемонстрировать этот подход и здесь.

Объектный подход.

При объектном подходе задачи перед нами стоят те же самые, наши фигуры должны получить возможность иметь возможность обозначать внутри себя участок фигуры точно отображающийся в заданную рамку, а другая часть будет отображаться вне указанной рамки. Если же таких границ не задавать, то как и прежде вся фигура будет отображаться целиком в указанную рамку.

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

(define-m (init-contour-shabl i-contour)
  (let ((min-p (min-pos i-contour))
        (max-p (max-pos i-contour)))
    (set! contour i-contour)
    (unless min-x
       (set! min-x (p-x min-p)))
    (unless min-y
       (set! min-y   (p-y min-p)))
    (unless max-x
       (set! max-x   (p-x max-p)))
    (unless max-y
       (set! max-y   (p-y max-p)))))


(define-m (get-gabarite-shabl)
   (list min-x min-y max-x max-y))

(define-m (get-name-shabl)
   name)

Инициализация хранимых габаритов, претерпела незначительные измения, если ранее мы безусловно брали габариты из имеющегося контура, то теперь если ранее габарит был уже установлен, функция инициализации его не изменяет.

Если ранее я "выделывался" чтобы показать, что внутренний формат хранения габаритов не зависим и местами хранил эти габариты в виде точек, то теперь я счёл этот момент запутывающим и установил для всех объктов единый формат хранения габаритов, в связи с чем шаблон функции отображения в рамку упростился:

(define-m (draw-fig-in-rect-shabl img r)
   (let  ((delta      0.00001)
          (tr  (make-tr2d-from-rect r
                                    (- max-x min-x)
                                    (- max-y min-y))))
      (if (or (> (abs min-x) delta)  ;;min-x
              (> (abs min-y) delta));;min-y фигуры сдвинуто относительно
          (set! tr (comb-tr2d            ;;начала координат надо подвинуть туда!
                    (make-tr2d-move (- min-x) (- min-y))
                    tr)))
      (draw img tr)))

Почему так? Потому что для получения отображения в рамку, я предполагаю что отображаемое изображение(фигура) находятся в нулевой позиции оси координат, исходя из этих предположений, функция make-tr2d-from-rect и строит преобразование в рамку, а если координаты изображения сдвинуты от нуля, то всё изображение надо "подвинуть" в нулевую позицию.

И вот так теперь мы будем определять класс фигур рисуемых кистью.

;;одноконтурная фигура рисуемая кистью
(defclass brush-fig
   (name (color default-color) (brush default-brush)
         contour min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((init-contour i-contour)
     (body-func init-contour-shabl))
    ((draw img tr)
     (let* ((contour    (if tr
                            (translate-contour contour tr)
                            contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        (gimp-context-set-foreground color)
        (brush)
        (gimp-paintbrush-default  dw (* 2  num-points) points)
        ;;contour
        ))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

(defun (brush-fig! &key (name "brush fig") (color default-color) (brush default-brush)
                   contour min-x min-y max-x max-y)
   (let ((f (make-brush-fig :name name :color color :brush brush
                            :min-x min-x :min-y min-y :max-x max-x :max-y max-y)))
      (f :init-contour contour)
      f))

И этот класс практически идентичен, который был описан в предыдущей статье, возникает вопрос, а что, что поменялось то?!? А поменялся именно шаблон, производящий трансформацию смещающую контур заданную нулевую позицию габаритов фигуры. И эта трансформация гарантирует нам корректное отображение части фигуры в заданную рамку, а части фигуры не попавшей в задаваемые габариты, в корректные места рядом с заданной рамкой. И поскольку функция шаблон, это аналог метода базового класса(которых у нас к сожалению нет в нашей простой объектной системе), то изменяется поведение объектов для всех классов которые используют шаблон данной функции.

Помимо этого я ввёл функцию (инициализирующий конструктор) brush-fig! и объекты теперь надо создавать используя её, а не конструктор, создаваемый по умолчанию. Интерфейс тот же, что и у конструктора по умолчанию, только теперь не надо вызывать отдельно инициализацию контура.

класс одноконтурной фигуры заливаемой цветом

(defclass shape-fig
   (name (color default-color) (brush default-brush)
         contour min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((init-contour i-contour)
     (body-func init-contour-shabl))
    ((draw img tr)
     (let* ((contour    (if tr
                            (translate-contour contour tr)
                            contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
       (gimp-context-set-foreground color)
       (when brush (brush))
       (gimp-free-select  img (- (* 2  num-points) 1) points  CHANNEL-OP-REPLACE 0 0 0)
       ;;(gimp-edit-fill dw  FOREGROUND-FILL) ;; для gimp 2.6
       (gimp-drawable-edit-fill dw  FILL-FOREGROUND)
       (gimp-selection-none img)))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

(defun (shape-fig! &key (name "shape fig") (color default-color) (brush default-brush)
                   contour min-x min-y max-x max-y)
   (let ((f (make-shape-fig :name name :color color :brush brush
                            :min-x min-x :min-y min-y :max-x max-x :max-y max-y)))
      (f :init-contour contour)
      f))

Здесь есть небольшие изменения, поменялась функция заливки, чтобы в 2.10 поддержать использование прозрачности.

класс одноконтурной фигуры рисуемой карандашом

(defclass pencil-fig
   (name (color default-color) (brush default-brush)
         contour min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((init-contour i-contour)
     (body-func init-contour-shabl))
    ((draw img tr)
     (let* ((contour    (if tr
                            (translate-contour contour tr)
                            contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        (gimp-context-set-foreground color)
        (brush)
        (gimp-pencil  dw (* 2  num-points) points)))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

(defun (pencil-fig! &key (name "shape fig") (color default-color) (brush default-brush)
                   contour min-x min-y max-x max-y)
   (let ((f (make-pencil-fig :name name :color color :brush brush
                            :min-x min-x :min-y min-y :max-x max-x :max-y max-y)))
     (f :init-contour contour)
     f))

Со сложной(комплексной) фигурой, как говорится - "всё сложно". С одной стороны она учитывает габариты входящих в неё фигур при подсчёте своих габаритов, с другой при построении она учитывает только свои габариты. Поэтому в её составе лучше не ставить фигуры имеющие какие либо габариты отличающиеся от габаритов фигур(т.е как раз выходящих за рамки). Возможно в дальнейшем, это поведения я подкорректирую, но пока у меня в голову не помещается как сформировать внятное изображение фигуры, на базе виртуальных габаритов входящих в неё простых(или сложных) фигур. Хотя с точки зрения математики и программирования ничего сложного в этом нет, перед отображением спросить у фигуры её габариты, и если эти габариты отличаются от габаритов сложной фигуры, составить трансформацию приводящую простую фигуру в позицию и размер, соответствующих габаритов в сложной фигуре, сложить полученную трансформацию с имеющейся и выполнить отображение. Но пока мы работаем по простому алгоритму не учитывающему виртуальные габариты простых фигур.

класс сложной фигуры состоящей из списка фигур

(define-m (minmax-pos-figs list-fig)
   (if (not (null? list-fig))
       (let ((min-x maxnum)
             (min-y maxnum)
             (max-x minnum)
             (max-y minnum))
          (do ((cur list-fig (cdr cur)))
                ((null? cur) (list (p! min-x min-y) (p! max-x max-y)))
             (let ((gab ((car cur) :get-gabarite)))
                (if (< (car gab) min-x)
                    (set! min-x (car gab)))
                (if (< (cadr gab) min-y)
                    (set! min-y (cadr gab)))
                (if (> (caddr gab) max-x)
                    (set! max-x (caddr gab)))
                (if (> (cadddr gab) max-y)
                    (set! max-y (cadddr gab)))
                )
             ))
       (prn ("error in minmax-pos-figs: list fig empty!\n"))))

(defclass complex-fig
   (name figs min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((init-figs i-figs) ;;принимает список фигур
     (let ((gab (minmax-pos-figs i-figs)))
        (unless min-x
           (set! min-x (p-x (car gab))))
        (unless min-y
           (set! min-y (p-y (car gab))))
        (unless max-x
           (set! max-x (p-x (cadr gab))))
        (unless max-y
           (set! max-y (p-y (cadr gab))))        
        (set! figs  i-figs)))
    ((draw img tr)
     (let* ((delta      0.00001)
            (dw         (car (gimp-image-get-active-drawable img))))
        (do ((cur figs (cdr cur)))
              ((null? cur) figs)
           ((car cur) :draw img tr))
        ))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())


(defun (complex-fig! &key (name "shape fig")
                     figs min-x min-y max-x max-y)
  (let ((f (make-complex-fig :name name
                             :min-x min-x :min-y min-y :max-x max-x :max-y max-y)))
    (prn "gab: " (f :get-gabarite) "\n")
    (f :init-figs figs)
    f))

Помимо указанных выше классов, я добавил ещё пару классов: класс изображений фигур и класс текстовых фигур.

класс одиночного изображения

(defclass image-fig
   (name image min-x min-y max-x max-y flip)
   (((get-name)
     (body-func get-name-shabl))
    ((init-img i-img) ;;принимает изображение
     (let ((width      (car (gimp-image-width  i-img)))
           (height     (car (gimp-image-height i-img))))
        (unless min-x
           (set! min-x 0))
        (unless min-y
           (set! min-y 0))
        (unless max-x
           (set! max-x width))
        (unless max-y
           (set! max-y height))        
        (set! image  i-img)))
    ((draw img tr)
     (draw-from-image-trans img image (if flip
                                          (comb-tr2d
                                           (make-tr2d-reflect-x)
                                           (make-tr2d-move 0 (+ min-y max-y))
                                           tr)
                                          tr)))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

(defun (image-fig! &key (name "image fig") 
                      image min-x min-y max-x max-y flip) 
   (let ((f (make-image-fig :name name 
                            :min-x min-x :min-y min-y :max-x max-x :max-y max-y :flip flip)))
     (f :init-img image)
      f))

Здесь я не стал мудрить, а просто использовал функцию draw-from-image-trans описанную ранее в GIMP Script-Fu Первый Дан. Линейные преобразования на плоскости.

Класс текстовых фигур более сложен и связано это с тем, что получить габариты текстового изображения, до его размещения на основном изображении невозможно, GIMP просто не предоставляет таких возможностей.

класс текстовой фигуры.

(defclass text-fig
   (name text font (height 100) (flip #f) color min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((draw img tr)
     (let ((tl (insert-to-img img)))
        (when flip
           (set! tr (comb-tr2d
                     (make-tr2d-reflect-x)
                     (make-tr2d-move 0 (+ min-y max-y))
                     tr)))
         (draw-use-tr2d tl img tr)
         tl))
    ((draw-to-rect img r)
     (let ((tl (insert-to-img img))
           (delta      0.00001)
           (tr  (if flip
                    (comb-tr2d
                     (make-tr2d-reflect-x)
                     (make-tr2d-move 0 (+ min-y max-y))
                     (make-tr2d-from-rect r
                                          (- max-x min-x)
                                          (- max-y min-y)))
                    (make-tr2d-from-rect r
                                         (- max-x min-x)
                                         (- max-y min-y)))))
        (if (or (> (abs min-x) delta)  ;;min-x
                (> (abs min-y) delta)) ;;min-y фигуры сдвинуто относительно
            (set! tr (comb-tr2d            ;;начала координат надо подвинуть туда!
                      (make-tr2d-move (- min-x) (- min-y))
                      tr)))
        (draw-use-tr2d tl img tr)
        tl))
    ((insert-to-img img)
     (let ((tl (car (gimp-text-layer-new img text font height 0))))
        (gimp-image-insert-layer img tl -1 0)
        (let ((width      (car (gimp-drawable-width  tl)))
              (height     (car (gimp-drawable-height tl))))    
           (unless min-x
              (set! min-x 0))
           (unless min-y
              (set! min-y 0))
           (unless max-x
              (set! max-x width))
           (unless max-y
              (set! max-y height)))
        tl))
    ((draw-use-tr2d tl img tr)
     (let ((m11 (tr2d-m11 tr))
           (m12 (tr2d-m12 tr))
           (m21 (tr2d-m21 tr))
           (m22 (tr2d-m22 tr))
           (mx  (tr2d-dx  tr))
           (my  (tr2d-dy  tr)))
        (gimp-text-layer-set-color  tl color)
        (gimp-item-transform-matrix tl
                                    m11 m21 mx
                                    m12 m22 my
                                    0   0   1)
        (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

(defun (text-fig! &key (name "text fig") 
                      text font (height 100) (flip #f) color min-x min-y max-x max-y)
   (let ((f (make-text-fig :name name :text text :font font :height height :color color :flip flip
                           :min-x min-x :min-y min-y :max-x max-x :max-y max-y)))
      f))

Весь код я свёл в файл fig-obj2.scm, теперь можно приступить к тестированию.

Тестирование.

подготовка.

(define path-home "D:") ;;для виндовс
;;(define path-home (getenv "HOME"))
(define path-lib (string-append path-home "/work/gimp/lib/"))
(define path-work (string-append path-home "/work/gimp/"))
(load (string-append path-lib "util.scm"))
(load (string-append path-lib "defun.scm"))
(load (string-append path-lib "struct.scm"))
(load (string-append path-lib "point.scm"))
(load (string-append path-lib "tr2d.scm"))
(load (string-append path-lib "contour.scm"))
(load (string-append path-lib "img2.6.scm"))
(load (string-append path-lib "rect.scm"))
(load (string-append path-lib "vect.scm"))
(load (string-append path-lib "brush-2.6.scm"))
(load (string-append path-lib "obj2.scm"))
(load (string-append path-lib "fig-obj2.scm"))

(define i1 (create-1-layer-img 640 480)) ;;подготовим полотно для рисования.

Изображение на котором будем рисовать i1.

Первым делом протестируем brush-fig создадим фигуру полностью умещающуюся в рамку и фигуру слегка выходящую за рамку. Поскольку мы используем один и тот же контур, во втором случае он у нас слегка вытягивается вдоль оси X.

код примера brush-fig

(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
;;поскольку в функции рисования мы больше не выравниваем контур по началу координат, надо его выправнивать предварительно
;;если конечно это нам действительно надо.

;;(define c1 (contour-to-origin (make-circle-n 50 50 50 10)))
(define c1 (make-circle-n 50 50 50 10))
(define c2 (make-rect-contour 0 0 50 50))

;;фигуры круга и прямоугольника точно умещающиеся в рамку
(define f1 (brush-fig! :name 'circle1 :color '(255 255 0) :contour c1))
(define f2 (brush-fig! :name 'rect1   :color '(255 0 0)   :contour c2))

(f2 :draw-to-rect i1 r1)
(f1 :draw-to-rect i1 r1)

;;фигура в которой контур сдвинут(выходит за рамку по минимальной х координате) на 10 пикселов.
(define r2 (make-rect-by-vect (p! 250 100) (p! 200 0) (p! 0 200)))
(define f3 (brush-fig! :name 'circle2 :color '(255 255 0) :contour c1 :min-x 10))

(f2 :draw-to-rect i1 r2)
(f3 :draw-to-rect i1 r2)

Проверим как мы "выходим за рамки" с разных сторон рамок.

код примера 2 brush-fig

(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
(define c2 (make-rect-contour 0 0 50 50))

(define c3 (contour-to-origin (translate-contour (make-star 50 5 0.3)
                                                 (make-tr2d-rot -90))))

(define f2 (brush-fig! :name 'rect1 :color '(255 0 0) :contour c2))
(define f3 (brush-fig! :name 'star1 :color '(0 255 0) :contour c3))

(define r2 (make-rect-by-vect (p! 100 350) (p! 100 0) (p! 0 -100)))
(define r3 (make-rect-by-vect (p! 250 350) (p! 100 0) (p! 0 -100)))
(define r4 (make-rect-by-vect (p! 400 350) (p! 150 0) (p! 0 -150)))

(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)


(define f3m1 (brush-fig! :name 'star1 :color '(0 255 0) :contour c3
                        :min-x 20 ))

(define pos-c3t-m (max-pos c3))
(define f3m2 (brush-fig! :name 'star1 :color '(0 255 0) :contour c3
                         :min-x 20  :max-x (- (p-x pos-c3t-m) 20)))
(define f3m3 (brush-fig! :name 'star1 :color '(0 255 0) :contour c3
                         :min-x -20  :max-x (+ (p-x pos-c3t-m) 20)))

(f3 :draw-to-rect i1 r1)
(f3m1 :draw-to-rect i1 r2)
(f3m2 :draw-to-rect i1 r3)
(f3m3 :draw-to-rect i1 r4)

(define f3m4 (brush-fig! :name 'star1 :color '(0 0 255) :contour c3
                         :min-x 10  :max-x (- (p-x pos-c3t-m) 10)
                         :min-y 10  :max-y (- (p-y pos-c3t-m) 10)))
(f3m4 :draw-to-rect i1 r4)

(define r5 (make-rect-by-vect (p! 170 390) (p! 290 0) (p! 0 -290)))
(f2 :draw-to-rect i1 r5)
(f3m4 :draw-to-rect i1 r5)

"Пример использования brush-fig. Рисуем звёзды "

Теперь не меняя контуры, протестируем shape-fig.

код примера shape-fig

(define c2 (make-rect-contour 0 0 50 50))
(define c3 (translate-contour (make-star 50 5 0.3)
                              (make-tr2d-rot 90)))

(define f2 (brush-fig! :name 'rect1   :color '(255 0 0)   :contour c2))
(define f3 (shape-fig! :name 'star1 :color '(0 255 0) :contour c3))

(define c3t (contour-to-origin c3))
(define f3m (shape-fig! :name 'star1 :color '(0 255 0) :contour c3t
                        :min-x 20 ))

(define pos-c3t-m (max-pos c3t))
(define f3m2 (shape-fig! :name 'star1 :color '(0 255 0) :contour c3t
                         :min-x 20  :max-x (- (p-x pos-c3t-m) 20)))

(define f3m3 (shape-fig! :name 'star1 :color '(0 255 0) :contour c3t
                         :min-x -20  :max-x (+ (p-x pos-c3t-m) 20)))
(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
(define r2 (make-rect-by-vect (p! 100 350) (p! 100 0) (p! 0 -100)))
(define r3 (make-rect-by-vect (p! 250 350) (p! 100 0) (p! 0 -100)))
(define r4 (make-rect-by-vect (p! 400 350) (p! 150 0) (p! 0 -150)))
(define r5 (make-rect-by-vect (p! 170 390) (p! 290 0) (p! 0 -290)))

(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)

(f3   :draw-to-rect i1 r1)
(f3m  :draw-to-rect i1 r2)
(f3m2 :draw-to-rect i1 r3)
(f3m3 :draw-to-rect i1 r4)

(define bsh2 (make-brush1 :name  "2. Hardness 075"  :size 20 :opacity 50))

(define f3m4 (shape-fig! :name 'star1 :color '(0 0 155) :contour c3t
                         :brush  bsh2
                         :min-x 10  :max-x (- (p-x pos-c3t-m) 10)
                         :min-y 10  :max-y (- (p-y pos-c3t-m) 10)))
(f3m4 :draw-to-rect i1 r4)
(f2   :draw-to-rect i1 r5)
(f3m4 :draw-to-rect i1 r5)

"Пример использования shape-fig. Рисуем звёзды "

Используя контуры звезды протестируем сложные фигуры.

код примера complex-fig

(define c2 (make-rect-contour 0 0 50 50))
(define c3 (translate-contour (make-star 50 5 0.3)
                              (make-tr2d-rot 90)))
(define c3t (contour-to-origin c3))

(define bsh1 (make-brush1 :name  "2. Hardness 075"  :size 10 :opacity 100 ))
(define bsh2 (make-brush1 :name  "2. Hardness 025"  :size 3  :opacity 100))
(define bsh3 (make-brush1 :name  "2. Hardness 075"  :size 10 :opacity 70))

(define f1 (brush-fig!  :name 'rect1   :color '(255 0 0)    :contour c2))
(define f2 (shape-fig!  :name 'star1   :color '(127 127 0)  :contour c3t :brush bsh3))
(define f3 (brush-fig!  :name 'star2   :color '(127 0 255)  :contour c3t :brush bsh1))
(define f4 (pencil-fig! :name 'star3   :color '(255 0 0)    :contour c3t :brush bsh2))

(define fs0 (complex-fig! :name 'star1x :figs (list f2 f3 f4)))
(define fs1 (complex-fig! :name 'star1x :figs (list f2 f3 f4)
                          :min-x 20 ))

(define pos-c3t-m (max-pos c3t))
(define fs2 (complex-fig! :name 'star2x :figs (list f2 f3 f4)
                          :min-x 20  :max-x (- (p-x pos-c3t-m) 20)))

(define fs3 (complex-fig! :name 'star3x :figs (list f2 f3 f4)
                          :min-x -20  :max-x (+ (p-x pos-c3t-m) 20)))

(define ft1 (make-complex-fig :name 's1 :max-y 23 :min-x 12))

(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
(define r2 (make-rect-by-vect (p! 100 350) (p! 100 0) (p! 0 -100)))
(define r3 (make-rect-by-vect (p! 250 350) (p! 100 0) (p! 0 -100)))
(define r4 (make-rect-by-vect (p! 400 350) (p! 150 0) (p! 0 -150)))
(define r5 (make-rect-by-vect (p! 170 390) (p! 290 0) (p! 0 -290)))

(gimp-context-set-opacity 100)

(f1 :draw-to-rect i1 r1)
(f1 :draw-to-rect i1 r2)
(f1 :draw-to-rect i1 r3)
(f1 :draw-to-rect i1 r4)

(fs0 :draw-to-rect i1 r1)
(fs1 :draw-to-rect i1 r2)
(fs2 :draw-to-rect i1 r3)
(fs3 :draw-to-rect i1 r4)

(define fs4 (complex-fig! :name 'star4x :figs (list f2 f3 f4)
                         :min-x 10  :max-x (- (p-x pos-c3t-m) 10)
                         :min-y 10  :max-y (- (p-y pos-c3t-m) 10)))
(f1  :draw-to-rect i1 r5)
(fs4 :draw-to-rect i1 r5)

"Пример использования complex-fig. Рисуем звёзды "

Для проверки работы image-fig я взял изображение "рыбы" Питера Хендерсона. Здесь я продемонстрирую работу флага flip, переворачивающего изображение вверх ногами. Это очень полезный флаг, который я также использую и с текстом. Дело в том, что GIMP вопреки обычным человеческим представлениям считает, что чем низ это верх, потому что его координаты 'Y' растут вниз экрана, с точки зрения нормального человека это скажем так - непривычно. Поэтому для создания нормального восприятия я создаю "перевёрнутые" рамки r2 и r3.

код примера image-fig

(define isource4 (car (file-png-load 1
                                     (string-append path-work "fish2.png") "t2")))

(define fish-min-x 51)  ;;граница изображения рыбы с которой необходимо размещать рыбу в рамке
(define fish-width  (car (gimp-image-width    isource4))) ;;размеры рыбы
(define fish-height (car (gimp-image-height   isource4)))

(define ff1 (image-fig! :image isource4 :min-x fish-min-x))
(define ff2 (image-fig! :image isource4 :min-x fish-min-x :flip #t))

(define c1 (make-rect-contour 0 0 10 10)) ;;это контур для обозначения рамки.

;;кисти для рисования визуализации рамки
(define bsh1 (make-brush1 :name  "2. Hardness 075"  :size 5  :opacity 100))
(define bsh2 (make-brush1 :name  "2. Hardness 075"  :size 20 :opacity 30))

;;составная фигура обозначающая рамку
;; (define fs1
;;    (list
;;     (make-shape-fig  c1 :color '(255 255 0) :brush bsh2)
;;     (make-brush-fig  c1 :color '(0 255 0) :brush bsh1)
;;     ))
(define fs1 (complex-fig! :figs (list (shape-fig! :contour c1 :color '(255 255 0) :brush bsh2)
                                      (brush-fig! :contour c1 :color '(0 255 0)   :brush bsh1))))

;;определим рамки.
(define r1  (rect! (p! 0 0) (p! 100 0) (p! 0 100))) ;;рамка в начале координат
(define r2  (rect! (p! 50 300) (p! 100 0) (p! 0 (- 100))))  ;;рамка для рыбы
(define r3  (rect! (p! 300 300) (p! 100 0) (p! 0 (- 100)))) ;;рамка для сложной фигуры.

;;рисуем в рамке предназначенной для отображения рыбы
(ff1 :draw-to-rect  i1 r1) ;;часть изображения может быть вне рамки.
(fs1 :draw-to-rect  i1 r1) ;; фигура размещается в габаритах рамки.

(ff1 :draw-to-rect  i1 r3)
(fs1 :draw-to-rect  i1 r3)

(ff2 :draw-to-rect  i1 r2)
(fs1 :draw-to-rect  i1 r2)

"Пример использования image-fig. Рисуем рыбу "

Тут наверное не сразу понятно, в чём действие флага flip, дело в том что нижние(нижние для людей, для GIMP эти рамки находятся выше, той что стоит у начала координат) рамки перевёрнутые и в них ось Y идёт снизу вверх. И если рисунок не переворачивать(flip #f) то нос рыбы смотрит вверх. Зато если переворачивать(flip #t) нос будет смотреть вниз, но выглядеть изображение будет так же как и в координатах GIMP.

Тестируем text-fig

Приведу несколько тестов выводящих текст в GIMP. Текст как и изображения в GIMP является перевёрнутым, т.е. то что мы считаем верхом, для GIMPа это низ, и наоборот.

код примера text-fig

(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
(define r2 (make-rect-by-vect (p! 100 350) (p! 100 0) (p! 0 -100)))
(define r3 (make-rect-by-vect (p! 250 350) (p! 100 0) (p! 0 -100)))
(define r4 (make-rect-by-vect (p! 400 350) (p! 150 20) (p! -10 -150)))
(define r5 (make-rect-by-vect (p! 200 300) (p! 200 -40) (p! -60 -150)))

(define c2 (make-rect-contour 0 0 50 50))
(define f2 (brush-fig! :name 'rect1   :color '(0 255 0)   :contour c2))

(define f1 (text-fig! :name 'rect1  :text "Привет\nМир!"  :font "DejaVu Sans Oblique" :color '(255 0 0)
                      :height 100))


(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)

(f1 :draw-to-rect i1 r1)
(f1 :draw-to-rect i1 r2)
(f1 :draw-to-rect i1 r3)
(f1 :draw-to-rect i1 r4)

"Пример использования text-fig. Приветствие"

Теперь используем "переворот"

;код примера text-fig c flip

(define f1 (text-fig! :name 'rect1  :text "Привет\nМир!\n(перевёрнуто)"  :font "DejaVu Sans Oblique"
                      :color '(255 0 0) :height 100 :flip #t))

(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)

(f1 :draw-to-rect i1 r1)
(f1 :draw-to-rect i1 r2)
(f1 :draw-to-rect i1 r3)
(f1 :draw-to-rect i1 r4)

"Пример использования text-fig. Приветствие c flip"

И как апофеоз, демонстрация отрисовки текста выходящего "за рамки".

код "апофеоза"

(define r1 (make-rect-by-vect (p! 0 0) (p! 200 0) (p! 0 200)))
(define r2 (make-rect-by-vect (p! 100 350) (p! 100 0) (p! 0 -100)))
(define r3 (make-rect-by-vect (p! 250 350) (p! 100 0) (p! 0 -100)))
(define r4 (make-rect-by-vect (p! 400 350) (p! 150 20) (p! -10 -150)))
(define r5 (make-rect-by-vect (p! 200 300) (p! 200 -40) (p! -60 -150)))

(define f1 (text-fig! :name 'rect1  :text "Здравствуй\nМир!"  :font "Noto Serif"
                      :color '(255 0 0) :height 100 :flip #f))

(f2 :draw-to-rect i1 r1)
(f1 :draw-to-rect i1 r1)

;;после отрисовки объекта мы можем узнать его габариты!!!
(f1 :get-gabarite) ;;(0 0 581 274)

;; после того как мы знаем с какми габаритами получим текстовый слой, мы можем его осознанно
;; сдвигать.

;;например немного раздвинув максимальную координату текста и сдвинув его вниз
(define f3 (text-fig! :name 'rect1  :text "Здравствуй\nМир!"  :font "Noto Serif"
                      :color '(255 0 0) :height 100 :flip #t
                      :max-x (- 581 81) :min-y -20))

;;а теперь мы можем его сдвинуть вниз и подпереть с низу, "сжав" высоту текста.
;;и конечно оставив выход за границы рамки по горизонтали.
(define f4 (text-fig! :name 'rect1  :text "Здравствуй\nМир!"  :font "Noto Serif"
                      :color '(255 0 0) :height 100 :flip #t
                      :max-x (- 581 81) :min-y -20 :max-y 350))

;;немного выдвинем текст за минимальную горизонтальную координату                      
(define f5 (text-fig! :name 'rect1  :text "Здравствуй\nМир!"  :font "Noto Serif"
                      :color '(255 0 0) :height 100 :flip #t
                      :max-x (- 581 81) :min-y -20 :max-y 350 :min-x 50))


(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)

(f3 :draw-to-rect i1 r2)
(f4 :draw-to-rect i1 r3)
(f5 :draw-to-rect i1 r4)

(f2 :draw-to-rect i1 r5)
(f5 :draw-to-rect i1 r5)

"Пример использования text-fig. Приветствие c flip и выходом за рамки"

Заключение

Устанавливать рамки, это правильно, при их установки мы чётко ограничиваем поведение объектов, но иногда эти рамки начинают мешать творчеству и надо иметь возможность иногда выходить за их пределы.

GIMP Script-Fu Первый Дан. Выходим за Рамки