Graphical interface: Graphics.oz

### Graphical interface: `Graphics.oz`

Source File

>     functor

>     export

>        DrawSchedule

>     import

>        Common(monday:         Monday
>               tuesday:        Tuesday
>               wednesday:      Wednesday
>               thursday:       Thursday
>               friday:         Friday
>               quartersPerDay: QuartersPerDay)

>        Scheduler(timeTable:      TimeTable)

>        Tk

>     define

>        Colors    = if Tk.isColor then
>                       colors('2': lightyellow1
>                              '4': lightsalmon2
>                              '6': cyan3
>                              '8': lightgoldenrod1
>                              'M': mistyrose3
>                              'F': tomato)
>                    else
>                       colors('2': white
>                              '4': white
>                              '6': white
>                              '8': white
>                              'M': white
>                              'F': white)
>                    end

>        RoomLimit      = 10
>        HeightLecture  = 15
>        DayHeight      = (RoomLimit + 1) * HeightLecture
>        YOff           = 6
>        XOff           = 10
>        CanvasWidth    = 720
>        Roff           = 2
>        CanvasHeight   = 5 * DayHeight
>        Quarter        = 20
>        WeekDaysWidth  = 90
>        TimeLineY      = 30
>        RoomMarkOffset = ~3
>        Font           = 'lucidasanstypewriter-12'

>        proc {GetEarliest Until Ind Lecture Canvas Day NewUntil}
>           if Ind > RoomLimit then
>              fail
>           elseif Until.Ind =< Lecture.start then
>              {Canvas
>               tk(crea rectangle
>                  ((Lecture.start-1) mod 36)*Quarter+Roff
>                  (Day-1)*DayHeight+HeightLecture*(Ind-1)+TimeLineY
>                  (((Lecture.start-1) mod 36)+(Lecture.dur))*Quarter+Roff
>                  (Day-1)*DayHeight+HeightLecture*(Ind)+TimeLineY
>                  fill:Colors.{String.toAtom
>                               [{Atom.toString Lecture.name}.1]})}
>              case Lecture.size of big
>              then {Canvas tk(crea line
>                              (((Lecture.start-1) mod 36)+
>                               (Lecture.dur))*Quarter+RoomMarkOffset*2+Roff
>                              (Day-1)*DayHeight+HeightLecture*(Ind-1)+
>                              TimeLineY
>                              (((Lecture.start-1) mod 36)+
>                               (Lecture.dur))*Quarter+RoomMarkOffset*2+Roff
>                              (Day-1)*DayHeight+HeightLecture*(Ind)+
>                              TimeLineY)}
>              else skip
>              end
>              if  Lecture.size==big orelse Lecture.size==small then
>                 {Canvas tk(crea line
>                            (((Lecture.start-1) mod 36)+
>                             (Lecture.dur))*Quarter+RoomMarkOffset+Roff
>                            (Day-1)*DayHeight+HeightLecture*(Ind-1)+
>                            TimeLineY
>                            (((Lecture.start-1) mod 36)+
>                             (Lecture.dur))*Quarter+RoomMarkOffset+Roff
>                            (Day-1)*DayHeight+HeightLecture*(Ind)+
>                            TimeLineY) }
>              else skip
>              end
>              {Canvas
>               tk(crea text
>                  ((Lecture.start-1) mod 36)*Quarter+XOff+Roff
>                  (Day-1)*DayHeight+HeightLecture*(Ind-1)+YOff+TimeLineY
>                  text : Lecture.name
>                  anchor:w
>                  font:Font)}
>              NewUntil = {AdjoinAt Until Ind Lecture.start+Lecture.dur}
>                else {GetEarliest Until Ind+1 Lecture Canvas Day NewUntil}
>           end
>        end

>        proc {DoDisplay SortedLectures Day Canvas Until}
>           case SortedLectures of nil then skip
>           [] L|Lr then
>              NewUntil = {GetEarliest Until 1 L Canvas Day} in
>              {DoDisplay Lr Day Canvas NewUntil}
>           end
>        end

>        proc {DrawSchedule FlatSols Parent}
>           W
>           CanvasColor = if Tk.isColor then mediumturquoise else white end
>           Canvas WeekDays
>        in
>           {TimeTable save("CurrentOut.ozt")}

>           W = {New Tk.toplevel tkInit(parent:Parent background:CanvasColor)}
>           {Tk.send wm(title W
>                       " Katholische Hochschule fuer Soziale Arbeit -- Wintersemester 1995/96 ")}
>           Canvas = {New Tk.canvas tkInit(parent: W
>                                          width:  CanvasWidth
>                                          height: CanvasHeight)}
>           WeekDays = {New Tk.canvas tkInit(parent: W
>                                            width:  WeekDaysWidth
>                                            height: CanvasHeight)}

>           {List.forAllInd ['Monday' 'Tuesday' 'Wednesday' 'Thursday' 'Friday']
>            proc {$ Ind Day}
>               {WeekDays tk(crea text 5 Ind*DayHeight-(DayHeight div 2)+18
>                            text:Day anchor:w)}
>            end}

>           {Tk.send pack(WeekDays Canvas side:left)}

>           {For 3 QuartersPerDay 4
>            proc{$ I}
>               Text={Int.toString 8 + (I+1)div 4}
>            in
>               {Canvas tk(crea line I*Quarter 0 I*Quarter 10)}
>               {Canvas tk(crea text I*Quarter 2*10 text: Text)}
>            end}

>           {List.forAllInd [Monday Tuesday Wednesday Thursday Friday]
>            proc{$ Ind Day}
>               LecturesOnThatDay = {List.filter FlatSols
>                                    fun {$ L}
>                                       %% We know that start time is fixed!
>                                       thread
>                                          cond L.start::Day then true else false end
>                                       end
>                                    end}
>               SortedLectures = {Sort LecturesOnThatDay
>                                 fun {$ L1 L2} L1.start<L2.start end}
>               TupleUntil = {MakeTuple until RoomLimit}
>            in
>               {Record.forAll TupleUntil fun{$} 0 end}
>               {DoDisplay SortedLectures Ind Canvas TupleUntil}
>               if Ind < 5 then
>                  {Canvas tk(crea line 0 Ind*DayHeight+3*HeightLecture div 2
>                             CanvasWidth Ind*DayHeight+3*HeightLecture div 2)}
>               else skip
>               end
>            end}
>        end
>     end