<<>> <> <> <> <> <> <> <<>> <> <> <<>> DIRECTORY Atom, AtomButtons, AtomButtonsTypes, Buttons, CodeTimer, FileNames, Imager, IO, Labels, MachineDependentPopping, Menus, PopUpButtons, Rope, TiogaButtons, VFonts, ViewerClasses, ViewerOps, ViewerTools; AtomButtonsImpl: CEDAR PROGRAM IMPORTS Atom, Buttons, CodeTimer, FileNames, IO, Labels, MachineDependentPopping, PopUpButtons, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools EXPORTS AtomButtons = BEGIN ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry; ButtonList: TYPE = AtomButtons.ButtonList; ButtonType: TYPE = AtomButtons.ButtonType; CompareProc: TYPE = AtomButtons.CompareProc; ConfirmProc: TYPE = AtomButtonsTypes.ConfirmProc; DisplayStyle: TYPE = AtomButtons.DisplayStyle; EnumTypeRec: TYPE = AtomButtonsTypes.EnumTypeRec; EnumTypeRef: TYPE = REF EnumTypeRec; Event: TYPE = AtomButtons.Event; FindProc: TYPE = AtomButtons.FindProc; HandleButtonProc: TYPE = AtomButtons.HandleButtonProc; InitButtonProc: TYPE = AtomButtonsTypes.InitButtonProc; InitTwoStateProc: TYPE = AtomButtonsTypes.InitTwoStateProc; Order: TYPE = AtomButtons.Order; PopUpChoice: TYPE = AtomButtons.PopUpChoice; ReadSortedProc: TYPE = AtomButtons.ReadSortedProc; WriteSortedProc: TYPE = AtomButtons.WriteSortedProc; ScalarButton: TYPE = AtomButtons.ScalarButton; SortedButtonClient: TYPE = REF SortedButtonClientObj; SortedButtonClientObj: TYPE = AtomButtonsTypes.SortedButtonClientObj; SortedButtonHandle: TYPE = REF SortedButtonHandleObj; SortedButtonHandleObj: TYPE = AtomButtonsTypes.SortedButtonHandleObj; SortedButtonEntry: TYPE = AtomButtons.SortedButtonEntry; StyleChoice: TYPE = AtomButtons.StyleChoice; TwoState: TYPE = REF TwoStateObj; TwoStateObj: TYPE = AtomButtonsTypes.TwoStateObj; UnQueuedButtonLineEntry: TYPE = AtomButtons.UnQueuedButtonLineEntry; UpdateProc: TYPE = AtomButtons.UpdateProc; Viewer: TYPE = ViewerClasses.Viewer; NotYetImplemented: PUBLIC SIGNAL = CODE; epsilon: REAL = 0.001; <> <<>> GGButtonData: TYPE = REF GGButtonDataObj; GGButtonDataObj: TYPE = RECORD [ clientData: REF ANY, events: LIST OF Event, handleProc: HandleButtonProc, confirmProc: ConfirmProc ]; <> BuildButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, entries: LIST OF ButtonLineEntry, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [nextX: INTEGER] = { thisButton, prevButton, firstButton: Buttons.Button; wxRelative: INTEGER ¬ -1; clientPackageName: Rope.ROPE ~ PopUpButtons.GuessPackageName[ MachineDependentPopping.GetCaller2sGlobalFrame[]]; firstButton ¬ prevButton ¬ BuildButton[container, x, y, clientData, handleProc, entries.first, horizontalSpace, lineHeight, clientPackageName]; FOR entryList: LIST OF ButtonLineEntry ¬ entries.rest, entryList.rest UNTIL entryList = NIL DO WITH entryList.first SELECT FROM a: ButtonLineEntry.button => wxRelative ¬ a.wxRelative; b: ButtonLineEntry.popUpButton => wxRelative ¬ b.wxRelative; c: ButtonLineEntry.label => wxRelative ¬ c.wxRelative; d: ButtonLineEntry.text => wxRelative ¬ d.wxRelative; e: ButtonLineEntry.twoState => wxRelative ¬ e.wxRelative; ENDCASE => ERROR; nextX ¬ IF wxRelative < 0 THEN prevButton.wx + prevButton.ww + horizontalSpace ELSE wxRelative; thisButton ¬ BuildButton[container, nextX, y, clientData, handleProc, entryList.first, horizontalSpace, lineHeight, clientPackageName]; prevButton ¬ thisButton; ENDLOOP; nextX ¬ prevButton.wx + prevButton.ww; }; BuildButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, entry: ButtonLineEntry, horizontalSpace: INTEGER, lineHeight: INTEGER, clientPackageName: Rope.ROPE] RETURNS [button: Buttons.Button] = { WITH entry SELECT FROM a: ButtonLineEntry.button => button ¬ BuildOldButton[container, x, y, clientData, handleProc, a.name, a.events, a.border, a.font, a.confirmProc, a.initProc, a.ww, lineHeight]; b: ButtonLineEntry.popUpButton => button ¬ BuildPopUpButton[container, x, y, clientData, handleProc, b.name, b.choices, b.border, b.font, b.help, b.disableDecoding, b.headMenu, b.confirmProc, b.initProc, b.ww, lineHeight, clientPackageName]; c: ButtonLineEntry.label => button ¬ BuildLabel[container, x, y, clientData, c.name, c.initProc, c.ww, c.border, c.font, lineHeight]; d: ButtonLineEntry.text => button ¬ BuildTextViewer[container, x, y, clientData, handleProc, d.name, d.initProc, d.ww, d.border, d.font, lineHeight]; e: ButtonLineEntry.twoState => button ¬ BuildTwoState[container, x, y, clientData, handleProc, e.name, e.event, e.on, e.initProc, e.ww, e.border, e.font, lineHeight]; ENDCASE => ERROR; }; HandleButton: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> buttonData: GGButtonData ¬ NARROW[clientData]; IF mouseButton = red THEN buttonData.handleProc[buttonData.clientData, buttonData.events.first] ELSE IF mouseButton = yellow THEN { IF buttonData.events.rest # NIL AND buttonData.events.rest.first # NIL THEN buttonData.handleProc[buttonData.clientData, buttonData.events.rest.first] ELSE buttonData.handleProc[buttonData.clientData, buttonData.events.first]; } ELSE { IF buttonData.events.rest # NIL AND buttonData.events.rest.rest # NIL AND buttonData.events.rest.rest.first # NIL THEN buttonData.handleProc[buttonData.clientData, buttonData.events.rest.rest.first] ELSE buttonData.handleProc[buttonData.clientData, buttonData.events.first]; }; <> }; BuildLabel: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, name: Rope.ROPE, initProc: InitButtonProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = { button ¬ Labels.Create[ info: [ parent: container, wx: x, wy: y, ww: ww, wh: lineHeight, name: name, border: border], font: font]; IF initProc # NIL THEN initProc[name, clientData, button]; }; BuildTwoState: PROC [container: ViewerClasses.Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, event: LIST OF REF ANY, state: BOOL ¬ FALSE, initProc: InitTwoStateProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER ¬ 15] RETURNS [button: Buttons.Button] = { stateInfo: TwoState ¬ NEW[TwoStateObj]; button ¬ Buttons.Create[ info: [ name: name, parent: container, wx: x, wy: y, ww: ww, wh: lineHeight, border: border], proc: TwoSwitchProc, clientData: stateInfo -- this will be passed to our button proc ]; stateInfo.button ¬ button; stateInfo.event ¬ event; stateInfo.clientData ¬ clientData; stateInfo.handleProc ¬ handleProc; SetBinaryState[stateInfo, state]; IF initProc # NIL THEN initProc[name, clientData, stateInfo]; }; BuildOldButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, events: LIST OF Event, border: BOOL ¬ FALSE, font: Imager.Font, confirmProc: ConfirmProc, initProc: InitButtonProc, ww: NAT, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = { buttonData: GGButtonData; buttonData ¬ NEW[GGButtonDataObj ¬ [clientData, events, handleProc, confirmProc]]; button ¬ Buttons.Create[ info: [name: name, wx: x, wy: y, wh: lineHeight, parent: container, border: border], proc: HandleButton, clientData: buttonData, documentation: handleConfirm, fork: FALSE, guarded: confirmProc # NIL, font: font ]; IF initProc # NIL THEN initProc[name, clientData, button]; }; PopUpButtonData: TYPE = REF PopUpButtonDataObj; PopUpButtonDataObj: TYPE = RECORD [ handleProc: HandleButtonProc ]; PopUpData: TYPE = REF PopUpDataObj; PopUpDataObj: TYPE = RECORD [ handleProc: HandlePopUpProc ]; BuildPopUpButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, choices: LIST OF PopUpChoice, border: BOOL ¬ FALSE, font: Imager.Font, help: PopUpButtons.Help, disableDecoding: BOOL ¬ FALSE, headMenu: BOOL ¬ FALSE, confirmProc: ConfirmProc, initProc: InitButtonProc, ww: NAT, lineHeight: INTEGER, clientPackageName: Rope.ROPE] RETURNS [button: Buttons.Button] = { popUpClassSpec: PopUpButtons.ClassSpec; popUpClass: PopUpButtons.Class; choiceList, ptr: LIST OF PopUpButtons.Choice; image: PopUpButtons.Image; instanceData: PopUpButtonData; [choiceList, ptr] ¬ StartChoiceList[]; FOR list: LIST OF PopUpChoice ¬ choices, list.rest UNTIL list = NIL DO IF list.first.actionImage = NIL THEN image ¬ PopUpButtons.ImageForRope[Atom.GetPName[NARROW[list.first.action.first]], NIL, list.first.font] ELSE image ¬ PopUpButtons.ImageForRope[list.first.actionImage, NIL, list.first.font]; [choiceList, ptr] ¬ AddChoice[[key: list.first.action, doc: list.first.doc, image: image], choiceList, ptr]; ENDLOOP; IF help=NIL THEN help ¬ PopUpButtons.DeduceHelp[buttonName: name, clientPackageName: clientPackageName]; popUpClassSpec ¬ [ classData: clientData, proc: HandlePopUpButton, choices: choiceList, fork: FALSE, disableDecoding: disableDecoding, headMenu: headMenu, image: PopUpButtons.ImageForRope[name, NIL, font, PopUpButtons.center], help: help ]; popUpClass ¬ PopUpButtons.MakeClass[popUpClassSpec]; instanceData ¬ NEW[PopUpButtonDataObj ¬ [handleProc]]; button ¬ PopUpButtons.Instantiate[ class: popUpClass, viewerInfo: [name: name, wx: x, wy: y, ww: ww, wh: lineHeight, parent: container, border: border], instanceData: instanceData, image: PopUpButtons.ImageForRope[name, NIL, font] ]; IF initProc # NIL THEN initProc[name, clientData, button]; }; HandlePopUpProc: TYPE = AtomButtons.HandlePopUpProc; BuildPopUp: PUBLIC PROC [clientData: REF, handleProc: HandlePopUpProc, paint: PopUpButtons.PaintProc, inButton: PopUpButtons.InTestProc, entry: ButtonLineEntry, clientPackageName: Rope.ROPE] RETURNS [instance: REF] = { CodeTimer.StartInt[$AtomButtonsBuildPopUp, $EmbeddedButtons]; WITH entry SELECT FROM b: ButtonLineEntry.popUpButton => instance ¬ BuildPopUpAux[clientData, handleProc, b.name, b.choices, b.font, b.help, b.disableDecoding, b.headMenu, b.confirmProc, b.initProc, paint, inButton, clientPackageName]; ENDCASE => ERROR; CodeTimer.StopInt[$AtomButtonsBuildPopUp, $EmbeddedButtons]; }; BuildPopUpAux: PROC [clientData: REF, handleProc: HandlePopUpProc, name: Rope.ROPE, choices: AtomButtons.PopUpChoices, font: Imager.Font, help: PopUpButtons.Help, disableDecoding: BOOL, headMenu: BOOL, confirmProc: ConfirmProc, initProc: InitButtonProc, paint: PopUpButtons.PaintProc, inButton: PopUpButtons.InTestProc, clientPackageName: Rope.ROPE] RETURNS [instance: REF] = { popUpClassSpec: PopUpButtons.ClassSpec; popUpClass: PopUpButtons.Class; choiceList, ptr: LIST OF PopUpButtons.Choice; image: PopUpButtons.Image; instanceData: PopUpData; [choiceList, ptr] ¬ StartChoiceList[]; FOR list: LIST OF PopUpChoice ¬ choices, list.rest UNTIL list = NIL DO IF list.first.actionImage = NIL THEN image ¬ PopUpButtons.ImageForRope[Atom.GetPName[NARROW[list.first.action.first]], NIL, IF list.first.font = NIL THEN font ELSE list.first.font] ELSE image ¬ PopUpButtons.ImageForRope[list.first.actionImage, NIL, IF list.first.font = NIL THEN font ELSE list.first.font]; [choiceList, ptr] ¬ AddChoice[[key: list.first.action, doc: list.first.doc, image: image], choiceList, ptr]; ENDLOOP; IF help=NIL THEN help ¬ PopUpButtons.DeduceHelp[buttonName: name, clientPackageName: clientPackageName]; popUpClassSpec ¬ [ classData: clientData, proc: HandlePopUp, choices: choiceList, fork: FALSE, disableDecoding: disableDecoding, headMenu: headMenu, image: PopUpButtons.ImageForRope[name, NIL, font, PopUpButtons.center], help: help ]; popUpClass ¬ PopUpButtons.MakeClass[popUpClassSpec]; instanceData ¬ NEW[PopUpDataObj ¬ [handleProc]]; instance ¬ PopUpButtons.GeneralInstantiate[ class: popUpClass, Paint: paint, InTest: inButton, instanceData: instanceData, image: PopUpButtons.ImageForRope[name, NIL, font], help: NIL ]; }; HandlePopUpButton: PROC [view: PopUpButtons.View, instanceData, classData, key: REF ANY] = { event: LIST OF REF ANY ¬ NARROW[key]; popUpButtonData: PopUpButtonData ¬ NARROW[instanceData]; popUpButtonData.handleProc[classData, event]; }; HandlePopUp: PROC [view: PopUpButtons.View, instanceData, classData, key: REF ANY] = { event: LIST OF REF ANY ¬ NARROW[key]; popUpData: PopUpData ¬ NARROW[instanceData]; popUpData.handleProc[view, classData, event]; }; StartChoiceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF PopUpButtons.Choice] = { ptr ¬ entityList ¬ NIL; }; AddChoice: PUBLIC PROC [entity: PopUpButtons.Choice, entityList, ptr: LIST OF PopUpButtons.Choice] RETURNS [newList, newPtr: LIST OF PopUpButtons.Choice] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr ¬ newList ¬ CONS[entity, NIL]; RETURN; } ELSE { newList ¬ entityList; ptr.rest ¬ CONS[entity, NIL]; newPtr ¬ ptr.rest; }; }; BuildTextViewer: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, initProc: InitButtonProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = { button ¬ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: ww, wh: lineHeight, data: name, scrollable: FALSE, border: border]]; IF initProc # NIL THEN initProc[name, clientData, button]; }; handleConfirm: REF Menus.ClickProc ¬ NEW[Menus.ClickProc ¬ HandleConfirm]; HandleConfirm: Menus.ClickProc = { buttonData: GGButtonData ¬ NARROW[clientData]; buttonData.confirmProc[buttonData.clientData]; }; <> SetBinaryState: PUBLIC PROC [twoState: TwoState, on: BOOL ¬ FALSE] = { twoState.on ¬ on; SELECT on FROM TRUE => Buttons.SetDisplayStyle[button: twoState.button, style: $WhiteOnBlack]; FALSE => Buttons.SetDisplayStyle[button: twoState.button, style: $BlackOnWhite]; ENDCASE => ERROR; }; GetBinaryState: PUBLIC PROC [twoState: TwoState] RETURNS [on: BOOL ¬ FALSE] = { on ¬ twoState.on; }; NextState: PROC [on: BOOL ¬ FALSE] RETURNS [BOOL ¬ FALSE] = { IF on = LAST[BOOL] THEN RETURN[FIRST[BOOL]] ELSE RETURN[SUCC[on]]; }; TwoSwitchProc: Buttons.ButtonProc = { handle: TwoState ¬ NARROW[clientData]; handle.handleProc[handle.clientData, handle.event]; }; SwitchBinaryState: PUBLIC PROC [handle: TwoState] = { nextState: BOOL ¬ FALSE; nextState ¬ NextState[handle.on]; SetBinaryState[handle, nextState]; }; <> CreateSortedButtonViewer: PUBLIC PROC [container: Viewer, x, y: NAT, lineHeight: INTEGER ¬ 15] RETURNS [SortedButtonHandle] = { sbHandle: AtomButtons.SortedButtonHandle ¬ NEW[SortedButtonHandleObj]; sbHandle.viewer ¬ MakeViewer[container, x, y, lineHeight]; sbHandle.headerButton ¬ NewHeaderButton[sbHandle.viewer, NIL]; RETURN[sbHandle]; }; BuildSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, sortedButtonList: LIST OF SortedButtonEntry] = { buttons: SortedButtonClient; prevButton: TiogaButtons.TiogaButton; oldSortedButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons]; <> FOR thisButton: SortedButtonClient ¬ oldSortedButtons, thisButton.next UNTIL thisButton=NIL DO thisButton.button.clientData ¬ NIL; thisButton.clientData ¬ NIL; TiogaButtons.DeleteButton[thisButton.button]; ENDLOOP; <> prevButton ¬ handle.headerButton; FOR list: LIST OF SortedButtonEntry ¬ sortedButtonList, list.rest UNTIL list = NIL DO prevButton ¬ AppendSortedButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.events, list.first.on]; IF list = sortedButtonList THEN buttons ¬ NARROW[prevButton.clientData]; ENDLOOP; handle.sortedButtons ¬ buttons; handle.handleProc ¬ handleProc; }; AppendSortedButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE ¬ NIL, value: REF ANY, events: LIST OF Event, on: BOOL ¬ FALSE] RETURNS [button: TiogaButtons.TiogaButton] = { <> buttonClient, prevButtonData: SortedButtonClient; buttonClient ¬ NEW[SortedButtonClientObj ¬ [NIL, name, value, events, on, NIL, clientData, handleProc]]; button ¬ TiogaButtons.AppendToButton[ button: prevButton, rope: Rope.Concat[name, " "], looks: "", proc: PressSorted, clientData: buttonClient, fork: FALSE]; prevButtonData ¬ NARROW[prevButton.clientData]; IF prevButtonData # NIL THEN prevButtonData.next ¬ buttonClient; <> buttonClient.button ¬ button; AdjustAppearance[buttonClient]; }; PressSorted: TiogaButtons.TiogaButtonProc ~ { buttonData: SortedButtonClient ¬ NARROW[clientData]; events: LIST OF Event ¬ buttonData.events; IF mouseButton = red THEN buttonData.handleProc[buttonData.clientData, events.first] ELSE IF mouseButton = yellow THEN { IF events.rest # NIL AND events.rest.first # NIL THEN buttonData.handleProc[buttonData.clientData, events.rest.first] ELSE buttonData.handleProc[buttonData.clientData, events.first]; } ELSE { -- mouseButton = blue IF events.rest # NIL AND events.rest.rest # NIL AND events.rest.rest.first # NIL THEN buttonData.handleProc[buttonData.clientData, events.rest.rest.first] ELSE buttonData.handleProc[buttonData.clientData, events.first]; }; }; ReadSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, readProc: ReadSortedProc, clientData: REF ANY ¬ NIL] = { buttonData: SortedButtonClient ¬ NARROW[handle.sortedButtons]; FOR thisButton: SortedButtonClient ¬ buttonData, thisButton.next UNTIL thisButton=NIL DO IF readProc[thisButton.on, thisButton.name, thisButton.value, clientData] THEN EXIT; ENDLOOP; }; AdjustAppearance: PROC [client: SortedButtonClient] = { IF client.on THEN TiogaButtons.ChangeButtonLooks[client.button, "b", ""] ELSE TiogaButtons.ChangeButtonLooks[client.button, "", "b"]; }; WriteSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, writeProc: WriteSortedProc, clientData: REF ANY ¬ NIL] = { buttonData: SortedButtonClient ¬ NARROW[handle.sortedButtons]; done, newState: BOOL ¬ FALSE; newName: Rope.ROPE; newValue: REF ANY; FOR thisClient: SortedButtonClient ¬ buttonData, thisClient.next UNTIL thisClient=NIL DO [newState, newName, newValue, done] ¬ writeProc[thisClient.on, thisClient.name, thisClient.value, clientData]; thisClient.on ¬ newState; thisClient.name ¬ IF newName = NIL THEN thisClient.name ELSE newName; thisClient.value ¬ newValue; AdjustAppearance[thisClient]; IF done THEN EXIT; ENDLOOP; }; AddSortedButton: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, entry: SortedButtonEntry, compareProc: CompareProc] RETURNS [oldFoundButton: SortedButtonClient ¬ NIL] = { <> list, finger: LIST OF AtomButtons.SortedButtonEntry; inserted: BOOL ¬ FALSE; oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons]; [list, finger] ¬ StartSortedButtonEntryList[]; FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO IF NOT inserted THEN { SELECT compareProc[entry.name, entry.value, thisClient.name, thisClient.value] FROM equal => { thisClient.on ¬ entry.on; AdjustAppearance[thisClient]; RETURN[thisClient]; }; less => { [list, finger] ¬ AddSortedButtonEntry[entry, list, finger]; inserted ¬ TRUE; }; ENDCASE => NULL; }; [list, finger] ¬ AddSortedButtonEntry[ [thisClient.name, thisClient.value, thisClient.events, thisClient.on], list, finger]; ENDLOOP; IF NOT inserted THEN { -- tack new slope onto right end of the list [list, finger] ¬ AddSortedButtonEntry[entry, list, finger]; }; <> FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO thisClient.button.clientData ¬ NIL; thisClient.clientData ¬ NIL; TiogaButtons.DeleteButton[thisClient.button]; ENDLOOP; handle.sortedButtons ¬ RebuildSortedButtons[handle.viewer, handle.headerButton, clientData, handle.handleProc, list]; FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO AdjustAppearance[thisClient]; ENDLOOP; }; DeleteSortedButtons: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, findProc: FindProc] = { oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons]; list, finger: LIST OF AtomButtons.SortedButtonEntry; found, done: BOOL ¬ FALSE; [list, finger] ¬ StartSortedButtonEntryList[]; FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO IF NOT done THEN { [found, done] ¬ findProc[thisClient.on, thisClient.name, thisClient.value, thisClient.clientData]; } ELSE found ¬ FALSE; IF NOT found THEN { [list, finger] ¬ AddSortedButtonEntry[ [thisClient.name, thisClient.value, thisClient.events, thisClient.on], list, finger]; }; ENDLOOP; FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO thisClient.button.clientData ¬ NIL; thisClient.clientData ¬ NIL; TiogaButtons.DeleteButton[thisClient.button]; ENDLOOP; handle.sortedButtons ¬ RebuildSortedButtons[handle.viewer, handle.headerButton, clientData, handle.handleProc, list]; FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO AdjustAppearance[thisClient]; ENDLOOP; }; RebuildSortedButtons: PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, sortedButtonList: LIST OF SortedButtonEntry] RETURNS [buttons: SortedButtonClient ¬ NIL] = { <> <> prevButton: TiogaButtons.TiogaButton ¬ headerButton; FOR list: LIST OF SortedButtonEntry ¬ sortedButtonList, list.rest UNTIL list = NIL DO prevButton ¬ AppendSortedButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.events, list.first.on]; IF list = sortedButtonList THEN buttons ¬ NARROW[prevButton.clientData]; ENDLOOP; }; StartSortedButtonEntryList: PROC [] RETURNS [entityList, ptr: LIST OF SortedButtonEntry] = { ptr ¬ entityList ¬ NIL; }; AddSortedButtonEntry: PROC [entity: SortedButtonEntry, entityList, ptr: LIST OF SortedButtonEntry] RETURNS [newList, newPtr: LIST OF SortedButtonEntry] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr ¬ newList ¬ CONS[entity, NIL]; RETURN; } ELSE { newList ¬ entityList; ptr.rest ¬ CONS[entity, NIL]; newPtr ¬ ptr.rest; }; }; <> <> <> <<>> BuildScalarButtons: PUBLIC PROC [handle: SortedButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, scalarButtonList: LIST OF ScalarButton] = { sortedList, ptr: LIST OF SortedButtonEntry; value: REF ANY; [sortedList, ptr] ¬ StartSortedButtonEntryList[]; FOR list: LIST OF ScalarButton ¬ scalarButtonList, list.rest UNTIL list = NIL DO value ¬ NEW[REAL ¬ list.first.value]; [sortedList, ptr] ¬ AddSortedButtonEntry[[list.first.name, value, list.first.events, list.first.on], sortedList, ptr]; ENDLOOP; BuildSortedButtons[handle, clientData, handleProc, header, sortedList]; }; SetAllScalarStates: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, on: BOOL ¬ FALSE] = { SetAll: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = { newState ¬ on; newValue ¬ value; }; WriteSortedButtons[handle, SetAll, clientData]; }; SetScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, on: BOOL ¬ FALSE, epsilon: REAL ¬ 0.001] = { SetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = { real: REAL ¬ NARROW[value, REF REAL]­; IF ABS[real-scalar] < epsilon THEN {newState ¬ on; done ¬ TRUE} ELSE newState ¬ state; newValue ¬ value; }; WriteSortedButtons[handle, SetOneState, clientData]; }; GetScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, epsilon: REAL ¬ 0.001] RETURNS [on: BOOL ¬ FALSE] = { GetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [done: BOOL ¬ FALSE] = { real: REAL ¬ NARROW[value, REF REAL]­; IF ABS[real-scalar] < epsilon THEN {on ¬ state; done ¬ TRUE; success ¬ TRUE}; }; success: BOOL ¬ FALSE; ReadSortedButtons[handle, GetOneState, clientData]; IF NOT success THEN ERROR; }; ToggleScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, epsilon: REAL ¬ 0.001] RETURNS [newState: BOOL ¬ FALSE] = { SetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = { real: REAL ¬ NARROW[value, REF REAL]­; IF ABS[real-scalar] < epsilon THEN {newState ¬ NOT state; done ¬ TRUE} ELSE newState ¬ state; newValue ¬ value; }; WriteSortedButtons[handle, SetOneState, clientData]; }; AppendScalarButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE ¬ NIL, value: REAL, on: BOOL ¬ FALSE, events: LIST OF Event] RETURNS [button: TiogaButtons.TiogaButton] = { refValue: REF ANY; IF name = NIL THEN { space: CHAR = ' ; name ¬ IO.PutFR1["%1.2f", [real[value]]]; name ¬ FileNames.Tail[name, space]; -- strip off leading spaces <> UNTIL Rope.Fetch[base: name, index: Rope.Length[name]-1]# '0 DO name ¬ Rope.Substr[base: name, start: 0, len: Rope.Length[name]-1]; ENDLOOP; <> IF Rope.Fetch[base: name, index: Rope.Length[name]-1] = '. THEN name ¬ Rope.Substr[base: name, start: 0, len: Rope.Length[name]-1]; }; refValue ¬ NEW[REAL ¬ value]; button ¬ AppendSortedButton[prevButton, clientData, handleProc, name, refValue, events, on]; }; AddScalarSorted: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, button: ScalarButton, order: Order ¬ incr] RETURNS [oldFoundButton: SortedButtonClient ¬ NIL] = { <> list, finger: LIST OF AtomButtons.ScalarButton; inserted: BOOL ¬ FALSE; oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons]; [list, finger] ¬ StartScalarButtonList[]; FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO <> thisScalar: REAL ¬ NARROW[thisClient.value, REF REAL]­; IF ABS[thisScalar-button.value] < epsilon THEN { thisClient.on ¬ button.on; AdjustAppearance[thisClient]; RETURN[thisClient]; }; IF NOT inserted AND order=decr AND thisScalarbutton.value THEN { -- insert new button behind thisClient [list, finger] ¬ AddScalarButton[button, list, finger]; inserted ¬ TRUE; }; [list, finger] ¬ AddScalarButton[ [thisClient.name, thisScalar, thisClient.events, thisClient.on], list, finger]; ENDLOOP; IF NOT inserted THEN { -- tack new slope onto proper end of the list [list, finger] ¬ AddScalarButton[button, list, finger]; }; <> FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO thisClient.button.clientData ¬ NIL; thisClient.clientData ¬ NIL; TiogaButtons.DeleteButton[thisClient.button]; ENDLOOP; handle.sortedButtons ¬ RebuildScalarButtons[viewer: handle.viewer, headerButton: handle.headerButton, clientData: clientData, handleProc: handle.handleProc, scalarButtonList: list]; FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO AdjustAppearance[thisClient]; ENDLOOP; }; RebuildScalarButtons: PUBLIC PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, scalarButtonList: LIST OF ScalarButton] RETURNS [buttons: SortedButtonClient ¬ NIL] = { <> <> prevButton: TiogaButtons.TiogaButton ¬ headerButton; FOR list: LIST OF ScalarButton ¬ scalarButtonList, list.rest UNTIL list = NIL DO prevButton ¬ AppendScalarButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.on, list.first.events]; IF list = scalarButtonList THEN buttons ¬ NARROW[prevButton.clientData]; ENDLOOP; }; StartScalarButtonList: PROC [] RETURNS [entityList, ptr: LIST OF ScalarButton] = { ptr ¬ entityList ¬ NIL; }; AddScalarButton: PROC [entity: ScalarButton, entityList, ptr: LIST OF ScalarButton] RETURNS [newList, newPtr: LIST OF ScalarButton] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr ¬ newList ¬ CONS[entity, NIL]; RETURN; } ELSE { newList ¬ entityList; ptr.rest ¬ CONS[entity, NIL]; newPtr ¬ ptr.rest; }; }; MakeViewer: PROC [container: Viewer, x, y: NAT, lineHeight: INTEGER] RETURNS [viewer: Viewer] = { viewer ¬ TiogaButtons.CreateViewer[ info: [ wx: x, wy: y, ww: container.ww, wh: lineHeight, parent: container, border: FALSE] ]; container.class.set[self: container, data: viewer, op: $XBound]; }; NewHeaderButton: PROC [v: Viewer, name: Rope.ROPE] RETURNS [button: TiogaButtons.TiogaButton] = { button ¬ TiogaButtons.CreateButton[ viewer: v, rope: name, format: "", looks: "", proc: NIL, clientData: NIL]; }; <> <<(like Choice Buttons, but built for the new User Interface Architecture (queues atoms onto the slack process queue and waits for them to return before acting. Thus, the buttons can be "pushed" from the TIP Table as well as with the mouse.>> BuildEnumTypeSelection: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: NAT, maxWidth: NAT, clientData: REF ANY, handleProc: HandleButtonProc, title: Rope.ROPE, default: Rope.ROPE, borderOnButtons: BOOL ¬ FALSE, style: StyleChoice, allInOneRow: BOOL ¬ FALSE, buttonNames: ButtonList, atom: ATOM, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [EnumTypeRef] = { foundDefault: BOOL ¬ FALSE; stateInfo: EnumTypeRef ¬ NEW[EnumTypeRec]; DefaultFound: PROC[currentName, defaultName: Rope.ROPE] RETURNS [BOOL ¬ FALSE] = { IF Rope.Equal[currentName, defaultName, FALSE] THEN RETURN [foundDefault ¬ TRUE] ELSE RETURN [FALSE]; }; BuildMenuSelection: PROC = { border: INTEGER ¬ 10; startButtons: NAT; startX: NAT ¬ 0; -- keeps a running tally of where the next x position is tempButton: Buttons.Button; eachButton: ButtonList; stateInfo.type ¬ menuStyle; stateInfo.handleProc ¬ handleProc; IF title # NIL THEN { titleLabel: Labels.Label¬ Labels.Create[[ name: title, parent: viewer, wx: x, wy: y, wh: lineHeight, border: FALSE ]]; startButtons ¬ titleLabel.wx + titleLabel.ww + horizontalSpace; } ELSE startButtons ¬ x; startX ¬ startButtons; FOR eachButton ¬ buttonNames, eachButton.rest UNTIL eachButton = NIL DO IF ~allInOneRow THEN { IF startX + VFonts.StringWidth[eachButton.first, VFonts.defaultFont] + border >= maxWidth THEN { startX ¬ startButtons; stateInfo.nexty ¬ stateInfo.nexty + lineHeight; }; }; tempButton ¬ Buttons.Create[info: [ name: eachButton.first, wx: startX, wy: stateInfo.nexty, <> wh: lineHeight, -- specify rather than defaulting so line is uniform parent: viewer, border: borderOnButtons ], proc: MenuSelectionProc, clientData: stateInfo ]; ViewerOps.AddProp[tempButton, $ChoiceButtons, stateInfo]; IF DefaultFound[eachButton.first, default] THEN { stateInfo.buttonOn ¬ tempButton; Buttons.SetDisplayStyle[button: tempButton, style: on]; }; startX ¬ tempButton.wx + tempButton.ww; ENDLOOP; stateInfo.nextx ¬ startX; }; BuildFlipThru: PROC = { eachButton: ButtonList; titleButton: Buttons.Button; nextx: INTEGER ¬ x; IF title # NIL THEN { -- create a title button stateInfo.type ¬ flipThruWithTitle; stateInfo.handleProc ¬ handleProc; titleButton ¬ Buttons.Create[ info: [name: title, parent: viewer, wx: nextx, wy: y, wh: lineHeight, border: TRUE ], proc: FlipThruButtonProc, clientData: stateInfo ]; nextx ¬ titleButton.wx + titleButton.ww + 3; } ELSE stateInfo.type ¬ flipThruNoTitle; FOR eachButton ¬ buttonNames, eachButton.rest UNTIL (eachButton = NIL) OR DefaultFound[eachButton.first, default] DO -- do nothing ENDLOOP; <> IF title # NIL THEN stateInfo.flipLabel ¬ Labels.Create[[ name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], -- first find the longest name so we can set up the <> wh: lineHeight, parent: viewer, border: FALSE ]] ELSE stateInfo.flipLabel ¬ Buttons.Create[ info: [name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], wh: lineHeight, parent: viewer, border: borderOnButtons ], proc: FlipThruButtonProc, clientData: stateInfo ]; stateInfo.nextx ¬ stateInfo.flipLabel.wx + stateInfo.flipLabel.ww; }; stateInfo.nextx ¬ x; stateInfo.nexty ¬ y; stateInfo.atom ¬ atom; stateInfo.namesOfButtons ¬ buttonNames; stateInfo.clientData ¬ clientData; IF default = NIL THEN -- set it to be the first name of the list of button names default ¬ buttonNames.first; SELECT style FROM menuSelection => BuildMenuSelection; flipThru => BuildFlipThru; ENDCASE => ERROR; <> IF ~foundDefault THEN SIGNAL DefaultDoesntExist; stateInfo.nexty ¬ stateInfo.nexty + lineHeight; RETURN[stateInfo]; }; -- end of BuildEnumTypeSelection FlipThruButtonProc: Buttons.ButtonProc = { info: EnumTypeRef ¬ NARROW[clientData]; IF mouseButton=red THEN info.handleProc[info.clientData, LIST[info.atom, $FlipForward--, info--]] ELSE info.handleProc[info.clientData, LIST[info.atom, $FlipBackward--, info--]]; }; TimeToFlipThru: PUBLIC PROC [event: LIST OF REF ANY] = { info: EnumTypeRef ¬ NARROW[event.rest.first]; IF event.first = $FlipForward THEN <> ViewerTools.SetContents[viewer: info.flipLabel, contents: GetNextName[info.namesOfButtons, info.flipLabel.name]] ELSE IF event.first = $FlipBackward THEN ViewerTools.SetContents[viewer: info.flipLabel, contents: GetPrevName[info.namesOfButtons, info.flipLabel.name]]; }; UpdateChoiceButtons: PUBLIC PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: Rope.ROPE] = { newButton: Buttons.Button ¬ NIL; GetDesiredButton: ViewerOps.EnumProc = { IF (Rope.Equal[v.name, newName, FALSE]) AND (ViewerOps.FetchProp[v, $ChoiceButtons] = enumTypeInfo) THEN { newButton ¬ v; RETURN [FALSE]; }; }; IF enumTypeInfo = NIL THEN SIGNAL ButtonsCannotBeUpdated; SELECT enumTypeInfo.type FROM menuStyle => {ViewerOps.EnumerateChildren[viewer, GetDesiredButton]; IF newButton # NIL THEN { SwitchButtons[enumTypeInfo.buttonOn, newButton]; enumTypeInfo.buttonOn ¬ newButton; } ELSE SIGNAL ChoiceDoesntExist; }; flipThruWithTitle => Labels.Set[label: enumTypeInfo.flipLabel, value: newName]; flipThruNoTitle => Buttons.ReLabel[button: enumTypeInfo.flipLabel, newName: newName]; ENDCASE => ERROR; }; DefaultDoesntExist: PUBLIC SIGNAL = CODE; ChoiceDoesntExist: PUBLIC SIGNAL = CODE; ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE; MaxNameWidth: PROC[listOfNames: ButtonList] RETURNS [CARDINAL] = { eachButton: ButtonList ¬ listOfNames; maxWidth: CARDINAL; IF eachButton # NIL THEN { maxWidth ¬ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton ¬ eachButton.rest } ELSE RETURN [0]; WHILE (eachButton # NIL) DO IF VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont] > maxWidth THEN maxWidth ¬ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton ¬ eachButton.rest; ENDLOOP; maxWidth ¬ maxWidth + VFonts.CharWidth['M]; -- add on a little extra just to be sure RETURN[maxWidth]; }; MenuSelectionProc: Buttons.ButtonProc = { info: EnumTypeRef ¬ NARROW[clientData]; viewer: ViewerClasses.Viewer ¬ NARROW[parent]; SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected info.buttonOn ¬ viewer; <> <> }; GetNextName: PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { eachButton: ButtonList ¬ listOfNames; WHILE (eachButton # NIL) AND (eachButton.first # currentName) DO eachButton ¬ eachButton.rest; ENDLOOP; IF eachButton = NIL THEN ERROR; -- This shouldn't happen; we should always be able to <> IF eachButton.rest = NIL THEN <> RETURN [listOfNames.first] ELSE RETURN [(eachButton.rest).first]; }; GetPrevName: PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { prev: Rope.ROPE ¬ listOfNames.first; eachName: ButtonList ¬ listOfNames.rest; WHILE (eachName # NIL) AND ~Rope.Equal[eachName.first, currentName, FALSE] DO prev ¬ eachName.first; eachName ¬ eachName.rest; ENDLOOP; RETURN[prev]; }; on: ATOM = $WhiteOnBlack; off: ATOM = $BlackOnWhite; SwitchButtons: PROC[oldButton, newButton: Buttons.Button] = { <> <> Buttons.SetDisplayStyle[button: oldButton, style: off]; <> Buttons.SetDisplayStyle[button: newButton, style: on]; }; <> GGUnQueuedButtonData: TYPE = REF GGUnQueuedButtonDataObj; GGUnQueuedButtonDataObj: TYPE = RECORD [ clientData: REF ANY, clickProc: Menus.ClickProc, confirmProc: ConfirmProc ]; BuildUnQueuedButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, entries: LIST OF UnQueuedButtonLineEntry, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [nextX: INTEGER] = { thisButton, prevButton: Buttons.Button; entry: UnQueuedButtonLineEntry; entry ¬ entries.first; prevButton ¬ BuildUnQueuedButton[container, x, y, clientData, entry.type, entry.clickProc, entry.name, entry.border, entry.ww, entry.updateProc, entry.confirmProc, entry.font, horizontalSpace, lineHeight]; nextX ¬ prevButton.wx + prevButton.ww; FOR entryList: LIST OF UnQueuedButtonLineEntry ¬ entries.rest, entryList.rest UNTIL entryList = NIL DO entry ¬ entryList.first; thisButton ¬ BuildUnQueuedButton[container, nextX + horizontalSpace, y, clientData, entry.type, entry.clickProc, entry.name, entry.border, entry.ww, entry.updateProc, entry.confirmProc, entry.font, horizontalSpace, lineHeight]; prevButton ¬ thisButton; nextX ¬ prevButton.wx + prevButton.ww; ENDLOOP; }; BuildUnQueuedButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, type: ButtonType, clickProc: Menus.ClickProc, name: Rope.ROPE, border: BOOL ¬ FALSE, ww: NAT, updateProc: UpdateProc, confirmProc: ConfirmProc, font: Imager.Font, horizontalSpace: INTEGER, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = { <> <> SELECT type FROM button => { buttonData: GGUnQueuedButtonData; buttonData ¬ NEW[GGUnQueuedButtonDataObj ¬ [clientData, clickProc, confirmProc]]; button ¬ Buttons.Create[ info: [name: name, wx: x, wy: y, wh: lineHeight, parent: container, border: border], proc: HandleUnQueuedButton, clientData: buttonData, documentation: handleUnQueuedConfirm, fork: TRUE, guarded: confirmProc # NIL, font: font ]; }; label => { button ¬ Labels.Create[ info: [ parent: container, name: name, wx: x, wy: y, ww: ww, wh: lineHeight, border: border]]; }; text => { button ¬ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: ww, wh: lineHeight, data: name, scrollable: FALSE, border: border]]; }; popUpButton => SIGNAL NotYetImplemented; -- not yet implemented ENDCASE => ERROR; IF updateProc # NIL THEN updateProc[name, clientData, button]; }; HandleUnQueuedButton: Menus.ClickProc = { buttonData: GGUnQueuedButtonData ¬ NARROW[clientData]; buttonData.clickProc[NIL, buttonData.clientData, mouseButton, shift, control]; }; handleUnQueuedConfirm: REF Menus.ClickProc ¬ NEW[Menus.ClickProc ¬ HandleUnQueuedConfirm]; HandleUnQueuedConfirm: Menus.ClickProc = { buttonData: GGUnQueuedButtonData ¬ NARROW[clientData]; buttonData.confirmProc[buttonData.clientData]; }; END.