text-shape.lisp
text-shape
(defclass text-shape (shape)
((text :initform "")
(position :initform (make-instance 'point))))
(defmethod text ((shape text-shape))
(slot-value shape 'text))
(defmethod text-position ((shape text-shape))
(slot-value shape 'position))
(defmethod initialize-instance ((shape text-shape) &rest args)
(call-next-method)
(let ((pos (text-position shape)))
(set-events pos '(ev-changing ev-change))
(set-delegate pos shape))
shape)
(defmethod ev-changing ((shape text-shape) sender msg &rest msg-args)
(changing shape 'ev-changing sender msg msg-args))
(defmethod ev-change ((shape text-shape) sender msg &rest msg-args)
(change shape 'ev-change sender msg msg-args))
(defmethod set-text ((shape text-shape) value)
(with-change (shape 'set-text value)
(setf (slot-value shape 'text) value)))
(defmethod do-move ((shape text-shape) dx dy)
(move (text-position shape) dx dy))
(defmethod do-scale ((shape text-shape) coeff center)
(scale (text-position shape) coeff center))
(defmethod do-rotate ((shape text-shape) angle center)
(rotate (text-position shape) angle center))
(defmethod contains-point-p ((shape text-shape) point)
nil)
(defmethod do-draw ((shape text-shape))
(mg:draw-string (shape-mg-window shape)
(text shape)
(x (text-position shape))
(y (text-position shape)))
shape)
#|
(setf ts (make-instance 'text-shape))
(set-text ts "ahoj")
(move ts 100 100)
(setf w (make-instance 'window))
(set-shape w ts)
(move ts 20 20)
|#