home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_JAN87.ZIP / EXPERT.JAN < prev    next >
Encoding:
Text File  |  1986-12-21  |  7.1 KB  |  278 lines
  1.  
  2.                          Expert's Toolbox
  3.                            January 1987
  4.                "Using Smalltalk to Implement Frames"
  5.                           by Marc Rettig
  6.  
  7.  
  8.  
  9. Listing 1
  10.  
  11. DEFINITION OF CLASS SLOT
  12.  
  13. Dictionary variableSubclass: #Slot
  14.   instanceVariableNames: ''
  15.   classVariableNames: ''
  16.   poolDictionaries: ''
  17.  
  18. METHODS FOR CLASS SLOT
  19.  
  20. setFacet:facetName with:aValue
  21.    self at:facetName put:aValue
  22.    ^aValue
  23.  
  24. getFacet: facetName
  25.    ^self at:facetName ifAbsent:[nil]
  26.  
  27. setValue:aValue
  28.    self setFacet:'value' with:aValue
  29.  
  30. getValue
  31.    ^self getFacet:'value'
  32.  
  33. _________________________________________
  34. DEFINITION OF CLASS FRAME
  35.  
  36. Dictionary variableSubclass: #Frame
  37.   instanceVariableNames: ''
  38.   classVariableNames: ''
  39.   poolDictionaries: ''
  40.  
  41. METHODS FOR CLASS FRAME
  42.  
  43. setSlot:slotName facet:facetName contents:aValue
  44.    | tempSlot |
  45.    tempSlot := self at:slotName 
  46.                     ifAbsent:[self at:slotName put: Slot new].
  47.    tempSlot setFacet:facetName with:aValue.
  48.    ^aValue
  49.  
  50. getSlot:slotName facet:facetName
  51.    ^(self includesKey:slotName)
  52.       ifTrue: [(self at:slotName) getFacet:facetName]
  53.       ifFalse:[nil]
  54.  
  55. setSlot:slotName value:aValue
  56.    ^self setSlot:slotName facet:'value' contents:aValue
  57.  
  58. getSlotValue:slotName
  59.    "Get the value facet of a slot.  If no such slot, look up the AKO
  60.     inheritance chain.  It that's no good, run a demon to get the value."
  61.    | temp |
  62.    ((temp := self getSlot:slotName) isNil)
  63.       ifTrue: [((temp := self lookUpAkoChain:slotName) isNil)
  64.          ifTrue: [^self runDemonForValue:slotName]
  65.          ifFalse:[^temp getValue]]
  66.       ifFalse:[(temp includesKey:'value')
  67.          ifTrue: [^temp getValue]]
  68.          ifFalse:[^self runDemonForValue:slotName]]
  69.  
  70. getSlot:slotName
  71.    ^self at:slotName ifAbsent:[nil]
  72.  
  73. setSlot:slotName with:aSlot
  74.    ^self at:slotName put:aSlot
  75.  
  76. lookUpAkoChain:slotName
  77.    "Look up the inheritance chain for a slot with the name in slotName.
  78.     If you find it, return the Slot."
  79.    ^(self includesKey:'AKO')
  80.       ifTrue: [((self isAKO) includesKey:slotName)
  81.          ifTrue: [^(self isAKO) getSlot:slotName]
  82.          ifFalse:[^(self isAKO) lookUpAkoChain:slotName]]
  83.       ifFalse:[nil]
  84.  
  85. isAKO
  86.    ^self getSlot:'AKO' facet:'value'
  87.  
  88. isAKO:aFrame
  89.    self setSlot:'AKO' value:aFrame
  90.  
  91. ____________________________________
  92. SOME SAMPLE METHODS FOR DEMONS
  93.  
  94. addDemon:aBlock slot:slotName type:demonType
  95.    (#('ifNeeded' 'ifAdded' 'ifRemoved') includes:demonType)
  96.       ifTrue: [self setSlot:slotName facet:demonType with:aBlock]
  97.       ifFalse:[self error:'Invalid Demon Type']
  98.  
  99. runDemonForValue:slotName
  100.    | aBlock |
  101.    aBlock := self getSlot:slotName facet:'ifNeeded'.
  102.    (aBlock isNil)
  103.      ifTrue: [^nil]
  104.      ifFalse:[^self setSlot:slotName value:(aBlock value)]
  105.  
  106.  
  107.  
  108. Listing 2 
  109.  
  110. A SAMPLE HIERARCHY OF FRAMES, SHOWING USE OF DEMONS
  111.  
  112. | mammal dog firstDog askDemon |
  113. mammal := Frame new.
  114. mammal setSlot:'hide' value:'hairy'.
  115. mammal setSlot:'blood' value:'warm'.
  116.  
  117. dog := Frame new.
  118. dog isAKO:mammal.
  119. dog setSlot 'numberOfLegs' value:4.
  120.  
  121. " Here is a simple if-needed demon, which will ask the 
  122.   user for a value,while suggesting a default value."
  123. askDemon := [Prompter prompt:'What is this doggie''s name?
  124.                       default:'Phydeaux'].
  125.  
  126. firstDog := Frame new.
  127. firstDog addDemon:askDemon slot:'name' type:'ifNeeded'.
  128. firstDog isAKO:dog.
  129. firstDog setSlot:'color' value:'brown'.
  130.  
  131. "This message would cause the demon to be fired off..."
  132. fido getSlotValue:'name'
  133.  
  134.  
  135. FRAME.CLS
  136.  
  137. Dictionary variableSubclass: #Frame
  138.   instanceVariableNames: ''
  139.   classVariableNames: ''
  140.   poolDictionaries: '' !
  141.  
  142. !Frame class methods ! !
  143.  
  144.  
  145. !Frame methods !
  146.  
  147. addDemon:aBlock slot:slotName type:demonType
  148.     (#('ifNeeded' 'ifAdded' 'ifRemoved') includes:demonType)
  149.         ifTrue: [self setSlot:slotName facet:demonType with:aBlock]
  150.         ifFalse:[self error:'Invalid Demon Type']!
  151.  
  152. getSlot:slotName
  153.     "return the slot object corresponding to slotName."
  154.  
  155.     ^self at: slotName ifAbsent: [nil]!
  156.  
  157. getSlot: slotName facet: facetName
  158.  
  159.     ^(self includesKey: slotName)
  160.         ifTrue: [(self at:slotName) getFacet:facetName]
  161.         ifFalse: [nil]!
  162.  
  163. getSlotValue:slotName
  164.     "get the value facet of a slot.  If no such slot, look up AKO chain.
  165.      If that's no good, run a demon to get the value."
  166.  
  167.     | temp |
  168.     ((temp := self getSlot: slotName) isNil)
  169.         ifTrue: [((temp := self lookUpAkoChain: slotName) isNil)
  170.             ifTrue: [^self runDemonForValue:slotName]
  171.             ifFalse:[^temp getValue]]
  172.         ifFalse:[(temp includesKey: 'value')
  173.             ifTrue: [^temp getValue]
  174.             ifFalse:[^self runDemonForValue:slotName]]!
  175.  
  176. isAKO
  177.     ^self getSlot: 'AKO' facet:'value'!
  178.  
  179. isAKO: aFrame
  180.     "set the AKO slot of a frame"
  181.  
  182.     self setSlot:'AKO' value:aFrame!
  183.  
  184. lookUpAkoChain: slotName
  185.     "Look up the inheritance chain for a slot with the name in slotName.
  186.      If you find it, return the Slot"
  187.  
  188.     ^(self includesKey: 'AKO')
  189.         ifTrue:[((self isAKO) includesKey:slotName)
  190.                     ifTrue: [^(self isAKO) getSlot: slotName]
  191.                     ifFalse:[^(self isAKO) lookUpAkoChain: slotName]]
  192.         ifFalse:[nil]!
  193.  
  194. removeSlot: slotName
  195.     ^self removeKey:slotName ifAbsent:[nil]!
  196.  
  197. runDemonForValue: slotName
  198.  
  199.     | aBlock |
  200.     aBlock := self getSlot: slotName facet: 'ifNeeded'.
  201.     (aBlock isNil)
  202.         ifTrue: [^nil]
  203.         ifFalse:[^self setSlot:slotName value:(aBlock value)]!
  204.  
  205. setSlot: slotName facet: facetName with: value
  206.  
  207.     | tempSlot |
  208.     tempSlot := self at:slotName
  209.                      ifAbsent: [self at:slotName put: Slot new].
  210.     tempSlot setFacet: facetName with: value.
  211.     ^value!
  212.  
  213. setSlot:slotName value:aValue
  214.     "set the value facet of a slot"
  215.  
  216.     ^self setSlot:slotName facet:'value' with:aValue.!
  217.  
  218. setSlot:slotName with: aSlot
  219.     "associate the slot aSlot with the name slotName. "
  220.  
  221.     ^self at: slotName put: aSlot! !
  222.  
  223.  
  224. FRMTRM.TXT
  225.  
  226. | mammal dog fido s askDemon t |
  227. " Examples of frame and slot classes in use.
  228.   Select and DOIT."
  229.   
  230. mammal := Frame new.
  231. mammal setSlot: 'hide' value: 'hairy'.
  232. mammal setSlot: 'bloodType' value: 'warm'.
  233.  
  234. dog := Frame new.
  235. dog isAKO: mammal.
  236. dog setSlot: 'numberLegs' value: 4.
  237.  
  238. askDemon := [Prompter prompt:'What is this dog''s name?' default: 'Bruno'].
  239. dog addDemon:askDemon slot:'name' type:'ifNeeded'.
  240.  
  241. fido := Frame new.
  242. fido addDemon:askDemon slot:'name' type:'ifNeeded'.
  243. fido isAKO:dog.
  244. fido setSlot:'color' value:'brown'.
  245.  
  246. " Let's see the demon fire "
  247. fido getSlotValue:'name'.
  248.  
  249.  
  250. SLOT.CLS
  251.  
  252. Dictionary variableSubclass: #Slot
  253.   instanceVariableNames: ''
  254.   classVariableNames: ''
  255.   poolDictionaries: '' !
  256.  
  257. !Slot class methods ! !
  258.  
  259.  
  260. !Slot methods !
  261.  
  262. getFacet: facetName
  263.     ^self at: facetName ifAbsent: [nil]!
  264.  
  265. getValue
  266.     ^self getFacet: 'value'!
  267.  
  268. removeFacet: facetName
  269.     ^self removeKey:facetName ifAbsent:[nil]!
  270.  
  271. setFacet: facetName with: aValue
  272.  
  273.     self at: facetName put: aValue.
  274.     ^aValue!
  275.  
  276. setValue: aValue
  277.     self setFacet: 'value' with: aValue! !
  278.  a