<<>> <> <> <> <> <<>> DIRECTORY Ascii, Convert, IO, KeySymsKB, KeySymsSun, KeySymsOSF, KeySymsHP, Rope, Xl, XlAscii, XlCursor, XlCutBuffers, XTk, XTkCommon, XTkNumberLabel, XTkFriends, XTkLabels, XTkInputFocus; XTkNumberLabelImpl: CEDAR MONITOR IMPORTS Convert, IO, Xl, XlAscii, XlCutBuffers, XTk, XTkLabels, XTkNumberLabel, XTkFriends, XTkInputFocus EXPORTS XTkNumberLabel = BEGIN Widget: TYPE = XTk.Widget; WidgetSpec: TYPE = XTk.WidgetSpec; StyleSpec: TYPE = XTkCommon.StyleSpec; NumberFilter: TYPE = XTkNumberLabel.NumberFilter; valueChangedKey: PUBLIC REF ¬ $XTkNumberLabelChanged; classImplementsFocus: XTk.ClassFlagKey ~ cf1; events: Xl.EventFilter ~ Xl.CreateEventFilter[keyPress, buttonPress]; listOfSpecials: LIST OF Xl.KeySym ~ LIST[KeySymsSun.Paste, KeySymsOSF.Paste, KeySymsHP.Paste, KeySymsKB.Stop, KeySymsKB.Next, KeySymsKB.MoveRight]; numberClass: XTk.Class ¬ MakeClass[]; MakeClass: PROC [] RETURNS [c: XTk.ImplementorClass] = { c ¬ XTkFriends.CreateClass[basicMethods: [ key: $Number, super: XTkLabels.labelClass, initInstPart: NumberInitInstPart, preferredSizeLR: NumberPreferredSize, wDataNum: 1, cursorKey: NEW[XlCursor.StandardFontCursors ¬ centerPtr] ]]; XTk.SetClassFlag[c, classImplementsFocus]; }; NumberData: TYPE = REF NumberDataRec; NumberDataRec: TYPE = RECORD[ val: INT _ -1, editable: BOOL _ FALSE, filter: REF FilterRec ¬ NIL ]; FilterRec: TYPE = RECORD [proc: NumberFilter, data: REF]; GetNumberData: PROC [widget: XTk.Widget] RETURNS [numberData: NumberData] = INLINE { numberData _ NARROW[XTkFriends.InstPart[widget, numberClass]]; }; NumberInitInstPart: XTk.InitInstancePartProc = { numberData: NumberData ~ NEW[NumberDataRec]; XTkFriends.AssignInstPart[widget, numberClass, numberData]; XTk.AddPermanentMatch[widget, [proc: EventProc, handles: events, tq: Xl.CreateTQ[], data: widget], [keyPress: TRUE, buttonPress: TRUE]]; }; EventProc: Xl.EventProcType = { ENABLE { Xl.XError => GOTO oops; }; Beep: PROC [] = { Xl.Bell[event.connection, 100]; }; widget: XTk.Widget ~ NARROW[clientData]; numberData: NumberData ~ GetNumberData[widget]; IF ~numberData.editable THEN { Beep[]; RETURN; }; WITH event SELECT FROM keyPress: Xl.KeyPressEvent => { char: CHAR; keysym: Xl.KeySym; matched: Xl.KeySym; isModifier: BOOL; [char: char, keysym: keysym, matched: matched, isModifier: isModifier] ¬ XlAscii.Convert[event.connection, keyPress.keyCode, keyPress.state, listOfSpecials]; IF isModifier THEN RETURN; IF matched = KeySymsSun.Paste OR matched = KeySymsOSF.Paste OR matched = KeySymsHP.Paste THEN { sel: Rope.ROPE ¬ XlCutBuffers.Get[widget.connection]; val: INT _ Convert.IntFromRope[r: sel ! Convert.Error => {Beep[]; GOTO oops}]; IF val<=LAST[NAT] AND val>=0 THEN SetVal[widget, val]; RETURN }; IF matched = KeySymsKB.Next OR matched = KeySymsKB.MoveRight THEN { XTkInputFocus.SetFocus[XTkInputFocus.NextFocusTarget[widget]]; RETURN; }; IF matched = KeySymsKB.Stop THEN { XTkInputFocus.GiveUpFocus[widget, keyPress.timeStamp]; RETURN; }; IF char IN ['0..'9] THEN { val: INT ¬ GetVal[widget]; digit: INT ~ ORD[char]-ORD['0]; IF val<=LAST[NAT]/10 THEN val ¬ val*10 ELSE {val ¬ LAST[NAT]; Beep[]}; IF val<=LAST[NAT]-digit THEN val ¬ val+digit ELSE {val ¬ LAST[NAT]; Beep[]}; SetVal[widget, val]; RETURN; }; IF char=Ascii.BS THEN { val: INT ¬ GetVal[widget]; val ¬ val/10; SetVal[widget, val]; RETURN; }; Beep[]; }; buttonPress: Xl.ButtonPressEvent => { XTkInputFocus.SetFocus[widget, buttonPress.timeStamp]; }; ENDCASE => {}; EXITS oops => {}; }; Redisplay: XTk.WidgetNotifyProc = { ValToText: PROC [val: NAT] RETURNS [r: Rope.ROPE] = { r _ IO.PutFR1["%5d", IO.int[val]]; }; val: NAT ¬ GetVal[widget]; XTkLabels.SetText[widget, ValToText[val]]; }; IsNumberLabel: PUBLIC PROC [widget: XTk.Widget] RETURNS [BOOL] = { RETURN [widget#NIL AND XTk.HasClass[widget, numberClass]]; }; <<>> Create: PUBLIC PROC [widgetSpec: XTk.WidgetSpec, init: NAT, filter: NumberFilter ¬ NIL, filterData: REF ¬ NIL, style: StyleSpec, editable: BOOL] RETURNS [w: XTk.Widget] = { widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, numberClass]; w ¬ XTkLabels.CreateLabel[widgetSpec: widgetSpec, style: style]; XTk.RegisterNotifier[w, XTkNumberLabel.valueChangedKey, Redisplay]; SetFilter[w, filter, filterData]; SetVal[w, init]; SetEditable[w, editable]; }; GetVal: PUBLIC PROC [widget: XTk.Widget] RETURNS [value: NAT] = { numberData: NumberData ~ GetNumberData[widget]; value _ MAX[numberData­.val, 0]; }; SetFilter: PUBLIC PROC [widget: XTk.Widget, filter: NumberFilter ¬ NIL, filterData: REF ¬ NIL] = { numberData: NumberData ~ GetNumberData[widget]; newFilter: REF FilterRec _ NIL; IF filter#NIL THEN { newFilter ¬ NEW[FilterRec ¬ [filter, filterData]] }; numberData.filter ¬ newFilter }; SetVal: PUBLIC PROC [widget: XTk.Widget, value: NAT, event: XTk.Event ¬ NIL] = { numberData: NumberData ~ GetNumberData[widget]; IF numberData.val#value THEN { new: NAT _ value; inhibit: BOOL ¬ FALSE; filter: REF FilterRec _ numberData.filter; IF filter#NIL THEN [new, inhibit] ¬ filter.proc[widget, filter.data, value, event]; IF ~inhibit THEN InternalSetVal[widget, new, event]; }; }; InternalSetVal: PUBLIC PROC [widget: XTk.Widget, value: NAT, event: XTk.Event ¬ NIL] = { numberData: NumberData ~ GetNumberData[widget]; IF numberData.val#value THEN { numberData.val _ value; XTkFriends.CallNotifiers[widget, XTkNumberLabel.valueChangedKey, NIL, event]; }; }; SetEditable: PUBLIC PROC [widget: XTk.Widget, editable: BOOL] = { numberData: NumberData ~ GetNumberData[widget]; numberData.editable _ editable; }; NumberPreferredSize: XTk.PreferredSizeProc = { preferred ¬ [ size: [widget.s.geometry.size.width, widget.s.geometry.size.height], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; IF preferred.borderWidth<0 THEN widget.s.geometry.borderWidth ¬ preferred.borderWidth ¬ 0; IF preferred.size.width<=0 THEN widget.s.geometry.size.width ¬ preferred.size.width ¬ 60; IF preferred.size.height<=0 THEN widget.s.geometry.size.height ¬ preferred.size.height ¬ 20; }; END.