GIMP Script-Fu ООП. Классы. Начало

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

Введение.

С необходимостью введения в язык Script-fu Объектно-ориентированного стиля программирования я столкнулся на поздних этапах реализации языка функциональной геометрии. Когда в коде появились «свичи/переключатели» и возможность исполнения кода в зависимости от типа входящих данных. Сам то этот «переключатель» написать не сложно, но в развивающемся проекте, постоянно возникают новые типы, изменяются, от каких то приходится отказываться, а ещё есть вариант создания модульных систем, когда в одном варианте существует один набор типов, а вдругом другой, ну а в третьем третий и т.д. И код этого «переключателя» постоянно приходится переписывать, или прибегать к различным «хакам», модифицирующим код в зависимости от того или иного варианта загрузки.

      (cond        ((eq? (fig-type fig) 'pencil)         ;;(print "call brush")         ((fig-brush fig))         ;;(print "call pencil")         (gimp-pencil  dw (* 2  num-points) points)         ;;(print contour)         )        ((eq? (fig-type fig) 'brush)         ((fig-brush fig))         ;;(print "call paintbrush")         (gimp-paintbrush-default  dw (* 2  num-points) points))        ((eq? (fig-type fig) 'shape)         ((fig-brush fig))         ;;(gimp-image-select-polygon  img CHANNEL-OP-REPLACE num-points points)         (gimp-free-select  img (- (* 2  num-points) 1) points  CHANNEL-OP-REPLACE 0 0 0)         (gimp-edit-fill dw  FOREGROUND-FILL)         (gimp-selection-none img))        ) 

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

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

В качестве образца(идеала) я выбрал CLOS — Common Lisp Object System.

Что такое CLOS.

CLOS это объектная система разработанная для различных реализаций лисп. В CLOS классы объектов определяются отдельно от функций работающих с этими объектами. Т.е фундаментальное отличие от Си++ подобных реализаций ООП состоит в том, что функции работающие с объектами отделены от классов, т.е классы объектов в CLOS не имеют функций-членов. Таким образом функции не принадлежат классам, кроме функций доступа к полям объекта(аццессоров).

;; типичное определение класса в CLOS (defclass filter-distinct-state ()     ((iterator :initarg :iterator)       (cyclic-p :initarg :cyclic-p)       (fixed :initarg :fixed)       (next :initarg :next)   (next-is-end-p)))  ;; функция играющая роль инициализирующего конструктора (defun filter-distinct (iterator &optional (preserve-cyclic-end-p nil))   (make-instance 'filter-distinct-state         ;;вызов конструктора объекта                  :iterator iterator                  :cyclic-p (not preserve-cyclic-end-p)                  :fixed nil                  :next nil)) 

А как же обеспечивается поведение объектов? С помощью ОБОБЩЁННЫХ(generic) функций! Обобщённая функция это как сигнал, как интерфейс, который мы описываем для объекта или группы объектов. Но в самой обобщённой функции мы никаких типов объектов не указываем, описание типов, т.е конкретных классов, происходит в определениях МЕТОДОВ обобщённой функции. Вот там, в определении метода мы и указываем конкретные классы, для указанного набора параметров. И когда при вызове типы объектов переданных в обобщённую функцию совпадут с типами указанным в определении метода, тогда и будет вызван код этого метода. Вот именно таким описанием и обеспеспечивается полиморфизм поведения в CLOS.

;; типичное определение методов обобщённых функций (defmethod path-iterator-reset ((iterator filter-distinct-state))   (with-slots ((sub iterator) next next-is-end-p) iterator     (path-iterator-reset sub)     (setf next nil           next-is-end-p nil)))  (defmethod path-iterator-next ((iterator filter-distinct-state))   (with-slots ((sub iterator) cyclic-p fixed next next-is-end-p) iterator     (when fixed       ;; constant result cached       (return-from path-iterator-next (values-list fixed)))     (labels ((get-next ()                "Get the next knot information as a list (not as                multiple values)."                (multiple-value-list (path-iterator-next sub)))    .......

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

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

Для многих программистов, особенно выросших на Java, где владение методами является основой описания классов, это будет разрывом шаблона. Просто ребята, примите это как данность, существует и другой мир, свободный от догматов, в которых методы являются «рабами» классов. CLOS устраняет «классвое рабство методов»!

Хотя на самом деле описание методов в стиле Java даёт некоторое преимущество перед стилем описания методов в CLOS, т.е. немного сокращает количество кода(нет необходимости указывать класс и сам параметр для объекта self, неявно присутствующий в каждом объявлении метода класса), но это преимущество CLOS может легко нивелировать написав специальный макрос, создающий синтаксис при использовании которого создаётся иллюзия, что класс всё-таки владеет методом, но это только видимость, предназначенная чисто для сокращения кода.

Много лет назад, когда я только начинал программировать, я начинал с С++. И уже тогда при проектировании систем(простеньких и детских) я сталкивался с проблемой отнесения метода к одному или к другому классу. И стоял как «буриданов осёл» не зная к какому классу правильно отнести метод, потому что действие метода затрагивало объекты разных классов.

CLOS выступает за свободу функций! Данной дилемы в нем просто не существует!

Конечно, сам CLOS гораздо богаче и гибче приведённого мной примера. CLOS реализуется через MOP(метаобъектный протокол), который позволяет изменять поведение методов обобщённых функций в зависимости от метаклассов объектов, определения самих классов, слотов объектов и других важных компонентов объектной системы. Но в большинстве случаев использование MOP избыточно и нужно лишь для моделирования различных ОО систем.

И одной из самых важных черт CLOS, на мой взгляд, является гомоиконичность. CLOS не вводит новых «объектных» синтаксисов. Люди просто помешались на них, и это мешает им адекватно воспринимать код.

;;"Объектный вызов метода" obj.method(a b c)  ;;обычный функциональный вызов в си стиле. method(obj a b c)  ;;вызов в стиле ЛИСП, (method obj a b c)

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

Какую ОО систему я хочу построить?

Как я уже сказал, мой идеал ОО системы это CLOS. Поэтому и для Script-fu я буду строить максимально приближенную к CLOS систему, но максимально упрощённую. Желательно что бы реализованная ОО система была максимально быстрой. Поэтому множество синтаксиса из CLOS я просто выброшу. Ну давайте разберём синтаксис определения класса в CLOS.

(defclass class-name ({superclass-name}*) ({slot-specifier}*) [[class-option]]) 

С именем класса и со списком суперклассов всё понятно, но вот спецификация слотов в CLOS очень загружена различными деталями. Помимо имени в описании слота могут присутствовать следующие спецификаторы.

:accessor :reader :initarg :initform :allocation

Вместо accessor и reader мы примем соглашение, согласно которому доступ к полю класса будут осуществлять функции начинающиеся с имени класса, далее тире и имя поля/слота. Имя функции изменяющее поле дополняется знаком восклицания. iniarg — инициализирующий аргумент можно сохранить, указывая вместо имени поля, список состоящий из имени поля и инициализирющего значения. initform — в целях упрощения синтаксиса отбросим, отдав инициализацию полей(в зависимости от необходимости) функциям инициализации. allocation это вообще дикость, указывает где располагается поле, либо в экземпляре объекта, либо в классе. Но позвольте, расположене в классе, это всего лишь ещё один вариант глобального состояния, и все переменные класса можно легко заменить обычными глобальными переменными, поэтому и необходимости в их отдельном описании никакого нет. Ну а class-option относятся к метаобъектному протоколу и их поддержка вообще не нужна. Главное в описании класса это описание полей объекта и список наследования класса.

;;классы будем определять в виде (defclass name-class (list-parents)   (list-fields))    ;;например (defclass a1 ()   ( fa1-1    (fa1-2 1)))  (defclass a2 (a1)   ((fa2-1 'a)    (fa2-2 2)     fa2-3))

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

;;объявление обобщённой функции (defgeneric test-gen1 a b c d)  ;;объявление методов обобщённой функции (defmethod (test-gen1 (a a1) (b b1) c d)   (prn "call test-gen1 with class a1 a: " a ", b: " b ", c: " c ", d: " d))    (defmethod (test-gen1 (a a2) (b b1) c d)   (prn "call test-gen1 with class a2 a: " a ", b: " b ", c: " c ", d: " d))

Обобщённая функция не указывает типы переменных, а вот в определениях методов мы указываем классы для некоторых аргументов, которые они будут принимать, либо их, либо их потомков. И это объявление будет определять шаблон вызова метода. При вызове обобщённой функции, та должна определить типы входных параметров, и в зависимости от них выбрать подходящий метод. Какое попущение я позволяю здесь себе сделать: мы не будем учитывать примитивные типы данных в составлении шаблонов вызовов методов. Т.е если у нас в определении методов не описаны какие-либо параметры, например c и d, то в шаблоне они будут указаны как :unspec, неопределённые, и фактически данные параметры могут принимать любые типы данных и это не будет учитываться при диспетчеризации для вызова метода. И да, примитивные типы данных не могут являтся спецификаторами для диспетчеризации, только КЛАССЫ! Помимо этого шаблоны методов не допускают применение ключевых, опциональных и остаточных параметров, это бы сильно затруднило работу диспетчера с шаблонами вызова метода, что сильно сказалось бы на скорости работы диспетчера.

Объекты.

Определившись с пожеланиями, или ещё можно сказать с требованиями, можно приступать к проектированию реализации, а для этого надо понять, что собой будут представлять у нас объекты, или как говорят в CLOS — ИНСТАНСЫ(INSTANCE). Вариантов несколько, ранее я уже определял структуры, очень удобная вещь на базе вектора, обеспечивает быстрый доступ к произвольному полю. Вариант со списком, можно отмести сразу, хоть все и говорят что Лисп это работа со списками, это не так, не всегда списки эффективны, особенно когда требуется доступ к произвольному полю. Ещё есть вариант предсталять объект в виде хеш-таблицы, как это сделано во многих языках программирования, очень интересный подход, можно «пихать» в объект дополнительные поля, вне зависимости от определения класса. Но в GIMP Script-fu есть небольшая проблема, символы являющиеся именами полей плохо(медленно) индексируются в хеш-таблице, фактически индексация происходит по имени символа, т.е по строке, а это медленно. Можно было бы сделать быстрее, ЗНАЧИТЕЛЬНО быстрее, но для этого необходимо чтобы в ВАШЕЙ версии Script-fu была разрешена загрузка расширений, тогда одно из моих расширений могло бы быстро предоставлять числовой идентификатор символа, что свело бы индексацию символов в хеш-таблице к скорости индексации чисел, а это очень быстро. Ещё есть вариант передставлять объекты в качестве окружений, в tinyscheme есть несколько операций позволяющих создавать окружения и использовать их. Эти функции позволяют создавать миниобъекты, которые фактически представляют из себя хеш-таблицы, только реализованные на Си, отлично работающие с символами, что нам и нужно! И хотя последний вариант кажется идеальным, но моим проектным решением реализации объекта будет вектор! Хорошо проверенное на структурах решение, позволяющие осуществлять произвольный доступ к слотам объекта, за постоянное время, как говорят O(1). Фактически моя реализация объектов, будет очень мало отличаться от реализации структур. Только классы объектов, это иерархии наследования, но в конечном итоге они строят точно такой же вектор содержащий все поля класса, как и описание структуры.

Реализация системы классов.

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

;;функции отслеживающие иерархию классов и набора полей классов. (define *class-hierarhy* (make-hash 32)) (define *class-fields*   (make-hash 32))  (define (class-defined? class)   (car (hash-ref *class-hierarhy* class)))  (define class? class-defined?)  (define (type-obj o)   (vector-ref o 0))  (define (object? obj)    (and (vector? obj)         (class?  (type-obj obj))))

Определим функции работы с иерархией. Мы работаем сразу с двумя иерархиями: классов и полей в классе.

(define (add-class-define class parents)   (hash-set! *class-hierarhy* class parents))  (define (class-parents class)   (hash-ref *class-hierarhy* class))  (define (save-class-fields class fields)   (hash-set! *class-fields* class fields))  (define (get-class-fields class)   (hash-ref *class-fields* class))  (define-m (get-class-parents-all class)   (let ((rez (make-hash 6))         (stack-class    (list class))         (cur-class nil)         (parents   nil))     (repeat      (set! cur-class (pop stack-class))      (set! parents   (class-parents cur-class))      (if (and (car parents) (list? (cdr parents)))          (for-list (el (cdr parents))                    (push stack-class el)                    (hash-set! rez el #t)))      ((empty? stack-class) (hash-keys rez))))) 

Чтобы корректно работать с объектом класса(инстансом/экземпляром) нам надо знать ВСЕХ его предков и ВСЕ его поля, а не только те которые даны непосредственно в определении класса

(define-m (get-class-parents-all-ordered class)   (let ((in-rez (make-hash 6))         (rez    '())         (stack-class    (list class))         (cur-class nil)         (parents   nil))     (repeat      (set! cur-class (pop stack-class))      (set! parents   (class-parents cur-class))      (if (and (car parents) (list? (cdr parents)))          (let ((tmp-stack '()))            (for-list (el (cdr parents))                      (unless (car (hash-ref in-rez el))                        (push tmp-stack   el)                        (push rez         el)                        (hash-set! in-rez el #t)))            (for-list (el tmp-stack)           ;;перекладываем элементы из временного стека в стек классов,                      (push stack-class   el)) ;;при этом меняется порядок, на нужный!            ))      ((empty? stack-class) (reverse rez)))))  (define-m (get-class-fields-all class)   (let ((rez (make-hash 6))         (classes   (cons class (get-class-parents-all class))))     (for-list (cur-class classes)               (let ((fields (get-class-fields cur-class)))                 (if (and (car fields) (list? (cdr fields)))                     (for-list (el (cdr fields))                               (if (list? el)                                   (hash-set! rez (car el) el)                                   (hash-set! rez el el))                       )))               )     (map cdr (hash2pairs rez)))) 

Основное отличие классов от структур состоит в наследовании и применении обобщённых функций. А что это значит? Это значит на обработку в метод может попасть как аргумент не просто объект указанного класса, но и любой произвольный его наследник. А в связи с множественным наследованием, никак не получиться гарантировать единообразный порядок расположение полей в векторе представляющим объект. Это значит, что для любого потомка расположение поля может не совпадать с расположением поля в базовом классе. ПОЭТОМУ в методах обобщённых функци НЕЛЬЗЯ использовать статические методы для доступа к полям объекта! Нужен способ гарантирующий единообразный доступ к одноимённым полям объектов! Этот спооб я определил как виртуальные методы доступа. Это такие функции которые в зависимости от типа передаваемого в них объекта, выдают значение именованного поля, или меняют его. Чтобы их построитьи обеспечить возможность их работы надо создать ещё пару хранилищ геттеров и сеттеров для полей классов.

;введём вспомогательную структуру позволяющую хранить вместе поля класса и связанные с ними данные (struct class-field (name index val key))  ;;таблицы позволяющие создать виртуальные методы доступа к полям объектов. (define *class-virtual-get*   (make-hash 128)) (define *class-virtual-set*   (make-hash 128))  (define (add-class-virtual-get  class key func)   (hash-set! *class-virtual-get* (list class key)  func))  (define (class-virtual-get . class-key)   (hash-ref *class-virtual-get* class-key))  (define (add-class-virtual-set  class key func)   (hash-set! *class-virtual-set* (list class key)  func))  (define (class-virtual-set . class-key)   (hash-ref *class-virtual-set* class-key)) 

Ну а теперь можно и определить макрос описания класса

Начало определения

((define (sym2key s)                    ;;создает по символу, символ ключ(символ с двоеточием)    (string->symbol (string-append ":"                                   (symbol->string s))))  (define-macro (defclass . param)

(define (make-name-complex base postfix)    (string->symbol (string-append (symbol->string base) postfix)))  (define (make-validator name)    (let ((f-name name)          (obj (gensym)))       `(define (,(make-name-complex f-name "?")   ,obj)           (and (vector? ,obj) (eq? (vector-ref ,obj 0) ',f-name)))))  ;;преобразует список полей в список где каждому полю соотвествует индекс в массиве представляющим объект,значение по умолчанию и ключевой символ (define-m (make-list-class-fields lst-names)    (let ((new-lst '())          (cur-ind 1))      (for-list (cur lst-names)  (if (atom? cur)              (set! new-lst (cons (class-field! cur       cur-ind  #f         (sym2key cur))       new-lst))              (set! new-lst (cons (class-field! (car cur) cur-ind (cadr cur)  (sym2key (car cur))) new-lst)))          (set! cur-ind (+ cur-ind 1)))       (reverse new-lst)))   (define (make-maker name fields)    (let ((f-name name)          (l-stru (length fields))          (s (gensym)) ;;name local structure          (t-stru  (gensym)))      `(defun (,(string->symbol (string-append "make-" (symbol->string f-name))) &key       ,@(map (lambda (f) (if (class-field-val f)      (list (class-field-name f) (class-field-val f))      (class-field-name f)))      fields))         (let ((,s (make-vector ,(+ 1 l-stru))))           (vector-set! ,s 0 ',f-name)           ,@(let ((rez '())                   (cur     fields))               (while (not (null? cur))                 (set! rez (cons `(vector-set! ,s                                               ,(class-field-index (car cur))                                               ,(class-field-name  (car cur)))                                 rez))                 (set! cur (cdr cur)))               (reverse rez))           ,s))))   (define (make-getters name fields)    (let ((f-name name)          (l-stru (length fields))          (obj  (gensym))  (rez '()))      (for-list (cur fields)        (let ((name-getters       (make-name-complex f-name  (string-append "-" (symbol->string  (class-field-name cur))))))  (push rez `(add-class-virtual-get ',f-name (class-field-key ,cur)    (lambda (x) (,name-getters x))))  (push rez `(define-macro (,name-getters    ,obj)                               `(vector-ref ,,obj ,,(class-field-index cur))))))      (reverse rez)))   (define-m (make-setters name fields)   (let ((f-name name)         (l-stru (length fields))         (v (gensym))         (obj  (gensym)) (rez '()))     (for-list (cur fields)       (let ((name-setters      (make-name-complex       f-name       (string-append "-"      (symbol->string       (class-field-name cur))      "!")))) (push rez `(add-class-virtual-set ',f-name (class-field-key ,cur)   (lambda (x v) (,name-setters x v)))) (push rez `(define-macro (,name-setters   ,obj ,v)      `(vector-set! ,,obj ,,(class-field-index cur) ,,v)))))     (reverse rez))) 

основное тело макроса:

       (let ((name      (car  param))            (parents   (car (cdr  param)))             (fields    (car (cddr  param))))        (add-class-define  name parents)        (save-class-fields name fields)        (let* ((parents-all (get-class-parents-all name))           (fields-all  (make-list-class-fields (get-class-fields-all  name))) ;;снабдим список полей индексами положения поля в массиве объекта.               (fields-key-new (map       (lambda (f) (if (pair? f)        (sym2key (car f))        (sym2key f)))              fields))           (valid     (make-validator name))               (maker     (make-maker     name fields-all))               (getters   (make-getters   name fields-all))               (setters   (make-setters   name fields-all)))  `(begin     ,valid ,@getters ,@setters ,maker)  )))

Как видите, макрос достаточно простой, вначале мы сохраняем в базе сведения о родителях определяемого класса и указанных в нём полях. Далее собираем информацию из базы о всех его предках и о всех его полях указанных не только в самом определении класса, но и во всех его предках. Далее для всех имён полей создаём список ключей, чтобы можно было их использовать как ключевые аргументы в функциях(и в этом нет необходимости, т.к теже ключевые аргументы создаёт определяемый далее конструктор(maker) объектов класса. Далее создаются функции предикат проверяющий тот ли это класс, конструктор объектов, наборы геттеров и сеттеров полей объектов класса. Надо заметить что мы создаём два типа геттеров и сеттеров. Статические методы и виртуальные. Статические работают только с указанным типом класса(фактически это не функции, а макросы преобразуемые в функцию вызова vector-ref и vector-set!, а виртуальные это те функции которые мы записываем в базу данных для данного класса и поля, которые в последствии будут применять в функции виртуального геттера и сеттера

(define (vfield obj key)   (let ((v (class-virtual-get (type-obj obj) key)))     (if (car v)    ((cdr v) obj)    (prn "can't find virtual get metod for object: " obj ", field " key))))  (define (vfield! obj key val)   (let ((v (class-virtual-set (type-obj obj) key)))     (if (car v)    ((cdr v) obj val)    (prn "can't find virtual set metod for object: " obj ", field " key))))

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

Ещё раз что это даёт. Написав в методе базового класса:

(vfield  obj-class-A :fieldA) (vfield! obj-class-A :fieldA value-for-A) 

мы можем быть уверены, что если в метод попадёт какой либо потомок класса class-A, то наш метод базового класса будет корректно с ним работать. Статические же методы, фактически первращающиеся в вызов функции (vector-ref obj-cass-A 7) будет корректно работать только с объектами класса class-A, но никак не с его потомками. Из за возможности подобных проблем, я вообще хотел удалить нафиг, все эти статические методы, чтобы у людей не возникало даже соблазна их применения. Но СКОРОСТЬ!!! Скорость с которой они работают и возможность кардинально ускорить код для объектов, тип которых мы знаем точно, убедили меня воздержаться от поспешных решений.(и не зря! в дальнейшем эти скромные статические методы доступа перевернут всю выстраиваемую мной объектную систему. но обо всём по порядку)

(define (sort-symb< lst)   (sort-c (lambda (f s)   (string<? (atom->string f) (atom->string s))) lst))  (define (obj2str obj)   (let* ((type   (type-obj obj))  (f1 (get-class-fields-all type))  (fields (if (not (null? f1))      (sort-symb< (map (lambda (x) (sym2key (if (pair? x)        (car x)        x)))       f1))      f1)))     (let ((rez '()))       (for-list (f fields) (push rez (string-append (to-str f) ": " (to-str (vfield obj f)))))       (apply join-to-str (insert-between-elements (reverse rez) ", ")))     ))

Все эти функции и макросы приведены в файле obj3.scm

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

(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 "hashtable2.scm")) (load (string-append path-lib "sort2.scm")) (load (string-append path-lib "obj3.scm"))

(defclass a1 ()   (fa1-1    (fa1-2 1)))   ;;описание поля со значением по умолчанию. (defclass b1 ()   ((fb1-1 1)    (fb1-2 2)    (fb1-3 3))) (defclass a2 (a1)   ((fa2-1 'a)    (fa2-2 2)    fa2-3)) (defclass a3 (a1 b1)   (fa3-1)) (defclass a4 (a2 a3)   ((fa4-1 4)    (fa4-2 5))) (defclass a5 (a4 b1)   ()) (defclass b2 (b1)   ((fb2-1 4))) (defclass b3 (b2)   ((fb3-1 5))) (defclass b4 (a4 a3 b3)   ((fb4-1 6) fb4-2 (fb4-3 7)))

;;определён ли класс? (class-defined? 'b3) ;;#t  ;;список прямых потомков класса(первым идёт коду успешности поиска предков) (class-parents  'a5) ;;(#t a4 b1)  ;;список всех потомков класса (get-class-parents-all 'a5) ;;(a4 a3 b1 a2 a1)  ;;первым идёт признак успешности поиска (get-class-fields 'a5) ;;(#t)  ;;список всех полей данного класса, со значениями по умолчанию. (get-class-fields-all 'a5)  ;;((fa4-2 5) (fa4-1 4) (fb1-3 3) fa3-1 fa2-3 (fb1-2 2) (fa2-2 2) (fb1-1 1) (fa2-1 'a) (fa1-2 1) fa1-1) 

(define a11 (make-a1 :fa1-1 123))  a11 ;;#(a1 1 123)  (get-class-fields-all 'a1) ;;((fa1-2 1) fa1-1)  (a1-fa1-1 a11) ;;123  (a1-fa1-2 a11) ;;1  (vfield a11 :fa1-1) ;;123  (vfield! a11 :fa1-1 124) ;;#(a1 1 124)  (vfield a11 :fa1-1)    ;;124  (obj2str a11) ;;":fa1-1: 124, :fa1-2: 1"

((get-class-fields-all 'a4)  ;;((fa4-2 5) (fa4-1 4) (fb1-3 3) fa3-1 fa2-3 (fb1-2 2) (fa2-2 2) (fb1-1 1) (fa2-1 'a) (fa1-2 1) fa1-1)  (define a42 (make-a4 :fa1-1 1 :fa1-2 2 :fa2-1 3 :fa2-2 4 :fa2-3 5 :fa3-1 6 :fb1-1 7 :fb1-2 8 :fb1-3 9                      :fa4-1 10 :fa4-2 11)) (obj2str a42) ":fa1-1: 1, :fa1-2: 2, :fa2-1: 3, :fa2-2: 4, :fa2-3: 5, :fa3-1: 6, :fa4-1: 10, :fa4-2: 11, :fb1-1: 7, :fb1-2: 8, :fb1-3: 9"  (a4-fa1-1 a42) ;;1  ;;не стоит так делать, т.е использовать статические методы достпупа в методах обобщённых функций, в метод ;;всегда может попасть не описываемый вами в параметре класс, а его потомок, применив к которому  ;;статический метод мы получим неверный результат!!! (a1-fa1-1 a42) ;;10  (vfield a42 :fa1-1) ;;1  (vfield! a42 :fa1-1 45) ;#(a4 11 10 9 6 5 8 4 7 3 2 45)  (vfield a42 :fa1-1)  ;;45 

Заключение

Итак, в данной статье я приступил к описанию создания ОО системы в GIMP Scrip-fu. Пусть пока показанный код выглядит как усовершенствованная структура, построение которой я описывал ранее в GIMP Script-Fu Первый Дан. Точки, Контуры, Кисти и Градиенты, а точнее структура с множественным наследованием, но надеюсь в дальнешем наше «строительство» превратиться в полноценную ОО систему, не уступающую по выразительной мощности, удобству использоания и скорости большинству ОО систем.