"blocks for readability"
findCreators := [ :class | | findConstructors creators | 
    findConstructors := [ 
            :cclass | cclass methods select: [ :m | m kind = 'constructor'] ].
    creators := Set new. 
    (findConstructors value: class) do: [
		:method | method incomingInvocations do: [ 
			:ii | creators add: ii sender parentType ]
		 ]. 
	creators. ].
newLine := Character cr asString.
camelWrap := [ :class |
	rex := '([a-z])([A-Z])' asRegex.
	rex copy: class name translatingMatchesUsing: 
    [ :each | (each at:1) asString, newLine, (each at:2) asString ]
 		].
classes := MooseModel root allModels first allClasses select: [
	 :c | c mooseName beginsWith: 'headfirst::designpatterns::factory::pizzaaf'].
thinArrow := RTDecoratedLine new
	head: (RTFilledNarrowArrow asHead);
	attachPoint: (RTBorderAttachPoint new);
	width: 2.
"inheritanceArrow := RTDecoratedLine new
	head: (RTEmptyNarrowArrow asHead);
	attachPoint: (RTBorderAttachPoint new);
	width: 2."
myClassShape := RTCompositeShape new
    add: (RTBox new); 
    add: (RTLabel new text:camelWrap);
    allOfSameSizeWithPadding.
b := RTMondrian new.
b shape shape: myClassShape; 
    borderColor: Color black;
    fillColor: Color paleYellow;
    textColor: Color black.
b nodes: classes.
b shape shape: thinArrow; 
    color: Color veryLightGray.
b edges moveBehind; connectFromAll: findCreators.
"b shape shape: inheritanceArrow; 
    color: Color green; withShorterDistanceAttachPoint.
b edges connectToAll: #directSuperclasses."
b layout dominanceTree verticalGap: 80; horizontalGap: 5.
b build.
b view @ RTZoomableView.
^ b