如何只为所有形状使用一个移动功能

作者：lookzana | 来源：互联网 | 2022-12-02 08:16

如何解决《如何只为所有形状使用一个移动功能》经验，为你挑选了1个好方法。

我的代码中的移动功能有问题.我需要它:

一个可以移动所有形状的功能,或

具有相同名称的多个函数.

到目前为止,我已经为点,圆和多边形移动了具有不同名称的函数.我无法弄清楚如何为图片制作移动功能.

如果你们能帮助我与移动的图片功能和编辑所有的举动,使他们的工作就像我在开头所描述的功能.

    ;
    ; POINT
    ;

    (defun make-point ()
      (list (list 0 0) :black))

    (defun x (point)
     (caar point))

    (defun y (point)
      (cadar point))

    (defun set-x (point new-x)
      (setf (caar point) new-x)
      point)

    (defun set-y (point new-y)
      (setf (cadar point) new-y)
      point)

    (defun move (point dx dy)
     (set-x point (+ (x point) dx))
     (set-y point (+ (y point) dy))
     point)

    ;
    ; CIRCLE
    ;

    (defun make-circle ()
      (list  (make-point) 1 :black))

    (defun center (circle)
      (car circle))

    (defun radius (circle)
      (cadr circle))

    (defun set-radius (circle new-rad)
      (if (> 0 new-rad)
          (format t "Polomer ma byt kladne cislo, zadali ste : ~s" new-rad)
        (setf (cadr circle) new-rad))
      circle)

    (defun movec (circle dx dy)
      (move (center circle) dx dy)
     circle)

    ;
    ; POLYGON
    ;

    (defun make-polygon ()
      (list nil :black))

    (defun items (shape)
     (car shape))

    (defun set-items (shape val)
      (setf (car shape) val)
      shape)

    (defun movep (polygon dx dy)
      (mapcar (lambda (b) (move b dx dy))  (items polygon))
      polygon)

    ;
    ; PICTURE
    ;

    (defun make-picture ()
      (list nil :black))

    ;(defun movepi (picture dx dy)) 

    ; items, set-items used for polygon and picture

coredump.. 6

您的对象只是列表,您将很难区分不同类型的形状.您可以在列表前面添加一个关键字,一个标签类型(例如:point,:circle等等),以便根据该标签更好地调度您的移动操作,但那将重新发明轮子,即对象.

简单的功能和列表

一个可以移动所有形状的功能

您可以这样做,前提是您可以调度您正在使用的实际对象类型.move应该能够知道正在移动的是什么样的形状.如果可以将对象类型添加为列表的CAR,则更改数据结构,并使用CASE分派,然后根据需要移动每个对象.

或多个具有相同名称的功能.

这是不可能的,至少在同一个包中.

CLOS

(defpackage :pic (:use :cl))
(in-package :pic)

多个形状有颜色,所以让我们定义一个表示具有颜色成分的对象的类:

(defclass has-color ()
  ((color :initarg :color :accessor color)))

如果您不熟悉CLOS(Common Lisp对象系统),则上面定义了一个名为的类has-color,没有超类和单个插槽color.访问者的名字都与读写器通用的功能,例如,你可以做(color object)检索对象,并(setf (color object) color)给对象的颜色设置为彩色.所述:initarg用于定义的关键字参数是在被使用make-instance.

在下面,我们定义一个point,它有一个颜色和附加x和y坐标.

(defclass point (has-color)
  ((x :initarg :x :accessor x)
   (y :initarg :y :accessor y)))

圆圈相同:

(defclass circle (has-color)
  ((center :initarg :center :accessor center)
   (radius :initarg :radius :accessor radius)))

还有一个多边形:

(defclass polygon (has-color)
  ((points :initarg :points :accessor points)))

最后,图片是一系列形状:

(defclass picture ()
  ((shapes :initarg :shapes :accessor shapes)))

您可以按如下方式创建一个圆圈:

(make-instance 'circle
               :center (make-instance 'point :x 10 :y 30)
               :color :black))

如果需要,您还可以定义更短的构造函数.

现在,您可以对move对象使用泛型函数.首先定义它DEFGENERIC,声明泛型函数的签名,以及其他选项.

(defgeneric move (object dx dy)
  (:documentation "Move OBJECT by DX and DY"))

现在,您可以向该泛型函数添加方法,并且您的泛型函数将基于一个或多个特化器和/或限定符分派给它们.

例如,您按如下方式移动一个点:

(defmethod move ((point point) dx dy)
  (incf (x point) dx)
  (incf (y point) dy))

你可以看到我们move根据第一个参数的类来专门化,这里命名为point.当绑定到的值point是类时,应用该方法point.调用INCF隐式调用(setf x)和(setf y)上面定义的.

移动圆圈意味着移动其中心:

(defmethod move ((circle circle) dx dy)
  (move (center circle) dx dy))

您可以在任何类上专门化泛型函数,例如标准SEQUENCE类.它使用相同的偏移量移动序列中的所有对象:

(defmethod move ((sequence sequence) dx dy)
  (map () (lambda (object) (move object dx dy)) sequence))

这对多边形很有用:

(defmethod move ((polygon polygon) dx dy)
  (move (points polygon) dx dy))

还有图片:

(defmethod move ((picture picture) dx dy)
  (move (shapes picture) dx dy))

不变的版本

您还可以move构建新实例,但这需要以某种方式复制现有对象.一个简单的方法是使用一个泛型函数,用一个源实例填充目标实例:

(defgeneric fill-copy (source target)
  (:method-combination progn))

这里的方法组合意味着fill-copy运行满足的所有方法,而不是仅运行最具体的方法.该progn建议的所有方法在运行progn块,一前一后.通过上面的定义,我们可以定义一个简单的copy-object泛型函数:

(defgeneric copy-object (source)
  (:method (source)
    (let ((copy (allocate-instance (class-of source))))
      (fill-copy source copy)
      copy)))

上面定义了一个名为的泛型函数copy-object,以及一个T类型对象(任何对象)的默认方法. ALLOCATE-INSTANCE创建一个实例但不初始化它.该方法用于FILL-COPY复制槽值.

例如,您可以定义如何复制color具有颜色的任何对象的插槽:

(defmethod fill-copy progn ((source has-color) (target has-color))
  (setf (color target) (color source)))

请注意,您在此处有多个分派:源对象和目标对象必须是has-color要调用的方法的类.该progn方法组合允许分配的工作fill-copy不同,解耦,方法中:

(defmethod fill-copy progn ((source point) (target point))
  (setf (x target) (x source))
  (setf (y target) (y source)))

如果您指出fill-copy,可以根据以下类层次结构应用两种方法point:为其定义的类has-color,以及专用于point类的类(对于两个参数).该progn方法相结合,确保两者都执行.

由于某些插槽可以解除绑定,因此可能会fill-copy失败.我们可以通过添加错误处理程序来解决这个问题 fill-copy:

(defmethod fill-copy :around (source target)
  (ignore-errors (call-next-method)))

该(call-next-method)表单调用其他方法(由progn限定符定义的方法),但我们将其包装在内部ignore-errors.这里没有定义颜色,但复制成功:

(copy-object (make-point :x 30 :y 20))
=> #

我们现在可以保留现有的,变异的move方法,并将它们包装在:around首先制作副本的专用方法中:

(defmethod move :around (object dx dy)
  ;; copy and mutate
  (let ((copy (copy-object object)))
    (prog1 copy
      (call-next-method copy dx dy))))

为了了解会发生什么,请定义一个方法PRINT-OBJECT:

(defmethod print-object ((point point) stream)
  (print-unreadable-object (point stream :identity t :type t)
    (format stream "x:~a y:~a" (x point) (y point))))

现在,移动一点创造了一个新观点:

(let ((point (make-instance 'point :x 10 :y 20)))
  (list point (move point 10 20)))

=> (# #)

您仍然需要更改SEQUENCE类型的方法,该类型当前会丢弃返回值move,但除此之外,对现有代码几乎没有任何更改.

另请注意,上述方法主要用于描述CLOS的各种用途,在实践中,您可能会选择某种方式移动点(可变或不可变),或者您将使用不同的函数而不是单个通用的(例如,mut-move和move).

1> coredump..：