home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
aijournl
/
1987_01
/
expert.jan
< prev
next >
Wrap
Text File
|
1986-12-21
|
7KB
|
278 lines
Expert's Toolbox
January 1987
"Using Smalltalk to Implement Frames"
by Marc Rettig
Listing 1
DEFINITION OF CLASS SLOT
Dictionary variableSubclass: #Slot
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
METHODS FOR CLASS SLOT
setFacet:facetName with:aValue
self at:facetName put:aValue
^aValue
getFacet: facetName
^self at:facetName ifAbsent:[nil]
setValue:aValue
self setFacet:'value' with:aValue
getValue
^self getFacet:'value'
_________________________________________
DEFINITION OF CLASS FRAME
Dictionary variableSubclass: #Frame
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
METHODS FOR CLASS FRAME
setSlot:slotName facet:facetName contents:aValue
| tempSlot |
tempSlot := self at:slotName
ifAbsent:[self at:slotName put: Slot new].
tempSlot setFacet:facetName with:aValue.
^aValue
getSlot:slotName facet:facetName
^(self includesKey:slotName)
ifTrue: [(self at:slotName) getFacet:facetName]
ifFalse:[nil]
setSlot:slotName value:aValue
^self setSlot:slotName facet:'value' contents:aValue
getSlotValue:slotName
"Get the value facet of a slot. If no such slot, look up the AKO
inheritance chain. It that's no good, run a demon to get the value."
| temp |
((temp := self getSlot:slotName) isNil)
ifTrue: [((temp := self lookUpAkoChain:slotName) isNil)
ifTrue: [^self runDemonForValue:slotName]
ifFalse:[^temp getValue]]
ifFalse:[(temp includesKey:'value')
ifTrue: [^temp getValue]]
ifFalse:[^self runDemonForValue:slotName]]
getSlot:slotName
^self at:slotName ifAbsent:[nil]
setSlot:slotName with:aSlot
^self at:slotName put:aSlot
lookUpAkoChain:slotName
"Look up the inheritance chain for a slot with the name in slotName.
If you find it, return the Slot."
^(self includesKey:'AKO')
ifTrue: [((self isAKO) includesKey:slotName)
ifTrue: [^(self isAKO) getSlot:slotName]
ifFalse:[^(self isAKO) lookUpAkoChain:slotName]]
ifFalse:[nil]
isAKO
^self getSlot:'AKO' facet:'value'
isAKO:aFrame
self setSlot:'AKO' value:aFrame
____________________________________
SOME SAMPLE METHODS FOR DEMONS
addDemon:aBlock slot:slotName type:demonType
(#('ifNeeded' 'ifAdded' 'ifRemoved') includes:demonType)
ifTrue: [self setSlot:slotName facet:demonType with:aBlock]
ifFalse:[self error:'Invalid Demon Type']
runDemonForValue:slotName
| aBlock |
aBlock := self getSlot:slotName facet:'ifNeeded'.
(aBlock isNil)
ifTrue: [^nil]
ifFalse:[^self setSlot:slotName value:(aBlock value)]
Listing 2
A SAMPLE HIERARCHY OF FRAMES, SHOWING USE OF DEMONS
| mammal dog firstDog askDemon |
mammal := Frame new.
mammal setSlot:'hide' value:'hairy'.
mammal setSlot:'blood' value:'warm'.
dog := Frame new.
dog isAKO:mammal.
dog setSlot 'numberOfLegs' value:4.
" Here is a simple if-needed demon, which will ask the
user for a value,while suggesting a default value."
askDemon := [Prompter prompt:'What is this doggie''s name?
default:'Phydeaux'].
firstDog := Frame new.
firstDog addDemon:askDemon slot:'name' type:'ifNeeded'.
firstDog isAKO:dog.
firstDog setSlot:'color' value:'brown'.
"This message would cause the demon to be fired off..."
fido getSlotValue:'name'
FRAME.CLS
Dictionary variableSubclass: #Frame
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: '' !
!Frame class methods ! !
!Frame methods !
addDemon:aBlock slot:slotName type:demonType
(#('ifNeeded' 'ifAdded' 'ifRemoved') includes:demonType)
ifTrue: [self setSlot:slotName facet:demonType with:aBlock]
ifFalse:[self error:'Invalid Demon Type']!
getSlot:slotName
"return the slot object corresponding to slotName."
^self at: slotName ifAbsent: [nil]!
getSlot: slotName facet: facetName
^(self includesKey: slotName)
ifTrue: [(self at:slotName) getFacet:facetName]
ifFalse: [nil]!
getSlotValue:slotName
"get the value facet of a slot. If no such slot, look up AKO chain.
If that's no good, run a demon to get the value."
| temp |
((temp := self getSlot: slotName) isNil)
ifTrue: [((temp := self lookUpAkoChain: slotName) isNil)
ifTrue: [^self runDemonForValue:slotName]
ifFalse:[^temp getValue]]
ifFalse:[(temp includesKey: 'value')
ifTrue: [^temp getValue]
ifFalse:[^self runDemonForValue:slotName]]!
isAKO
^self getSlot: 'AKO' facet:'value'!
isAKO: aFrame
"set the AKO slot of a frame"
self setSlot:'AKO' value:aFrame!
lookUpAkoChain: slotName
"Look up the inheritance chain for a slot with the name in slotName.
If you find it, return the Slot"
^(self includesKey: 'AKO')
ifTrue:[((self isAKO) includesKey:slotName)
ifTrue: [^(self isAKO) getSlot: slotName]
ifFalse:[^(self isAKO) lookUpAkoChain: slotName]]
ifFalse:[nil]!
removeSlot: slotName
^self removeKey:slotName ifAbsent:[nil]!
runDemonForValue: slotName
| aBlock |
aBlock := self getSlot: slotName facet: 'ifNeeded'.
(aBlock isNil)
ifTrue: [^nil]
ifFalse:[^self setSlot:slotName value:(aBlock value)]!
setSlot: slotName facet: facetName with: value
| tempSlot |
tempSlot := self at:slotName
ifAbsent: [self at:slotName put: Slot new].
tempSlot setFacet: facetName with: value.
^value!
setSlot:slotName value:aValue
"set the value facet of a slot"
^self setSlot:slotName facet:'value' with:aValue.!
setSlot:slotName with: aSlot
"associate the slot aSlot with the name slotName. "
^self at: slotName put: aSlot! !
FRMTRM.TXT
| mammal dog fido s askDemon t |
" Examples of frame and slot classes in use.
Select and DOIT."
mammal := Frame new.
mammal setSlot: 'hide' value: 'hairy'.
mammal setSlot: 'bloodType' value: 'warm'.
dog := Frame new.
dog isAKO: mammal.
dog setSlot: 'numberLegs' value: 4.
askDemon := [Prompter prompt:'What is this dog''s name?' default: 'Bruno'].
dog addDemon:askDemon slot:'name' type:'ifNeeded'.
fido := Frame new.
fido addDemon:askDemon slot:'name' type:'ifNeeded'.
fido isAKO:dog.
fido setSlot:'color' value:'brown'.
" Let's see the demon fire "
fido getSlotValue:'name'.
SLOT.CLS
Dictionary variableSubclass: #Slot
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: '' !
!Slot class methods ! !
!Slot methods !
getFacet: facetName
^self at: facetName ifAbsent: [nil]!
getValue
^self getFacet: 'value'!
removeFacet: facetName
^self removeKey:facetName ifAbsent:[nil]!
setFacet: facetName with: aValue
self at: facetName put: aValue.
^aValue!
setValue: aValue
self setFacet: 'value' with: aValue! !
a