Posted 2020-12-16 23:30:16 GMT
allocate-instance Advent Calendar 2020 17日目の記事です。
完全なるネタ切れですが、今回はアンドゥ可能なスロットを実現してみたいと思います。
以前に紹介した履歴付きスロットと似たような感じですが、こちらは限定された回数スロットの状態をアンドゥできることをメインに考えます!
仕様としては、どこかのスロットが変更された場合、スロット全部を保存することにします。
内部では、16セットのスロットを二次元配列で表現したものと現在の位置を、オブジェクトのストレージとします。
また、ユーティリティとしてundo-slotsとreset-slotsも用意してみます。
(defclass foo (undoable-slots-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass undoable-slots-class))
(defparameter *foo* (make-instance 'foo))
(describe *foo*)
#<foo 4020002193> is a foo
a 0
b 1
c 2
;; 乱数を任意のスロットに代入 x 15回
(dotimes (i 15)
(setf (slot-value *foo* (elt #(a b c) (mod i 3)))
(random 1000)))
;; 15回状態を戻す
(dotimes (i 15)
(describe (undo-slots *foo*)))
#<foo 4020002193> is a foo
a 930
b 743
c 626
#<foo 4020002193> is a foo
a 930
b 365
c 626
#<foo 4020002193> is a foo
a 571
b 365
c 626
#<foo 4020002193> is a foo
a 571
b 365
c 695
#<foo 4020002193> is a foo
a 571
b 92
c 695
#<foo 4020002193> is a foo
a 895
b 92
c 695
#<foo 4020002193> is a foo
a 895
b 92
c 905
#<foo 4020002193> is a foo
a 895
b 139
c 905
#<foo 4020002193> is a foo
a 841
b 139
c 905
#<foo 4020002193> is a foo
a 841
b 139
c 859
#<foo 4020002193> is a foo
a 841
b 342
c 859
#<foo 4020002193> is a foo
a 10
b 342
c 859
#<foo 4020002193> is a foo
a 10
b 342
c 2
#<foo 4020002193> is a foo
a 10
b 1
c 2
#<foo 4020002193> is a foo
a 0
b 1
c 2
nil
(defpackage "955b5b51-173a-50c3-82f6-7add63d9b29a"
(:use c2cl slotted-objects))
(cl:in-package "955b5b51-173a-50c3-82f6-7add63d9b29a")
(defconstant undo-limit 16.)
(defclass undoable-slots-storage ()
((slots :initarg :slots :accessor undoable-slots-storage-slots)
(history# :initform 0 :accessor undoable-slots-storage-history#)))
(defclass undoable-slots-class (slotted-class)
()
(:metaclass standard-class))
(defclass undoable-slots-object (slotted-object)
()
(:metaclass undoable-slots-class))
(defmethod allocate-instance ((class undoable-slots-class) &key &allow-other-keys)
(allocate-slotted-instance (class-wrapper class)
(make-instance 'undoable-slots-storage
:slots (make-array `(,undo-limit ,(length (class-slots class)))
:initial-element (make-unbound-marker)))))
(defclass undoable-slots-object (slotted-object)
()
(:metaclass undoable-slots-class))
(defmethod slot-value-using-class ((class undoable-slots-class) instance (slotd slot-definition))
(let ((storage (instance-slots instance)))
(aref (undoable-slots-storage-slots storage)
(undoable-slots-storage-history# storage)
(slot-definition-location slotd))))
(defmethod (setf slot-value-using-class) (value (class undoable-slots-class) instance (slotd slot-definition))
(let* ((storage (instance-slots instance))
(curpos (mod (undoable-slots-storage-history# storage) undo-limit))
(loc (slot-definition-location slotd)))
(flet ((backup ()
(dotimes (idx (length (class-slots class)))
(let ((new (mod (1+ curpos) undo-limit))
(old curpos))
(setf (aref (undoable-slots-storage-slots storage) new idx)
(aref (undoable-slots-storage-slots storage) old idx)))))
(incpos ()
(setf (undoable-slots-storage-history# storage)
(mod (1+ curpos) undo-limit))))
(backup)
(incpos)
(setf (aref (undoable-slots-storage-slots storage)
(undoable-slots-storage-history# storage)
loc)
value))))
(defmethod initialize-slot-from-initarg ((class undoable-slots-class) instance slotd initargs)
(let ((slot-initargs (slot-definition-initargs slotd)))
(loop :for (initarg value) :on initargs :by #'cddr
:do (when (member initarg slot-initargs)
(let ((storage (instance-slots instance)))
(setf (aref (undoable-slots-storage-slots storage)
(undoable-slots-storage-history# storage)
(slot-definition-location slotd))
value))
(return T)))))
(defmethod initialize-slot-from-initfunction ((class undoable-slots-class) instance slotd)
(let ((initfun (slot-definition-initfunction slotd)))
(unless (not initfun)
(let ((storage (instance-slots instance)))
(setf (aref (undoable-slots-storage-slots storage)
(undoable-slots-storage-history# storage)
(slot-definition-location slotd))
(funcall initfun))))))
(defun undo-slots (obj)
(let ((storage (instance-slots obj)))
(setf (undoable-slots-storage-history# storage)
(mod (1- (undoable-slots-storage-history# storage)) undo-limit)))
obj)
(defun reset-slots (obj)
(let ((storage (instance-slots obj)))
(setf (undoable-slots-storage-history# storage)
0))
obj)
■
HTML generated by 3bmd in LispWorks 7.0.0