| 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 | |