<> <> DIRECTORY Buttons USING [ Button, SetDisplayStyle], BasicTime USING [ GMT, Unpacked, Unpack, DayOfWeek, MonthOfYear, Now, Update], Calendar USING [ Days, Weekdays, Months, Years, Date, ZoomLevel], CalBrowser, CalForm USING [ CreateCalForm], CalNuts USING [ ResetNutInfo], CalStorage USING [ protData, GetEventsOfDay, StoreViewer, RetrieveViewer, Mode, FindEvent], CalSupport USING [ MakeMenu, DisplayMsg, PreviousDay, NextDay, GetMonthInfo, GetMonthName, FormWidth, FormHeight, CharWidth, RowHeight, I2M, GetRowCol, CreateTextViewer, ExtractDate, M2I, GetDayName, CreateButton, ClearButton, GetIconFlavor], CalWalnut USING [ DisplayMessage], Containers USING [ Create, Container], Hickory USING [ EventList, Event, Reason, EventTuple, ForgetEvent], IO USING [ int, rope, PutFR], Labels USING [ Label, SetDisplayStyle, Create], Menus USING [ MenuProc], Rope USING [ ROPE, Concat, Length, FromChar, Substr, Equal], RopeSets USING [ RopeSet], ViewerClasses USING [ Viewer, ViewerRec], ViewerOps USING [ DestroyViewer, PaintViewer, MoveViewer, SetMenu], VTables USING [ VTable, Create, SetTableEntry, Install, NullBorder, FullBorder, Border, GetTableEntry], ViewerTools USING [ SetContents] ; CalBrowserImpl: CEDAR MONITOR LOCKS CalStorage.protData IMPORTS BasicTime, CalStorage, CalSupport, IO, Rope, ViewerOps, VTables, CalForm, Containers, Buttons, Labels, ViewerTools, Hickory, CalWalnut, CalNuts EXPORTS CalBrowser SHARES CalSupport, CalForm, CalStorage, CalWalnut, CalNuts = BEGIN OPEN Calendar, CalStorage.protData; <> RowHeight: CARDINAL _ CalSupport.RowHeight; ButtonHeight: CARDINAL _ RowHeight - 4; CharWidth: CARDINAL = CalSupport.CharWidth; FormHeight: CARDINAL _ CalSupport.FormHeight; FormWidth: CARDINAL _ CalSupport.FormWidth; Delta: CARDINAL = 10000; -- to move viewer into outer space <> EventList: TYPE = Hickory.EventList; Commands: TYPE = { Enter, Query, Edit, Forget, ShowMsg}; EventButton: TYPE = RECORD [ index: CARDINAL _ 0, ev: Hickory.Event _ NIL, button: Buttons.Button _ NIL ]; EventButtonList: TYPE = LIST OF EventButton; <> DayGrid: TYPE = RECORD [ Format: Rope.ROPE _ " %13g %-3g %-55g %-10g", TimeWidth: CARDINAL _ 13, -- must match with above rope...!! TextWidth: CARDINAL _ 55, -- units are nbr of chars PlaceWidth: CARDINAL _ 10, TimeFormat: Rope.ROPE _ "%02g:%02g  %02g:%02g", TimeFormat2: Rope.ROPE _ " %02g:%02g ", buttons: EventButtonList _ NIL ]; MonthGrid: TYPE = RECORD [ Rows: CARDINAL _ 6, Cols: CARDINAL _ 7, DayFieldWidth: CARDINAL _ 0, -- how wide is a day field in table ( pixels) DayViewers: ARRAY Days OF VTables.VTable, DateFormat: Rope.ROPE _ "%3g %02g" -- for date of day ]; YearGrid: TYPE = RECORD [ Rows: CARDINAL _ 8, -- 4 month tables and 4 title tables... Cols: CARDINAL _ 3, -- 3 months in a row MonthViewers: ARRAY Months OF VTables.VTable, SmallRows: CARDINAL _ 4 + 7*4, DateFormat: Rope.ROPE _ "%02g" -- for date of day ]; <> <<>> dayGrid: DayGrid; monthGrid: MonthGrid; yearGrid: YearGrid; zoomLevel: ZoomLevel; cont: ViewerClasses.Viewer; -- the container for the browser view selectedEvent: REF Hickory.EventTuple _ NIL; selectedButton: REF EventButton; <> FindEventButton: PROCEDURE [ list: EventButtonList, index: CARDINAL] RETURNS [ rec: EventButton] = BEGIN IF list = NIL THEN ERROR; WHILE list # NIL DO IF list.first.index = index THEN RETURN[ list.first]; list _ list.rest; ENDLOOP; END; -- FindEventButton DeleteEventButton: PROCEDURE [ list: EventButtonList, index: CARDINAL] RETURNS [ truncatedList: EventButtonList] = BEGIN <> prev, cur: EventButtonList; prev _ NIL; cur _ list; WHILE cur # NIL AND cur.first.index # index DO prev _ cur; cur _ cur.rest; ENDLOOP; IF prev = NIL THEN BEGIN list _ cur.rest; cur.rest _ NIL; END ELSE IF cur # NIL THEN BEGIN prev.rest _ cur.rest; cur.rest _ NIL; END ELSE ERROR; RETURN[ list]; END; -- DeleteEventButton CreateLabel: PROCEDURE [ title: Rope.ROPE, myParent: ViewerClasses.Viewer, hi, wi: CARDINAL, xOff, yOff: CARDINAL _ 0, displayStyle: ATOM _ $BlackOnWhite] RETURNS [ label: Labels.Label] = BEGIN <> view: ViewerClasses.ViewerRec; BEGIN OPEN view; name _ title; parent _ myParent; wx _ xOff; wy _ yOff; ww _ wi; wh _ hi; iconic _ FALSE; scrollable _ FALSE; border _ FALSE; END; -- OPEN label _ Labels.Create[ info: view, paint: FALSE]; Labels.SetDisplayStyle[ label, displayStyle, FALSE]; RETURN[ label]; END; -- CreateLabel CreateContainer: PROCEDURE [ myParent: ViewerClasses.Viewer, scroll: BOOLEAN _ FALSE] RETURNS [ cont: ViewerClasses.Viewer] = BEGIN <> view: ViewerClasses.ViewerRec; BEGIN OPEN view; ww _ FormWidth; wh _ FormHeight; scrollable _ scroll; iconic _ FALSE; border _ TRUE; parent _ myParent; -- calViewer... END; -- OPEN cont _ Containers.Create[ view, FALSE]; RETURN[ cont]; END; -- CreateContainer ResetIcon: PROCEDURE [ newMode: CalStorage.Mode, date: Date, oldZoom, newZoom: ZoomLevel] = BEGIN <> OPEN CalSupport; IF curMode # Browse THEN -- we just entered browsing mode.. calViewer.icon _ CalSupport.GetIconFlavor[ Browse, newZoom, date.Day] ELSE BEGIN -- we were in browsing mode.. IF oldZoom = newZoom AND newZoom = Day THEN calViewer.icon _ CalSupport.GetIconFlavor[ Browse, newZoom, date.Day] ELSE IF oldZoom # newZoom THEN calViewer.icon _ CalSupport.GetIconFlavor[ Browse, newZoom, date.Day] END; END; -- ResetIcon <> Enter: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN DoCmd[ Enter]; END; -- Reset ShowMsg: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN DoCmd[ ShowMsg]; END; -- Reset Edit: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN DoCmd[ Edit] END; -- Reset Forget: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN DoCmd[ Forget]; END; -- Reset Print: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN CalSupport.DisplayMsg[ "Print: Not yet implemented!"]; END; -- Print Next: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN ShowNextOrPrevious[ TRUE]; END; -- Next Previous: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> IF mouseButton = red THEN ShowNextOrPrevious[ FALSE]; END; -- Previous ZoomOut: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN < month or month -> year>> zoom: REF ZoomLevel = NARROW[ clientData]; IF mouseButton = red THEN DoZoomOut[ zoom^]; -- ISTYPE[ clientData, ZoomLevel].... END; -- ZoomOut ZoomIn: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN < day or year -> month>> IF mouseButton = yellow THEN DoZoomIn[ clientData]; -- can't NARROW here because it's either Days or Months END; -- ZoomIn SelectEvent: Menus.MenuProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE] -- = BEGIN <> index: REF CARDINAL _ NARROW[ clientData]; IF mouseButton = red THEN DoSelection[ index^]; END; -- SelectEvent <> DoSelection: ENTRY PROC [ butIndex: CARDINAL] = BEGIN <> ENABLE UNWIND => NULL; but: EventButton; but _ FindEventButton[ list: dayGrid.buttons, index: butIndex]; IF selectedButton # NIL AND Rope.Equal[ but.ev, selectedButton^.ev] THEN BEGIN <> Buttons.SetDisplayStyle[ but.button, $BlackOnWhite, TRUE]; selectedEvent _ NIL; selectedButton _ NIL; END ELSE BEGIN IF but.button # NIL THEN Buttons.SetDisplayStyle[ but.button, $BlackOnGrey, TRUE]; IF selectedButton # NIL THEN BEGIN but: EventButton _ FindEventButton[ list: dayGrid.buttons, index: selectedButton.index]; IF but.button # NIL THEN Buttons.SetDisplayStyle[ but.button, $BlackOnWhite, TRUE]; END; selectedButton _ NEW[ EventButton _ but]; selectedEvent _ CalStorage.FindEvent[ curDate, selectedButton.ev]; END; END; --DoSelection DoCmd: ENTRY PROCEDURE [ cmd: Commands] = BEGIN <> ENABLE UNWIND => NULL; SELECT cmd FROM Enter => BEGIN HideContainer[]; -- destroying day viewer, saving month & year viewers CalForm.CreateCalForm[ mode: EnterEvent, ev: NIL]; END; Edit => BEGIN IF selectedEvent = NIL THEN CalSupport.DisplayMsg[ "No event selected!"] ELSE BEGIN HideContainer[]; -- destroying day viewer, saving month & year viewers CalForm.CreateCalForm[ mode: EnterEvent, ev: selectedEvent]; END; END; Forget => BEGIN IF selectedEvent = NIL THEN CalSupport.DisplayMsg[ "No event selected!"] ELSE BEGIN Hickory.ForgetEvent[ selectedEvent^.Key, TRUE]; END END; ShowMsg => BEGIN IF selectedEvent = NIL THEN CalSupport.DisplayMsg[ "No event selected!"] ELSE BEGIN CalWalnut.DisplayMessage[ selectedEvent.Message]; CalSupport.ClearButton[ selectedButton.button]; END; END; ENDCASE; selectedEvent _ NIL; END; -- DoEnterCmd HideContainer: INTERNAL PROCEDURE = BEGIN <> IF cont # NIL AND zoomLevel # Day THEN BEGIN ViewerOps.MoveViewer[ viewer: cont, x: cont.wx+Delta, y: cont.wy+Delta, w: cont.ww, h: cont.wh, paint: FALSE]; cont _ NIL; END ELSE BEGIN ViewerOps.DestroyViewer[ viewer: cont, paint: FALSE]; dayGrid.buttons _ NIL; END; END; ShowNextOrPrevious: ENTRY PROCEDURE [ next: BOOLEAN] = BEGIN <> ENABLE UNWIND => NULL; newDate: Date _ curDate; IF next THEN BEGIN -- have to move forward in time... SELECT zoomLevel FROM Day => newDate _ CalSupport.NextDay[ newDate]; Month => IF newDate.Month = December THEN BEGIN newDate.Month _ January; newDate.Year _ SUCC[ newDate.Year] END ELSE newDate.Month _ SUCC[ newDate.Month]; Year => newDate.Year _ SUCC[ newDate.Year]; ENDCASE; END ELSE BEGIN -- next = FALSE: have to go backward in time SELECT zoomLevel FROM Day => newDate _ CalSupport.PreviousDay[ newDate]; Month => IF newDate.Month # January THEN newDate.Month _ PRED[ newDate.Month] ELSE BEGIN newDate.Month _ December; newDate.Year _ PRED[ newDate.Year] END; Year => newDate.Year _ PRED[ newDate.Year]; ENDCASE; END; curDate _ newDate; DisplayEvents[ zoomLevel, curDate]; END; -- ShowNextOrPrevious DoZoomOut: ENTRY PROCEDURE [ newZoom: ZoomLevel] = BEGIN ENABLE UNWIND => NULL; DisplayEvents[ newZoom, curDate]; END; -- DoZoomOut DoZoomIn: ENTRY PROCEDURE [ clientData: REF ANY] = BEGIN < month or month -> day, depending on the clientData>> ENABLE UNWIND => NULL; IF ISTYPE[ clientData, REF Days] THEN BEGIN -- month -> day rDay: REF Days = NARROW[ clientData]; curDate.Day _ rDay^; DisplayEvents[ Day, curDate]; END ELSE IF ISTYPE[ clientData, REF Months] THEN BEGIN -- year -> month rMonth: REF Months = NARROW[ clientData]; curDate.Month _ rMonth^; DisplayEvents[ Month, curDate]; END ELSE ERROR; END; -- DoZoomIn <> DisplayEvents: PUBLIC INTERNAL PROCEDURE [ zoom: ZoomLevel, date: Calendar.Date] = BEGIN <> <> curMode _ Browse; ResetIcon[ curMode, date, zoomLevel, zoom]; CalNuts.ResetNutInfo[ zoom, Browse]; curDate _ date; selectedEvent _ NIL; AdjustCaption[ zoom, date]; SetMenu[ zoom, calViewer]; cont _ RetrieveCalBrowser[ zoom, zoomLevel, date, cont]; zoomLevel _ zoom; IF cont = NIL THEN BEGIN SELECT zoom FROM Day => BEGIN cont _ CreateContainer[ calViewer, TRUE]; DisplayDay[ cont, date]; END; Month => BEGIN cont _ CreateContainer[ myParent: calViewer]; DisplayMonth[ cont, date]; CalStorage.StoreViewer[ date, Month, cont]; END; Year => BEGIN cont _ CreateContainer[ myParent: calViewer]; DisplayYear[ cont, date]; CalStorage.StoreViewer[ date, Year, cont]; END; ENDCASE => ERROR; ViewerOps.PaintViewer[ viewer: calViewer, hint: all]; END ELSE --remember calViewer is top level viewer....! It also appears that moving calViewer <> ViewerOps.MoveViewer[ viewer: cont, x: cont.wx-Delta, y: cont.wy-Delta, w: cont.ww, h: cont.wh, paint: TRUE]; END; -- DisplayEvents RetrieveCalBrowser: INTERNAL PROCEDURE [ newZoom, oldZoom: ZoomLevel, date: Date, oldViewer: ViewerClasses.Viewer] RETURNS [ newViewer: ViewerClasses.Viewer] = BEGIN IF oldViewer # NIL THEN IF oldZoom # Day THEN -- hide it away ViewerOps.MoveViewer[ viewer: oldViewer, x: oldViewer.wx+Delta, y: oldViewer.wy+Delta, w: oldViewer.ww, h: oldViewer.wh] ELSE BEGIN ViewerOps.DestroyViewer[ oldViewer, FALSE]; -- don't bother saving it dayGrid.buttons _ NIL; END; SELECT newZoom FROM Day => newViewer _ NIL; Month => newViewer _ CalStorage.RetrieveViewer[ date, Month]; Year => newViewer _ CalStorage.RetrieveViewer[ date, Year]; ENDCASE; RETURN[ newViewer]; END; -- RetrieveCalBrowser SetMenu: INTERNAL PROCEDURE[ zoomLevel: ZoomLevel, viewer: ViewerClasses.Viewer] = BEGIN <> <<>> SELECT zoomLevel FROM Day => BEGIN rz: REF ZoomLevel _ NEW[ ZoomLevel _ Month]; ViewerOps.SetMenu[ viewer: viewer, menu: CalSupport.MakeMenu[ LIST[ "Next", "Previous", "Month", "Print", "Forget", "Edit", "Enter", "ShowMsg"], LIST[ Next, Previous, ZoomOut, Print, Forget, Edit, Enter, ShowMsg], LIST[ NIL, NIL, rz, NIL, NIL, NIL, NIL, NIL]], paint: TRUE]; END; -- Day Month => BEGIN rz: REF ZoomLevel _ NEW[ ZoomLevel _ Year]; ViewerOps.SetMenu[ viewer: viewer, menu: CalSupport.MakeMenu[ LIST[ "Next", "Previous", "Year", "Print", "Enter"], LIST[ Next, Previous, ZoomOut, Print, Enter], LIST[ NIL, NIL, rz, NIL, NIL]], paint: FALSE]; END; -- Month Year => BEGIN ViewerOps.SetMenu[ viewer: viewer, menu: CalSupport.MakeMenu[ LIST[ "Next", "Previous", "Print", "Enter"], LIST[ Next, Previous, Print, Enter], LIST[ NIL, NIL, NIL, NIL]], paint: FALSE]; END; -- Year ENDCASE; END; -- SetMenu AdjustCaption: INTERNAL PROCEDURE [ zoomLevel: ZoomLevel, curDate: Date] = BEGIN <> newTitle: Rope.ROPE _ "Calendar: "; now: BasicTime.GMT _ BasicTime.Now[]; time: BasicTime.Unpacked _ BasicTime.Unpack[ now]; SELECT zoomLevel FROM Day => newTitle _ Rope.Concat[ newTitle, IO.PutFR[ "%g, %g %2g, %4g", IO.rope[ CalSupport.GetDayName[ curDate]], IO.rope[ CalSupport.GetMonthName[ curDate.Month]], IO.int[ curDate.Day], IO.int[ curDate.Year]]]; Month => newTitle _ Rope.Concat[ newTitle, IO.PutFR[ "%g %4g", IO.rope[ CalSupport.GetMonthName[ curDate.Month]], IO.int[ curDate.Year]]]; Year => newTitle _ Rope.Concat[ newTitle, IO.PutFR[ "%4g", IO.int[ curDate.Year]]]; ENDCASE; calViewer.name _ newTitle; END; -- AdjustCaption DisplayDay: INTERNAL PROCEDURE [ cont: ViewerClasses.Viewer, date: Date] = BEGIN <> OPEN dayGrid; evl: EventList _ NIL; rowCount: CARDINAL _ 0; but: Buttons.Button; msg, txtRope, tr, plRope: Rope.ROPE; time: BasicTime.Unpacked; buttonLabel: Rope.ROPE; IF cont = NIL THEN RETURN; evl _ CalStorage.GetEventsOfDay[ date, Day]; IF evl = NIL THEN BEGIN [] _ CreateLabel[ myParent: cont, hi: ButtonHeight, wi: cont.cw, title: "Sorry, no events on this day...", displayStyle: $BlackOnWhite]; RETURN; END; buttons _ NIL; FOR l: EventList _ evl, l.rest UNTIL l = NIL DO time _ BasicTime.Unpack[ l.first.EventTime]; txtRope _ l.first.Text; plRope _ l.first.Place; IF l.first.Duration # 0 THEN BEGIN duration: LONG CARDINAL _ l.first.Duration; endTime: BasicTime.Unpacked; duration _ duration*60; endTime _ BasicTime.Unpack[ BasicTime.Update[ l.first.EventTime, duration]]; tr _ IO.PutFR[ TimeFormat, IO.int[ time.hour], IO.int[ time.minute], IO.int[ endTime.hour], IO.int[ endTime.minute]]; END ELSE tr _ IO.PutFR[ TimeFormat2, IO.int[ time.hour], IO.int[ time.minute]]; IF l.first.Message # NIL THEN msg _ " M" ELSE msg _ " "; IF Rope.Length[ txtRope] > TextWidth THEN txtRope _ Rope.Substr[ txtRope, 0, TextWidth]; IF Rope.Length[ plRope] > PlaceWidth THEN plRope _ Rope.Substr[ plRope, 0, PlaceWidth]; buttonLabel _ IO.PutFR[ Format, IO.rope[ tr], IO.rope[ msg], IO.rope[ txtRope], IO.rope[ plRope]]; but _ CalSupport.CreateButton[ myParent: cont, hi: ButtonHeight, wi: cont.cw, yOff: rowCount*ButtonHeight, xOff: 0, proc: SelectEvent, clientData: NEW[ CARDINAL _ rowCount], title: buttonLabel, displayStyle: $BlackOnWhite]; buttons _ CONS[ [ rowCount, l.first.Key, but], buttons]; rowCount _ rowCount + 1; ENDLOOP; END; -- DisplayDay TitleMonthGrid: INTERNAL PROCEDURE [ monthTable: VTables.VTable] RETURNS [ newMonthTable: VTables.VTable] = BEGIN <> OPEN monthGrid; width: INT_ monthTable.cw/Cols; newMonthTable _ monthTable; FOR d: Weekdays IN [ Monday..Sunday] DO dr: Rope.ROPE; col: NAT; SELECT d FROM Monday => BEGIN dr _ "Mo"; col _ 1; END; Tuesday => BEGIN dr _ "Tu"; col _ 2; END; Wednesday => BEGIN dr _ "We"; col _ 3; END; Thursday => BEGIN dr _ "Th"; col _ 4; END; Friday => BEGIN dr _ "Fr"; col _ 5 ;END; Saturday => BEGIN dr _ "Sa"; col _ 6; END; Sunday => BEGIN dr _ "Su"; col _ 0; END; ENDCASE; VTables.SetTableEntry[ table: newMonthTable, row: 0, column: col, name: dr, border: [ FALSE, TRUE, FALSE, TRUE], w: width]; ENDLOOP; END; -- TitleMonthGrid CreateDayViewer: INTERNAL PROCEDURE [ width, height: INT, myParent: ViewerClasses.Viewer, butLabel: Rope.ROPE, butProc: Menus.MenuProc, dayOfMonth: Days, contents: Rope.ROPE] RETURNS [ table: VTables.VTable] = BEGIN <> <> button, txtViewer: ViewerClasses.Viewer; table _ VTables.Create[ rows: 2, columns: 1, parent: myParent, w: width, h: height]; VTables.SetTableEntry[ table: table, row: 0, column: 0, flavor: $Button, proc: butProc, clientData: NEW[ Days _ dayOfMonth], name: butLabel, w: width, border: [ FALSE, TRUE, FALSE, FALSE]]; VTables.Install[ table, FALSE]; button _ VTables.GetTableEntry[ table, 0, 0]; txtViewer _ CalSupport.CreateTextViewer[ width: width, height: height - button.wh, myParent: table, scrolling: TRUE, cont: contents, edit: FALSE]; VTables.SetTableEntry[ table: table, row: 1, column: 0, flavor: $Viewer, clientData: txtViewer, border: [ TRUE, TRUE, FALSE, TRUE], h: height - button.wh, w: width]; -- ouff VTables.Install[ table, FALSE]; END; -- CreateDayViewer FillInDayGrid: INTERNAL PROCEDURE [ table: VTables.VTable, date: Date] RETURNS [ newTable: VTables.VTable] = BEGIN <> OPEN monthGrid; width, height: INT; nbrOfDays: Days; firstDay: Weekdays; cont: Rope.ROPE; DayName: INTERNAL PROCEDURE [ col: INT, i: Days] RETURNS [ namedDay: Rope.ROPE] = INLINE BEGIN r: Rope.ROPE; SELECT col FROM 1 => r _ "Mon"; 2 => r _ "Tue"; 3 => r _ "Wed"; 4 => r _ "Thu"; 5 => r _ "Fri"; 6 => r _ "Sat"; 0 => r _ "Sun"; ENDCASE; RETURN[ IO.PutFR[ monthGrid.DateFormat, IO.rope[ r], IO.int[ i]]]; END; -- DayName [ nbrOfDays, firstDay] _ CalSupport.GetMonthInfo[ curDate.Month, curDate.Year]; width _ table.cw/Cols; height _ table.ch/Rows; FOR d: Days IN [ 1.. nbrOfDays] DO row, col: INT; dayViewer: ViewerClasses.Viewer; [ row, col] _ CalSupport.GetRowCol[ d, firstDay]; cont _ DayContents[ [ d, date.Month, date.Year], width]; dayViewer _ CreateDayViewer[ width, height, table, DayName[ col, d], ZoomIn, d, cont]; monthGrid.DayViewers[ d] _ dayViewer; ENDLOOP; RETURN[ table]; END; -- FillInDayGrid CreateMonthGrid: INTERNAL PROCEDURE [ myParent: ViewerClasses.Viewer, height, width: INT, zoom: ZoomLevel, date: Date] RETURNS [ table: VTables.VTable] = BEGIN <> <> monthTable: VTables.VTable; IF zoomLevel = Year THEN monthTable _ VTables.Create[ columns: monthGrid.Cols, rows: monthGrid.Rows+1, parent: myParent, h: height, w: width] ELSE monthTable _ VTables.Create[ columns: monthGrid.Cols, rows: monthGrid.Rows, parent: myParent, h: height, w: width]; IF monthTable = NIL THEN BEGIN CalSupport.DisplayMsg[ "Failure to create month grid!"]; RETURN; END; IF zoomLevel = Year THEN monthTable _ TitleMonthGrid[ monthTable] ELSE monthTable _ FillInDayGrid[ monthTable, date]; VTables.Install[ monthTable, FALSE]; RETURN[ monthTable]; END; -- CreateMonthGrid DayContents: INTERNAL PROCEDURE [ date: Date, fieldWidth: INT _ 0] RETURNS [ entry: Rope.ROPE] = BEGIN <> <> <> <> OPEN monthGrid; evl: EventList _ CalStorage.GetEventsOfDay[ date, Day]; length: INT _ fieldWidth/CharWidth-2; -- estimate how many chars fit on a line IF evl = NIL THEN RETURN[ NIL]; IF evl = NIL THEN RETURN[ NIL]; entry _ Rope.Concat[ entry, " "]; -- text viewer's first char... FOR l: EventList _ evl, l.rest UNTIL l = NIL DO IF fieldWidth = 0 THEN entry _ Rope.Concat[ entry, l.first.Text] ELSE IF Rope.Length[ l.first.Text] > length THEN BEGIN entry _ Rope.Concat[ entry, Rope.Substr[ base: l.first.Text, len: length]]; entry _ Rope.Concat[ entry, "..."]; END ELSE entry _ Rope.Concat[ entry, l.first.Text]; entry _ Rope.Concat[ entry, Rope.FromChar[ '\n]]; ENDLOOP; RETURN[ entry]; END; -- DayContents FillMonthGrid: INTERNAL PROCEDURE [ date: Date, monthTable: VTables.VTable, zoom: ZoomLevel] = BEGIN <> OPEN monthGrid; wid, hi: INT; -- h, w for entry row, col: INTEGER; noLeftBorder: VTables.Border _ [ TRUE, TRUE, FALSE, TRUE]; noRightBorder: VTables.Border _ [ TRUE, TRUE, TRUE, FALSE]; firstDay: Weekdays; nbrOfDays: Days; GetBorder: INTERNAL PROCEDURE [ index: INT] RETURNS [ border: VTables.Border] = INLINE BEGIN IF index = 0 THEN RETURN[ noLeftBorder] ELSE IF index = Rows-1 THEN RETURN[ noRightBorder] ELSE RETURN[ VTables.FullBorder]; END; -- GetBorder IF zoom = Year THEN BEGIN wid _ monthTable.cw/monthGrid.Cols; hi _ RowHeight; END ELSE BEGIN OPEN monthGrid; wid _ FormWidth/Cols; hi _ FormHeight/Rows; END; [ nbrOfDays, firstDay] _ CalSupport.GetMonthInfo[ date.Month, date.Year]; [ row, col] _ CalSupport.GetRowCol[ 1, firstDay]; IF col # 0 THEN -- fill first row partially FOR c: INT IN [ 0..col-1] DO VTables.SetTableEntry[ table: monthTable, row: IF zoom = Year THEN 1 ELSE 0, column: c, w: wid, h: hi, border: GetBorder[ c]]; ENDLOOP; [ row, col] _ CalSupport.GetRowCol[ nbrOfDays, firstDay]; IF col # 6 THEN -- fill last row partially FOR c: INT IN [ col+1..monthGrid.Cols) DO VTables.SetTableEntry[ table: monthTable, row: IF zoom = Year THEN row + 1 ELSE row, column: c, w: wid, h: hi, border: GetBorder[ c]]; ENDLOOP; VTables.Install[ monthTable, FALSE]; FOR i: Days IN [ 1..nbrOfDays] DO [ row, col] _ CalSupport.GetRowCol[ i, firstDay]; <> IF zoomLevel = Month THEN BEGIN <> dayViewer: VTables.VTable _ monthGrid.DayViewers[ i]; VTables.SetTableEntry[ table: monthTable, row: row, column: col, flavor: $Viewer, w: wid, h: hi, clientData: dayViewer, border: GetBorder[ col]]; END ELSE BEGIN -- zoomLevel = Year; proc registered with title table... evl: EventList _ CalStorage.GetEventsOfDay[ [ i, date.Month, date.Year], Year]; VTables.SetTableEntry[ table: monthTable, row: row+1, column: col, name: IO.PutFR[ "%02g", IO.int[ i]], w: wid, h: hi, border: GetBorder[ col], proc: NIL, displayStyle: IF evl = NIL THEN $BlackOnWhite ELSE $BlackOnGrey]; END; VTables.Install[ monthTable, FALSE]; ENDLOOP; END; -- FillMonthGrid DisplayMonth: INTERNAL PROCEDURE [ cont: ViewerClasses.Viewer, date: Date] = BEGIN <> OPEN monthGrid; table : VTables.VTable _ CreateMonthGrid[ cont, cont.ch, cont.cw, Month, date]; -- above call sets monthGrid.dayViewers FillMonthGrid[ date, table, Month]; END; -- DisplayMonth CreateTitleTable: INTERNAL PROCEDURE [ myParent: ViewerClasses.Viewer, height, width: INT, mo: Months] RETURNS [ table: VTables.VTable] = BEGIN <> table _ VTables.Create[ columns: 1, rows: 1, parent: myParent, w: width, h: height]; VTables.SetTableEntry[ table: table, row: 0, column: 0, name: CalSupport.GetMonthName[ mo], proc: ZoomIn, clientData: NEW[ Months _ mo], w: width, h: height, border: VTables.NullBorder]; VTables.Install[ table, FALSE]; END; -- CreateTitleTable CreateYearGrid: INTERNAL PROCEDURE [ myParent: ViewerClasses.Viewer, date: Date] RETURNS [ yearTable: VTables.VTable] = BEGIN <> OPEN yearGrid; table: VTables.VTable; wid: INT; -- height is constant yearTable _ VTables.Create[ columns: Cols, rows: Rows, parent: myParent, h: myParent.ch, w: myParent.cw]; wid _ yearTable.cw/Cols; -- width of a month table within year grid. FOR l: INT IN [ 0..Rows-1] DO FOR k: INT IN [ 0..Cols-1] DO OPEN yearGrid; mo: Months _ CalSupport.I2M[ (l/2)*Cols+k]; IF l MOD 2 = 0 THEN table _ CreateTitleTable[ yearTable, RowHeight, wid, mo] ELSE BEGIN table _ CreateMonthGrid[ yearTable, ( monthGrid.Rows+1)*RowHeight, wid, Year, [ date.Day, mo, date.Year]]; yearGrid.MonthViewers[ mo] _ table; END; VTables.SetTableEntry[ table: yearTable, row: l, column: k, flavor: $Viewer, clientData: table, proc: NIL]; VTables.Install[ table, FALSE]; ENDLOOP; ENDLOOP; VTables.Install[ table: yearTable, paint: FALSE]; RETURN[ yearTable]; END; -- CreateYearGrid DisplayYear: INTERNAL PROCEDURE [ cont: ViewerClasses.Viewer, date: Date] = BEGIN <> table: VTables.VTable _ CreateYearGrid[ cont, date]; FOR curMonth: Months IN [ January..December] DO curMonthTable: VTables.VTable _ yearGrid.MonthViewers[ curMonth]; FillMonthGrid[ [ date.Day, curMonth, date.Year], curMonthTable, Year]; ENDLOOP; VTables.Install[ table: table, paint: FALSE]; END; -- DisplayYear <> HickoryChange: PUBLIC INTERNAL PROCEDURE [ reason: Hickory.Reason, oldEvl, newEvl: Hickory.EventList, data: RopeSets.RopeSet] = BEGIN <> <> <> prevDate: Date _ [ 0, January, 1968]; -- fix same day only once dayViewerFixed: BOOLEAN _ FALSE; IF calViewer = NIL OR calViewer.destroyed THEN RETURN; IF reason = Edit OR reason = Destroy OR reason = Forget THEN -- get rid of old stuff FOR l: Hickory.EventList _ oldEvl, l.rest UNTIL l = NIL DO date: Date _ CalSupport.ExtractDate[ l.first.EventTime]; viewer: ViewerClasses.Viewer; IF date # prevDate THEN BEGIN viewer _ CalStorage.RetrieveViewer[ date, Month]; IF viewer # NIL THEN CleanMonthViewer[ viewer, date]; IF curDate = date AND zoomLevel = Day AND curMode = Browse THEN BEGIN <> FixDayViewer[ date]; dayViewerFixed _ TRUE; END; END; prevDate _ date; ENDLOOP; IF reason = Edit OR reason = NewEvent OR reason = UnForget THEN -- insert new stuff FOR l: Hickory.EventList _ newEvl, l.rest UNTIL l = NIL DO date: Date _ CalSupport.ExtractDate[ l.first.EventTime]; viewer: ViewerClasses.Viewer; IF date # prevDate THEN BEGIN viewer _ CalStorage.RetrieveViewer[ date, Month]; IF viewer # NIL THEN FixMonthViewer[ viewer, date]; viewer _ CalStorage.RetrieveViewer[ date, Year]; IF viewer # NIL THEN FixYearViewer[ viewer, date]; IF NOT dayViewerFixed AND curDate = date AND zoomLevel = Day AND curMode = Browse THEN BEGIN <> FixDayViewer[ date]; END; END; prevDate _ date; ENDLOOP; END; -- HickoryChange CleanMonthViewer: INTERNAL PROCEDURE [ monthViewer: Containers.Container, date: Date] = BEGIN <> monthTable: VTables.VTable _ monthViewer^.child; -- there ought to be only one row, col: CARDINAL; firstDay: Weekdays; nbrOfDays: Days; dayViewer, txtViewer: ViewerClasses.Viewer; IF monthTable = NIL THEN RETURN; [ nbrOfDays, firstDay] _ CalSupport.GetMonthInfo[ date.Month, date.Year]; [ row, col] _ CalSupport.GetRowCol[ date.Day, firstDay]; dayViewer _ VTables.GetTableEntry[ table: monthTable, row: row, column: col]; txtViewer _ VTables.GetTableEntry[ table: dayViewer, row: 1, column: 0]; ViewerTools.SetContents[ viewer: txtViewer, contents: DayContents[ date, dayViewer.cw]]; END; -- FixMonthViewer FixMonthViewer: INTERNAL PROCEDURE [ monthViewer: Containers.Container, date: Date] = BEGIN <> monthTable: VTables.VTable _ monthViewer^.child; -- there ought to be only one row, col: CARDINAL; firstDay: Weekdays; nbrOfDays: Days; dayViewer, txtViewer: ViewerClasses.Viewer; IF monthTable = NIL THEN RETURN; [ nbrOfDays, firstDay] _ CalSupport.GetMonthInfo[ date.Month, date.Year]; [ row, col] _ CalSupport.GetRowCol[ date.Day, firstDay]; dayViewer _ VTables.GetTableEntry[ table: monthTable, row: row, column: col]; txtViewer _ VTables.GetTableEntry[ table: dayViewer, row: 1, column: 0]; ViewerTools.SetContents[ viewer: txtViewer, contents: DayContents[ date, dayViewer.cw]]; END; -- FixMonthViewer FixYearViewer: INTERNAL PROCEDURE [ yearViewer: Containers.Container, date: Date] = BEGIN <> yearTable: VTables.VTable _ yearViewer^.child; -- there ought to be only one row, col: CARDINAL; firstDay: Weekdays; nbrOfDays: Days; label: Labels.Label; monthTable: VTables.VTable; evl: Hickory.EventList; IF yearTable = NIL THEN RETURN; [ nbrOfDays, firstDay] _ CalSupport.GetMonthInfo[ date.Month, date.Year]; row _ ( CalSupport.M2I[ date.Month])/yearGrid.Cols; col _ ( CalSupport.M2I[ date.Month]) MOD yearGrid.Cols; row _ 2*row + 1; -- month button rows... monthTable _ VTables.GetTableEntry[ table: yearTable, row: row, column: col]; [ row, col] _ CalSupport.GetRowCol[ date.Day, firstDay]; row _ row + 1; -- day title row label _ VTables.GetTableEntry[ table: monthTable, row: row, column: col]; evl _ CalStorage.GetEventsOfDay[ date, Day]; IF evl = NIL THEN Labels.SetDisplayStyle[ label: label, style: $BlackOnWhite] ELSE Labels.SetDisplayStyle[ label: label, style: $BlackOnGrey]; END; -- FixYearViewer FixDayViewer: INTERNAL PROCEDURE [ date: Date] = BEGIN <> <> <> IF cont # NIL THEN BEGIN ViewerOps.DestroyViewer[ viewer: cont, paint: TRUE]; cont _ NIL; dayGrid.buttons _ NIL; END; cont _ CreateContainer[ calViewer, TRUE]; DisplayDay[ cont, date]; ViewerOps.PaintViewer[ cont, all]; END; -- FixDayViewer <> zoomLevel _ unspecified; END.utto