Библиотека функций к Script-fu
Язык функциональной геометрии

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

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

;;создать рисунок(picture) из фигуры
(defun (make-picture-from-fig figs &key :min-x :min-y :max-x :max-y)
   (lambda (img dest-r)
      (draw-figs-ext3 img figs dest-r
                      :min-x min-x
                      :min-y min-y
                      :max-x max-x
                      :max-y max-y)))

;;создать изображение из image
(defun (make-picture-from-img src-image &key :min-x :min-y :max-x :max-y)
   (lambda (img dest-r)
      (draw-from-image-rect-ext img src-image dest-r
                                :min-x min-x
                                :min-y min-y
                                :max-x max-x
                                :max-y max-y)))

Но в виду введения объектного подхода, можно написать ещё вот такую функцию, строящую картинку из фигур-объектов.

;;создать рисунок(picture) из объекта фигуры
(defun (make-picture fig-obj)
   (lambda (img dest-r)
      (fig-obj :draw-to-rect img dest-r)))

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

Подготовка к тестированию

Прежде чем продемонстрировать функции создадим объект для тестирования. Это будет условный "Джордж". Вначале я его нарисовал в графическом редакторе.

Далее я посмотрел в редакторе GIMP, на ключевые точки на рисунке и составил несколько списков контуров.

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

(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 "obj2.scm"))
(load (string-append path-lib "fig-obj2.scm"))
(load (string-append path-lib "pic.scm"))

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

;я предварительно нарисовал его, теперь создадим контурный вариант.
;выпишем контуры джорджа с рисунка
(define c1    (list (p! 0 56) (p! 32 78) (p! 68 52) (p! 85 48) (p! 66 25) (p! 85 0)))
(define c2    (list (p! 100 0) (p! 114 24) (p! 102 48) (p! 144 57) (p! 200 85)))
(define c3    (list (p! 198 123) (p! 140 80) (p! 130 80) (p! 135 115) (p! 125 140)
                    (p! 150 164) (p! 165 200)))
(define c4    (list (p! 134 200) (p! 102 158) (p! 92 156) (p! 70 180) (p! 70 200)))
(define c5    (list (p! 32 200) (p! 47 162) (p! 60 144) (p! 46 117) (p! 51 83)
                    (p! 30 100) (p! 0 90)))
;;только эти контура перевёрнуты

Выглядящий нормально на экране "Джордж" является перевёрнутым(стоящим на голове) с точки зрения GIMP, работать с ним для нас будет неудобно. Поэтому надо выполнить некоторые преобразования для переворачивания "Джорджа" на ноги.

Переворачиваем Джорджа

;;определим габариты
;; найдем габариты группы контуров
(define (find-contours-max-pos contours)
  (prn contours)
  (let ((max-x (p-x (car (car contours))))
        (max-y (p-y (car (car contours)))))
    (do ((cur contours (cdr cur)))
        ((null? cur) (p! max-x max-y))
      (let ((cur-p (max-pos (car cur))))
        (if (> (p-x cur-p) max-x)
            (set! max-x (p-x cur-p)))
        (if (> (p-y cur-p) max-y)
            (set! max-y (p-y cur-p)))
        )
      )))

(define (find-contours-min-pos contours)
  (let ((min-x (p-x (car (car contours))))
        (min-y (p-y (car (car contours)))))
    (do ((cur contours (cdr cur)))
        ((null? cur) (p! min-x min-y))
      (let ((cur-p (min-pos (car cur))))
        (if (< (p-x cur-p) min-x)
            (set! min-x (p-x cur-p)))
        (if (< (p-y cur-p) min-y)
            (set! min-y (p-y cur-p)))
        )
      )))

(define minp1 (find-contours-min-pos (list c1 c2 c3 c4 c5))) ;;#(p 0 0)
(define maxp1 (find-contours-max-pos (list c1 c2 c3 c4 c5))) ;;#(p 200 200)

;;определим матрицу преобразования переворачивающую контур относительно оси X
(define tr-fs4
  (comb-tr2d
   (make-tr2d-reflect-x)
   (make-tr2d-move 0 (p-y maxp1))
   ))

;; и преобразуем каждый контур!
(define c1t (translate-contour c1 tr-fs4))
(define c2t (translate-contour c2 tr-fs4))
(define c3t (translate-contour c3 tr-fs4))
(define c4t (translate-contour c4 tr-fs4))
(define c5t (translate-contour c5 tr-fs4))

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

Для того чтобы наш рисунок получился на прозрачном фоне напишем функцию создающую изображение с прозрачным фоном, т.к используемая ранее функция create-1-layer-img этого сделать не могла(по умолчанию GIMP создаёт слои без прозрачного канала). Нам нужно добавить к слою создаваемого изображения канал прозрачности и очистить изображение.

(define (create-transparent-layer-img w h)
    (let* ((i1  (car (gimp-image-new w h RGB)))
          (l1  (car (gimp-layer-new i1 w h
                                 RGB "layer 1" 100 LAYER-MODE-NORMAL-LEGACY))))
       (gimp-image-add-layer i1 l1 0)
       (gimp-layer-add-alpha l1)
       (gimp-selection-all i1)
       (gimp-drawable-fill l1 TRANSPARENT-FILL)
       (gimp-display-new i1)
       i1))

Создадим Джорджа красного и сохраним его в файл.

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

;;Воспользуемся объектным синтаксисом
(define fs4
   (complex-fig! :figs
     (list
        (shape-fig!  :contour (append c1t c2t c3t c4t c5t (list (car c1t))) :color '(200 0 0) :brush bsh2)
        (pencil-fig! :contour c1t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c2t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c3t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c4t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c5t :color '(255 255 0) :brush bsh1))))
        
(define r2 (rect! (p! 0 0) (p! 200 0) (p! 0 200)))
(define i2 (create-transparent-layer-img 200 200))
(fs4 :draw-to-rect i2 r2)

(define (save-png img path name)
 (gimp-file-save 1 img (car (gimp-image-active-drawable img))
                (join-to-str path name) name))

(save-png i2 path-work "george.png")

Таким образом для тестирования мы можем загружать "Красного Джорджа" из файла:

(define i-red (img-load (join-to-str path-work "george.png")))
(define red-fig (image-fig! :image i-red)) 
(define red-pic (make-picture red-fig))
(define r1 (rect! (p! 0 100) (p! 100 0) (p! 0 -100)))
(red-pic i1 r1)

А также можем строить контурного "Зелёного Джорджа".

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

(define green-fig
   (complex-fig! :figs
     (list
        (shape-fig!  :contour (append c1t c2t c3t c4t c5t (list (car c1t))) :color '(0 127 0) :brush bsh2)
        (pencil-fig! :contour c1t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c2t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c3t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c4t :color '(0 255 0)   :brush bsh1)
        (pencil-fig! :contour c5t :color '(255 255 0) :brush bsh1))))
        
(define green-pic (make-picture green-fig))
(define r1 (rect! (p! 0 100) (p! 100 0) (p! 0 -100)))
;;или все операции сохранить в отдельный файл и загружать его
;;(load (string-append path-work "green-george.scm"))
(green-pic i1 r1)

У контурного рисунка, в контексте использования его как базового элемента построений функциональной геометрии есть один, но очень существенный недостаток, это КИСТЬ. Само изображение мы можем неограниченно масштабировать, а вот кисть при этом остаётся неизменной поэтому для мелких рисунков, толщина отрисовываемых контуров может значительно превышать разумные пределы.

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

beside

Функция рисования двух картинок рядом друг с другом, коэффициент k задаёт отношение, в котором будет делиться пространство рамки

(define (pic-beside p1 p2 k)
   (lambda (img dest-r)
      (p1 img (rect!
               (rect-origin dest-r)
               (vect-scale  (rect-horiz dest-r) k)
               (rect-vert   dest-r)))
      (p2 img (rect!
               (vect+ (rect-origin dest-r)
                      (vect-scale (rect-horiz dest-r) k))
               (vect-scale (rect-horiz dest-r) (- 1 k))
               (rect-vert dest-r)))))

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

И теперь протестируем эту функцию на джордже.

(define r1 (make-rect-by-vect (p! 10  210) (p! 200 0)  (p!   0 -200)))
(define r2 (make-rect-by-vect (p! 270 210) (p! 200 0)  (p! -40 -200)))
(define r3 (make-rect-by-vect (p! 100 370) (p! 100 0)  (p!   0 -100)))
(define r4 (make-rect-by-vect (p! 250 370) (p! 100 0)  (p!   0 -100)))
(define r5 (make-rect-by-vect (p! 400 370) (p! 150 40) (p!  30 -150)))


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

;;рамки для обозначения габаритов рисования.
(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)
(f2 :draw-to-rect i1 r5)

((pic-beside red-pic green-pic 0.7) i1 r1)
((pic-beside red-pic green-pic 0.3) i1 r2)

(define bs (pic-beside red-pic green-pic 0.4))

(bs i1 r3)
(bs i1 r4)

((pic-beside red-pic green-pic 0.8) i1 r5)

rot

Поворот картинки на 90 и 180 градусов.

(define (pic-rotate90 p1)
   (lambda (img dest-r)
      (p1 img (rect!
               (vect+ (rect-origin dest-r)
                      (rect-horiz  dest-r))
               (rect-vert dest-r)
               (vect-scale  (rect-horiz dest-r) -1)))))


(define (pic-rotate180 p1)
   (lambda (img dest-r)
      (p1 img (rect!
               (vect+  (rect-origin dest-r)
                       (vect+ (rect-vert   dest-r)
                              (rect-horiz  dest-r)))
               (vect-scale  (rect-horiz dest-r) -1)
               (vect-scale  (rect-vert  dest-r) -1)))))

тестируем повороты

(define r1 (make-rect-by-vect (p! 10  210) (p! 200 0)  (p!   0 -200)))
(define r2 (make-rect-by-vect (p! 270 210) (p! 200 0)  (p! -40 -200)))
(define r3 (make-rect-by-vect (p! 100 370) (p! 100 0)  (p!   0 -100)))
(define r4 (make-rect-by-vect (p! 250 370) (p! 100 0)  (p!   0 -100)))
(define r5 (make-rect-by-vect (p! 400 370) (p! 150 40) (p!  30 -150)))


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

;;рамки для обозначения габаритов рисования.
(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)
(f2 :draw-to-rect i1 r5)

((pic-rotate90  red-pic)   i1 r1)
((pic-rotate180 green-pic) i1 r2)
((pic-rotate180 red-pic)   i1 r3)
((pic-rotate90  green-pic) i1 r4)
;;демонстрация небольшой комбинации функций.
((pic-rotate90 (pic-rotate180 (pic-beside red-pic green-pic 0.6))) i1 r5)

above

Функция рисования картинок одна над другой.

(define (pic-above p1 p2 k)
   (lambda (img dest-r)
      (p1 img (rect!
               (rect-origin dest-r)
               (rect-horiz  dest-r)
               (vect-scale  (rect-vert   dest-r) k)
               ))
      (p2 img (rect!
               (vect+ (rect-origin dest-r)
                      (vect-scale (rect-vert dest-r) k))
               (rect-horiz  dest-r)
               (vect-scale (rect-vert dest-r) (- 1 k))))))

тестируем above

(define r1 (make-rect-by-vect (p! 10  210) (p! 200 0)  (p!   0 -200)))
(define r2 (make-rect-by-vect (p! 270 210) (p! 200 0)  (p! -40 -200)))
(define r3 (make-rect-by-vect (p! 100 450) (p! 100 0)  (p!   0 -180)))
(define r4 (make-rect-by-vect (p! 250 450) (p! 100 0)  (p!   0 -180)))
(define r5 (make-rect-by-vect (p! 400 450) (p! 150 40) (p!  30 -180)))


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

;;рамки для обозначения габаритов рисования.
(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)
(f2 :draw-to-rect i1 r5)

((pic-above red-pic green-pic 0.7) i1 r1)
((pic-above red-pic green-pic 0.3) i1 r2)

(define bs (pic-above red-pic green-pic 0.4))

(bs i1 r3)
(bs i1 r4)

((pic-above red-pic (pic-beside red-pic green-pic 0.4) 0.8) i1 r5)

flip

Функции переворачивания отображений относительно вертикальной и горизонтальных осей.

;;зеркальное отражение относительно вертикальной оси
(define (pic-flip p1)
   (lambda (img dest-r)
      (p1 img (rect!
               (vect+ (rect-origin dest-r)
                      (rect-horiz  dest-r))
               (vect-scale  (rect-horiz dest-r) -1)
               (rect-vert   dest-r)))))

;;зеркальное отражение относительно горизонтальной оси.
(define (pic-flip-vert p1)
   (lambda (img dest-r)
      (p1 img (rect!
               (vect+ (rect-origin dest-r)
                      (rect-vert  dest-r))
               (rect-horiz  dest-r)
               (vect-scale  (rect-vert dest-r) -1)))))

тест flip

(define r3 (make-rect-by-vect (p! 100 450) (p! 100 0)  (p!   0 -180)))
(define r4 (make-rect-by-vect (p! 250 450) (p! 100 0)  (p!   0 -180)))

((pic-above red-pic green-pic 0.4) i1 r5)
((pic-above (pic-flip red-pic) (pic-flip-vert green-pic) 0.4) i1 r3)
((pic-above (pic-flip-vert red-pic) (pic-flip green-pic) 0.4) i1 r4)

rot45

Функция вращения на 45 градусов, отличается от предыдущих тем что она выходит за рамки указанной рамки при вращении исходной рамки, при этом центр указанной рамки становиться опорной точкой новой рамки.

(define (pic-rotate45 p1)
   (lambda (img dest-r)
      (p1 img (make-rect-by-point
               (vect+ (rect-origin dest-r)
                      (vect+ (vect-scale (rect-horiz dest-r) 0.5)
                             (vect-scale (rect-vert  dest-r) 0.5)))
               (vect+ (rect-origin dest-r)
                      (rect-vert   dest-r))
               (vect+ (rect-origin dest-r)
                      (vect+ (rect-horiz dest-r)
                             (rect-vert  dest-r)))))))

Тестируем вращение на 45 градусов.

(define r1 (make-rect-by-vect (p! 10  210) (p! 200 0)  (p!   0 -200)))
(define r2 (make-rect-by-vect (p! 270 210) (p! 200 0)  (p! -40 -200)))
(define r3 (make-rect-by-vect (p! 100 450) (p! 100 0)  (p!   0 -180)))
(define r4 (make-rect-by-vect (p! 250 450) (p! 100 0)  (p!   0 -180)))
(define r5 (make-rect-by-vect (p! 400 450) (p! 150 40) (p!  30 -180)))


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


;;рамки для обозначения габаритов рисования.
(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)
(f2 :draw-to-rect i1 r5)

((pic-rotate270 (pic-rotate45 pic3)) i1 r1)
((pic-rotate270 (pic-rotate45 red-pic)) i1 r1)
((pic-rotate270 (pic-rotate45 pic3)) i1 r2)
((pic-rotate270 (pic-rotate45 green-pic)) i1 r2)

(define bs (pic-above red-pic green-pic 0.4))

((pic-rotate90 (pic-rotate45 pic3)) i1 r3)
((pic-rotate90 (pic-rotate45 bs)) i1 r3)
((pic-rotate45 pic3) i1 r4)
((pic-rotate45 bs) i1 r4)

((pic-rotate45 pic3) i1 r5)
((pic-rotate45 green-pic) i1 r5)

over и empty

И ещё две базовые функции манипулирования картинками: пустая картинка и наложение картинок.

;;пустая картинка
(define-m (pic-empty)
   (lambda (img dest-r)
      ))

;;наслоение картинок одна над другой. первая самая верхняя!!!!
(define-m (pic-over . pics)
  (lambda (img dest-r)
    (for-list (p (reverse pics))
	(p img dest-r)
	)))

text picture

А теперь все базовые преобразования на примере текстовой буквы F.

(define r1 (make-rect-by-vect (p! 10  110) (p! 100 0)  (p!   0 -100)))
(define r2 (make-rect-by-vect (p! 170 110) (p! 100 0)  (p! -40 -100)))
(define r3 (make-rect-by-vect (p! 300 110) (p! 100 20) (p!  30 -100)))
(define r4 (make-rect-by-vect (p! 440 110) (p! 100 0)  (p!   0 -100)))
(define r5 (make-rect-by-vect (p! 10  350) (p! 100 0)  (p!   0 -180)))
(define r6 (make-rect-by-vect (p! 150 350) (p! 100 0)  (p!   0 -180)))
(define r7 (make-rect-by-vect (p! 250 350) (p! 150 40) (p!  30 -180)))
(define r8 (make-rect-by-vect (p! 470 380) (p! 150 40) (p!  -30 -180)))


(define c2 (make-rect-contour 0 0 50 50))
(define f2 (brush-fig! :name 'rect1   :color '(255 0 0)   :contour c2))
(define f2 (text-fig!  :name 'text1   :text "F" :font "Noto Serif" 
                       :color '(0 0 255)  :height 30 :flip #t))
(define pic-f (make-picture f2))
(define f3 (brush-fig! :name 'rect2   :color '(127 0 0)   :contour c2))
(define pic3 (make-picture f3))


;;рамки для обозначения габаритов рисования.
(f2 :draw-to-rect i1 r1)
(f2 :draw-to-rect i1 r2)
(f2 :draw-to-rect i1 r3)
(f2 :draw-to-rect i1 r4)
(f2 :draw-to-rect i1 r5)
(f2 :draw-to-rect i1 r6)
(f2 :draw-to-rect i1 r7)
(f2 :draw-to-rect i1 r8)

(pic-f i1 r1)
((pic-rotate90 pic-f) i1 r2)
((pic-flip     pic-f) i1 r3)
((pic-rotate90 (pic-flip  pic-f)) i1 r4)

((pic-above  pic-f pic-f 0.4)  i1 r5)
((pic-beside pic-f pic-f 0.7)  i1 r6)
((pic-above  (pic-beside pic-f pic-f 0.3) pic-f 0.6) i1 r7)
((pic-rotate45 (pic-over pic-f pic3)) i1 r8)

"Тест базовых функций на примере текстовой фигуры"

Заключение

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

GIMP Script-Fu Первый Дан. Язык функциональной геометрии. Рисунки(картинки) и базовые операции