From sce!mitel!uunet!mailrus!cs.utexas.edu!tut.cis.ohio-state.edu!ucbvax!hplabs!hpfcso!hpfcbig!tim Fri Feb 16 07:17:21 EST 1990
Article: 73 of comp.lang.lisp.x
Path: cognos!sce!mitel!uunet!mailrus!cs.utexas.edu!tut.cis.ohio-state.edu!ucbvax!hplabs!hpfcso!hpfcbig!tim
From: tim@hpfcbig.SDE.HP.COM (Tim Mikkelsen)
Newsgroups: comp.lang.lisp.x
Subject: Re: intro to XLISP objects
Message-ID: <1170006@hpfcbig.SDE.HP.COM>
Date: 12 Feb 90 16:24:20 GMT
References: <1170004@hpfcbig.SDE.HP.COM>
Organization: HP SESD, Fort Collins, CO
Lines: 228


A MORE REALISTIC EXAMPLE 
______________________________________________________________________________


The following is an example, using the idea of tools again.  It contains
a hierarchy of tool  classes.  The top of the class  hierarchy is TOOLS.
HAND-TOOLS and SHOP-TOOLS are sub-classes of TOOLS.  The example creates
instances of these  sub-classes.  It is possible to extend this  example
in various ways.  One obvious  extension would be to create a third tier
of classes  under  HAND-TOOLS  that could  contain  classes like drills,
screwdrivers, pliers and so on.




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	File name:	tools.lsp
;	Author:		Tim Mikkelsen
;	Description:	Object-oriented example program
;	Language:	XLISP 2.0
;
;	Date Created:	10-Jan-1988
;	Date Updated:	2-Apr-1989
;	
;	(c) Copyright 1988, by Tim Mikkelsen, all rights reserved.
;	    Permission is granted for unrestricted non-commercial use.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	Define the superclasses and classes
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
; make TOOLS superclass
;	with a different :ISNEW method
;	added methods are :BORROW and :RETURN
;	class variables are	NUMBER		contains # of tool instances
;				ACTIVE-LIST	contains list of current objects
;	instance variables are 	POWER 		list - (AC BATTERY HAND)
;				MOVEABLE 	CAN-CARRY or CAN-ROLL or FIXED
;				OPERATIONS	list
;				MATERIAL 	list - (WOOD METAL PLASTIC ...)
;				PIECES 		list
;				LOCATION	HOME or person's name
;

(setq tools (send class :new '(power 
			       moveable 
			       operations 
			       material 
			       pieces 
			       location) 
			     '(number active-list)))
(send tools :answer :isnew '() 
		           '((if (null number) (setq number 1)
		      			       (setq number (1+ number)))
			     (setq active-list (cons self active-list))
			     (setq location 'home)))
(send tools :answer :borrow '(by-who)
		            '((if (eq location 'home) (setq location by-who)
		       				      (print "you can't"))))
(send tools :answer :return '()
		            '((if (eq location 'home) (print "got it already")
		       				      (setq location 'home))))

;
; make HAND-TOOLS class
;	with a different :ISNEW method
;	new instance variable	WEIGHT		<number> of pounds
;	the rest is inherited from TOOLS 
; 

(setq hand-tools (send class :new '(weight) '() tools))
(send hand-tools :answer :isnew '(pow op mat parts w-in)
			        '((setq power pow)
			          (setq moveable 'can-carry)
			          (setq operations op)
			          (setq material mat)
    			          (setq pieces parts)
			          (setq weight w-in)
			          (send-super :isnew)))

;
; make SHOP-TOOLS class
;	with a different :ISNEW method
;	no new instance variables
;	the rest is inherited from TOOLS 
; 

(setq shop-tools (send class :new '() '() tools))
(send shop-tools :answer :isnew '(pow mov op mat parts)
			        '((setq power pow)
			         (setq moveable mov)
			         (setq operations op)
			         (setq material mat)
			         (setq pieces parts)
			         (send-super :isnew)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	Create instances of various tool classes 
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq hand-drill (send hand-tools :new 		; make an instance - HAND-DRILL
			     '(ac) 
			     '(drill polish grind screw)
			     '(wood metal plastic)
			     '(drill drill-bits screw-bits buffer)
			     '2.5))

(setq table-saw (send shop-tools :new 		; make an instance - TABLE-SAW
			     '(ac)
			     'fixed
			     '(rip cross-cut)
			     '(wood plastic)
			     '(saw blades fence)))


(setq radial-arm (send shop-tools :new 		; make an instance = RADIAL-ARM
			     '(ac)
			     'can-roll
			     '(rip cross-cut)
			     '(wood plastic)
			     '(saw blades dust-bag)))


The following  session shows how to use the tool  definitions  from this
better  example.  The example starts at the OS shell and brings up xlisp
running the file 'tools.lsp'.

	 ________________________________________________________________
	|
	|	cmd? xlisp tools
	|	; loading "init.lsp"
	|	; loading "tools.lsp"
	|	> (send hand-drill :borrow 'fred)
	|	FRED
	|
	|	> (send table-saw :return)
	|	"got it already"
	|	"got it already"
	|
	|	> (send hand-drill :borrow 'joe)
	|	"you can't"
	|	"you can't"
	|
	|	> (send hand-drill :return)
	|	HOME
	|________________________________________________________________


So, Fred was able to borrow the HAND-DRILL.  When an attempt was made to
return the  TABLE-SAW,  it was  already  at home.  A second  attempt  to
borrow the HAND-DRILL  indicated that "you can't" because it was already
lent out.  Lastly, the HAND-DRILL was returned successfully.  (Note that
the "got it  already"  and "you  can't"  strings  show up  twice  in the
display because the methods both print and return the string.)

The following session shows the structure of the TOOLS object:

	 ________________________________________________________________
	|
	|	> (send tools :show)
	|	Object is #<Object: #276fc>, Class is #<Object: #23fe2>
	|	  MESSAGES = ((:RETURN . #<Closure-:RETURN: #2dbd0>) 
	|	  	      (:BORROW . #<Closure-:BORROW: #2ddba>) 
	|		      (:ISNEW . #<Closure-:ISNEW: #274a4>))
	|	  IVARS = (POWER MOVEABLE OPERATIONS MATERIAL PIECES LOCATION)
	|	  CVARS = (NUMBER ACTIVE-LIST)
	|	  CVALS = #(3 (#<Object: #2cadc> 
	|	  	       #<Object: #2cda2> 
	|	       #<Object: #2d0e0>))
	|	  SUPERCLASS = #<Object: #23fd8>
	|	  IVARCNT = 6
	|	  IVARTOTAL = 6
	|	#<Object: #276fc>
	|________________________________________________________________


The two TOOLS sub-classes HAND-TOOLS and SHOP-TOOLS structure looks like:

	 ________________________________________________________________
	|
	|	> (send hand-tools :show)
	|	Object is #<Object: #2dab8>, Class is #<Object: #23fe2>
	|	  MESSAGES = ((:ISNEW . #<Closure-:ISNEW: #2d7a2>))
	|	  IVARS = (WEIGHT)
	|	  CVARS = NIL
	|	  CVALS = NIL
	|	  SUPERCLASS = #<Object: #276fc>
	|	  IVARCNT = 1
	|	  IVARTOTAL = 7
	|	#<Object: #2dab8>
	|
	|	> (send shop-tools :show)
	|	Object is #<Object: #2d680>, Class is #<Object: #23fe2>
	|	  MESSAGES = ((:ISNEW . #<Closure-:ISNEW: #2d450>))
	|	  IVARS = NIL
	|	  CVARS = NIL
	|	  CVALS = NIL
	|	  SUPERCLASS = #<Object: #276fc>
	|	  IVARCNT = 0
	|	  IVARTOTAL = 6
	|	#<Object: #2d680>
	|________________________________________________________________


The class HAND-TOOLS has an instance HAND-DRILL which looks like:

	 ________________________________________________________________
	|
	|	> (send hand-drill :show)
	|	Object is #<Object: #2d0e0>, Class is #<Object: #2dab8>
	|	  WEIGHT = 2.5
	|	  POWER = (AC)
	|	  MOVEABLE = CAN-CARRY
	|	  OPERATIONS = (DRILL POLISH GRIND SCREW)
	|	  MATERIAL = (WOOD METAL PLASTIC)
	|	  PIECES = (DRILL DRILL-BITS SCREW-BITS BUFFER)
	|	  LOCATION = HOME
	|	#<Object: #2d0e0>
	|________________________________________________________________