我的代码中的移动功能存在问题。 我需要它：
到目前为止，我有 move 函数，它们具有point, circle and polygon的不同名称。 我不知道如何使图片的移动功能。
如果你们可以通过图片的移动功能帮助我并编辑所有移动功能，以便它们像我在开始时所述的那样工作。
;
; 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
答案 0 :(得分：6)
您的对象只是列表，您将很难区分不同的形状。您可以在列表的前面添加关键字（标签类型）（例如:point，:circle等），以根据该标签更好地调度移动操作，但是那会重新发明轮，又名物体。
一个可以移动所有形状的功能
您可以执行此操作，前提是您可以分派正在使用的对象的实际类型。 move应该能够知道要移动的形状。如果可以将对象类型添加为列表的CAR，并使用CASE进行分派，然后根据需要移动每个对象，请更改数据结构。
或具有相同名称的多个功能。
这是不可能的，至少在同一包装中。
(defpackage :pic (:use :cl))
(in-package :pic)
多个形状都有一种颜色，因此让我们定义一个类来表示具有颜色成分的对象：
(defclass has-color ()
((color :initarg :color :accessor color)))
如果您不熟悉CLOS（公共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定义的，另一种是专门针对{ {1}}类（用于两个参数）。 point方法组合可确保两者均被执行。
由于某些插槽可以解除绑定，因此progn可能会失败。我们可以通过添加错误处理程序 around 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))
=> #<POINT {1008480D93}>
方法，并将它们包装在首先制作副本的move专用方法中：
:around为了查看会发生什么，请为PRINT-OBJECT定义一个方法：
(defmethod move :around (object dx dy)
;; copy and mutate
(let ((copy (copy-object object)))
(prog1 copy
(call-next-method copy dx dy))))
现在，移动一个点将创建一个新点：
(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))))
您仍然需要更改SEQUENCE类型的方法，该方法当前会丢弃(let ((point (make-instance 'point :x 10 :y 20)))
(list point (move point 10 20)))
=> (#<POINT x:10 y:20 {1003F7A4F3}> #<POINT x:20 y:40 {1003F7A573}>)
的返回值，但除此之外，对现有代码几乎没有任何更改。
还请注意，上述方法主要用作描述CLOS各种用途的方法，实际上，您可能会选择一种或另一种方法来移动点（是否可变）。而不是单个通用功能（例如mut-move和move）。
答案 1 :(得分：2)
草图，标记形状：
(defun p (x y) (list x y))
(defun make-shape (type points colour data)
(list* type points colour data))
(defmacro defshape (name args &key verify-points verify-args)
"define the function (make-NAME points ARGS...)
to make a shape of type :NAME. Optionally
evaluate the form VERIFY-ARGS with the
lambda-list ARGS bound and call the
function VERIFY-POINTS with the points of
the shape, ignoring its result."
(let ((type (intern name (symbol-package :key)))
(fun (intern (concatenate 'String "MAKE-" name) (symbol-package name)))
(all (gensym "ARGS"))
(colour (gensym "COLOUR"))
(points (gensym "POINTS")))
`(defun ,fun (,points ,colour &rest ,all)
(destructuring-bind ,args ,all
,verify-args
,(if verify-points `(funcall ,verify-points ,points))
(make-shape ,type ,points ,colour ,all))))
(defun singlep (list) (and list (null (cdr list))))
(defshape point () :verify-points #'singlep
(defshape circle (radius) :verify-args (assert (realp radius) radius)
:verify-points #'singlep)
(defshape polygon ())
您可以使用此：
CL-USER> (make-circle (list (p 0 0)) :black 2)
(:CIRCLE ((0 0)) :BLACK)
CL-USER> (make-point (list (p 1 2)) :blue)
(:POINT ((1 2)) :BLUE)
CL-USER> (make-polygon (list (p 0 0) (p 0 1) (p 1 0)) :red)
(:POLYGON ((0 0) (0 1) (1 0)) :RED)
您可以编写一些功能：
(defun map-points (function shape)
(destructuring-bind (type points colour &rest data)
shape
(make-shape type (mapcar function points) colour data)))
并应用它们：
CL-USER> (map-points (lambda (p) (list (1+ (first p)) (second p))) '(:POLYGON ((0 0) (0 1) (1 0)) :RED))
(:POLYGON ((1 0) (1 1) (2 0)) :RED)
并解决您的问题：
(defun move (dx dy shape)
(map-points (lambda (p) (destructuring-bind (x y) p (list (+ x dx) (+ y dy)))) shape))
您可能想要的另一件事是根据形状的类型（即CAR）进行大写处理，根据将类型映射到哈希表中的内容或将其内容放入符号plist中进行调度