chiark - git - mdw - sod/blob - examples.lisp

   1 (set-dispatch-macro-character #\# #\{ 'c-fragment-reader)
   2
   3 (progn
   4   (clear-the-decks)
   5
   6   (define-sod-class "Animal" ("SodObject")
   7     :nick 'nml
   8     :link '|SodObject|
   9     (slot "tickles" int)
  10     (instance-initializer "nml" "tickles" :single #{ 0 })
  11     (message "tickle" (fun void))
  12     (method "nml" "tickle" (fun void) #{
  13        me->tickles++;
  14      }
  15      :role :before)
  16     (method "nml" "tickle" (fun void) #{ }))
  17
  18   (define-sod-class "Lion" ("Animal")
  19     :nick 'lion
  20     :link '|Animal|
  21     (message "bite" (fun void))
  22     (method "lion" "bite" (fun void) nil)
  23     (method "nml" "tickle" (fun void) #{
  24        me->_vt->lion.bite(me);
  25        CALL_NEXT_METHOD;
  26      }))
  27
  28   (define-sod-class "Goat" ("Animal")
  29     :nick 'goat
  30     (message "butt" (fun void))
  31     (method "goat" "butt" (fun void) nil)
  32     (method "nml" "tickle" (fun void) #{
  33        me->_vt->goat.bite(me);
  34        CALL_NEXT_METHOD;
  35      }))
  36
  37   (define-sod-class "Serpent" ("Animal")
  38     :nick 'serpent
  39     (message "bite" (fun void))
  40     (method "serpent" "bite" (fun void) nil)
  41     (message "hiss" (fun void))
  42     (method "serpent" "hiss" (fun void) nil)
  43     (method "nml" "tickle" (fun void) #{
  44        if (me->tickles < 3) me->_vt->hiss(me);
  45        else me->_vt->bite(me);
  46        CALL_NEXT_METHOD;
  47      }))
  48
  49   (define-sod-class "Chimaera" ("Lion" "Goat" "Serpent")
  50     :nick 'sir
  51     :link '|Lion|)
  52
  53   (defparameter *chimaera* (find-sod-class "Chimaera"))
  54   (defparameter *emeth* (find "tickle"
  55                               (sod-class-effective-methods *chimaera*)
  56                               :key (lambda (method)
  57                                      (sod-message-name
  58                                       (effective-method-message method)))
  59                               :test #'string=)))
  60