Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Adam and Eve demonstrating light-weight classes! and instances!

 [1/1] 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!"