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).
归档时间: |
|
查看次数: |
123 次 |
最近记录: |