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)
|#
YPP2/text-shape.lisp.txt · Last modified: 2014/10/22 00:45 (external edit)
CC Attribution-Noncommercial-Share Alike 4.0 International
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0