DIRECTORY Real, Xl, XTk, XTkBiScrollerFrame, XTkFriends, XTkXBiScroller, XTkXScroller; XTkXBiScrollerImpl: CEDAR MONITOR IMPORTS Real, Xl, XTkXScroller, XTkBiScrollerFrame, XTk, XTkFriends EXPORTS XTkXBiScroller = BEGIN OPEN XTkXBiScroller; stateChanged: PUBLIC ATOM ฌ $XBiScrollerState; xBiScrollerClass: PUBLIC XTk.Class ~ CreateXBiScrollerClass[]; CreateXBiScrollerClass: PROC [] RETURNS [XTk.Class] = { class: XTk.ImplementorClass ~ XTkFriends.CreateClass[[super: XTkBiScrollerFrame.biScrollerFrameClass, key: $xBiScroller, initInstPart: XBiScrollerInitInstPart, wDataNum: 1]]; RETURN [class]; }; CreateXBiScroller: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ฌ [], child: XTk.Widget ฌ NIL, insideSize: Xl.Size ฌ [XTk.dontUse, XTk.dontUse], vsbar, hsbar: BOOL] RETURNS [XBiScroller] = { widgetSpec.class ฌ XTkFriends.InitClassField[widgetSpec.class, xBiScrollerClass]; BEGIN xBiScroller: XTk.Widget ฌ XTkBiScrollerFrame.CreateBiScrollerFrame[widgetSpec, NIL, insideSize, vsbar, hsbar]; xbsd: XBSData ฌ GetXBiScrollerData[xBiScroller]; IF child#NIL THEN ReplaceChild[xBiScroller, child, TRUE]; XTkBiScrollerFrame.SetScrollProc[xBiScroller, Scroll]; XTkXScroller.SetBindXY[xbsd.dummyChild, NOT hsbar, NOT vsbar]; RETURN [xBiScroller]; END; }; IsXBiScroller: PUBLIC PROC [widget: XTk.Widget] RETURNS [BOOL] = { RETURN [XTk.HasClass[widget, xBiScrollerClass]] }; XBSData: TYPE = REF XBSDataRec; XBSDataRec: TYPE = RECORD [ dummyChild: XTk.Widget ฌ NIL, --direct child of biscroller, parent of real child pos: Xl.Point ฌ [0, 0], filterPair: REF FilterPair ฌ NIL ]; GetXBiScrollerData: PROC [widget: XTk.Widget] RETURNS [XBSData] = INLINE { RETURN [ NARROW[XTkFriends.InstPart[widget, xBiScrollerClass]] ]; }; XBiScrollerInitInstPart: XTk.InitInstancePartProc = { xbsd: XBSData ~ NEW[XBSDataRec ฌ []]; XTkFriends.AssignInstPart[widget, xBiScrollerClass, xbsd]; xbsd.dummyChild ฌ XTkXScroller.CreateXScroller[]; XTkBiScrollerFrame.ReplaceChild[widget, xbsd.dummyChild]; XTk.RegisterNotifier[xbsd.dummyChild, XTk.postConfigureLRKey, CheckChildState, widget]; XTk.RegisterNotifier[xbsd.dummyChild, XTk.postWindowCreationLRKey, CheckChildState, widget]; }; GetInnerSize: PROC [w: XTk.Widget] RETURNS [sz: Xl.Size ฌ [200, 200]] = { IF w#NIL THEN { sz.width ฌ MIN[MAX[w.actual.size.width, 1], 10000]; sz.height ฌ MIN[MAX[w.actual.size.height, 1], 10000]; }; }; GetOuterSize: PROC [w: XTk.Widget] RETURNS [sz: Xl.Size ฌ [200, 200]] = { IF w#NIL THEN { b: INT ฌ MIN[MAX[w.actual.borderWidth, 0], 500]; sz ฌ GetInnerSize[w]; sz.width ฌ sz.width + 2*b; sz.height ฌ sz.height + 2*b; }; }; Scroll: XTkBiScrollerFrame.ScrollProc = { xBiScroller: XBiScroller ~ biScrollerFrame; <> doit: BOOL ฌ FALSE; xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; dummyChild: XTk.Widget ฌ xbsd.dummyChild; realChild: XTk.Widget ฌ XTkXScroller.Child[dummyChild]; docsz: Xl.Size ฌ GetOuterSize[realChild]; winsz: Xl.Size ฌ GetInnerSize[dummyChild]; p: Xl.Point ฌ EntryGetState[xbsd]; SELECT hAction FROM thumb => { p.x ฌ - Real.Round[x*docsz.width]; doit ฌ TRUE; }; forward => { p.x ฌ p.x - Real.Round[x*winsz.width]; doit ฌ TRUE; }; backward => { p.x ฌ p.x + Real.Round[x*winsz.width]; doit ฌ TRUE; }; ENDCASE => {}; SELECT vAction FROM thumb => { p.y ฌ - Real.Round[y*docsz.height]; doit ฌ TRUE; }; forward => { p.y ฌ p.y - Real.Round[y*winsz.height]; doit ฌ TRUE; }; backward => { p.y ฌ p.y + Real.Round[y*winsz.height]; doit ฌ TRUE; }; ENDCASE => {}; IF doit THEN PublicSetState[xBiScroller, p, event]; }; FilterPair: TYPE = RECORD [ filterProc: FilterProc ฌ NIL, filterData: REF ฌ NIL ]; SetFilterProc: PUBLIC PROC [xBiScroller: XBiScroller, filterProc: FilterProc, filterData: REF ฌ NIL] = { xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; pair: REF FilterPair ฌ NIL; IF filterProc#NIL THEN pair ฌ NEW[FilterPair ฌ [filterProc, filterData]]; xbsd.filterPair ฌ pair }; Child: PUBLIC PROC [xBiScroller: XTk.Widget] RETURNS [XTk.Widget ฌ NIL] = { xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; RETURN [XTkXScroller.Child[xbsd.dummyChild]]; }; ReplaceChild: PUBLIC PROC [xBiScroller: XBiScroller, child: XTk.Widget, delayed: BOOL ฌ FALSE, preventDestructionOfOldChild: BOOL ฌ FALSE] = { xbsd: XBSData ฌ GetXBiScrollerData[xBiScroller]; XTkXScroller.ReplaceChild[xbsd.dummyChild, child, delayed, preventDestructionOfOldChild]; }; SizeSubtract: PROC [szVal: INT, sub: INT] RETURNS [INT] = { IF szVal>0 THEN szVal ฌ MAX[szVal-sub, 1]; RETURN [szVal] }; PublicSetState: PUBLIC PROC [xBiScroller: XBiScroller, p: Xl.Point, event: XTk.Event ฌ NIL] = { xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; pair: REF FilterPair ฌ xbsd.filterPair; IF pair=NIL THEN <>DirectSetState[xBiScroller, p, event] ELSE pair.filterProc[xBiScroller, p, pair.filterData, event] }; CheckChildState: XTk.WidgetNotifyProc = { xBiScroller: XTk.Widget ~ NARROW[registerData]; xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; state: XTkBiScrollerFrame.State2; f: REAL; docSize: Xl.Size ฌ GetOuterSize[XTkXScroller.Child[xbsd.dummyChild]]; winSize: Xl.Size ฌ GetInnerSize[xbsd.dummyChild]; p: Xl.Point ฌ EntryGetState[xbsd]; state.v.start ฌ (f ฌ MAX[-p.y, 0])/docSize.height; state.h.start ฌ (f ฌ MAX[-p.x, 0])/docSize.width; state.v.next ฌ state.v.start + (f ฌ winSize.height)/docSize.height; state.h.next ฌ state.h.start + (f ฌ winSize.width)/docSize.width; <>XTkBiScrollerFrame.ParentalSetState[xBiScroller, state, event]; }; DirectSetState: PUBLIC PROC [xBiScroller: XBiScroller, p: Xl.Point, event: XTk.Event ฌ NIL] = { xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; rootTQ: Xl.TQ ฌ xBiScroller.rootTQ; action: PROC [] = { EntrySetState[xbsd, p]; <>XTkXScroller.SetOffset[xbsd.dummyChild, p]; XTkFriends.CallNotifiers[xBiScroller, stateChanged, xbsd, event]; }; IF rootTQ=NIL OR xBiScroller.state>=screened THEN action[] ELSE Xl.CallWithLock[rootTQ, action]; }; GetState: PUBLIC PROC [xBiScroller: XBiScroller] RETURNS [p: Xl.Point] = { xbsd: XBSData ~ GetXBiScrollerData[xBiScroller]; RETURN [EntryGetState[xbsd]]; }; EntrySetState: ENTRY PROC [xbsd: XBSData, p: Xl.Point] = INLINE { xbsd.pos ฌ p }; EntryGetState: ENTRY PROC [xbsd: XBSData] RETURNS [p: Xl.Point] = INLINE { RETURN [xbsd.pos] }; END. โ XTkXBiScrollerImpl.mesa Copyright ำ 1992, 1993 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, June 9, 1992 6:45 pm PDT Christian Jacobi, September 17, 1993 10:32 am PDT <> สj–(cedarcode) style•NewlineDelimiter ™code™Kšœ ฯeœ7™BK™5K™1K™—šฯk œ˜ K˜K˜K˜K˜K˜ K˜K˜ K˜—šฯnœžœžœ˜"Kšžœ<˜CKšžœ˜—Kšžœžœ˜K˜Kšœžœžœ˜.K˜šœžœ&˜>šŸœžœžœ˜7K˜ฎKšžœ ˜Kšœ˜K˜——š Ÿœžœžœ7žœBžœžœ˜นK˜Qšž˜KšœOžœ˜nK˜0Kšžœžœžœ"žœ˜9K˜6Kšœ(žœžœ˜>Kšžœ˜Kšžœ˜—K˜—K˜š Ÿ œžœžœžœžœ˜BKšžœ)˜/K˜K˜—Kšœ žœžœ ˜šœ žœžœ˜Kšœžœฯc2˜PK˜Kšœ žœž˜ K˜K˜—šŸœžœžœ žœ˜JKšžœžœ2˜AK˜K˜—šŸœ˜5Kšœžœ˜%K˜:K˜1K˜9K˜WK˜\K˜K˜—šŸ œžœžœ˜Išžœžœžœ˜Kšœ žœžœ!˜3Kšœ žœžœ"˜5K˜—K˜K˜—šŸ œžœžœ˜Išžœžœžœ˜Kšœžœžœžœ ˜0K˜K˜K˜K˜—K˜—K˜šŸœ#˜)Kšœ,ฯiœ˜5Kšœžœžœ˜K˜0K˜)K˜7K˜)K˜*K˜"šžœ ž˜˜ K˜"Kšœžœ˜ K˜—˜ K˜&Kšœžœ˜ K˜—˜ K˜&Kšœžœ˜ K˜—Kšžœ˜—šžœ ž˜˜ K˜#Kšœžœ˜ K˜—˜ K˜'Kšœžœ˜ K˜—˜ K˜'Kšœžœ˜ K˜—Kšžœ˜—Kšžœžœ'˜3K˜—K˜šœ žœžœ˜Kšœžœ˜Kšœ žœž˜˜K˜——š Ÿ œžœžœ@žœžœ˜hK˜0Kšœžœžœ˜Kšžœ žœžœžœ(˜IK˜Kšœ˜K˜—š Ÿœžœžœžœžœ˜KK˜0Kšžœ'˜-K˜K˜—šŸ œžœžœ8žœžœ žœžœ˜ŽK˜0K™K˜YK˜K˜—š Ÿ œžœ žœžœžœžœ˜;Kšžœ žœ žœ˜*Kšžœ˜K˜—K˜šŸœžœžœ<žœ˜_K˜0Jšœžœ˜'šžœžœ˜ Jšžœกœ%˜2Jšžœ8˜<—K˜K˜—šŸœ˜)Kšœžœ˜/K˜0K˜!Kšœžœ˜K˜EK˜1K˜"Kšœžœ˜2Kšœžœ˜1K˜CK˜AKšกœ?˜XK˜—K˜šŸœžœžœ<žœ˜_K˜0Kšœ žœ˜#šœžœ˜K˜Kšกœ+˜@K˜AK˜—šžœžœžœ˜-Kšžœ ˜Kšžœ!˜%—K˜K˜—šŸœžœžœžœ˜JK˜0Kšžœ˜K˜K˜—šŸ œžœžœ žœ˜AK˜ K˜K˜—š Ÿ œžœžœžœžœ˜JKšžœ ˜K˜K˜—Kšžœ˜K˜KšŸ˜—…—`ฌ