Widget to display and edit tasks: TaskBoard.oz

### Widget to display and edit tasks: `TaskBoard.oz`

Source File

>     functor

>     import
>        Tk

>        Configure(maxJobs: MaxJobs
>                  maxSpan: MaxSpan

>                  durUnit:     DurUnit
>                  durFrame:    DurFrame
>                  jobDistance: JobDistance

>                  type:      Courier
>                  resColors: ResColors)

>     export
>        'class': TaskBoard

>     prepare

>        fun {GetTaskName J T}
>           {VirtualString.toAtom j#J#t#T}
>        end

>        fun {GetResourceName R}
>           {VirtualString.toAtom r#R}
>        end

>        proc {TaskNameTo TN ?J ?T}
>           S = {Atom.toString TN}.2
>        in
>           J = {String.toInt {List.takeWhile S Char.isDigit}}
>           T = {String.toInt {List.dropWhile S Char.isDigit}.2}
>        end

>     define

>        OffX = 20
>        OffY = JobDistance

>        class Task
>           from Tk.canvasTag
>           attr
>              X0:0 Y0:0 X1:0
>              Duration: 0
>              Resource: unit
>              EditMode: true

>           meth init(parent:P resource:R duration:D x:X y:Y)
>              Task, tkInit(parent:P)
>              X0       <- X
>              Y0       <- Y
>              Duration <- D
>              Resource <- R
>              {P tk(create rectangle
>                    X                         Y - DurUnit div 2
>                    X + D*DurUnit - DurFrame  Y + DurUnit div 2
>                    fill:ResColors.R tags:self)}
>              Task, tkBind(event:  '<1>'
>                           args:   [int(y)]
>                           action: P # action(self))
>           end

>           meth setDuration(D)
>              Duration <- D
>              Task, tk(coords
>                       @X0                      @Y0 - DurUnit div 2
>                       @X0 + D*DurUnit-DurFrame @Y0 + DurUnit div 2)
>           end

>           meth getDuration($)
>              @Duration
>           end

>           meth setResource(R)
>              Resource <- R
>              Task, tk(itemconfigure fill:ResColors.R)
>           end

>           meth getResource($)
>              @Resource
>           end

>           meth move(ByX)
>              X0 <- @X0 + ByX
>              Task,tk(move ByX 0)
>           end

>           meth setSol(S)
>              X = S * DurUnit
>           in
>              if @EditMode then Task,tk(move X-@X0 0)
>              else Task,tk(move X-@X1 0)
>              end
>              EditMode <- false
>              X1       <- X
>           end

>           meth setEdit
>              if @EditMode then skip else
>                 EditMode <- true
>                 Task,tk(move @X0-@X1 0)
>              end
>           end

>        end

>        class Job
>           feat
>              Number
>              Parent
>           attr
>              Tasks:  nil
>              NextX:  0

>           meth init(parent:P number:N)
>              self.Parent = P
>              self.Number = N
>              Tasks <- nil
>              NextX <- 0
>           end

>           meth newTask(resource:R duration:D)
>              Tasks <- {Append @Tasks
>                        [{New Task
>                          init(parent:   self.Parent
>                               resource: R
>                               duration: D
>                               x:        @NextX
>                               y:        (self.Number - 1) * JobDistance)}]}
>              NextX <- @NextX + DurUnit * D
>           end

>           meth DelTask(Ts D $)
>              case Ts of nil then nil
>              [] T|Tr then
>                 if T==D then
>                    {ForAll Tr
>                     proc {$ T}
>                        {T move(~{D getDuration($)} * DurUnit)}
>                     end} Tr
>                 else T|Job,DelTask(Tr D $)
>                 end
>              end
>           end

>           meth deleteTask(D)
>              {D tk(delete)}
>              NextX <- @NextX - {D getDuration($)} * DurUnit
>              Tasks <- Job,DelTask(@Tasks D $)
>           end

>           meth SetDur(Ts S D)
>              case Ts of nil then skip
>              [] T|Tr then
>                 if T==S then
>                    {ForAll Tr
>                     proc {$ T}
>                        {T move((D-{S getDuration($)}) * DurUnit)}
>                     end}
>                 else Job,SetDur(Tr S D)
>                 end
>              end
>           end

>           meth setDuration(T D)
>              NextX <- @NextX + (D - {T getDuration($)}) * DurUnit
>              Job,SetDur(@Tasks T D)
>              {T setDuration(D)}
>           end

>           meth setSol(S)
>              {Record.forAllInd S
>               proc {$ A S}
>                  if A\=pa andthen A\=pe then J T in
>                     {TaskNameTo A ?J ?T}
>                     if self.Number==J then {{Nth @Tasks T} setSol(S)} end
>                  end
>               end}
>           end

>           meth setEdit
>              {ForAll @Tasks proc {$ T} {T setEdit} end}
>           end

>           meth getLastSpec($)
>              case @Tasks of nil then nil else
>                 [{GetTaskName self.Number {Length @Tasks}}]
>              end
>           end

>           meth getSpec($)
>              {List.mapInd @Tasks
>               fun {$ I T}
>                  Task={GetTaskName self.Number I}
>                  Dur ={T getDuration($)}
>                  Res ={GetResourceName {T getResource($)}}
>                  Pre = if I==1 then [pa]
>                        else [{GetTaskName self.Number I-1}]
>                        end
>               in
>                  Task(dur:Dur pre:Pre res:Res)
>               end}
>           end

>        end

>        class TaskBoard
>           from Tk.canvas
>           feat
>              Jobs Tools BackTag
>           attr
>              EditMode: true

>           meth tkInit(parent:P tools:T spec:Spec)
>              self.Jobs       = {NewArray 1 MaxJobs 1}
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  {Put self.Jobs J {New Job init(number:J parent:self)}}
>               end}
>              self.Tools      = T
>              Tk.canvas, tkInit(parent:       P
>                                bg:           ivory
>                                width:  400
>                                height: 220
>                                bd:2 relief:sunken
>                                scrollregion: q(~OffX
>                                                ~OffY
>                                                MaxSpan * DurUnit
>                                                MaxJobs * JobDistance)
>                                xscrollincrement: 1
>                                yscrollincrement: 1)
>              TaskBoard, tk(xview scroll ~OffX-6 units)
>              TaskBoard, tk(yview scroll ~OffY units)
>              self.BackTag = {New Tk.canvasTag tkInit(parent:self)}
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  Y = (MaxJobs - J) * JobDistance
>               in
>                  {self tk(create text ~5 Y font:Courier
>                           text:  if J==1 then 10 else 0#(MaxJobs - J + 1) end
>                           anchor:e)}
>               end}
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  Y  = (MaxJobs - J) * JobDistance
>                  Y0 = Y - JobDistance div 2 + 1
>                  Y1 = Y + JobDistance div 2 - 1
>               in
>                  {self tk(create rectangle 0 Y0 MaxSpan*DurUnit Y1
>                           fill:ivory outline:'' tags:self.BackTag)}
>               end}
>              {For 1 MaxJobs+1 1
>               proc {$ J}
>                  Y = (MaxJobs - J) * JobDistance + JobDistance div 2
>               in
>                  {self tk(create line 0 Y MaxSpan*DurUnit Y
>                           fill:gray50)}
>               end}
>              {self.BackTag tkBind(event:  '<1>'
>                                   args:   [int(y)]
>                                   action: self # action(unit))}
>              {List.forAllInd Spec
>               proc {$ JN Ts}
>                  J={Get self.Jobs JN}
>               in
>                  {ForAll Ts proc {$ D#R}
>                                {J newTask(resource:R duration:D)}
>                             end}
>               end}
>           end

>           meth action(T SY)
>              if @EditMode then
>                 Y = SY - OffY
>                 J = {Get self.Jobs
>                      {Min {Max 1 (Y + JobDistance div 2 ) div JobDistance + 1}
>                       MaxJobs}}
>              in
>                 case {self.Tools getTool($)}
>                 of create(R D) then
>                    {J newTask(resource:R duration:D)}
>                 [] delete      then
>                    if T\=unit then {J deleteTask(T)} end
>                 [] resource(GR) then
>                    if T\=unit then {T setResource({GR})} end
>                 [] duration(GD) then
>                    if T\=unit then {J setDuration(T {GD})} end
>                 end
>              end
>           end

>           meth getSpec($)
>              pa(dur:0) |
>              pe(dur:0 pre:{ForThread 1 MaxJobs 1
>                            fun {$ Js J}
>                               {Append {{Get self.Jobs J}
>                                        getLastSpec($)}
>                                Js}
>                            end nil}) |
>              {ForThread 1 MaxJobs 1
>               fun {$ Ss J}
>                  {Append {{Get self.Jobs J} getSpec($)} Ss}
>               end nil}
>           end

>           meth setEdit
>              EditMode <- true
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  {{Get self.Jobs J} setEdit}
>               end}
>           end

>           meth setSol(Sol)
>              EditMode <- false
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  {{Get self.Jobs J} setSol(Sol)}
>               end}
>           end
>           meth displaySol(Sol)
>              {For 1 MaxJobs 1
>               proc {$ J}
>                  {{Get self.Jobs J} setSol(Sol)}
>               end}
>           end

>        end

>     end