projection: Model-Context-Classes
Class: BB9BackloadCtx
BB1Context subclass: #BB9BackloadCtx
instanceVariableNames: 'activity model'
category: 'BB9Planning-Model-Context'
" Find latest time period for each activity. "
instanceMethods: system operations
backload: mod
model := mod.
self triggerInteractionFrom: #MODEL with: #backload.
instanceMethods: role binding
ACTIVITY
^activity
CONTEXT
^self
MODEL
^model
PROJECTFINISH
^model projectFinish
SUCCESSORS
^activity
ifNil: [Array new]
ifNotNil: [model successorsOf: activity]
remap
" Need to find an activity that is ready for planning first since it is used by two role mappings. "
activity := model allActivities
detect:
[:act |
act lateFinish isNil
and: [(model successorsOf: act) noneSatisfy: [:pred | pred lateStart isNil]]]
ifNone: [nil].
super remap.
projection: BB9BackloadCtx-Interaction
roleMethods: MODEL
backload
MODEL allActivities do: [:act | act lateFinish: nil]. " set to unplanned "
[CONTEXT remap. ACTIVITY notNil] whileTrue: [ACTIVITY backload].
roleMethods: ACTIVITY
backload
| minSucc |
ACTIVITY lateFinish: PROJECTFINISH.
minSucc := SUCCESSORS detectMin: [:succ | succ lateStart].
minSucc ifNotNil: [ACTIVITY lateFinish: minSucc lateStart - 1].
Class: BB9FrontloadCtx
BB1Context subclass: #BB9FrontloadCtx
instanceVariableNames: 'activity model'
category: 'BB9Planning-Model-Context'
" Find earliest time period for each activity. "
instanceMethods: system operations
frontload: mod
model := mod.
self triggerInteractionFrom: #PLAN with: #frontload.
instanceMethods: role binding
ACTIVITY
^activity
CURRENTCONTEXT
^self
PLAN
^model
PREDECESSORS
^activity
ifNil: [Array new]
ifNotNil: [model predecessorsOf: activity]
PROJECTSTART
^model projectStart
remap
" Need to find an activity that is ready for planning first since it is used by two role mappings. "
activity := model allActivities
detect:
[:act |
act earlyStart isNil and:
[(model predecessorsOf: act) noneSatisfy: [:pred | pred earlyFinish isNil]]]
ifNone: [nil].
super remap.
projection: BB9FrontloadCtx-Interaction
roleMethods: ACTIVITY
frontload
| maxPred |
maxPred := PREDECESSORS detectMax: [:pred | pred earlyFinish].
maxPred
ifNil: [ACTIVITY earlyStart: PROJECTSTART.]
ifNotNil: [ACTIVITY earlyStart: maxPred earlyFinish + 1].
roleMethods: PLAN
frontload
PLAN allActivities do: [:act | act earlyStart: nil]. " set to unplanned "
[ACTIVITY notNil]
whileTrue:
[ACTIVITY frontload.
CURRENTCONTEXT remap. ].
"[CURRENTCONTEXT remap. ACTIVITY notNil] whileTrue: [ACTIVITY frontload]."
Class: BB9ResourceAllocationCtx
BB1Context subclass: #BB9ResourceAllocationCtx
instanceVariableNames: 'model'
category: 'BB9Planning-Model-Context'
" Allocate resources to each activity. "
instanceMethods: system operations
allocateResources: aModel
model := aModel.
"self triggerInteractionFrom: #ALLOCATOR with: #allocateResources."
instanceMethods: role binding
ALLACTIVITIES
^BB1OrderedCollection newFrom: model allActivities
ALLOCATOR
^self
DDD
^self
RESOURCE
^model resource
YYY
^nil
projection: BB9ResourceAllocationCtx-Interaction
roleMethods: RESOURCE
allocate: act
" Simplest possible allocation assuming infinite capacity. "
" First come, first served. "
| weekAllocations tentativeStart |
tentativeStart := act lateStart.
tentativeStart ifNil: [^self].
0 to: act duration - 1 do:
[:indx |
weekAllocations := RESOURCE allocationsAt: tentativeStart + indx.
act resourceRequirement timesRepeat: [weekAllocations addLast: act]].
act plannedStart: tentativeStart.
roleMethods: ALLOCATOR
allocateResources
RESOURCE reset.
" First decision is to allocate the activities in sequence. "
" An alternative could be to let the resource control the sequence. "
ALLACTIVITIES allocateResources.
roleMethods: ALLACTIVITIES
allocateResources
" Second decision is to order the activities sorted by name. "
(self asSortedCollection: [:x :y | x name < y name])
do: [:act | RESOURCE allocate: act].
projection: Model-Data-classes
Class: BB9DBase
Object subclass: #BB9DBase
instanceVariableNames: ''
category: 'BB9Planning-Model-Data'
" This class manages files that contain persistent model objects.
Persistence is by saving the Model with Squeak ReferenceStream.
This means that saved model files cannot be read after any model class has been changed.
Procedure for retaining a model through changes in any of the model classes.
Open the BB9 UI on the model file
Change one or more model classes.
Change BB9Base>>baseExtension to a new extension.
THEN store the model with the new classes and the new extension.
"
classMethods: class initialization
baseExtension
" BB9DBase baseExtension. "
^'bb13'
baseName
" BB9DBase baseName. "
^'dBase-5' "'dBase-test-1'"
classMethods: operations
open
| mvcMod fileNames indx fileName strm m |
mvcMod := BB9Model new.
fileName := 'NewModel'.
fileNames := (FileDirectory default fileNames select: [:nam | (FileDirectory extensionFor: nam) = self baseExtension ]) asSortedCollection asArray.
fileNames ifEmpty:
[self notify: 'No data files with extension ' , self baseExtension , String cr , ' I cannot open this planning demo.'.
^self].
indx := (PopUpMenu labelArray: fileNames)
startUpWithCaption: 'Choose file'.
indx = 0 ifTrue: [^self].
fileName := fileNames at: indx.
[strm := ReferenceStream fileNamed: fileName.
m := strm next.
] ensure: [strm close].
m ifNotNil: [mvcMod resetFromModel: m].
BB9Controller new openOn: mvcMod title: fileName.
readModelTo: mod
| strm fileNames indx m fileName |
fileNames := (FileDirectory default fileNames select: [:nam | (FileDirectory extensionFor: nam) = self baseExtension ]) asSortedCollection.
indx := (PopUpMenu labelArray: fileNames) startUpWithCaption: 'Choose file'.
indx = 0 ifTrue: [^self].
fileName := fileNames at: indx.
[strm := ReferenceStream fileNamed: fileName.
m := strm next.
] ensure: [strm close].
m ifNotNil: [mod resetFromModel: m].
^fileName copyFrom: 1 to: fileName size - self baseExtension size-1
saveModelFrom: mod
" Note: The model is always stored to a new version of the file selected by the user. "
| baseNames indx fileName strm |
baseNames := #('dataBase' 'testBase').
indx := (PopUpMenu labelArray: baseNames)
startUpWithCaption: 'Choose name of file for saving.'.
indx = 0 ifTrue: [^self].
fileName := FileDirectory default
nextNameFor: (baseNames at: indx)
extension: self baseExtension.
[ strm := ReferenceStream fileNamed: fileName.
strm nextPut: mod.
] ensure: [strm close].
classMethods: attributes-read
model
" BB9DBase model "
model ifNil: [model := BB9Model new].
^model
classMethods: attributes-write
model: m
model := m.
Class: BB9Activity
Object subclass: #BB9Activity
instanceVariableNames: 'name duration earlyStart lateFinish plannedStart resourceRequirement'
category: 'BB9Planning-Model-Data'
" An activity has a name and a duration and represents a task that needs to be done.
An activity is performed by a resource. There is only one resource in this program. An activity property is the resource requirements (no.of people, bods). "
instanceMethods: attributes-read
duration
^ duration
earlyFinish
^earlyStart ifNil: [nil] ifNotNil: [earlyStart + duration - 1]
earlyStart
^ earlyStart
lateFinish
^ lateFinish
lateStart
^ lateFinish ifNil: [nil] ifNotNil: [lateFinish - duration + 1]
name
^name
plannedFinish
^ plannedStart ifNil: [nil] ifNotNil: [plannedStart + duration - 1]
plannedStart
^ plannedStart
resourceRequirement
^ resourceRequirement
instanceMethods: attributes-write
bods: resourceInt
resourceRequirement := resourceInt.
duration: durationInt
duration := durationInt.
name: aName
name := aName asSymbol.
name: aName duration: durationInt bods: resourceInt
name := aName asSymbol.
duration := durationInt.
resourceRequirement := resourceInt.
earlyStart: anIntegerOrNil
earlyStart := anIntegerOrNil.
lateFinish: anIntegerOrNil
lateFinish := anIntegerOrNil.
plannedStart: anInteger
plannedStart := anInteger.
instanceMethods: operations
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '[' , name , ']'.
Class: BB9Dependency
Object subclass: #BB9Dependency
instanceVariableNames: 'fromActivity toActivity'
category: 'BB9Planning-Model-Data'
" An activity can depend on other activities: it cannot start before all its predecessor activities are completed, and it must end before its successor activities can start. Instances of this class represent such dependencies. "
instanceMethods: initialize-release
fromActivity: activity1 toActivity: activity2
fromActivity := activity1.
toActivity := activity2.
instanceMethods: attributes-read
fromActivity
^ fromActivity
toActivity
^ toActivity
instanceMethods: attributes-write
toActivity: act
toActivity = act ifTrue: [^self].
toActivity := act.
instanceMethods: operations
printOn: strm
super printOn: strm.
strm nextPutAll: ' (' , fromActivity printString , '->' , toActivity printString ,')'.
Class: BB9Model
Object subclass: #BB9Model
instanceVariableNames: 'activities activityPositions dependencies projectStart projectFinish resource'
category: 'BB9Planning-Model-Data'
" Instances of this class represent an activity network plan.
An activity has a name and a duration and represents a task that needs to be done. An activity can depend on other activities: it cannot start before all its predecessor activities are completed, and it must end before its successor activities can start.
Front- and backloading compute the earliest and latest start and end times given project start and end.
An activity is performed by a resource. (There is only one resource in this program.) Its resource requirements (no.of people, bods) is a property of the activity. "
instanceMethods: initialize-release
initialize
super initialize.
activities := OrderedCollection new.
activityPositions := IdentityDictionary new.
dependencies := IdentitySet new.
resource := BB9Resource new.
projectStart := projectFinish := 0.
resetFromModel: m
self copyAddedStateFrom: m.
instanceMethods: attributes-read
activityNamed: aSymbol
^activities detect: [:act | act name = aSymbol] ifNone: [nil]
activityPositionFor: act
^activityPositions at: act ifAbsent: [nil]
allActivities
" Return a copy, the activities inst.var. is private to the model object. "
^BB1OrderedCollection newFrom: activities
dependenciesFromActivity: act
^ dependencies select: [:dep | dep fromActivity == act]
dependenciesToActivity: act
^ dependencies select: [:dep | dep toActivity == act]
name
^'xxx'
name: nam
'xxx'
predecessorsOf: act
^ (self dependenciesToActivity: act) collect: [:dep | dep fromActivity]
successorsOf: act
^ (self dependenciesFromActivity: act) collect: [:dep | dep toActivity]
projectStart
projectStart ifNil: [projectStart := 0].
^ projectStart
projectFinish
projectFinish ifNil: [projectFinish := 100].
^ projectFinish
resource
^resource
instanceMethods: attributes-write
activityPositionFor: act put: aPoint
(self activityPositionFor: act) = aPoint ifTrue: [^self].
activityPositions at: act put: aPoint.
addActivity: anActivity
activities addLast: anActivity.
addDependency: dep
dependencies add: dep.
projectFinish: weekNo
projectFinish:= weekNo.
projectStart: weekNo
projectStart:= weekNo.
removeActivity: act
(activityPositions includesKey: act)
ifTrue:
[activityPositions removeKey: act.
dependencies copy do: [:dep | (dep fromActivity = act or: [dep toActivity = act])
ifTrue: [dependencies remove: dep]].
activities remove: act].
removeDependency: dep
dependencies remove: dep ifAbsent: [].
instanceMethods: operations
readModel
BB9DBase readModelTo: self.
self endTransaction.
endTransaction
self recomputeModel.
self changed: #Model.
recomputeModel
BB9BackloadCtx new backload: self.
BB9FrontloadCtx new frontload: self.
BB9ResourceAllocationCtx new allocateResources: self.
resetModel
self initialize.
saveModel
BB9DBase saveModelFrom: self.
Class: BB9Resource
Object subclass: #BB9Resource
instanceVariableNames: 'allocations'
category: 'BB9Planning-Model-Data'
" An activity is performed by a resource. Its resource requirements (no.of people, bods) is a property of the activity.
The one and only resource is here a team of programmers with indistinguishable qualifications.
Instances of this class reprsent an activity network plan. The number of people (bods) required to perform an activity is a property of that activity.
"
instanceMethods: initialize-release
initialize
super initialize.
allocations := Dictionary new. " weekNo -> Array of Activities served. "
instanceMethods: attributes-read
allocations
^allocations
maxHeight
| max |
max := 0.
allocations do: [:coll | max := max max: coll size].
^max
maxRequirement
| max |
max := 0.
allocations do: [:coll | max := max max: coll size].
^max
reset
allocations := Dictionary new. " weekNo -> Array of Activities "
instanceMethods: attributes-write
allocationsAt: weekNo
(allocations includesKey: weekNo) ifFalse: [allocations at: weekNo put: OrderedCollection new].
^ allocations at: weekNo
projection: UI-Context-Classes
Class: BB9AddActivityCtx
BB1Context subclass: #BB9AddActivityCtx
instanceVariableNames: 'view model'
category: 'BB9Planning-UI-Context'
instanceMethods: system operations
addActivityIn: aModel
" BB9AddActivityCtx new addActivityIn: aModel. "
model := aModel.
self triggerInteractionFrom: #ACTIVITY with: #initialize.
instanceMethods: role binding
ACTIVITY
^BB9Activity new
MODEL
^model
projection: BB9AddActivityCtx-Interaction
roleMethods: ACTIVITY
initialize
| actName actDur actBods |
actName := (FillInTheBlank request: 'Please type name of new Activity' initialAnswer: '')
asSymbol.
actName size = 0 ifTrue: [^self].
(MODEL activityNamed: actName)
ifNotNil:
[self inform: actName , ' already in use. \Use a different name.' withCRs.
^ACTIVITY initialize].
actName size = 0 ifTrue: [^self].
ACTIVITY name: actName.
actDur := (FillInTheBlank request: 'Please type duration of ' , actName initialAnswer: '') asNumber.
actDur = 0 ifTrue: [^self].
ACTIVITY duration: actDur.
actBods := (FillInTheBlank request: 'Please type resorce requirements for ' , actName initialAnswer: '') asNumber.
actBods = 0 ifTrue: [^self].
ACTIVITY bods: actBods.
MODEL addActivity: ACTIVITY..
MODEL endTransaction.
Class: BB9AddDependencyCtx
BB1Context subclass: #BB9AddDependencyCtx
instanceVariableNames: 'view dependencyLine fromActivitySymbol'
category: 'BB9Planning-UI-Context'
" Add a new dependency from one activity to another. "
instanceMethods: system operations
newDependencyIn: depView from: actSymbol
view := depView.
fromActivitySymbol := actSymbol.
self triggerInteractionFrom: #VIEW with: #connectDependency
instanceMethods: role binding
DEPENDENCYLINE
| dep |
dependencyLine
ifNil:
[dep := BB9Dependency new
fromActivity: fromActivitySymbol activity
toActivity: fromActivitySymbol activity. " Will be redefined by user. "
dependencyLine := BB9DependencyLine new
dependency: dep
view: view
fromActivitySymbol: fromActivitySymbol
toActivitySymbol: fromActivitySymbol.
view addMorphFront: dependencyLine].
^dependencyLine
MODEL
^view model
VIEW
^view
projection: BB9AddDependencyCtx-Interaction
roleMethods: VIEW
connectDependency
| pt activitySymbol2 w |
[Sensor noButtonPressed]
whileTrue:
[ pt := VIEW globalPointToLocal: Sensor mousePoint.
(activitySymbol2 := VIEW activitySymbols
detect: [:sym | sym bounds containsPoint: pt] ifNone: [nil]).
activitySymbol2
ifNotNil: [
DEPENDENCYLINE toActivitySymbol: activitySymbol2.
DEPENDENCYLINE refresh.
(w := VIEW world) ifNotNil: [w doOneCycle]]].
[Sensor anyButtonPressed] whileTrue.
activitySymbol2
ifNotNil:
[MODEL addDependency: DEPENDENCYLINE dependency]
ifNil:
[DEPENDENCYLINE delete].
Class: BB9DependencyDisplayCtx
BB1Context subclass: #BB9DependencyDisplayCtx
instanceVariableNames: 'view'
category: 'BB9Planning-UI-Context'
" Display the activities with their dependencies. "
instanceMethods: system operations
refreshDependencyView: aView
view := aView.
self triggerInteractionFrom: #VIEW with: #refresh.
instanceMethods: role binding
MODEL
^view model
NAMESORTEDACTIVITIES
^(view model allActivities asSortedCollection: [:x :y | x name < y name])
SYMBOLEXTENT
^BB9ActivitySymbol extent
VIEW
^view
projection: BB9DependencyDisplayCtx-Interaction
roleMethods: VIEW
refresh
VIEW removeAllMorphs.
VIEW refreshSymbols.
VIEW refreshDependencyLines.
VIEW selectionChanged.
refreshDependencyLines
| toSym newDependencyLine |
VIEW activitySymbols do:
[:fromSym |
(MODEL dependenciesFromActivity: fromSym activity) do:
[:dep |
toSym := VIEW activitySymbols
detect: [:sym | sym activity == dep toActivity] ifNone: [nil].
toSym notNil
ifTrue:
[newDependencyLine := BB9DependencyLine new
dependency: dep
view: VIEW
fromActivitySymbol: fromSym
toActivitySymbol: toSym.
VIEW addDependencyLine: newDependencyLine]]].
refreshSymbols
| pos newActivitySymbol w unplacedSymbols point |
unplacedSymbols := OrderedCollection new.
NAMESORTEDACTIVITIES do:
[:act |
newActivitySymbol := VIEW addActivitySymbolFor: act hasName: true color: Color pp1. "lightGreen."
(pos := MODEL activityPositionFor: act)
ifNotNil: [newActivitySymbol position: pos]
ifNil: [unplacedSymbols add: newActivitySymbol]].
unplacedSymbols do:
[:symb |
VIEW addMorphFront: symb. " Move to top. "
[Sensor redButtonPressed not]
whileTrue:
[point := (VIEW globalPointToLocal: Sensor cursorPoint) rounded.
symb position: (point - (symb extent // 2)).
(w := VIEW world) ifNotNil: [w doOneCycle]].
[Sensor redButtonPressed] whileTrue: [].
MODEL activityPositionFor: symb activity put: symb position].
Class: BB9GanttDisplayCtx
BB1Context subclass: #BB9GanttDisplayCtx
instanceVariableNames: 'view'
category: 'BB9Planning-UI-Context'
" Display the Gantt diagram with time bars
for early and late start/end. "
instanceMethods: system operations
refresh: aView
view := aView.
self triggerInteractionFrom: #VIEW with: #refresh.
instanceMethods: role binding
GRID
^BB9ActivitySymbol extent
NAMESORTEDACTIVITIES
^view model allActivities asSortedCollection: [:x :y | x name < y name]
PROJECTFINISH
^view model projectFinish
PROJECTSTART
^view model projectStart
VIEW
^view
projection: BB9GanttDisplayCtx-Interaction
roleMethods: VIEW
refresh
| weekWidth bodyBox leftMarginBox bottomMarginBox |
weekWidth := 30.
bodyBox := GRID x @ 10
extent:
((PROJECTFINISH - PROJECTSTART + 1) * GRID x)
@ (GRID y * NAMESORTEDACTIVITIES size ).
leftMarginBox := 0@10 corner: GRID x @ bodyBox bottom.
bottomMarginBox := bodyBox left @ bodyBox bottom
corner: bodyBox right @ (bodyBox bottom + GRID y).
VIEW removeAllMorphs.
VIEW addLinesIn: bodyBox.
VIEW addBottomAnnotationsIn: bottomMarginBox.
VIEW addLeftAnnotationsIn: leftMarginBox.
VIEW addActivitySymbolsIn: bodyBox.
VIEW selectionChanged.
addLinesIn: bodyBox
| x y |
" Vertical lines. "
PROJECTSTART to: PROJECTFINISH + 1do:
[:week |
x := (week - PROJECTSTART) * GRID x + bodyBox left.
VIEW addLineFrom: x @ bodyBox top to: x @ bodyBox bottom].
" Horizontal lines. "
1 to: NAMESORTEDACTIVITIES size + 1 do:
[:indx |
y := bodyBox top + (GRID y * (indx-1)).
VIEW addLineFrom: bodyBox left @ y to: bodyBox right @ y].
addBottomAnnotationsIn: bottomMargin
| x |
PROJECTSTART to: PROJECTFINISH do:
[:week |
x := bottomMargin left + ((week - PROJECTSTART) * GRID x).
VIEW
addAnnotation: week printString
at: (x + (GRID x // 2) - 10) @ (bottomMargin top)].
addLeftAnnotationsIn: leftMarginBox
| x act y annot |
x := leftMarginBox left.
1 to: NAMESORTEDACTIVITIES size do:
[:indx |
act := NAMESORTEDACTIVITIES at: indx.
y := leftMarginBox top + (GRID y * (indx-1)).
annot := VIEW addActivitySymbolFor: act hasName: true color: Color transparent.
annot
position: x @y;
"autoFit: true;"
width: GRID x;
textColor: Color gray;
borderColor: Color lightGray].
addActivitySymbolsIn: bodyBox
| barHeight currAct x0 currY earlyWidth lateWidth earlyBar lateBar |
barHeight := GRID y //3 + 2.
1 to: NAMESORTEDACTIVITIES size do:
[:indx |
currAct := NAMESORTEDACTIVITIES at: indx.
" Early. "
currY := bodyBox top + (GRID y * (indx - 1) + 1).
currAct earlyStart
ifNotNil:
[x0 := bodyBox left + (currAct earlyStart - PROJECTSTART * GRID x).
earlyWidth := (currAct earlyFinish - currAct earlyStart + 1) * GRID x.
earlyBar := VIEW addActivitySymbolFor: currAct hasName: false color: Color yellow.
earlyBar bounds: (x0 @ ((currY+VIEW top) + 1)
extent: earlyWidth @ barHeight)].
" Late. "
currY := currY +barHeight + 1.
currAct lateStart
ifNotNil:
[x0 := bodyBox left + (currAct lateStart - PROJECTSTART * GRID x).
lateWidth := (currAct lateFinish - currAct lateStart + 1) * GRID x.
lateBar := VIEW addActivitySymbolFor: currAct hasName: false color: Color green.
lateBar bounds: (x0 @ ((currY+VIEW top) + 1)
extent: lateWidth @ (GRID y //3 +2))]].
addAnnotation: aString at: pt
| annot |
annot := StringMorph
contents: aString
font: VIEW defaultFont
emphasis: 3.
annot
color: Color gray;
borderColor: Color lightGray;
width: GRID x;
position: pt.
VIEW addMorphBack: annot.
Class: BB9ResourceDisplayCtx
BB1Context subclass: #BB9ResourceDisplayCtx
instanceVariableNames: 'view'
category: 'BB9Planning-UI-Context'
" Display the resource utilization diagram. "
instanceMethods: system operations
refresh: aResurceView
view := aResurceView.
self triggerInteractionFrom: #VIEW with: #refresh.
instanceMethods: role binding
GRID
^BB9ActivitySymbol extent
MAXREQIREMENT
^view model resource maxRequirement
PROJECTFINISH
^view model projectFinish
PROJECTSTART
^view model projectStart
RESOURCE
^view model resource
VIEW
^view
projection: BB9ResourceDisplayCtx-Interaction
roleMethods: VIEW
refresh
| bodyBox bottomMarginBox leftMarginBox |
bodyBox := GRID x@10
extent:
((PROJECTFINISH - PROJECTSTART + 1) * GRID x)
@ (GRID y * MAXREQIREMENT).
leftMarginBox := 0@10 corner: bodyBox left @ bodyBox bottom.
bottomMarginBox := bodyBox left @ bodyBox bottom corner: bodyBox right @ (bodyBox bottom + GRID y).
VIEW removeAllMorphs.
VIEW addLinesIn: bodyBox.
VIEW addBottomAnnotationsIn: bottomMarginBox.
VIEW addLeftAnnotationsIn: leftMarginBox.
VIEW addActivitySymbolsIn: bodyBox.
VIEW selectionChanged.
addLinesIn: bodyBox
| x y |
" Vertical lines. "
PROJECTSTART to: PROJECTFINISH + 1 do:
[:week |
x := (week - PROJECTSTART) * GRID x + bodyBox left.
VIEW addLineFrom: x @ bodyBox top to: x @ bodyBox bottom].
" Horizontal lines. "
1 to: MAXREQIREMENT + 1 do:
[:indx |
y := bodyBox top + (GRID y * (indx-1)).
VIEW addLineFrom: bodyBox left @ y to: bodyBox right @ y].
addBottomAnnotationsIn: bottomMargin
| x |
PROJECTSTART to: PROJECTFINISH do:
[:week |
x := bottomMargin left + ((week - PROJECTSTART) * GRID x).
VIEW
addAnnotation: week printString
at: (x + (GRID x // 2) - 10) @ (bottomMargin top)].
addLeftAnnotationsIn: leftMarginBox
| x y names key |
x := leftMarginBox left + 5.
names := #(Joe Ava Max Mia Kai Zoe Jay Eve Zac Lex Ali Kim Rob Ben Ola Per Jan ).
1 to: MAXREQIREMENT do:
[:indx |
y := leftMarginBox top + (GRID y * (MAXREQIREMENT - indx)).
key := indx > names size
ifTrue: [indx asString] ifFalse: [names at: indx].
VIEW
addAnnotation: key
at: x @ y].
"#(Joe Ava Max Mia Kai Zoe Jay Eve Zac Lex Ali Kim Rob Ben Ola Per Jan ) size Nothing more expected ->17
asSortedCollection
#(Ali Ava Ben Eve Jay Joe Kai Kim Lex Max Mia Rob Zac Zoe)
size 14
need 17 "
addActivitySymbolsIn: bodyBox
| x0 y0 currActSymb |
PROJECTSTART to: PROJECTFINISH do:
[:week |
x0 := bodyBox left + ((week - PROJECTSTART) * GRID x).
y0 := bodyBox bottom - GRID y.
(RESOURCE allocationsAt: week) do:
[:activity |
currActSymb := VIEW addActivitySymbolFor: activity hasName: true color: Color pp1. "lightGreen."
currActSymb bounds: (x0 @ y0 extent: GRID).
y0 := y0 - GRID y]].
addAnnotation: aString at: pt
| annot |
(annot := StringMorph contents: aString font: VIEW defaultFont)
color: Color gray;
position: pt.
VIEW addMorphBack: annot.
projection: UI-Data-classes
Class: BB9ActivitySymbol
RectangleMorph subclass: #BB9ActivitySymbol
instanceVariableNames: 'activity ownerView hasName nameMorph'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
self
hResizing: #rigid; vResizing: #rigid;
layoutPolicy: TableLayout new;
extent: self class extent;
shadowOffset: 5@5;
shadowColor: Color pp1 "green";
color: Color pp1 "green".
hasName := false.
nameMorph ifNotNil: [nameMorph delete].
nameMorph := nil.
activity: anActivity view: view hasName: bool
activity := anActivity.
ownerView := view.
(hasName := bool) ifTrue: [self refreshName].
activity addDependent: self.
refreshName
(hasName == true & nameMorph isNil)
ifTrue:
[nameMorph := TextMorph new
autoFit: true;
hResizing: #spaceFill;
vResizing: #spaceFill;
contents: '';
beAllFont: self class defaultFont;
wrapFlag: false;
centered;
margins: 4@0;
updateFromParagraph;
lock.
self addMorphBack: nameMorph].
nameMorph newContents: activity name asString asText allBold.
self invalidRect: self bounds.
remove
self model removeActivity: self activity; endTransaction.
self delete.
instanceMethods: attributes-read
activity
^activity
attachPointFrom: aPoint
" Answer a point on my bounds suitable as an arrow end point. "
^self bounds intersectionWithLineSegmentFromCenterTo: aPoint
balloonText
^ ('name: ' , activity name
, '\early start: ' , activity earlyStart printString , ' end: ' , activity earlyFinish printString
, '\late start: ' , activity lateStart printString , ' end: ' , activity lateFinish printString
, '\planned start: ' , activity plannedStart printString , ' end: ' , activity plannedFinish printString
, '\duation: ' , activity duration printString , ' bods: ' , activity resourceRequirement printString
) withCRs
model
^ownerView model
instanceMethods: attributes-write
textColor: aColor
nameMorph ifNotNil: [nameMorph textColor: aColor].
instanceMethods: operations
addDependency
self controller selectActivitySymbol: self.
BB9AddDependencyCtx new newDependencyIn: ownerView from: self.
self model endTransaction.
startDrag: evt
| dependencyLines point w |
ownerView ifNil: [^self].
dependencyLines := ownerView dependencyLines select: [:line | line fromActivitySymbol = self or: [line toActivitySymbol = self]].
point := self position.
self isSelected ifFalse: [self controller selectActivitySymbol: self].
[Sensor redButtonPressed]
whileTrue:
[point := (self globalPointToLocal: Sensor cursorPoint) - (self extent // 2).
self position: point.
dependencyLines do: [:line | line refresh].
(w := self world) ifNotNil: [w doOneCycle]].
self model
activityPositionFor: self activity put: self position;
endTransaction.
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '[' , activity name , ']'.
instanceMethods: operations-selection
click: evt
| ctr |
(ctr := self controller)
ifNil: [^self]
ifNotNil: [ctr activitySymbolClicked: self].
evt wasHandled: true.
selectionChanged
self
borderColor: self borderColor;
borderWidth: self borderWidth.
instanceMethods: private
borderColor
^self isSelected
ifTrue: [Color red]
ifFalse: [Color gray]
borderWidth
^self isSelected
ifTrue: [2]
ifFalse: [1]
color
^self isSelected
ifTrue: [Color lightMagenta]
ifFalse: [Color white]
controller
^ ownerView controller
isSelected
| ctr |
^(ctr := self controller) ifNotNil: [self controller selectedActivity == activity] ifNil: [false]
instanceMethods: I/O
handlesMouseDown: evt
^true
mouseDown: evt
(owner == self controller dependencyView and: [evt yellowButtonPressed])
ifTrue: [^self yellowButtonActivity: evt].
(evt redButtonPressed and: [self bounds containsPoint: evt cursorPoint])
ifTrue:
[evt hand
waitForClicksOrDrag: self
event: evt
selectors: #( #click: nil nil #startDrag:)
threshold: 10].
yellowButtonActivity: shiftKeyState
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
aMenu addTitle: 'ActivityMenu'.
aMenu addList:
#(
('add dependency' #addDependency 'Add a dependency from this activity to another.')
-
('remove activity' #remove 'Remove this activity from the system.')
).
aMenu popUpInWorld.
classMethods: constants
defaultFont
^ ((TextStyle named: 'BitstreamVeraSans') addNewFontSize: 10) emphasis: 1 " was 13pt "
extent
^70@20
Class: BB9ActivityTextView
BB9View subclass: #BB9ActivityTextView
instanceVariableNames: 'textMorph'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
self
layoutPolicy: ProportionalLayout new;
borderWidth: 2.
self color: Color pp1light. "Color paleGreen."
self addMorph: self buildTextMorph fullFrame: (LayoutFrame fractions: (0@0 corner: 1@1)).
textMorph
font: ((TextStyle named: 'BitstreamVeraSans') fontAt: 4);
beSticky;
color: Color transparent;borderWidth: 1;
update: #blurbText;
setProperty: #noVScrollBarPlease toValue: true;
setProperty: #vScrollBarAlways toValue: false;
wantsDropFiles: false.
instanceMethods: operations
activityText: txt notifying: editor
(Compiler evaluate: txt for: self notifying: editor logged: false)
ifNotNil: [textMorph hasUnacceptedEdits: false].
self model endTransaction.
^ true
selectionChanged
textMorph update: #activityText.
instanceMethods: private
activityText
| strm act |
(controller isNil or: [controller selectedActivity isNil]) ifTrue: [^ 'No activity selected' asText allBold].
strm := TextStream on: Text new.
act := controller selectedActivity.
strm
nextPutAll: 'controller selectedActivity' asText;
cr; tab; nextPutAll: 'name: ' , act name printString;
cr; tab; nextPutAll: 'duration: ' , act duration printString;
cr; tab; nextPutAll: 'bods: ' , act resourceRequirement printString.
^strm contents
buildTextMorph
textMorph := BB1PluggableTextMorph
on: self
text: #activityText
accept: #activityText:notifying:
readSelection: nil
menu: #activityTextMenu: .
^textMorph
instanceMethods: I/O
activityTextMenu: aMenu
^ParagraphEditor yellowButtonMenu
handlesMouseDown: evt
^false
Class: BB9BlurbView
BB9View subclass: #BB9BlurbView
instanceVariableNames: 'textMorph'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
self
layoutPolicy: ProportionalLayout new;
borderWidth: 2.
self buildTextMorph.
self color: Color pp1light. "paleGreen."
self addMorph: textMorph fullFrame: (LayoutFrame fractions: (0@0 corner: 1@1)).
textMorph
font: ((TextStyle named: 'BitstreamVeraSans') fontAt: 4);
beSticky;
color: Color transparent;borderWidth: 1;
update: #blurbText;
setProperty: #noVScrollBarPlease toValue: true;
setProperty: #vScrollBarAlways toValue: false;
wantsDropFiles: false.
instanceMethods: operations-selection
selectionChanged
textMorph update: #blurbText.
instanceMethods: private
blurbText
| time directoryEntry |
directoryEntry := ((FileDirectory default entries select: [:ent | ent name includesSubString: '.changes'])
asSortedCollection: [:x :y | x modificationTime < y modificationTime]) last.
time := Time dateAndTimeFromSeconds: directoryEntry modificationTime.
"---"
^ 'Prokon' asText allBold
, '\A planning system.' withCRs asText allItalics
, ('\Program file: \ ' , (directoryEntry name copyReplaceAll: '.changes' with: '' )) withCRs asText allItalics allBlue
, ('\last modified \ ' , time first yyyymmdd ", ' at: ' , time last hhmm24") withCRs asText allItalics allBlue.
buildTextMorph
textMorph := BB1PluggableTextMorph
on: self
text: #blurbText
accept: nil
readSelection: nil
menu: nil.
textMorph lock.
^textMorph
Class: BB9Controller
SystemWindow subclass: #BB9Controller
instanceVariableNames: 'mvcModel blurbView selectedActivitySymbol dependencyView ganttView resourceView activityTextView'
category: 'BB9Planning-UI-Data'
" MVC Controller sets up and coordinates the Views. "
instanceMethods: initialize-release
initialize
super initialize.
self setLabel: 'BB9'.
self color: Color pp1light. "paleGreen lighter."
self setWindowColor: Color pp1light. "paleGreen lighter."
selectedActivitySymbol := nil.
self
layoutInset: 1;
borderWidth: 3;
borderColor: Color black.
openOn: aModel
mvcModel := aModel.
self setLabel: 'BB9-' , mvcModel name.
mvcModel addDependent: self.
self addPanes.
self openInWorld: self currentWorld.
self update: #Model.
delete
mvcModel removeDependent: self.
blurbView delete.
selectedActivitySymbol ifNotNil: [selectedActivitySymbol delete].
dependencyView delete.
ganttView delete.
resourceView delete.
activityTextView delete.
super delete.
openOn: aModel title: title
mvcModel := aModel.
self setLabel: title , ' (BB9)'.
mvcModel addDependent: self.
self addPanes.
self openInWorld: self currentWorld.
self update: #Model.
instanceMethods: attributes-read
dependencyView
^dependencyView
model
^mvcModel
instanceMethods: operations
runProgram
mvcModel recomputeModel; endTransaction.
endTransaction
mvcModel endTransaction.
specifyProjectStart
| startString projectStart start |
(start := mvcModel projectStart) ifNil: [start := 0].
(startString := FillInTheBlank request: 'Please type the required start week. ' initialAnswer: start printString)
isEmpty ifTrue: [^nil].
projectStart := startString asInteger.
mvcModel projectStart: projectStart; endTransaction.
specifyProjectFinish
| projectFinish fin finString |
(fin := mvcModel projectFinish) ifNil: [fin := 0].
(finString := FillInTheBlank request: 'Please type the required completion week. ' initialAnswer: fin printString)
isEmpty ifTrue: [^nil].
projectFinish := finString asInteger.
mvcModel projectFinish: projectFinish; endTransaction.
readModel
mvcModel readModel; endTransaction.
self selectActivitySymbol: nil.
saveModel
mvcModel endTransaction; saveModel.
resetModel
mvcModel resetModel.
self selectActivitySymbol: nil; endTransaction.
update: aSymbol
aSymbol = #Model
ifTrue:
[BB9DependencyDisplayCtx new refreshDependencyView: dependencyView.
BB9GanttDisplayCtx new refresh: ganttView.
BB9ResourceDisplayCtx new refresh: resourceView.
activityTextView selectionChanged.
blurbView selectionChanged].
instanceMethods: operations-selection
activitySymbolClicked: actSym
self selectActivitySymbol: (actSym activity == self selectedActivity ifTrue: [nil] ifFalse: [actSym]).
selectActivitySymbol: actSym
| w |
selectedActivitySymbol := actSym.
dependencyView selectionChanged.
ganttView selectionChanged.
resourceView selectionChanged.
activityTextView selectionChanged.
blurbView selectionChanged.
(w := self world) ifNotNil: [w doOneCycle].
selectedActivity
^ selectedActivitySymbol ifNotNil: [selectedActivitySymbol activity] ifNil: [nil]
instanceMethods: compensating overrides
addMorph: aMorph fullFrame: aLayoutFrame
" Library class changes some the attributes of the added morph. "
| mCol mWidz result bCol |
mCol := aMorph color.
mWidz := aMorph borderWidth.
bCol := aMorph borderColor.
result := super addMorph: aMorph fullFrame: aLayoutFrame.
aMorph color: mCol.
aMorph borderWidth: mWidz.
aMorph borderColor: bCol.
^result
instanceMethods: private
addPanes
self addMorph: self buildBlurbView
fullFrame: (LayoutFrame fractions: (0@0 corner: 0@0) offsets: (0@0 corner: 180@150)).
self addMorph: self buildActivityTextView
fullFrame: (LayoutFrame fractions: (0@0 corner: 0@1) offsets: (0@150 corner: 180@0)).
self addMorph: self buildDependencyView
fullFrame: (LayoutFrame fractions: (0@0 corner: 1@0.33) offsets: (180@0 corner: 0@0)).
" Margin changed from 250 to 180 "
self addMorph: self buildGanttView
fullFrame: (LayoutFrame fractions: (0@0.33 corner: 1@0.66) offsets: (180@0 corner: 0@0)).
self addMorph: self buildResourceView
fullFrame: (LayoutFrame fractions: (0@0.66 corner: 1@1) offsets: (180@0 corner: 0@0)).
self addPaneSplitters.
self changed: #blurbText.
self changed: #activityText.
buildBlurbView
^blurbView := BB9BlurbView new controller: self.
buildActivityTextView
^activityTextView := BB9ActivityTextView new controller: self.
buildDependencyView
dependencyView := BB9DependencyView new controller: self.
dependencyView extent: BB9Controller defaultExtent.
^dependencyView inAScrollPane alwaysShowScrollBars: true.
buildGanttView
ganttView := BB9View new controller: self.
ganttView extent: BB9Controller defaultExtent.
^ ganttView inAScrollPane alwaysShowScrollBars: true.
buildResourceView
resourceView := BB9View new controller: self.
resourceView extent: BB9Controller defaultExtent.
^resourceView inAScrollPane alwaysShowScrollBars: false
classMethods: constants
defaultExtent
^BB9ActivitySymbol extent * 50
Class: BB9DependencyLine
PolygonMorph subclass: #BB9DependencyLine
instanceVariableNames: 'dependency ownerView fromActivitySymbol toActivitySymbol'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
closed := false.
smoothCurve := false.
self
color: Color black;
borderColor: Color black;
makeForwardArrow;
sticky: true;
arrowSpec: 4@2;
borderWidth: 3.
dependency: dep view: view fromActivitySymbol: from toActivitySymbol: to
dependency := dep.
ownerView := view.
fromActivitySymbol := from.
toActivitySymbol := to.
dep fromActivity: fromActivitySymbol activity toActivity: toActivitySymbol activity.
self refresh.
remove
self delete.
ownerView model removeDependency: dependency.
ownerView model endTransaction.
instanceMethods: attributes-read
dependency
^dependency
fromActivity
^ fromActivitySymbol activity
fromActivitySymbol
^ fromActivitySymbol
toActivity
^ toActivitySymbol activity
toActivitySymbol
^ toActivitySymbol
instanceMethods: attributes-write
toActivitySymbol: symb
toActivitySymbol := symb.
dependency toActivity: toActivitySymbol activity.
instanceMethods: operations
refresh
(fromActivitySymbol notNil and: [toActivitySymbol notNil])
ifTrue:
[self setVertices:
(Array
with: (fromActivitySymbol attachPointFrom: toActivitySymbol center) rounded
with: (toActivitySymbol attachPointFrom: fromActivitySymbol center) rounded)].
printOn: strm
super printOn: strm.
strm nextPutAll: ' (' , fromActivitySymbol activity printString , '->' , toActivitySymbol activity printString ,')'.
instanceMethods: I/O
handlesMouseDown: evt
^true
mouseDown: evt
| m |
"evt shiftPressed ifTrue: [^super mouseDown: evt]." " User set break points. "
" To be done: Store break points in MVCmodel. "
(evt yellowButtonPressed and: [self bounds containsPoint: evt cursorPoint])
ifTrue:
[(m := MenuMorph new defaultTarget: self)
addTitle: 'Dependency Menu';
add: 'remove dependency' action: #remove.
"m add: 'straighten' action: #straighten."
^m popUpInWorld].
Class: BB9DependencyView
BB9View subclass: #BB9DependencyView
instanceVariableNames: 'dependencyLines'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
dependencyLines := OrderedCollection new.
instanceMethods: attributes-read
dependencyLines
^dependencyLines
instanceMethods: attributes-write
addDependencyLine: depLin
self addMorphFront: depLin.
dependencyLines add: depLin.
removeAllMorphs
dependencyLines ifNotNil: [dependencyLines copy do: [:sym | sym delete]].
dependencyLines := OrderedCollection new.
super removeAllMorphs.
self changed.
instanceMethods: operations
addActivity
BB9AddActivityCtx new addActivityIn: self model.
self model endTransaction.
instanceMethods: I/O
yellowButtonActivity: shiftKeyState
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
aMenu addTitle: 'Dependencies Menu'.
aMenu addList: #(
('add activity' #addActivity 'Add a new activity in this plan')
).
aMenu popUpInWorld.
Class: BB9View
PasteUpMorph subclass: #BB9View
instanceVariableNames: 'controller activitySymbols'
category: 'BB9Planning-UI-Data'
instanceMethods: initialize-release
initialize
super initialize.
self
color: Color pp1light; "Color paleGreen;"
borderColor: Color black;
borderWidth: 2.
activitySymbols := OrderedCollection new.
controller: ctr
controller := ctr.
delete
super delete.
self removeAllMorphs.
instanceMethods: attributes-read
controller
^controller
defaultFont
^ ((TextStyle named: 'BitstreamVeraSans') fontAt: 3) emphasis: 3
activitySymbols
^activitySymbols
model
^controller model
instanceMethods: attributes-write
removeAllMorphs
activitySymbols ifNotNil: [activitySymbols copy do: [:sym | sym delete]].
activitySymbols := OrderedCollection new.
super removeAllMorphs.
self changed.
instanceMethods: operations
addActivitySymbolFor: act hasName: bool color: aColor
| actSymb |
actSymb := BB9ActivitySymbol new activity: act view: self hasName: bool.
actSymb color: aColor.
activitySymbols add: actSymb.
self addMorphBack: actSymb.
^actSymb
addLineFrom: pt1 to: pt2
| line |
(line := PolygonMorph vertices: {pt1. pt2.} color: Color black borderWidth: 2 borderColor: Color black)
makeOpen;
sticky: true;
color: Color gray;
borderColor: Color lightGray.
self addMorphFront: line.
instanceMethods: operations-selection
selectionChanged.
activitySymbols do: [:symb | symb selectionChanged].
instanceMethods: I/O
handlesMouseDown: evt
^true
yellowButtonActivity: shiftKeyState
| aMenu |
aMenu := MenuMorph new defaultTarget: self controller.
aMenu addTitle: 'Main Menu'.
aMenu addList: #(
('run all system operations' #runProgram 'Run application on current database.')
-
('specifyProjectStart' #specifyProjectStart 'Specify project start week.')
('specifyProjectFinish' #specifyProjectFinish 'Specify when project must be finished')
-
('read Model from file' #readModel 'Select model version and read it.')
('save Model to file' #saveModel 'Save current model to new file.')
('reset model' #resetModel 'Install new, empty Model.')
).
aMenu popUpInWorld.