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

Реализовав простейшую объектную систему в Scheme полезно было бы продемонстрировать преимущество от её использования. Чем в этой статье мы и займёмся. Демонстрацию проведём на примере абстракции Фигуры, ведь именно при реализации этой абстракции у меня и возникло сожаление об отсутствии ОО средств в Scheme.

Наследование

Но прежде чем приступить к кодированию, поговорим о наследовании.

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

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

(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 "obj2.scm"))

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

макросы обеспечивающие работу с шаблонами функций.

;;данный макрос на основе шаблонной функции создаёт запись идентичную определению 
;;метода в defclass
(define-macro (method-by-func name func)
   (let ((code (get-closure-code (eval func))))
      `((,name ,@(cadr code))
        ,@(cddr code))))

;;данный макрос извлекает только тело функции
(define-macro (body-func func)
   (let ((code (get-closure-code (eval func))))
      `(begin ,@(cddr code))))

как это работает, проведём небольшой тест.

;;шаблонная функция для использования в коде метода
(define-m (get-x2-shabl)
   (prn "in get-x2\n")
   x2)

(defclass tst1
   (x1 x2)
   (((get-x1)
     (prn "in get-x1\n")
     x1)
    ((get-x2)
     (body-func get-x2-shabl))    ;;использование шаблонной функции для формирования метода
    ((get-var sym)                ;;хакерский метод для получения доступа к внутренним переменным и методам.
     (eval sym))
    )
   ())

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

(define t1 (make-tst1 :x1 5 :x2 "qwe"))

(t1 :get-x2)
;;in get-x2
;;"qwe"

(t1 :get-var 'x2)
;;"qwe"

(t1 :get-var 'get-x1)
;;##

(get-closure-code (t1 :get-var 'get-x1))
;;(lambda () (prn "in get-x1\n") x1)

(get-closure-code (t1 :get-var 'get-x2))
;;(lambda () (begin (prn "in get-x2\n") x2))

Фигуры

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

;;функции шаблоны
(define-m (init-contour-shabl i-contour)
  ;;(prn "Hello\n")
  (let ((min-p (min-pos i-contour))
        (max-p (max-pos i-contour)))
    (set! contour i-contour)
    (set! min-x   (p-x min-p))
    (set! min-y   (p-y min-p))
    (set! max-x   (p-x max-p))
    (set! max-y   (p-y max-p))))

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

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

;;вынесем функционал формирования массива из списка точек в отдельную функцию
(define (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))

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

;;класс фигур заполняемых цветом по контуру
(defclass shape-fig
   (name (color default-color) 
         contour min-x min-y max-x max-y)
   (((get-name)
     (body-func get-name-shabl))
    ((init-contour i-contour)
     (body-func init-contour-shabl))
    ((draw img tr)
     (let* ((contour    (if tr
                            (translate-contour contour tr)
                            contour))
            (num-points (length contour))
            (points     (make-contour-vector contour  num-points))
            (dw         (car (gimp-image-get-active-drawable img))))
        (gimp-context-set-foreground color)
        (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)))
    ((get-gabarite)
     (body-func get-gabarite-shabl))
    )
   ())

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

При таком подходе, за отрисовку объекта отвечает классовый метод, и никакой функции draw-fig отвечающей за отрисовку ЛЮБОЙ фигуры не требуется, каждый объект в соответсвии со своим классом имеет свою функцию отрисовки, которая будет вызываться в ответ на сообщение :draw.

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

(define c1 (make-circle-n 50 50 50 10))
(define f1 (make-brush-fig :name 'circle1))
(f1 :get-name) ;;circle1
(f1 :init-contour c1) ;;100.0
(f1 :get-gabarite)    ;;(2,447174185.0 0.0 97,55282581.0 100.0)

(define f2 (make-pencil-fig :name 'circle2 :color '(0 255 255)))
(f2 :init-contour c1)
(f2 :get-name) ;;circle2

(define tr3       (comb-tr2d
                   (make-tr2d-scale 2 1.5)
                   (make-tr2d-shear-y 15)
                   (make-tr2d-rot -90)
                   (make-tr2d-move 100 300)))

;; (draw-fig i1 f1 #f)
;; (draw-fig i1 f2 tr3)
(f1 :draw i1 #f)
(f2 :draw i1 tr3)

Здесь мы выполняем помимо конструирования объекта, инициализацию контура с помощью сообщения init-contour, это немного не удобно и объясняется тем, что в конструкторе по умолчанию создаваемым макросом defclass не предусмотрен код выполняющий какие либо вычисления, написав более сложный макрос, в котором можно было бы предусмотреть блок инициализации в конструкторе, этого недостатка можно было бы избежать. Но в целом мы получаем результат аналогичный предыдущему подходу.

Теперь рисуем фигуру заполняемую цветом

(define f3        (make-shape-fig :name 'circle2 :color '(255 255 0)))
(f3 :init-contour c1)
(define tr4       (comb-tr2d
                   (make-tr2d-scale 1.5 1.5)
                   (make-tr2d-shear-y 0)
                   (make-tr2d-rot 30)
                   (make-tr2d-move 350 50)))
;;(draw-fig i1 f3 tr4)
(f3 :draw i1 tr4)

(define tr5       (comb-tr2d
                   (make-tr2d-scale 1. 1.)
                   (make-tr2d-shear-x 20)
                   (make-tr2d-rot 0)
                   (make-tr2d-move 90 100)))
;;(draw-fig i1 f3 tr5)
(f3 :draw i1 tr5)

Составная фигура

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

;;составная фигура.
;; функция по списку фигур, получает у них их габариты и находит минимальные и максимальные позиции
;; всего списка фигур
;;gab list of  min-x min-y max-x max-y
(define-m (minmax-pos-figs list-fig)
   (if (not (null? list-fig))
       (let ((min-x maxnum)
             (min-y maxnum)
             (max-x minnum)
             (max-y minnum))
          (do ((cur list-fig (cdr cur)))
                ((null? cur) (list (p! min-x min-y) (p! max-x max-y)))
             (let ((gab ((car cur) :get-gabarite))) ;;вот для чего каждая фигура должна выдавать свои габариты
                (if (> (car gab) min-x)
                    (set! min-x (car gab)))
                (if (> (cadr gab) min-y)
                    (set! min-y (cadr gab)))
                (if (< (caddr gab) max-x)
                    (set! max-x (caddr gab)))
                (if (< (cadddr gab) max-y)
                    (set! max-y (cadddr gab)))
                )
             ))
       (prn ("error in minmax-pos-figs: list fig empty!\n"))))
       
(defclass complex-fig
   (name figs p-min p-max)
   (((get-name)
     (body-func get-name-shabl))
    ((init-figs i-figs) ;;принимает список фигур
     (let ((gab (minmax-pos-figs i-figs)))
        (set! p-min (car gab))
        (set! p-max (cadr gab))
        (set! figs  i-figs)))
    ((draw img tr)
     (let* ((delta      0.00001)
            (dw         (car (gimp-image-get-active-drawable img))))
        ;;(gimp-context-push)
        (if (or (> (abs (p-x p-min)) delta)
                (> (abs (p-y p-min)) delta));;начало фигуры сдвинуто относительно
            (set! tr (comb-tr2d             ;;начала координат надо подвинуть туда!
                      (make-tr2d-move (- (p-x p-min)) (- (p-y p-min)))
                      tr)))
        (do ((cur figs (cdr cur)))
              ((null? cur) figs)
           ((car cur) :draw img tr))
        ;;(gimp-context-pop)
        ))
    ((get-gabarite)
     (list (p-x p-min) (p-y p-min) (p-x p-max) (p-y p-max)))
    )
   ())

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

Давайте проверим работоспособность нашего класса complex-fig.

(define bsh1 (make-brush1 :name  "2. Hardness 075"  :size 20))
(define bsh2 (make-brush1 :name  "2. Hardness 025"  :size 10))
;;2.6
;;посмотрим какие кисти есть.
;;(gimp-brushes-get-list ".*")
;;Circle Fuzzy (11)
(define bsh1 (make-brush1 "Circle Fuzzy (17)" :name "My Brush1" :radius 20))
(define bsh2 (make-brush2 "My Brush1" :radius 10 :aspect-ratio 0.5))

;; рисуем обычную звезду.
(define c2 (translate-contour (make-star 50 5 0.3)
                              (make-tr2d-rot -90)))
(define p1n (min-pos c2))
(define p1x (max-pos c2))

(define c2o (translate-contour c2
                               (make-tr2d-move (abs (p-x p1n)) (abs (p-y p1n)))))
                               

(define f2 (make-shape-fig :name 'star1 :color '(127 127 0)))
(f2 :init-contour c2o)
(define f3 (make-brush-fig :name 'star2 :color '(127 0 255) :brush bsh1))
(f3 :init-contour c2o)
(define f4 (make-brush-fig :name 'star3 :color '(255 0 0) :brush bsh2))
(f4 :init-contour c2o)

;; Сложная фигура на базе простых.
;; (define fs1 (list f2 f3 f4))
(define fs1 (make-complex-fig :name "Complex fig1"))
(fs1 :init-figs (list f2 f3 f4))
(fs1 :get-name)     ;;"Complex fig1"
(fs1 :get-gabarite) ;; (0 0 95.10565163 90.45084972)

;;создаём рамку и выполняем создание трасформацию, чтобы наша фигура была отображена в указанную рамку
;;раньше эта операция выполнялась в функции draw-figs
(define r1 (make-rect-by-vect (p! 100 50) (p! 200 0) (p! 0 200)))
(define tr1 (let ((gab (fs1 :get-gabarite)))
               (make-tr2d-from-rect r1
                                    (- (caddr gab)  (car gab))
                                    (- (cadddr gab) (cadr gab)))))

;;(draw-figs i1 fs1 r1)
(fs1 :draw i1 tr1)

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

Отображение фигуры в рамку.

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

;;вместо определения в базовом классе(которого у нас нет) создадим шаблон функции
(define-m (draw-fig-in-rect-shabl img r)
   ;;(prn "in draw-fig-in-rect\n")
   (let* ((gab (get-gabarite))
          (tr  (make-tr2d-from-rect r
                                    (- (caddr gab)  (car gab))
                                    (- (cadddr gab) (cadr gab)))))
      ;;(prn "tr: " tr "\n")
      (draw img tr)))

;;внесём определение метода в каждый класс:
...
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))

;;вместо определения в базовом классе(которого у нас нет) создадим шаблон функции
(define-m (draw-fig-in-rect-shabl img r)
   ;;(prn "in draw-fig-in-rect\n")
   (let* ((gab (get-gabarite))
          (tr  (make-tr2d-from-rect r
                                    (- (caddr gab)  (car gab))
                                    (- (cadddr gab) (cadr gab)))))
      ;;(prn "tr: " tr "\n")
      (draw img tr)))

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


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

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

(defclass complex-fig
   (name figs p-min p-max)
   (((get-name)
     (body-func get-name-shabl))
    ((init-figs i-figs) ;;принимает список фигур
     (let ((gab (minmax-pos-figs i-figs)))
        (set! p-min (car gab))
        (set! p-max (cadr gab))
        (set! figs  i-figs)))
    ((draw img tr)
     (let* ((delta      0.00001)
            (dw         (car (gimp-image-get-active-drawable img))))
        ;;(gimp-context-push)
        (if (or (> (abs (p-x p-min)) delta)
                (> (abs (p-y p-min)) delta));;начало фигуры сдвинуто относительно
            (set! tr (comb-tr2d             ;;начала координат надо подвинуть туда!
                      (make-tr2d-move (- (p-x p-min)) (- (p-y p-min)))
                      tr)))
        (do ((cur figs (cdr cur)))
              ((null? cur) figs)
           ((car cur) :draw img tr))
        ;;(gimp-context-pop)
        ))
    ((draw-to-rect img r)
     (body-func draw-fig-in-rect-shabl))
    ((get-gabarite)
     (list (p-x p-min) (p-y p-min) (p-x p-max) (p-y p-max)))
    )
   ())

тестируем рисуя сложную фигуру в заданную рамку, и простые фигуры в отдельно задаваемые рамки:

(define f2 (make-shape-fig :name 'star1 :color '(127 127 0)))
(f2 :init-contour c2o)
(define f3 (make-brush-fig :name 'star2 :color '(127 0 255) :brush bsh1))
(f3 :init-contour c2o)
(define f4 (make-brush-fig :name 'star3 :color '(255 0 0) :brush bsh2))
(f4 :init-contour c2o)

;; (define fs1 (list f2 f3 f4))
(define fs1 (make-complex-fig :name "Complex fig1"))
(fs1 :init-figs (list f2 f3 f4))
(fs1 :get-name)     ;;"Complex fig1"
(fs1 :get-gabarite) ;; (0 0 95.10565163 90.45084972)

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

;;(draw-figs i1 fs1 r1)
(fs1 :draw-to-rect i1 r1)

(define r2 (make-rect-by-vect (p! 250 400) (p! 100 -5) (p! 5 -200)))
(f2 :draw-to-rect i1 r2)

(define r3 (make-rect-by-vect (p! 250 400) (p! 200 5) (p! 5 -100)))
(f3 :draw-to-rect i1 r3)

(define r4 (make-rect-by-vect (p! 400 200) (p! 100 0) (p! 0 -100)))
(f4 :draw-to-rect i1 r4)

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

Стрелка.

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

(define tr-s-arrow       (make-tr2d-scale (- (/ 1 10)) (- (/ 1 10))))
(define tr-up-arrow      (make-tr2d-rot  15))
(define tr-down-arrow    (make-tr2d-rot (- 15)))
(define (make-arrow1 target)
   (let* ((p2 (p-tr2d target tr-s-arrow))
          (p3 (p-tr2d p2     tr-down-arrow))
          (p4 (p-tr2d p2     tr-up-arrow))
          (tr-s1 (make-tr2d-move (p-x target) (p-y target)))
          (p3a (p-tr2d p3 tr-s1))
          (p4a (p-tr2d p4 tr-s1)))
      (list (p! 0 0) target p3a p4a target)))

Данный контур имеет острие равное десятой части полной длины стрелки, и угол заострения 30 градусов.

;;контур прямоугольника
(define c8 (make-rect-contour 0 0 50 50))
;;контур стрелки сдвинутой к середине прямоугольника.
(define c9 (translate-contour  (make-arrow1 (p! 0 50))
                               (make-tr2d-move 25 0)))

;;2.10
(define bsh4 (make-brush1 :name  "2. Hardness 075"  :size 5))
;;2.6
(define bsh4 (make-brush2 "My Brush1" :radius 2))

;;составная фигура из прямоугольника, заливки и стрелки.
;; (define fs3
;;    (list
;;     (make-shape-fig  c8 :color '(255 255 0))
;;     (make-pencil-fig c8 :color '(0 255 0) :brush bsh4)
;;     (make-pencil-fig c9 :color '(255 0 0) :brush bsh4)))
(define f1 (make-shape-fig :color '(255 255 0)))
(f1 :init-contour c8)
(define f2 (make-pencil-fig :color '(0 255 0) :brush bsh4))
(f2 :init-contour c8)
(define f3 (make-pencil-fig :color '(255 0 0) :brush bsh4))
(f3 :init-contour c9)
(define fs1 (make-complex-fig :name "Complex fig2"))
(fs1 :init-figs (list f1 f2 f3))

;; рисуем в 3х разных рамках, рамки получаем трансляцией базовой рамки 100х100
(fs1 :draw-to-rect i1 (rect! (p! 0 0) (p! 100 0) (p! 0 100)))
(fs1 :draw-to-rect i1 
           (rect-tr2d base-rect
                      (comb-tr2d
                       (make-tr2d-scale 100 50)
                       (make-tr2d-rot 45)
                       (make-tr2d-move 300 200))))
(fs1 :draw-to-rect i1 
           (rect-tr2d base-rect
                      (comb-tr2d
                       (make-tr2d-scale 100 100)
                       (make-tr2d-shear-x -40)
                       (make-tr2d-shear-y 10)
                       (make-tr2d-rot -45)
                       (make-tr2d-move 75 335))))

Итого

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