[SML 7721] Re: Smalltalk勉強会＠京都 課題 「CSV to HTML」できました

[hirowadenden]

ハンドル名で失礼します、hirowadendenと申します。
前回投稿したクラス図を表示するコードですが、気が付いた点を少し修正したので
再投稿させていただきます。よろしけばお使いください。修正箇所は以下のとおり
です(機能には変更ありません):
・クラスに対応するJunRoughClassEntityを捜すときのキーを、名前の文字列か
らクラスそのものに変更しました。
・描画するクラス全体を保持するのに、クラスの名前をキーにしたDictionaryを
用いていましたがDictionaryである必要は無く、OrderedCollectionに変更し
ました。

以下はコードです。

| aNameSpace aDiagram entitiesDictionary classes nameSpacesAndClasses x
y xStart yMax solitaryClasses topClasses layoutOrder addSubclasses |
aNameSpace := PrimeMinisters.
classes := OrderedCollection new.
solitaryClasses := OrderedCollection new.
topClasses := OrderedCollection new.
layoutOrder := OrderedCollection new.
nameSpacesAndClasses := aNameSpace withAllNameSpacesAndAllClasses.
entitiesDictionary := Dictionary new: nameSpacesAndClasses size.
aDiagram := JunRoughClassDiagram new.
nameSpacesAndClasses
  do:
    [:item |
    (JunStringUtility
      stringMatch: item name asString
      and: '*Test')
      ifFalse:
        [| anEntity |
        item isBehavior
          ifTrue:
            [anEntity := JunRoughClassEntity fromClass: item.
            anEntity detail: true.
            classes add: item]
          ifFalse:
            [anEntity := JunRoughClassEntity label: item printString.
            anEntity origin: 0 @ 0].
        anEntity fitExtent.
        aDiagram addEntity: anEntity.
        entitiesDictionary at: item put: anEntity]].
classes
  do:
    [:class |
    (class superclass = nil
      or: [(entitiesDictionary includesKey: class superclass) not])
      ifTrue:
        [(class subclasses select: [:each | entitiesDictionary
includesKey: each])
          size = 0
          ifTrue: [solitaryClasses add: class]
          ifFalse: [topClasses add: class]]].
layoutOrder add: topClasses.
addSubclasses := [:classCollection |
| subclassCollection |
subclassCollection := OrderedCollection new.
classCollection
  do:
    [:class |
    subclassCollection
      addAll:
        (class subclasses
          select: [:subclass | entitiesDictionary includesKey: subclass])].
subclassCollection size ~= 0
  ifTrue:
    [layoutOrder add: subclassCollection.
    addSubclasses value: subclassCollection]].
addSubclasses value: topClasses.
layoutOrder add: solitaryClasses.
xStart := 20.
x := xStart.
y := 50.
yMax := 0.
layoutOrder
  do:
    [:lineLayout |
    lineLayout
      do:
        [:class |
        | anEntity anExtent |
        anEntity := entitiesDictionary at: class.
        anExtent := anEntity extent.
        anEntity origin: x @ y.
        x := x + anExtent x.
        yMax := yMax max: anExtent y.
        x := x + 30].
    x := xStart.
    y := y + yMax + 30.
    yMax := 0].
classes
  do:
    [:class |
    class superclass
      ifNotNil:
        [(entitiesDictionary includesKey: class superclass)
          ifTrue:
            [(aDiagram
              connect: (entitiesDictionary at: class)
              to: (entitiesDictionary at: class superclass)) kind:
#is_a_kind_of]]].
aDiagram openIn: (0 @ 0 extent: 1260 @ 740)


-- hirowadenden