src/class-output.lisp: Output effective methods directly from the class.

[sod] / pre-reorg / examples.lisp

(set-dispatch-macro-character #\# #\{ 'c-fragment-reader)

(defparameter *chimaera-module*
  (define-module ("chimaera.sod")

    (define-fragment (:c :includes) #{
       #include "chimaera.h"
     })

    (define-fragment (:h :includes) #{
       #include "sod.h"
     })

    (define-sod-class "Animal" ("SodObject")
      :nick 'nml
      :link '|SodObject|
      (slot "tickles" int)
      (instance-initializer "nml" "tickles" :single #{ 0 })
      (message "tickle" (fun void))
      (method "nml" "tickle" (fun void) #{
         me->tickles++;
       }
       :role :before)
      (method "nml" "tickle" (fun void) #{ }))

    (define-sod-class "Lion" ("Animal")
      :nick 'lion
      :link '|Animal|
      (message "bite" (fun void))
      (method "lion" "bite" (fun void) #{
         puts("Munch!");
       })
      (method "nml" "tickle" (fun void) #{
         me->_vt->lion.bite(me);
         CALL_NEXT_METHOD;
       }))

    (define-sod-class "Goat" ("Animal")
      :nick 'goat
      (message "butt" (fun void))
      (method "goat" "butt" (fun void) #{
         puts("Whack!");
       })
      (method "nml" "tickle" (fun void) #{
         me->_vt->goat.bite(me);
         CALL_NEXT_METHOD;
       }))

    (define-sod-class "Serpent" ("Animal")
      :nick 'serpent
      (message "bite" (fun void))
      (method "serpent" "bite" (fun void) #{
         puts("Nom!");
       })
      (message "hiss" (fun void))
      (method "serpent" "hiss" (fun void) #{
         puts("Ssss!");
       })
      (method "nml" "tickle" (fun void) #{
         if (me->tickles < 3) me->_vt->hiss(me);
         else me->_vt->bite(me);
         CALL_NEXT_METHOD;
       }))

    (define-sod-class "Chimaera" ("Lion" "Goat" "Serpent")
      :nick 'sir
      :link '|Lion|)

    (defparameter *chimaera* (find-sod-class "Chimaera"))
    (defparameter *emeth* (find "tickle"
                                (sod-class-effective-methods *chimaera*)
                                :key (lambda (method)
                                       (sod-message-name
                                        (effective-method-message method)))
                                :test #'string=))))