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

Введение

Вы любите рефакторинг? Ну вот и я приблизительно так же. Основное правило хорошего программиста, такое: «Работает, НЕ ТРОГАЙ!». Но иногда, в редкие минуты помутнения/вдохновения, возникает желание, или я бы даже сказал зуд, в одном месте, и мы садимся за рабочее место, берём в руки клавиатуру и начинаем «творить шедевры» с чистого листа.

Системы подпрограмм для языка функциональной геометрии я писал три раза: сначала в функциональном стиле (и в этом то месте и возник пресловутый «свитчинг по типам», потом в стиле примитивных объектов, который не имел наследования, но я придумав хак с шаблонным использованием кода, значительно сократил его дублирование и теперь, когда я разработал развитую ООП систему, во многом повторяющую функциональность CLOS. И это событие прекрасная причина, чтобы переработать старый ООП код, в новой ОО системе. Чем мы с вами здесь и займёмся.

Миксины как способ конструирования классов

Обычно объекты классов имеют какие то свойства, которые мы храним в полях. Миксины это классы хранящие некоторые независимые от основного класса свойства, независимые или необязательные. Да и в самом классе если внимательно присмотреться могут обнаружиться свойства никак друг с другом не пересекающиеся, или имеющие весьма слабую связь. Те свойства, которые никак не коррелируют друг с другом мы будем называть ортогональными, и их можно вынести в отдельный класс, называемый миксином. Например к ортогональным свойствам можно отнести: цвет, имя объекта, контур, или кисть. Слабо связанные свойства тоже можно считать условно ортогональными, но поскольку они связаны, их связь или корреляцию, должен отслеживать какой то промежуточный класс, методы которого будут поддерживать эту связь, т. е. консистентное состояние объектов класса. К таким слабо связанным свойствам, можно отнести габариты и контур. Разбивая свойства большого класса, на миксины, мы преследуем очевидную цель, развести методы работающие или использующие данные свойства по отдельным небольшим классам, тем самым устранив дублирование кода.

Итак, разъяснив принципы создания классов с использованием миксинов можно приступать к проектированию классов и методов.

Система классов для рисования в GIMP

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

(define default-color '(127 127 127))
(define default-brush (make-brush1 :name "Circle (05)"))

;;создание вектора координат пригодных для отображения в функцих GIMP по контуру
(define (make-contour-vector contour num-points)
   (let ((points     (make-vector (* 2 num-points) 'double))
         (i   0)
         (cur contour))
      (while (< i num-points)
         (vector-set! points (* 2 i)       (p-x (car cur)))
         (vector-set! points (+ (* 2 i) 1) (p-y (car cur)))
         (set! i   (+ i 1))
         (set! cur (cdr cur)))
      points))
	  
;;рисование изображения
 (define (draw-from-image-trans dest src tr)
   (let* ((dw2 (car (gimp-layer-new-from-drawable
                    (car (gimp-image-get-active-layer src)) dest)))
         (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-image-add-layer dest dw2 0)
     (gimp-item-transform-matrix dw2
                                m11 m21 mx
                                m12 m22 my
                                0   0   1)
     (gimp-image-merge-visible-layers dest CLIP-TO-IMAGE)
     ))

Базовые классы миксины используя которые мы будем описывать классы фигур

(defclass contoured ()
  (contour))

(defclass gabarited ()
  ((min-x #f) (min-y #f) (max-x #f) (max-y #f)))

(defclass named ()
  (name))

(defclass fliped ()
  ((flip #f)))

(defclass colored ()
  ((color default-color)))

(defclass brushed ()
  ((brush default-brush)))

Описание классов фигур через миксины:

(defclass fig (named gabarited)
  ())

(defclass contour-fig (fig contoured)
  ())

;;одноконтурная фигура рисуемая кистью
(defclass brush-fig (contour-fig colored brushed)
  ())

;;закрашиваемая фигура, ксть ей нужна потому что в ней устанавливается прозрачность.
(defclass shape-fig (contour-fig colored brushed)
  ())

;;фигура рисуемая крандашом
(defclass pencil-fig (contour-fig colored brushed)
  ())

;;составная фигура
(defclass complex-fig (fig)
  (figs))

;;одиночное изображение
(defclass image-fig (fig fliped)
  (image))

;;изображение текста.
(defclass text-fig (colored fig fliped)
  (text font (height 100)) )

Классы: brush-fig, shape-fig и pencil-fig имеют одинаковый набор свойст, но разное поведение.

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

Как получить изображение иерархии нескольких классов

;;копирует иерархию классов, но только ту, которые есть в списке классв.
(define-m (copy-class-hierarhy lst-class class-hierarhy)
  (let ((rez (make-hash 16))
        (tmp-base #f))
    (for-list (el lst-class)
       (set! tmp-base (hash-ref class-hierarhy el))
       (if (car tmp-base)
           (hash-set! rez el (cdr tmp-base))
           (hash-set! rez el '())))
    rez))


(define-m (classes-to-pairs classes)
  (let ((in-rez (make-hash 32))
        (rez '()))
    (for-list (cls classes)
       (let* ((lst-class (cons cls (get-class-parents-all cls)))
              (class-hierarhy (copy-class-hierarhy lst-class *class-hierarhy*))
              (lst (hash2pairs class-hierarhy)))
	 (for-list (p lst)
	     (do ((parents (cdr p) (cdr parents)))
		 ((null? parents) rez)
	       (let ((new-pair (cons (car p) (car parents))))
		 (unless (car (hash-ref in-rez new-pair))
		   (hash-set! in-rez new-pair #t)
		   (push rez new-pair)))))))
    rez))

(classes-to-pairs '(fig))
(classes-to-pairs '(image-fig shape-fig text-fig pencil-fig brush-fig complex-fig))


(define-m (classes-to-graphvz classes file)
  (with-output-to-file (string-append file ".gv")
    (lambda ()
      (prn "digraph G{\n")
      ;;(prn "  rankdir=RL;\n")
      ;;(prn "  rankdir=LR;\n")
      (for-list (p (classes-to-pairs classes))
                (prn "  \"" (car p) "\" -> \"" (cdr p) "\";\n"))
      (prn "}\n")))
  (join-to-str "dot -Tpng "  file ".gv -o "  file ".png" ))

(classes-to-pairs '(image-fig shape-fig text-fig pencil-fig brush-fig complex-fig))

(classes-to-graphvz '(image-fig shape-fig text-fig pencil-fig brush-fig complex-fig)
		  (string-append path-work "doc/oop/" "fig-obj4"))
;;"dot -Tpng ~/work/gimp/doc/oop/fig-obj4.gv -o ~/work/gimp/doc/oop/fig-obj4.png"

Приступим к описанию методов

Миксин named отвечает за имя объекта, поэтому имеет метод выдачи этого имени и также отвечает за его установку в классе потомке.

(defmethods named
  (get-name ()
    name)
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :name parsed) (set! self.name (cdr it)))
     self)
  )

Миксин «перевёртывания» отвечает за установку данного свойства в классе потомке.

(defmethods fliped
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :flip parsed) (set! self.flip (cdr it)))
     self)
  )

Миксин «габаритов» фигуры, хранит её габариты, отвечает за установку габаритов, а так же, внезапно, за рисование фигуры в указанный объём (rect это не совсем прямоугольник, это скорее параллелограмм), а также выдаёт значения габаритов по запросу и имеет метод assign-undefined который присваивает не установленные значения габаритов.

(defmethods gabarited
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :min-x parsed)  (set! self.min-x  (cdr it)))
     (awhen (assq :max-x parsed)  (set! self.max-x  (cdr it)))
     (awhen (assq :min-y parsed)  (set! self.min-y  (cdr it)))
     (awhen (assq :max-y parsed)  (set! self.max-y  (cdr it)))
     self)
  (assign-undefined (min-x min-y max-x max-y )
       (unless self.min-x
	 (set! self.min-x   min-x))
       (unless self.min-y
	 (set! self.min-y   min-y))
       (unless self.max-x
	 (set! self.max-x   max-x))
       (unless self.max-y
	 (set! self.max-y   max-y)))
  (get-gabarite ()
     (list self.min-x self.min-y self.max-x self.max-y))
  (draw-to-rect (img r)
     (let  ((delta      0.00001)
            (tr  (make-tr2d-from-rect r
                                      (- self.max-x self.min-x)
                                      (- self.max-y self.min-y))))
       (if (or (> (abs self.min-x) delta)  ;;min-x
               (> (abs self.min-y) delta));;min-y фигуры сдвинуто относительно
           (set! tr (comb-tr2d            ;;начала координат надо подвинуть туда!
                     (make-tr2d-move (- self.min-x) (- self.min-y))
                     tr)))
       (draw self img tr))     	
     )
  (draw (img tr)
     (prn "draw not implemented for: " (type-obj self) "\n")
     )
  )

Миксин контура, хранит контур и отвечает за его присваивание в классе потомке.

(defmethods contoured
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :contour parsed)  (set! self.contour  (cdr it)))
     self)
  )

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

(defmethods colored
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :color parsed)  (set! self.color  (cdr it)))
     self)
  (:before draw (img tr)
     (when self.color (gimp-context-set-foreground self.color)))
  )

(defmethods brushed
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :brush parsed)  (set! self.brush  (cdr it)))
     self)
  (:before draw (img tr)
     (when self.brush (self.brush)))
  )

Контурная фигура, это уже производный класс двух миксинов. Она согласовывает изменения в между габаритами контура и габаритами фигуры, т. к. контур и габарит имеют некоторую связь между собой, мы должны поддерживать консистентное состояние в объектах класса при изменении контура или габаритов, именно здесь это и происходит. Сначала мы пропускаем через себя параметры изменяющие объект, а затем определив габариты контура, пытаемся установить (ненавязчиво) габариты фигуры. Таким образом присвоив одному (или нескольким габаритам значение #f), мы сбросим габариты фигуры и она сама установит их значение из значений габаритов контура.

(defmethods contour-fig
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (let ((min-p (min-pos self.contour))
           (max-p (max-pos self.contour)))
       (assign-undefined self (p-x min-p) (p-y min-p) (p-x max-p) (p-y max-p)))
     self)
  )

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

(defmethods brush-fig
  (draw (img tr)
     (let* ((contour    (if tr
                            (translate-contour self.contour tr)
                            self.contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        (gimp-paintbrush-default  dw (* 2  num-points) points))
     )
  )

Аналогичные методы имеют классы рисования заливкой и карандашом

(defmethods shape-fig
  (draw (img tr)
     (let* ((contour    (if tr
                            (translate-contour self.contour tr)
                            self.contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        ;;кисть может понадобиться если устанавливается прозрачность, а задаётся она там(хотя можно было бы и вынести это свойство отдельно)
       (gimp-free-select  img (- (* 2  num-points) 1) points  CHANNEL-OP-REPLACE 0 0 0)
       (gimp-drawable-edit-fill dw  FILL-FOREGROUND)
       (gimp-selection-none img))
     )
  )

(defmethods pencil-fig
  (draw (img tr)
     (let* ((contour    (if tr
                            (translate-contour self.contour tr)
                            self.contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        (gimp-pencil  dw (* 2  num-points) points))
     )
  )

Сложная или составная фигура имеет обычную функцию расчёта габаритов по списку фигур, а также как и контурная фигура согласовывает габариты списка фигур и свои собственные габариты.

(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 (get-gabarite (car cur))))
                (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"))))

(defmethods complex-fig
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :figs parsed)  (set! self.figs  (cdr it)))
     (let ((gab (minmax-pos-figs self.figs)))
       (assign-undefined self (p-x (car gab)) (p-y (car gab)) (p-x (cadr gab)) (p-y (cadr gab))))
     )
  (draw (img tr)
     (let* ((delta      0.00001)
            (dw         (car (gimp-image-get-active-drawable img))))
       (do ((cur self.figs (cdr cur)))
           ((null? cur) #t)
         (draw (car cur) img tr))
       ))
  )

Аналогично и фигура изображение тоже согласовывает свои габариты с имеющимся рисунком.

(defmethods image-fig
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :image parsed)  (set! self.image  (cdr it)))
     (let ((width      (car (gimp-image-width  self.image)))
           (height     (car (gimp-image-height self.image))))
       (assign-undefined self 0 0 width height))     
     )
  (draw (img tr)
     (draw-from-image-trans img self.image (if self.flip
                                               (comb-tr2d
						(make-tr2d-reflect-x)
						(make-tr2d-move 0 (+ self.min-y self.max-y))
						tr)
                                               tr))	
     )
  )

Текстовая фигура имеет ряд особенностей, по простой причине, мы не знаем её размеров до момента попытки её отображения на рисунке. GIMP не предоставляет примитивов узнать габариты изображения до рисования, поэтому согласование габаритов происходит прямо в процессе рисования. Поэтому текстовая фигура и переопределяет метод draw-to-rect базового класса gabarite и уже после размещения на рисунке текстовая фигура устанавливает свои согласованные габариты.

Абстракция текстовой фигуры

(define-m  (draw-textlayer-use-tr2d tl img tr color)
  ;;(prn "(draw-textlayer-use-tr2d tr: " tr "\n"))
  (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)))


(defmethods text-fig
  (parsed-change (parsed)
     (if (next-method-p) (call-next-method))
     (awhen (assq :text parsed)  (set! self.text  (cdr it)))
     (awhen (assq :font parsed)  (set! self.font  (cdr it)))
     (awhen (assq :height parsed)  (set! self.height  (cdr it)))
     )
  (draw (img tr) ;;можно сделать :around методом чтобы не вызывался метод :before draw из класса colored
     (let ((tl (insert-to-img self img)))
       (when self.flip
         (set! tr (comb-tr2d
                   (make-tr2d-reflect-x)
                   (make-tr2d-move 0 (+ self.min-y self.max-y))
                   tr)))
       (draw-textlayer-use-tr2d tl img tr self.color)
       tl)	
     )
  (draw-to-rect (img r)
	(let ((tl (insert-to-img self img))
              (delta      0.00001)
              (tr  (if self.flip
                       (comb-tr2d
			(make-tr2d-reflect-x)
			(make-tr2d-move 0 (+ self.min-y self.max-y))
			(make-tr2d-from-rect r
                                             (- self.max-x self.min-x)
                                             (- self.max-y self.min-y)))
                       (make-tr2d-from-rect r
                                            (- self.max-x self.min-x)
                                            (- self.max-y self.min-y)))))
          (if (or (> (abs self.min-x) delta)  ;;min-x
                  (> (abs self.min-y) delta));;min-y фигуры сдвинуто относительно
              (set! tr (comb-tr2d            ;;начала координат надо подвинуть туда!
			(make-tr2d-move (- self.min-x) (- self.min-y))
			tr)))
          (draw-textlayer-use-tr2d tl img tr self.color)
          tl)
        )
  (insert-to-img (img)
     (let ((tl (car (gimp-text-layer-new img self.text self.font self.height 0))))
        (gimp-image-insert-layer img tl -1 0)
        (let ((width      (car (gimp-drawable-width  tl)))
              (height     (car (gimp-drawable-height tl))))
	      (assign-undefined self 0 0 width height))
        tl))
 )

В классе text-fig «неправильно» ведёт себя метод draw унаследованный от класса color. Дело в том что при рисовании текста в GIMP используется своя установка цвета рисования, не такая как при рисовании других примитивов. Что с этим можно сделать? Во первых объявить метод рисования как :around, тогда никакие другие унаследованные методы вызываться не будут. Во вторых не наследовать миксин color, т.к класс определяется не только хранимыми в нём данными но и своим поведением, и создать свой миксин, например text-color у которого будет правильное поведение, а свойство мы можем устанавливать и по ключу :color. Но в целом этот лишний вызов установки цвета не особо мешает, поэтому я и оставил его как есть.

Чтобы производить изменения объектов написана обычная функция change производящая разбор параметров, для удобства работы методов классов: parsed-change.

(define-m (change obj . data)
   (parsed-change obj (keyargs-to-pairs data)))

Чтобы создавать объекты, используя полиморфную функцию присваивания change я создаю конструкторы используя макрос:

(define-macro (make-constructors . classes-list)
  (cons 'begin
	(map (lambda (cl)
	  `(define-m (,(make-symbol cl "!") . args)
	     (let ((tmp (,(make-symbol "make-" cl "-create"))))
	       (,(make-symbol "make-" cl "-initialize") tmp)
	       (apply change tmp args)
	       tmp)))
	     classes-list)))

(make-constructors brush-fig shape-fig pencil-fig complex-fig image-fig text-fig)

И это всё! Я привёл здесь код всей объектной библиотеки поддерживающей работу языка функциональной геометрии.

Примеры работы

Приведу несколько примеров использования построенных классов.

Подготовка к работе

(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 "struct2.scm"))
(load (string-append path-lib "storage.scm"))
(load (string-append path-lib "cyclic.scm"))
(load (string-append path-lib "hashtable3.scm")) ;;хеш который может работать с объектами в качестве ключей!
(load (string-append path-lib "sort2.scm"))
(load (string-append path-lib "tsort.scm"))
;;(load (string-append path-lib "cpl-sbcl.scm"))
(load (string-append path-lib "cpl-mro.scm"))
;;(load (string-append path-lib "cpl-topext.scm"))
(load (string-append path-lib "struct2ext.scm"))
(load (string-append path-lib "queue.scm"))
(load (string-append path-lib "obj5.scm"))
(load (string-append path-lib "obj/object.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-obj4.scm"))

Создаём изображение и 5 фоновых квадратов, для чего используем составную фигуру (complex-fig).

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

(define c2 (make-rect-contour 0 0 50 50))

(define bsh4 (make-brush1 :name  "2. Hardness 075"  :size 5))

(define r1 (make-rect-by-vect (p! 5 210) (p! 200 0) (p! 0 -200)))
(define r2 (make-rect-by-vect (p! 210 210) (p! 200 0) (p! 0 -200)))
(define r3 (make-rect-by-vect (p! 420 210) (p! 200 0) (p! 0 -200)))
(define r4 (make-rect-by-vect (p! 5 420) (p! 200 0) (p! 0 -200)))
(define r5 (make-rect-by-vect (p! 210 420) (p! 200 0) (p! 0 -200)))

(define fon (complex-fig! :figs
			  (list (shape-fig! :contour c2 :color '(127 127 0))
				    (brush-fig! :contour c2 :color '(0 0 255)))))
(draw-to-rect fon i1 r1)
(draw-to-rect fon i1 r2)
(draw-to-rect fon i1 r3)
(draw-to-rect fon i1 r4)
(draw-to-rect fon i1 r5)

Далее в указанных квадратах рисуем создаваемые фигуры.

;;создаём звезду и отображаем её в 1 квадрате
(define c3 (translate-contour (make-star 30 5 0.3)
			      (make-tr2d-rot 90)))

(define f1 (brush-fig! :contour c3 :color '(255 0 0) :brush bsh4))
(draw-to-rect f1 i1 r1)

;;создаём круг, "поджатый" с боков и отображаем во 2 квадрате
(define c4 (make-circle-n 50 50 50 10)) ;;габариты такого контура будут от 0 до 100.
(define f2 (shape-fig! :contour c4 :color '(255 0 0) :brush bsh4 :min-x -10 :max-x 110))
(draw-to-rect f2 i1 r2)

;;создаём повёрнуты квадрат рисуемый карандашом и отображаем в 3 квадрате
(define c5 (translate-contour (make-rect-contour 0 0 50 50) (make-tr2d-rot 45)))
(define f3 (pencil-fig! :contour c5 :color '(0 127 255) :brush bsh4))
(draw-to-rect f3 i1 r3)

;;загружаем изображение и отображаем его в 4 квадрате
(define i-george (img-load (join-to-str path-work "george.png")))
(define f4 (image-fig! :image i-george))
(draw-to-rect f4 i1 r4)

;;создаём текстовую надпись и отображаем в 5 квадрате.
(define f5 (text-fig! :name 'text2  :text
"Привет
 Мир!"
    :font "Noto Serif Display Thin" :color '(255 255 0)
    :height 100 :flip #t))

(draw-to-rect f5 i1 r5)

Полученное в результате тестирования изображение

Заключение

Итак, в данной статье я привёл переработанный код для классов фигур, создающих абстракции, на базе которых строится язык функциональной геометрии, реализованный для GIMP Script-fu. Так же здесь показаны принципы создания классов на основе выявления ортогональных свойств классов объектов и выделенияих в отдельные классы — миксины, на базе которых, в дальнейшем, и проектируются классы фигур. Данные примеры показывают (на мой взгляд) всю мощь ООО систем использующих множественное наследование. Данный подход позволяет оптимальным, или я бы даже сказал, естественным образом распределить код по методам базовых классов минимизируя или даже исключая его дублирование.

GIMP Script-Fu ООП. ООП на миксинах или сказ о том: «Да что оно может ваше множественное наследование?»