DCIprogram: #Plan

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.

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

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 , ')'.

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]].
        ].

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.

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

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.