home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP31.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  8KB  |  313 lines
  1.  
  2. 'Smalltalk Textbook Appendix 31'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiDirectedGraph subclass: #EngiClassGraph
  9.     instanceVariableNames: ''
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Inheritance'!
  13. EngiClassGraph comment:
  14. '
  15.  
  16. Engi 0.07 (24 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiClassGraph methodsFor: 'defaults'!
  23.  
  24. defaultArrangeFormat
  25.     ^Array
  26.         with: #left
  27.         with: 20
  28.         with: 1
  29.         with: #balance!
  30.  
  31. defaultBranchClass
  32.     ^EngiClassBranch!
  33.  
  34. defaultVertexClass
  35.     ^EngiClassVertex! !
  36. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  37.  
  38. EngiClassGraph class
  39.     instanceVariableNames: ''!
  40.  
  41.  
  42. !EngiClassGraph class methodsFor: 'instance creation'!
  43.  
  44. fromClass: aClass 
  45.     "EngiClassGraph fromClass: Number."
  46.  
  47.     | graphGenerationBlock aGraph |
  48.     graphGenerationBlock := 
  49.             [:collection :graph :table | 
  50.             | fromVertex toVertex |
  51.             (table includesKey: collection first)
  52.                 ifTrue: [fromVertex := table at: collection first]
  53.                 ifFalse: 
  54.                     [fromVertex := graph defaultVertex.
  55.                     fromVertex className: collection first.
  56.                     table at: collection first put: fromVertex].
  57.             (collection copyFrom: 2 to: collection size)
  58.                 do: 
  59.                     [:each | 
  60.                     graphGenerationBlock
  61.                         value: each
  62.                         value: graph
  63.                         value: table.
  64.                     (table includesKey: each first)
  65.                         ifTrue: [toVertex := table at: each first]
  66.                         ifFalse: 
  67.                             [toVertex := graph defaultVertex.
  68.                             toVertex className: each first.
  69.                             table at: each first put: toVertex].
  70.                     graph connect: fromVertex with: toVertex].
  71.             graph yourself].
  72.     aGraph := graphGenerationBlock
  73.                 value: (self classHierarchy: aClass)
  74.                 value: self new
  75.                 value: Dictionary new.
  76.     aGraph arrangeScan.
  77.     ^aGraph! !
  78.  
  79. !EngiClassGraph class methodsFor: 'utilities'!
  80.  
  81. classHierarchy: aClass 
  82.     "EngiClassGraph classHierarchy: Number."
  83.  
  84.     | theClass collection old |
  85.     aClass isMeta
  86.         ifTrue: [theClass := aClass soleInstance]
  87.         ifFalse: [theClass := aClass].
  88.     collection := self subclassHierarchy: theClass.
  89.     (theClass allSuperclasses select: [:each | each isMeta not])
  90.         do: 
  91.             [:each | 
  92.             old := collection.
  93.             collection := OrderedCollection new.
  94.             collection addFirst: old.
  95.             collection addFirst: each name].
  96.     ^collection!
  97.  
  98. subclassHierarchy: aClass 
  99.     "EngiClassGraph subclassHierarchy: Number."
  100.  
  101.     | theClass collection subs |
  102.     aClass isMeta
  103.         ifTrue: [theClass := aClass soleInstance]
  104.         ifFalse: [theClass := aClass].
  105.     collection := OrderedCollection new.
  106.     theClass subclasses isEmpty
  107.         ifFalse: 
  108.             [subs := SortedCollection sortBlock: [:x :y | x name > y name].
  109.             subs addAll: (theClass subclasses select: [:each | each isMeta not]).
  110.             subs do: [:each | collection addFirst: (self subclassHierarchy: each)]].
  111.     collection addFirst: theClass name.
  112.     ^collection!
  113.  
  114. superclassHierarchy: aClass 
  115.     "EngiClassGraph superclassHierarchy: Number."
  116.  
  117.     | theClass collection old |
  118.     aClass isMeta
  119.         ifTrue: [theClass := aClass soleInstance]
  120.         ifFalse: [theClass := aClass].
  121.     collection := OrderedCollection new.
  122.     collection addFirst: theClass name.
  123.     (theClass allSuperclasses select: [:each | each isMeta not])
  124.         do: 
  125.             [:each | 
  126.             old := collection.
  127.             collection := OrderedCollection new.
  128.             collection addFirst: old.
  129.             collection addFirst: each name].
  130.     ^collection! !
  131.  
  132. !EngiClassGraph class methodsFor: 'examples'!
  133.  
  134. example1
  135.     "EngiClassGraph example1."
  136.  
  137.     | classGraph activeWindow activeSensor |
  138.     classGraph := EngiClassGraph fromClass: Magnitude.
  139.     activeWindow := classGraph class activeWindow.
  140.     activeWindow clear.
  141.     classGraph display.
  142.     activeSensor := activeWindow sensor.
  143.     [activeSensor anyButtonPressed] whileFalse.
  144.     activeWindow display.
  145.     ^classGraph!
  146.  
  147. example2
  148.     "EngiClassGraph example2."
  149.  
  150.     | classGraph graphModel |
  151.     classGraph := EngiClassGraph fromClass: Magnitude.
  152.     graphModel := EngiGraphModel on: classGraph.
  153.     graphModel windowLabel: 'Inheritance'.
  154.     graphModel open! !
  155.  
  156.  
  157.  
  158.  
  159.  
  160. EngiGraphModel subclass: #EngiClassGraphModel
  161.     instanceVariableNames: ''
  162.     classVariableNames: 'MenuForClassGraph '
  163.     poolDictionaries: ''
  164.     category: 'Engi-Inheritance'!
  165. EngiClassGraphModel comment:
  166. '
  167.  
  168. Engi 0.07 (24 March 1994)
  169. Copyright (C) 1994 by Atsushi Aoki
  170.  
  171. '!
  172.  
  173.  
  174. !EngiClassGraphModel methodsFor: 'displaying'!
  175.  
  176. displayAxesOn: graphicsContext at: aPoint 
  177.     ^self! !
  178.  
  179. !EngiClassGraphModel methodsFor: 'menu messages'!
  180.  
  181. arrangeBalance
  182.     | graph balance answer |
  183.     graph := self value.
  184.     balance := graph arrangeBalance = #balance.
  185.     answer := EngiTextModel request: 'arrange balance:' default: balance printString.
  186.     (answer isNil or: [answer isEmpty])
  187.         ifTrue: [^nil].
  188.     answer := Compiler evaluate: answer logged: false.
  189.     ((answer isKindOf: Boolean)
  190.         and: [answer ~= balance])
  191.         ifTrue: 
  192.             [answer
  193.                 ifTrue: [graph arrangeBalance: #balance]
  194.                 ifFalse: [graph arrangeBalance: #unbalance].
  195.             graph arrangeScan.
  196.             self flushBounds.
  197.             self changed: #value]!
  198.  
  199. arrangeClasses
  200.     | graph |
  201.     graph := self value.
  202.     graph arrangeScan.
  203.     self flushBounds.
  204.     self changed: #value!
  205.  
  206. arrangeInterval
  207.     | graph interval answer |
  208.     graph := self value.
  209.     interval := graph arrangeInterval.
  210.     answer := EngiTextModel request: 'arrange interval:' default: interval printString.
  211.     (answer isNil or: [answer isEmpty])
  212.         ifTrue: [^nil].
  213.     answer := Compiler evaluate: answer logged: false.
  214.     ((answer isKindOf: Number)
  215.         and: [answer ~= interval])
  216.         ifTrue: 
  217.             [graph arrangeInterval: (answer asInteger max: 0).
  218.             graph arrangeScan.
  219.             self flushBounds.
  220.             self changed: #value]!
  221.  
  222. arrangeMargin
  223.     | graph margin answer |
  224.     graph := self value.
  225.     margin := graph arrangeMargin.
  226.     answer := EngiTextModel request: 'arrange margin:' default: margin printString.
  227.     (answer isNil or: [answer isEmpty])
  228.         ifTrue: [^nil].
  229.     answer := Compiler evaluate: answer logged: false.
  230.     ((answer isKindOf: Number)
  231.         and: [answer ~= margin])
  232.         ifTrue: 
  233.             [graph arrangeMargin: (answer asInteger max: 0).
  234.             graph arrangeScan.
  235.             self flushBounds.
  236.             self changed: #value]!
  237.  
  238. browseClass
  239.     | aSymbol aClass |
  240.     self selections isEmpty ifTrue: [^nil].
  241.     self selections
  242.         do: 
  243.             [:each | 
  244.             aSymbol := each className asSymbol.
  245.             (Smalltalk includesKey: aSymbol)
  246.                 ifTrue: 
  247.                     [aClass := Smalltalk at: aSymbol.
  248.                     (aClass isBehavior and: [aClass isMeta not])
  249.                         ifTrue: [aClass browse]]]!
  250.  
  251. yellowButtonMenu
  252.     "EngiClassGraphModel flushMenus."
  253.  
  254.     MenuForClassGraph isNil
  255.         ifTrue: 
  256.             [| collection menu |
  257.             collection := OrderedCollection new.
  258.             collection add: 'arrange' -> #arrangeClasses.
  259.             collection add: 'interval' -> #arrangeInterval.
  260.             collection add: 'margin' -> #arrangeMargin.
  261.             collection add: 'balance' -> #arrangeBalance.
  262.             menu := EngiMenuMaker fromCollection: collection.
  263.             collection := OrderedCollection new.
  264.             collection add: 'browse' -> #browseClass.
  265.             collection add: 'arrange' -> menu.
  266.             MenuForClassGraph := EngiMenuMaker fromCollection: collection].
  267.     ^MenuForClassGraph! !
  268.  
  269. !EngiClassGraphModel methodsFor: 'defaults'!
  270.  
  271. defaultWindowLabel
  272.     ^'Inheritance'! !
  273. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  274.  
  275. EngiClassGraphModel class
  276.     instanceVariableNames: ''!
  277.  
  278.  
  279. !EngiClassGraphModel class methodsFor: 'class initialization'!
  280.  
  281. flushMenus
  282.     "EngiClassGraphModel flushMenus."
  283.  
  284.     MenuForClassGraph := nil! !
  285.  
  286. !EngiClassGraphModel class methodsFor: 'examples'!
  287.  
  288. example1
  289.     "EngiClassGraphModel example1."
  290.  
  291.     | classGraph graphModel |
  292.     classGraph := EngiClassGraph fromClass: Collection.
  293.     graphModel := EngiClassGraphModel openOn: classGraph.
  294.     ^graphModel!
  295.  
  296. example2
  297.     "EngiClassGraphModel example2."
  298.  
  299.     | classGraph graphModel |
  300.     classGraph := EngiClassGraph fromClass: Collection.
  301.     classGraph
  302.         doVertices: 
  303.             [:vertex | 
  304.             vertex strokeColor: ColorValue blue.
  305.             vertex fillColor: ColorValue green].
  306.     classGraph
  307.         doBranches: 
  308.             [:branch | 
  309.             branch strokeColor: ColorValue red.
  310.             branch lineWidth: 2].
  311.     graphModel := EngiClassGraphModel openOn: classGraph.
  312.     ^graphModel! !
  313.