Re: Subclasses

Espen S Johnsen <[email protected]> writes:

> And then about subclassing... With the code in CVS it is now possible to
> do subclassing without explicit registering the type with the gobject
> system first. Adding slots with instance allocation should work as
> expected (but gtk 2.8 is recommended when doing this). It is still not
> possible to specialize on gtk "methods" but many methods where this
> would be useful, just emit a signal. So by overriding default class
> signal handlers, it should be possible to customize the behavior of
> subclasses. I've added a macro to do this, with the following syntax:
> 
> (define-signal-handler signal-name ((object class) &rest args)
>   (do-something)
>   (call-next-handler)
>   (do-more))
> 
> Call-next-handler is more or less equivalent to call-next-method in
> standard methods.

I found an article¹ about writing custom widgets in Pyton and decided to
write the example in Lisp. It is not very advanced, but it could easily
be extended to do something more useful. The next article is promised to
do that. Anyway here is the example (it requires the latest code which
may not propagate into anonymous CVS until a few hours²):

(defclass egg-clock-face (drawing-area)
  (cr)
  (:metaclass gobject-class))

(define-signal-handler expose-event ((clock egg-clock-face) event)
  (unless (slot-boundp clock 'cr)
    (setf (slot-value clock 'cr) (gdk:cairo-create (widget-window clock))))

  (with-slots (cr) clock
    (cairo:with-context (cr)
      (with-slots (gdk:x gdk:y gdk:width gdk:height) event
        (cairo:rectangle cr gdk:x gdk:y gdk:width gdk:height))
      (cairo:clip cr)
    
      (multiple-value-bind (width height) (widget-get-size-allocation clock)
        (let* ((x (/ width 2))
               (y (/ height 2))
               (radius (- (min (/ width 2) (/ height 2)) 5)))

          (cairo:circle cr x y radius)
          (cairo:set-source-color cr 1.0 1.0 1.0)
          (cairo:fill cr t)
          (cairo:set-source-color cr 0 0 0)
          (cairo:stroke cr)

          (loop
           for tick from 0 below 12
           do (cairo:with-context (cr)
                (let ((inset (if (zerop (mod tick 3))
                                 (* 0.2 radius)
                               (progn
                                 (setf 
                                  (cairo:line-width cr) 
                                  (* 0.5 (cairo:line-width cr)))
                                 (* 0.1 radius)))))
                
                  (cairo:move-to cr 
                   (+ x (* (- radius inset) (cos (* tick (/ pi 6)))))
                   (+ y (* (- radius inset) (sin (* tick (/ pi 6))))))
                  (cairo:line-to cr 
                   (+ x (* radius (cos (* tick (/ pi 6)))))
                   (+ y (* radius (sin (* tick (/ pi 6))))))
                  (cairo:stroke cr))))))))
  nil)


#+sbcl(sb-int:set-floating-point-modes :traps nil) 
#+cmu(ext:set-floating-point-modes :traps nil)

(make-instance 'window 
 :child (make-instance 'egg-clock-face :visible t)
 :visible t)


¹http://www.pygtk.org/articles/cairo-pygtk-widgets/cairo-pygtk-widgets.htm
²A work around would be to do (make-instance 'egg-clock-face) before
 defining the signal handler
-- 
Espen


-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems?  Stop!  Download the new AJAX search engine that makes
searching your log files as easy as surfing the  web.  DOWNLOAD SPLUNK!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid3432&bid#0486&dat1642