DCIprogram: #Plan

Context subclass: #FrontloadCtx
    instanceVariableNames: 'data'
    category: 'Plan-Context'

" This Context selects an activity that is ready for forntload planning and lets it play the ACTIVITY role in the Interaction.
It also computes its prdecessors, thus supporting the simple frontloader algorithm.

Instance variables:
    none.

See Controller>Controller for more information. "

instanceMethods: operations

data: model frontloadNetworkFrom: projectStartWeek
    data := model.
    self triggerInteractionFrom: #MODEL with: #frontloadFrom: andArgs: {projectStartWeek}.

instanceMethods: role binding

ACTIVITY
    ^data allActivities
        detect:
            [:act |
            act earlyStart isNil
            and:
                [(data predecessorsOf: act) noneSatisfy: [:pred | pred earlyFinish isNil]]]
        ifNone: [nil]

ALLACTIVITIES
    ^data allActivities

CONTEXT
    ^self

MODEL
    ^data

PREDECESSORS
    ^data predecessorsOf: (self at: #ACTIVITY)

remap
    | messName |
    roleMap := self newRoleMap.
    " Must do ACTIVITY first because PREDECESSORS depend on it. "
    #(#ACTIVITY) , (self class roleNames copyWithout: #ACTIVITY) asArray
    do:
        [:rNam |
        messName := rNam asString asSymbol.
        roleMap at: messName put: (self perform: messName ifNotUnderstood: [nil])].

instanceMethods: role methods

frontloadFrom: projectStartWeek
    ALLACTIVITIES do: [:act | act resetForFrontload].
    [CONTEXT remap. ACTIVITY notNil]
    whileTrue:
        [ACTIVITY frontloadFrom: projectStartWeek].

instanceMethods: role methods

frontloadFrom: projectStartWeek
    | maxPred |
    self earlyStart: projectStartWeek.
    maxPred := PREDECESSORS detectMax: [:pred | pred earlyFinish].
    maxPred ifNotNil: [self earlyStart: maxPred earlyFinish + 1].

Context subclass: #DependencyCtx
    instanceVariableNames: 'data view rankedActivities activityRanks'
    category: 'Plan-Context'

" This Context computes a number of values that support drawing the dependency diagram.
Let the cursor hover over the roles in the Interaction diagram to see how these values are computed.

The corresponding Interaction actually draws the diagram.
The presentation is simply based on rank where the rank of an activity is the max length of its predecessor chain.

Instance variables:
    view (DependencyView) The roles are computed for this view.
    rankedActivities (OrderedCollection rank -> activityCollection) The activities at each rank.
    activityRanks (Dictionary activity -> rank )

See Controller>Controller for more information. "

instanceMethods: operations

instanceMethods: role methods

run
    VIEW addActivityViews.
    VIEW addLines.

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: RANKEDACTIVITYLIST size do:
        [:rank |
        xPos := x0 + (gridX * (rank-1)).
        yPos := y0.
        (RANKEDACTIVITYLIST at: rank) do:
            [:act |
                actView := self addActivityViewFor: act.
                actView bounds: ((xPos @ yPos) extent: actViewExtent).
                yPos := yPos + gridY.
            ] ].

addLines
    | fromView toView pt1 pt2 |
    DEPENDENCIES 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.
        ].

Context subclass: #GanttCtx
    instanceVariableNames: 'data view'
    category: 'Plan-Context'

" This Context computes a number of values that support drawing the dependency diagram.
Let the cursor hover over the roles in the Interaction diagram to see how these values are computed.

The corresponding Interaction actually draws the diagram.
The presentation is simply based on rank where the rank of an activity is the max length of its predecessor chain.

Instance variables:
    view (GanttView) The roles are computed for this view.

See Controller>Controller for more information. "

instanceMethods: operations

instanceMethods: role methods

displayGantt
    VIEW addActivityViews.
    VIEW addLines.

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

SystemWindow subclass: #Controller
    instanceVariableNames: 'dependencyView ganttView selectedActivity gofCollab'
    category: 'Plan-Controller'

" This example is a DCI implementation of the Plan example.

The point of this example is to illustrate how the code for a system operation (use case) is separated according to DCI.

This class is the C (controller) part of the 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 the 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: [self resetDemo].
    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].
    FrontloadCtx new data: model frontloadNetworkFrom: 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)
        addTitle: self printString;
        add: 'build demo network' action: #buildDemoNetwork;
        add: 'frontload from week 1' action: #frontloadDemo;
        add: 'reset demo' action: #resetDemo.
    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>BB4aController for more information.

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
    super 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
        ifNil: [nil]
        ifNotNil: [earlyStart + duration - 1]

earlyStart
    ^earlyStart

name
    ^name

resetForFrontload
    earlyStart := nil.

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>BB4aController for more information.

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'
    category: 'Plan-Data'

" The Model part of MVC. Represents an activity network.

See Controller>Controller for more information.

Instance variables:
    activities (Set of Activity)
    dependencies (Set of Dependency)
    
Note: There is no activityRanks instance variable here. It is in DependencyCtx, keeping the Model itself clean from system behavior details. "

instanceMethods: initialize-release

RectangleMorph subclass: #ActivityView
    instanceVariableNames: 'model 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 information. "

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
    ^controller isSelected: activity

instanceMethods: operations

changed
    super changed.
    model ifNotNil: [model changed].

update: aParameter
    aParameter = #selection
    ifTrue:
        [self borderWidth: self borderWidth.
        self color: self color.
        self borderColor: self borderColor.
    "    self invalidRect: self bounds."
        
        
"    self traceRM: {activity name. self borderColor.}."
    
    ].

printOn: strm
    super printOn: strm.
    strm nextPutAll: ' (' , nameMorph text asString , ')'.

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

The main difference from the plain BB4a solution is that we here get Model data presented through a Context (DependencyCtx) that transforms Model data to a form that is ideal for drawing this View.

See Controller>Controller for more information. "

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: attributes-write

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.

instanceMethods: operations

addActivityViewFor: act
    | actView |
    actView := ActivityView new controller: controller activity: act.
    activityViews at: act put: actView.
    self addMorph: actView.
    controller addDependent: actView.
    ^actView

refresh
    self deleteContents.
    DependencyCtx new
        data: controller model
        refresh: self.

deleteContents
    activityViews values do: [:p | p delete].
    activityViews := Dictionary new.
    lines do: [:lin | lin delete].
    lines := OrderedCollection new.
    self changed.

update: aSymbol
    aSymbol = #model ifTrue: [self refresh].

instanceMethods: private

changed
    super changed.
    model ifNotNil: [model changed].

instanceMethods: I/O

handlesMouseDown: evt
    ^false

PasteUpMorph subclass: #GanttView
    instanceVariableNames: 'controller activityViews lines annotations'
    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.

The main difference from the plain BB4a solution is that we here get Model data presented through a Context (GanttCtx) that transforms Model data to a form that is ideal for drawing this View.

See Controller>Controller for more information. "

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

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.

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.

instanceMethods: operations

addActivityViewFor: act
    | actView |
    actView := ActivityView new controller: controller activity: act.
    activityViews at: act put: actView.
    self addMorph: actView.
    controller addDependent: actView.
    ^actView

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.
    self changed.

refresh
    self deleteContents.
    GanttCtx new data: controller model refresh: self.

update: aSymbol
    aSymbol = #model ifTrue: [self refresh].

instanceMethods: private

changed
    super changed.
    model ifNotNil: [model changed].