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