DCIprogram: #Plan
" Exported from Squeak 7179-basic.226 last modified on 3 November 2014 by: Trygve"
projection: Controller
Class: Controller
SystemWindow subclass: #Controller
instanceVariableNames: 'dependencyView ganttView selectedActivity'
category: 'Plan-Controller'
" This example is a refactoring of the BB4bPlan example. The difference is that the Context and Role methods have been merged into the relevant Data classes. The Context and Interaction projections are empty.
The point of this example is to illustrate how system behavior code gets mixed with other code when using conventional coding techniques.
This class is the C part of the original MVC paradigm:
M is the Model that represents domain information
V is a View that presents Model data to an end user and lets the user edit these data.
C is a Controller that sets up and coordinates a number of Views. "
instanceMethods: operations
open
self buildDependencyView.
self addMorph: dependencyView
fullFrame: (LayoutFrame fractions: (0@0 corner: 1@0.4)).
self addMorph: self buildGanttView
fullFrame: (LayoutFrame fractions: (0@0.4 corner: 1@1)).
self bounds: (Rectangle originFromUser: 700@400).
model ifNotNil: [self changed: #model].
self openAsIsIn: self currentWorld.
buildDemoNetwork
model ifNotNil:
[dependencyView deleteContents.
ganttView deleteContents.].
model := Model new.
model
newActivityNamed: 'actA' duration: 2 color: Color yellow;
newActivityNamed: 'actB' duration: 7 color: Color lightBlue;
newActivityNamed: 'actC' duration: 3 color: Color lightMagenta;
newActivityNamed: 'actD' duration: 2 color: Color lightGreen.
model
newDependencyFrom: 'actA' to: 'actC';
newDependencyFrom: 'actB' to: 'actD';
newDependencyFrom: 'actC' to: 'actD'.
self changed: #model.
frontloadDemo
model ifNil: [self inform: 'Define the model before frontloading. \Command ignored.' withCRs. ^self].
model frontloadFrom: 1.
self changed: #model.
resetDemo
self model: nil.
dependencyView deleteContents.
ganttView deleteContents.
instanceMethods: operations-selection
clickAt: act
selectedActivity := selectedActivity == act ifTrue: [nil] ifFalse: [act].
self changed: #selection.
isSelected: act
^selectedActivity == act.
selectedActivity
^selectedActivity
instanceMethods: I/O
handlesMouseDown: evt
^true
mouseDown: evt
super mouseDown: evt.
evt yellowButtonPressed
ifTrue: [^self yellowButtonActivity: evt].
yellowButtonActivity: shiftKeyState
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
aMenu addTitle: self printString.
aMenu addList: #(
('build demo network' #buildDemoNetwork)
('frontload from week 1' #frontloadDemo)
('reset demo' #resetDemo)
" ('export diagram as GIF' #exportAsGIF 'Store this diagram as a GIF picture.' ) "
).
aMenu popUpInWorld.
instanceMethods: private
buildDependencyView
(dependencyView := DependencyView new)
color: Color lightGreen lighter;
borderWidth: 2;
borderColor: Color black;
controller: self.
buildGanttView
(ganttView := GanttView new)
color: Color lightBlue lighter;
borderWidth: 2;
borderColor: Color black;
controller: self.
^ganttView
instanceMethods: overrides
addMorph: aMorph fullFrame: aLayoutFrame
" Suppresses crazy handling of panes in StandardSystemWindow. "
| left right bottom top windowBorderWidth |
windowBorderWidth _ self class borderWidth.
left _ aLayoutFrame leftOffset ifNil: [0].
right _ aLayoutFrame rightOffset ifNil: [0].
bottom _ aLayoutFrame bottomOffset ifNil: [0].
top _ aLayoutFrame topOffset ifNil: [0].
aLayoutFrame rightFraction = 1 ifTrue: [aLayoutFrame rightOffset: right - windowBorderWidth].
aLayoutFrame leftFraction = 0
ifTrue: [aLayoutFrame leftOffset: left + windowBorderWidth]
ifFalse: [aLayoutFrame leftOffset: left + ProportionalSplitterMorph splitterWidth].
aLayoutFrame bottomFraction = 1 ifTrue: [aLayoutFrame bottomOffset: bottom - windowBorderWidth].
aLayoutFrame topFraction = 0
ifTrue: [aLayoutFrame topOffset: top]
ifFalse: [aLayoutFrame topOffset: top + ProportionalSplitterMorph splitterWidth].
(aMorph class name = #BrowserCommentTextMorph) ifTrue:
[aLayoutFrame rightOffset: windowBorderWidth negated.
aLayoutFrame leftOffset: windowBorderWidth.
aLayoutFrame bottomOffset: windowBorderWidth negated.
aLayoutFrame topOffset: (windowBorderWidth negated) + 4].
" super addMorph: aMorph fullFrame: aLayoutFrame."
aMorph layoutFrame: aLayoutFrame.
aMorph hResizing: #spaceFill; vResizing: #spaceFill.
self addMorph: aMorph.
paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
" aMorph adoptPaneColor: self paneColor."
" aMorph borderWidth: 1; borderColor: Color lightGray; color: Color white."
Preferences scrollBarsOnRight "reorder panes so flop-out right-side scrollbar is visible"
ifTrue: [self addMorphBack: aMorph].
self addPaneSplitters.
classMethods: instance creation
open
(self labelled: 'Plan') open.
projection: Data
Class: Activity
Object subclass: #Activity
instanceVariableNames: 'earlyStart duration name color'
category: 'Plan-Data'
" Instances of this class represent the notion of an activity in a planning activity network.
Note that the successor and predecessor relations are not part of the activity; they are generated in a Context when needed.
See Controller>Controller for more details.
Instance variables:
earlyStart (Integer) earliest start week for this activity.
duration (Integer) in weeks
name (String) activity name
color (Color) simple representation of activity kind. "
instanceMethods: initialize-release
initialize
earlyStart := nil.
duration := 0.
name := 'Act' , self asOop printString.
color := Color gray.
name: nam duration: dur color: col
name := nam.
duration := dur.
color := col.
instanceMethods: attributes-read
color
^color
displayName
^name , ' (' , duration printString , ')'
duration
^duration
earlyFinish
^earlyStart isNil
ifTrue: [nil]
ifFalse: [earlyStart + duration - 1]
earlyStart
^earlyStart
name
^name
instanceMethods: attributes-write
earlyStart: week
earlyStart := week.
instanceMethods: operations
printOn: strm
super printOn: strm.
strm nextPutAll: ' (' , name , ')'.
classMethods: instance creation
name: nam duration: dur color: col
| act |
act := self new.
act name: nam duration: dur color: col.
^act
Class: Dependency
Object subclass: #Dependency
instanceVariableNames: 'predecessor successor'
category: 'Plan-Data'
" Instances of this class represents a predecessor/successor relationship between activities.
See Controller>Controller for more details.
Instance variables:
predecessor (Activity)
successor (Activity) "
instanceMethods: initialize-release
predecessor: pred successor: succ
predecessor := pred.
successor := succ.
instanceMethods: attributes-read
predecessor
^predecessor
successor
^successor
instanceMethods: operations
printOn: strm
super printOn: strm.
strm nextPutAll: ' (' , predecessor name , '-->' , successor name , ')'.
Class: Model
Object subclass: #Model
instanceVariableNames: 'activities dependencies activityRanks'
category: 'Plan-Data'
" The Model part of MVC. Represents an activity network.
See Controller>Controller for more details.
Instance variables:
activities (Set of Activity)
dependencies (Set of Dependency)
activityRanks (Integer) A cache that is needed for certain computations.
It has nothing to do with the Model as such
and illustrates how behavior data get mixed into real domain Model data.
(It is an instance variable in a Context in the BB4b example) "
instanceMethods: initialize-release
initialize
activities := Set new.
dependencies := Set new.
instanceMethods: attributes-read
activityNamed: actNam
| act |
act := activities detect: [:a | a name = actNam] ifNone: [nil].
act ifNil: [self error: 'Activity ' , actNam , ' does not exist.'. ^nil].
^act
allActivities
^activities
allDependencies
^dependencies
hasDependencyFrom: fromAct to: toAct
| found |
found := dependencies
detect: [:dep | (dep predecessor = fromAct) and: [dep successor = toAct]]
ifNone: [nil].
^found notNil
predecessorsOf: succ
| preds |
preds := Set new.
dependencies do: [:dep | dep successor == succ ifTrue: [preds add: dep predecessor]].
^preds
successorsOf: pred
| succs |
succs := Set new.
dependencies do: [:dep | dep predecessor == pred ifTrue: [succs add: dep successor]].
^succs
instanceMethods: attributes-write
newActivityNamed: nam duration: dur color: col
| act |
act := Activity name: nam duration: dur color: col.
activities add: act.
self changed: #activities.
^act
newDependencyFrom: predNam to: succNam
| pred succ |
pred := self activityNamed: predNam.
succ := self activityNamed: succNam.
(self hasDependencyFrom: pred to: succ)
ifFalse:
[dependencies add:
(Dependency new
predecessor: pred
successor: succ).
self changed: #model].
instanceMethods: private
frontActivity
^self allActivities
detect:
[:act |
act earlyStart isNil
and:
[(self predecessorsOf: act) noneSatisfy: [:pred | pred earlyStart isNil]]]
ifNone: [nil]
computeRankedActivities
| rankedActivities |
rankedActivities :=OrderedCollection new. " rank -> activityCollection "
activityRanks := Dictionary new. " activity -> rank "
self allActivities do:
[:act || rnk coll |
rnk := self rankOf: act.
activityRanks at: act put: rnk.
coll := rankedActivities
at: rnk
ifAbsentPut: [SortedCollection sortBlock: [:x :y | x name < y name]].
coll add: act].
^rankedActivities
rankOf: act
" NOTE: A feature of the structure, not of an individual activity. "
| rnk |
^activityRanks
at: act
ifAbsent:
[rnk := 1.
(self predecessorsOf: act) do: [:pred | rnk := rnk max: (self rankOf: pred) + 1].
rnk]
instanceMethods: operations
frontloadFrom: startWeek
| frontAct |
self allActivities do: [:act | act earlyStart: nil].
[frontAct := self frontActivity. frontAct notNil]
whileTrue:
[frontAct earlyStart: startWeek.
(self predecessorsOf: frontAct) do:
[:pred |
(pred earlyFinish > frontAct earlyStart)
ifTrue: [frontAct earlyStart: pred earlyFinish + 1]].
].
projection: View
Class: ActivityView
RectangleMorph subclass: #ActivityView
instanceVariableNames: 'controller activity nameMorph'
category: 'Plan-View'
" This class is a V part of the original MVC paradigm:
M is the Model that represents domain information
V is a View that presents Model data to an end user and lets the user edit these data.
C is a Controller that sets up and coordinates a number of Views.
This View presents a single network activity.
See Controller>Controller for more details. "
instanceMethods: initialize-release
initialize
super initialize.
self
borderWidth: 2;
borderColor: Color black;
layoutPolicy: (TableLayout new);
hResizing: #rigid;
vResizing: #rigid;
color: Color gray;
extent: 75@50.
nameMorph := TextMorph new
hResizing: #shrinkWrap;
contents: '';
wrapFlag: false;
centered;
margins: 10;
lock;
yourself.
self addMorphBack: nameMorph.
controller: cnt activity: act
controller := cnt.
activity := act.
self color: act color.
nameMorph
newContents: '' asText; " To block any TextMorph optimization if name unchanged. "
newContents: activity displayName asText allBold;
updateFromParagraph.
self update: nil.
self invalidRect: self bounds.
instanceMethods: attributes-read
borderColor
^self isSelected
ifTrue: [Color red]
ifFalse: [Color black]
borderWidth
^self isSelected
ifTrue: [5]
ifFalse: [2]
isSelected
" self traceRM: {activity name. controller isSelected: activity.}."
^controller isSelected: activity
instanceMethods: operations
printOn: strm
super printOn: strm.
strm nextPutAll: ' (' , nameMorph text asString , ')'.
update: aParameter
| w |
aParameter = #selection
ifTrue:
[self borderWidth: self borderWidth.
self color: self color.
self borderColor: self borderColor.
self invalidRect: self bounds.
(w := self world) ifNotNil: [w doOneCycle].
" self traceRM: {activity name. self borderColor.}."
].
instanceMethods: I/O
handlesMouseDown: evt
^true
mouseDown: evt
evt yellowButtonPressed
ifTrue: [^self yellowButtonActivity: evt].
(evt redButtonPressed and: [self bounds containsPoint: evt cursorPoint])
ifTrue: [evt hand waitForClicksOrDrag: self event: evt].
click: evt
controller clickAt: activity.
Class: DependencyView
PasteUpMorph subclass: #DependencyView
instanceVariableNames: 'controller activityViews lines rankedActivities maxRank maxRankSetSize'
category: 'Plan-View'
" This class is a V part of the original MVC paradigm:
M is the Model that represents domain information
V is a View that presents Model data to an end user and lets the user edit these data.
C is a Controller that sets up and coordinates a number of Views.
This View presents a an activity network as a graph.
See Controller>Controller for more details. "
instanceMethods: initialize-release
initialize
super initialize.
activityViews := Dictionary new.
lines := OrderedCollection new.
controller: cnt
controller := cnt.
controller addDependent: self.
instanceMethods: attributes-read
activiyViewAt: act
^activityViews at: act
instanceMethods: operations
addActivityViewFor: act
| actView |
actView := ActivityView new controller: controller activity: act.
activityViews at: act put: actView.
self addMorph: actView.
controller addDependent: actView.
^actView
addLineFrom: pt1 to: pt2
| line |
(line := PolygonMorph vertices: {pt1. pt2.} color: Color black borderWidth: 2 borderColor: Color black)
makeOpen;
sticky: true.
lines add: line.
self addMorph: line.
deleteContents
activityViews values do: [:p | p delete].
activityViews := Dictionary new.
lines do: [:lin | lin delete].
lines := OrderedCollection new.
refresh
activityViews values do: [:v | v delete].
activityViews := Dictionary new.
self resetView.
update: aSymbol
(aSymbol = #model and: [controller model notNil]) ifTrue: [self refresh].
instanceMethods: role methods
addActivityViews
| gridX gridY x0 y0 actViewExtent xPos yPos actView |
gridX := self bounds width // maxRank.
gridY := self bounds height // maxRankSetSize.
x0 := self bounds left + 10.
y0 := self bounds top + 10.
actViewExtent := 100 @ 40. "(gridX-50) @ (gridY-20)."
1 to: rankedActivities size do:
[:rank |
xPos := x0 + (gridX * (rank-1)).
yPos := y0.
(rankedActivities at: rank) do:
[:act |
actView := self addActivityViewFor: act.
actView bounds: ((xPos @ yPos) extent: actViewExtent).
yPos := yPos + gridY.
] ].
addLines
| fromView toView pt1 pt2 |
controller model allDependencies do:
[:dep |
fromView := self activiyViewAt: dep predecessor.
toView := self activiyViewAt: dep successor.
pt1 := fromView right
@ ((fromView top + (fromView height // 2))).
pt2 := toView left
@ ((toView top + (toView height // 2))).
self addLineFrom: pt1 to: pt2.
]
resetView
"---------------- Context responsibility start ------------------------"
rankedActivities := controller model computeRankedActivities.
maxRank := rankedActivities size.
maxRankSetSize := 0.
rankedActivities do: [:coll | maxRankSetSize := maxRankSetSize max: coll size].
"---------------- Context responsibility end ------------------------"
self deleteContents.
self addActivityViews.
self addLines.
instanceMethods: I/O
handlesMouseDown: evt
^false
Class: GanttView
PasteUpMorph subclass: #GanttView
instanceVariableNames: 'controller activityViews lines annotations endTime startTime nameSortedActivities'
category: 'Plan-View'
" This class is a V part of the original MVC paradigm:
M is the Model that represents domain information
V is a View that presents Model data to an end user and lets the user edit these data.
C is a Controller that sets up and coordinates a number of Views.
This View presents the network activities along a time axis showing the time period of the execution of each activity.
See Controller>Controller for more details. "
instanceMethods: initialize-release
initialize
super initialize.
activityViews := Dictionary new.
lines := OrderedCollection new.
annotations := OrderedCollection new.
controller: cnt
controller := cnt.
controller addDependent: self.
instanceMethods: attributes-write
addActivityViewFor: act
| actView |
actView := ActivityView new controller: controller activity: act.
activityViews at: act put: actView.
self addMorph: actView.
controller addDependent: actView.
^actView
addAnnotation: aString at: pt
| annot |
annot := StringMorph
contents: aString
font: ( ((TextStyle named: 'BitstreamVeraSans') fontAt: 3))
emphasis: 1.
annot
color: Color lightGray;
position: pt.
annotations add: annot.
self addMorphBack: annot.
addLineFrom: pt1 to: pt2
| line |
(line := PolygonMorph vertices: {pt1. pt2.} color: Color black borderWidth: 2 borderColor: Color black)
makeOpen;
sticky: true;
color: Color lightGray;
borderColor: Color lightGray.
lines add: line.
self addMorphBack: line.
deleteContents
activityViews values do: [:view | view delete].
activityViews := Dictionary new.
lines do: [:lin | lin delete].
lines := OrderedCollection new.
annotations do: [:ann | ann delete].
annotations := OrderedCollection new.
instanceMethods: operations
refresh
activityViews values do: [:v | v delete].
activityViews := Dictionary new.
self resetView.
update: aSymbol
(aSymbol = #model and: [controller model notNil]) ifTrue: [self refresh].
instanceMethods: role methods
addActivityViews
| currY maxX maxY gridX gridY x0 width actView |
startTime = endTime ifTrue: [^self. "Network not planned. "].
maxX := self width - 20.
maxY := self height - 20.
gridX := maxX // (endTime - startTime + 1).
gridY := maxY // (nameSortedActivities size + 1).
currY := 10.
nameSortedActivities do: [:act |
x0 := act earlyStart - startTime * gridX + 10.
width := (act earlyFinish - act earlyStart + 1) * gridX.
actView := self addActivityViewFor: act.
actView bounds: ((x0+self left) @ ((currY+self top) + 1) extent: width @ (gridY-2)).
currY := currY + gridY].
addLines
| maxX maxY gridX gridY y1 y2 y0 |
maxX := self width - 20.
maxY := self height - 20.
gridX := maxX // (endTime - startTime + 1).
gridY := maxY // (nameSortedActivities size + 1).
y0 := self top + 10.
y1 := nameSortedActivities size * gridY + self top + 20.
y2 := self bottom - 10.
self addLineFrom: (self left + 10) @ y1 to: (self right - 10) @ y1.
0 to: endTime - startTime + 1 do:
[:week || x |
x := week * gridX + self left + 10.
self addLineFrom: x @ y0 to: x @ y2.
self
addAnnotation: (startTime + week) printString
at: (gridX // 2 + x) @ (y1 + 10).
].
resetView
"---------------- Context responsibility start ------------------------"
endTime := nil.
controller model allActivities do: [:act | endTime ifNil: [endTime := act earlyFinish] ifNotNil: [endTime := act earlyFinish max: endTime]].
endTime := endTime ifNil: [0] ifNotNil: [endTime].
startTime := nil.
controller model allActivities do: [:act | startTime ifNil: [startTime := act earlyStart] ifNotNil: [startTime := act earlyStart min: startTime]].
startTime := startTime ifNil: [0] ifNotNil: [startTime].
nameSortedActivities := controller model allActivities asSortedCollection: [:x :y | x name < y name].
"---------------- Context responsibility end ------------------------"
self deleteContents.
self addActivityViews.
self addLines.