[REBOL] Adam and Eve demonstrating light-weight classes! and instances!
From: christian::ensel::gmx::de at: 7-Mar-2001 17:27
Hi list,
from time to time people on this list misses some OOP functionality in REBOL.
Not knowing much about OOP recently me too had the need to deal with a huge
amount of different objects which (for memory concerns) I didn't want the
objects to carry all their functions (methods) code in them.
Have fun with Adam and Eve demonstrating what I fiddled together.
Inhancement ideas? Drawbacks? Bugs? All welcome ...
Christian
P.S.: What I like most about this is the syntax of the method calls.
It's so readable (at least I think so ;-)
REBOL [
title: "Class Objects"
name: %class-objects.r
author: "Christian 'CHE' Ensel"
date: 7-mar-2001
]
;===================================================================== CLASS!
==
; ŻŻŻŻŻŻ
class!: make object! [super: none
;================================= METHOD self method /WITH-ARGS args ==
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
method: func [
"Dispatches a method, fails for unknown methods."
self [object!]
method [word!]
/with-args
"Allows additional arguments"
args
]
;.......................................................................
[
do reduce either with-args [
compose [get in self/do method self (args)]
][
[get in self/do method self]
]
]
;-----------------------------------------------------------------------
;============================= ANY-METHOD self method /WITH-ARGS args ==
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
any-method: func [
"Dispatches a method, does nothing for unknown methods."
self [object!]
method [word!]
/with-args
"Allows additional arguments"
args
/local
result
]
;.......................................................................
[
if not error? result: try [
either with-args [
self/do/method/with-args self method args
][
self/do/method self method
]
][
return result
]
]
;-----------------------------------------------------------------------
]
;-------------------------------------------------------------------------------
;#################################################### sample class definition
##
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
;=============================================================== HUMAN-CLASS!
==
; ŻŻŻŻŻŻŻŻŻŻŻŻ
human-class!: make class! [ super: none
; ^^^^^^^^^^^
; human-class! is underived
;---------------------------------------------------------- INTRODUCE --
; ŻŻŻŻŻŻŻŻŻ
introduce: func [
self [object!]
][
self/do/say self rejoin ["Hi, I'm " self/name "!"]
self/do/say self "I'm human."
true
]
;----------------------------------------------------------- SAY what --
; ŻŻŻŻŻŻŻŻ
say: func [
self [object!] what [string!]
][
print rejoin [self/name {: ^-"} what {"}]
true
]
;--------------------------------------------------- SAY-TO whom what --
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
say-to: func [
self [object!] whom [object!] what [string!]
][
self/do/say self rejoin [whom/name ", " lowercase/part what 1 ]
true
]
]
;================================================================= MAN-CLASS!
==
; ŻŻŻŻŻŻŻŻŻŻ
man-class!: make human-class! [ super: human-class!
; ^^^^^^^^^^^^^^^^^^^
; man-class! inherits from human-class!
;---------------------------------------------------------- INTRODUCE --
; ŻŻŻŻŻŻŻŻŻ
introduce: func [
self [object!]
][
self/do/super/introduce self
self/do/say self "I'm a man."
true
]
]
;================================================================ MAN-OBJECT!
==
; ŻŻŻŻŻŻŻŻŻŻŻ
man-object!: make object! [do: man-class!]
;=============================================================== WOMAN-CLASS!
==
; ŻŻŻŻŻŻŻŻŻŻŻŻ
woman-class!: make human-class! [super: human-class!
; ^^^^^^^^^^^^^^^^^^^
; woman-class! inherits from human-class!
;---------------------------------------------------------- INTRODUCE --
; ŻŻŻŻŻŻŻŻŻ
introduce: func [
self [object!]
][
self/do/super/introduce self
self/do/say self "I'm a woman."
true
]
;------------------------------------------------------- BEWITCH whom --
; ŻŻŻŻŻŻŻŻŻŻŻŻ
bewitch: func [
self [object!] whom [object!]
][
self/do/say-to self whom "Eat this!"
true
]
]
;============================================================== WOMAN-OBJECT!
==
; ŻŻŻŻŻŻŻŻŻŻŻŻŻ
woman-object!: make object! [do: woman-class!]
;########################################################### sample instances
##
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
adam: make man-object! [name: "Adam"]
eve: make woman-object! [name: "Eve" ]
; direct method call:
adam/do/introduce adam
eve/do/introduce eve
; dispatched method calls:
adam/do/method/with-args adam 'say "Hello Eve!"
eve/do/method/with-args eve 'say "Hello Adam!"
; direct method call only eve understands:
eve/do/bewitch eve adam
; dispatched method all with arguments:
adam/do/method/with-args adam 'say-to [eve "An apple!"]
; call a method adam doesn't understand:
;
; especially useful when promoting a methods
; only understand by some of a set of objects
foreach person reduce [adam eve] [
person/do/any-method/with-args person 'bewitch adam
]
; not to forget, here are examples of how to do "super-methods":
adam/do/super/introduce adam
eve/do/super/method eve 'introduce
adam/do/super/say adam "Hello!"
eve/do/super/method/with-args eve 'say "Hello!"
