Ale*_*ová 2 lisp common-lisp lispworks
我的代码中的移动功能有问题.我需要它:
到目前为止,我已经为点,圆和多边形移动了具有不同名称的函数.我无法弄清楚如何为图片制作移动功能.
如果你们能帮助我与移动的图片功能和编辑所有的举动,使他们的工作就像我在开头所描述的功能.
;
; 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
Run Code Online (Sandbox Code Playgroud)
您的对象只是列表,您将很难区分不同类型的形状.您可以在列表前面添加一个关键字,一个标签类型(例如:point,:circle等等),以便根据该标签更好地调度您的移动操作,但那将重新发明轮子,即对象.
一个可以移动所有形状的功能
您可以这样做,前提是您可以调度您正在使用的实际对象类型.move应该能够知道正在移动的是什么样的形状.如果可以将对象类型添加为列表的CAR,则更改数据结构,并使用CASE分派,然后根据需要移动每个对象.
或多个具有相同名称的功能.
这是不可能的,至少在同一个包中.
(defpackage :pic (:use :cl))
(in-package :pic)
Run Code Online (Sandbox Code Playgroud)
多个形状有颜色,所以让我们定义一个表示具有颜色成分的对象的类:
(defclass has-color ()
((color :initarg :color :accessor color)))
Run Code Online (Sandbox Code Playgroud)
如果您不熟悉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)))
Run Code Online (Sandbox Code Playgroud)
圆圈相同:
(defclass circle (has-color)
((center :initarg :center :accessor center)
(radius :initarg :radius :accessor radius)))
Run Code Online (Sandbox Code Playgroud)
还有一个多边形:
(defclass polygon (has-color)
((points :initarg :points :accessor points)))
Run Code Online (Sandbox Code Playgroud)
最后,图片是一系列形状:
(defclass picture ()
((shapes :initarg :shapes :accessor shapes)))
Run Code Online (Sandbox Code Playgroud)
您可以按如下方式创建一个圆圈:
(make-instance 'circle
:center (make-instance 'point :x 10 :y 30)
:color :black))
Run Code Online (Sandbox Code Playgroud)
如果需要,您还可以定义更短的构造函数.
现在,您可以对move对象使用泛型函数.首先定义它DEFGENERIC,声明泛型函数的签名,以及其他选项.
(defgeneric move (object dx dy)
(:documentation "Move OBJECT by DX and DY"))
Run Code Online (Sandbox Code Playgroud)
现在,您可以向该泛型函数添加方法,并且您的泛型函数将基于一个或多个特化器和/或限定符分派给它们.
例如,您按如下方式移动一个点:
(defmethod move ((point point) dx dy)
(incf (x point) dx)
(incf (y point) dy))
Run Code Online (Sandbox Code Playgroud)
你可以看到我们move根据第一个参数的类来专门化,这里命名为point.当绑定到的值point是类时,应用该方法point.调用INCF隐式调用(setf x)和(setf y)上面定义的.
移动圆圈意味着移动其中心:
(defmethod move ((circle circle) dx dy)
(move (center circle) dx dy))
Run Code Online (Sandbox Code Playgroud)
您可以在任何类上专门化泛型函数,例如标准SEQUENCE类.它使用相同的偏移量移动序列中的所有对象:
(defmethod move ((sequence sequence) dx dy)
(map () (lambda (object) (move object dx dy)) sequence))
Run Code Online (Sandbox Code Playgroud)
这对多边形很有用:
(defmethod move ((polygon polygon) dx dy)
(move (points polygon) dx dy))
Run Code Online (Sandbox Code Playgroud)
还有图片:
(defmethod move ((picture picture) dx dy)
(move (shapes picture) dx dy))
Run Code Online (Sandbox Code Playgroud)
您还可以move构建新实例,但这需要以某种方式复制现有对象.一个简单的方法是使用一个泛型函数,用一个源实例填充目标实例:
(defgeneric fill-copy (source target)
(:method-combination progn))
Run Code Online (Sandbox Code Playgroud)
这里的方法组合意味着fill-copy运行满足的所有方法,而不是仅运行最具体的方法.该progn建议的所有方法在运行progn块,一前一后.通过上面的定义,我们可以定义一个简单的copy-object泛型函数:
(defgeneric copy-object (source)
(:method (source)
(let ((copy (allocate-instance (class-of source))))
(fill-copy source copy)
copy)))
Run Code Online (Sandbox Code Playgroud)
上面定义了一个名为的泛型函数copy-object,以及一个T类型对象(任何对象)的默认方法.
ALLOCATE-INSTANCE创建一个实例但不初始化它.该方法用于FILL-COPY复制槽值.
例如,您可以定义如何复制color具有颜色的任何对象的插槽:
(defmethod fill-copy progn ((source has-color) (target has-color))
(setf (color target) (color source)))
Run Code Online (Sandbox Code Playgroud)
请注意,您在此处有多个分派:源对象和目标对象必须是has-color要调用的方法的类.该progn方法组合允许分配的工作fill-copy不同,解耦,方法中:
(defmethod fill-copy progn ((source point) (target point))
(setf (x target) (x source))
(setf (y target) (y source)))
Run Code Online (Sandbox Code Playgroud)
如果您指出fill-copy,可以根据以下类层次结构应用两种方法point:为其定义的类has-color,以及专用于point类的类(对于两个参数).该progn方法相结合,确保两者都执行.
由于某些插槽可以解除绑定,因此可能会fill-copy失败.我们可以通过添加错误处理程序来解决这个问题 fill-copy:
(defmethod fill-copy :around (source target)
(ignore-errors (call-next-method)))
Run Code Online (Sandbox Code Playgroud)
该(call-next-method)表单调用其他方法(由progn限定符定义的方法),但我们将其包装在内部ignore-errors.这里没有定义颜色,但复制成功:
(copy-object (make-point :x 30 :y 20))
=> #<POINT {1008480D93}>
Run Code Online (Sandbox Code Playgroud)
我们现在可以保留现有的,变异的move方法,并将它们包装在:around首先制作副本的专用方法中:
(defmethod move :around (object dx dy)
;; copy and mutate
(let ((copy (copy-object object)))
(prog1 copy
(call-next-method copy dx dy))))
Run Code Online (Sandbox Code Playgroud)
为了了解会发生什么,请定义一个方法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))))
Run Code Online (Sandbox Code Playgroud)
现在,移动一点创造了一个新观点:
(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}>)
Run Code Online (Sandbox Code Playgroud)
您仍然需要更改SEQUENCE类型的方法,该类型当前会丢弃返回值move,但除此之外,对现有代码几乎没有任何更改.
另请注意,上述方法主要用于描述CLOS的各种用途,在实践中,您可能会选择某种方式移动点(可变或不可变),或者您将使用不同的函数而不是单个通用的(例如,mut-move和move).