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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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'.
$ 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
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>