Библиотека функций к 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 может легко нивелировать написав специальный макрос, создающий синтаксис при использовании которого создаётс�� иллюзия, что класс всё-таки владеет методом, но это только видимость, предназначенная чисто для сокращения кода.
Много лет назад, когда я только начинал программировать, я начинал с С++. И уже тогда при проектировании систем (простеньких и детских) я сталкивался с проблемой отнесения метода к одному или к другому классу. И стоял как «буриданов осёл» не зная к какому классу правильно отнести метод, потому что действие метода затрагивало объекты разных классов.
boom?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 Первый Дан. Точки, Контуры, Кисти и Градиенты, а точнее структура с множественным наследованием, но надеюсь в дальнешемнаше «строительство» превратиться в полноценную ОО систему, не уступающую по выразительной мощности, удобству использоания и скорости большинству ОО систем.
