<> <> <> <> <<>> DIRECTORY Imager, Real, SF, Xl, XlBitmap, XTk, XTkBiScrollerFrame, XTkBitmapScroller, XTkBitmapWidgets; XTkBitmapScrollerImpl: CEDAR MONITOR IMPORTS Real, SF, XlBitmap, XTkBiScrollerFrame, XTkBitmapWidgets, Xl, XTk EXPORTS XTkBitmapScroller SHARES XTkBitmapWidgets = BEGIN OPEN XTkBitmapScroller; <<>> BitmapScrollerRec: TYPE = RECORD [ bm: XlBitmap.Bitmap ¬ NIL, bitmap: XTk.Widget ¬ NIL, clientRestrict: SF.Box ¬ [min: [1, 1], max: [0, 0]], surfaceUnitsPerPixel: NAT ¬ 1, windowPos: Xl.Point ¬ [0, 0], --window position to place origin of bitmap scrolledCallBack: ScrolledCallBackProc ¬ NIL, scrollTQ: Xl.TQ ¬ NIL, scrollData: REF ¬ NIL ]; myKey: REF INT ¬ NEW[INT]; GetData: PROC [scroller: XTk.Widget] RETURNS [REF BitmapScrollerRec] = { RETURN [NARROW[XTk.GetWidgetProp[scroller, myKey]]]; }; CreateBitmapScroller: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], scrolledCallBack: ScrolledCallBackProc, scrollTQ: Xl.TQ, scrollData: REF, insideSize: Xl.Size] RETURNS [XTk.Widget] = { data: REF BitmapScrollerRec ¬ NEW[BitmapScrollerRec ¬ [scrollTQ: scrollTQ, scrolledCallBack: scrolledCallBack, scrollData: scrollData]]; bitmap: XTk.Widget ¬ data.bitmap ¬ XTkBitmapWidgets.CreateBitmapWidget[]; biScroller: XTk.Widget ¬ XTkBiScrollerFrame.CreateBiScrollerFrame[ widgetSpec: widgetSpec, child: bitmap, insideSize: insideSize ]; XTk.PutWidgetProp[biScroller, myKey, data]; XTk.RegisterNotifier[bitmap, XTk.postWindowCreationKey, PostRealize, biScroller]; XTk.RegisterNotifier[bitmap, XTk.postConfigureKey, PostRealize, biScroller]; XTkBiScrollerFrame.SetScrollProc[biScrollerFrame: biScroller, scrollProc: BiScrollerProc, clientData: data, tq: scrollTQ]; RETURN [biScroller] }; PostRealize: XTk.WidgetNotifyProc = { <<--when realized, the pos for scrollpos is ok, but the displayed fields are NOT>> scroller: XTk.Widget ¬ NARROW[registerData]; ScrollTo[scroller, GetScrollPos[scroller]] }; BiScrollerProc: XTkBiScrollerFrame.ScrollProc = { <<--called from biscroller, must perform action and new display>> data: REF BitmapScrollerRec ¬ NARROW[clientData]; bmBox: SF.Box ¬ data.clientRestrict; bmSize: SF.Vec ¬ SF.Size[bmBox]; wPos: Xl.Point ¬ data.windowPos; windowH: INT ¬ data.bitmap.actual.size.height; windowW: INT ¬ data.bitmap.actual.size.width; SELECT hAction FROM forward => {wPos.x ¬ Real.Round[wPos.x-x*windowW]}; backward => {wPos.x ¬ Real.Round[wPos.x+x*windowW]}; thumb => { thumbBaseX: INT ¬ MAX[bmSize.f-windowW, 0]; wPos.x ¬ -Real.Round[bmBox.min.f+x*thumbBaseX] }; configure => {}; ENDCASE => {}; SELECT vAction FROM forward => {wPos.y ¬ Real.Round[wPos.y-y*windowH]}; backward => {wPos.y ¬ Real.Round[wPos.y+y*windowH]}; thumb => { thumbBaseY: INT ¬ MAX[bmSize.s-windowH, 0]; wPos.y ¬ -Real.Round[bmBox.min.s+y*thumbBaseY] }; configure => {}; ENDCASE => {}; <<--beeing interactive we limit the possible range to nearly usefull...>> wPos.x ¬ MIN[wPos.x, <>-bmBox.min.f]; wPos.x ¬ MAX[wPos.x, -bmBox.max.f]; wPos.y ¬ MIN[wPos.y, <>-bmBox.min.s]; wPos.y ¬ MAX[wPos.y, -bmBox.max.s]; ScrollTo[biScrollerFrame, wPos]; }; SetBitmap: PUBLIC PROC [scroller: XTk.Widget, bitmap: XlBitmap.Bitmap, surfaceUnitsPerPixel: NAT ¬ 1, pos: Xl.Point] = { data: REF BitmapScrollerRec ¬ NARROW[XTk.GetWidgetProp[scroller, myKey]]; data.bm ¬ bitmap; data.clientRestrict ¬ XlBitmap.GetBox[bitmap]; data.surfaceUnitsPerPixel ¬ surfaceUnitsPerPixel; ScrollTo[scroller, pos]; }; GetBitmap: PUBLIC PROC [scroller: XTk.Widget] RETURNS [bitmap: XlBitmap.Bitmap, surfaceUnitsPerPixel: NAT] = { data: REF BitmapScrollerRec ¬ GetData[scroller]; bitmap ¬ data.bm; surfaceUnitsPerPixel ¬ data.surfaceUnitsPerPixel; }; CreateAndSetBitmap: PUBLIC PROC [scroller: XTk.Widget, size: SF.Vec, bpp: NAT ¬ 1, surfaceUnitsPerPixel: NAT ¬ 1, pos: Xl.Point ¬ [0, 0]] = { bm: XlBitmap.Bitmap ¬ XlBitmap.Create[size, bpp]; SetBitmap[scroller, bm, surfaceUnitsPerPixel, pos] }; CreateContext: PUBLIC PROC [scroller: XTk.Widget] RETURNS [context: Imager.Context] = { data: REF BitmapScrollerRec ¬ GetData[scroller]; RETURN [XTkBitmapWidgets.CreateContext[data.bitmap, data.surfaceUnitsPerPixel]]; }; ShowScrollbars: PROC [biScroller: XTk.Widget, data: REF BitmapScrollerRec, pos: Xl.Point] = { state2: XTkBiScrollerFrame.State2; bmBox: SF.Box ¬ data.clientRestrict; bmSz: SF.Vec ¬ SF.Max[SF.Size[bmBox], [1, 1]]; winW: INT ¬ MAX[data.bitmap.actual.size.width, 1]; winH: INT ¬ MAX[data.bitmap.actual.size.height, 1]; pX: REAL ¬ -(pos.x + bmBox.min.f); pY: REAL ¬ -(pos.y + bmBox.min.s); <<--horizontal>> IF bmSz.f<=winW THEN { state2.h.start ¬ pX/bmSz.f; state2.h.next ¬ state2.h.start + MAX[bmSz.f-pX, 0.0]/bmSz.f; } ELSE { w: REAL = winW; state2.h.start ¬ pX/bmSz.f; state2.h.next ¬ state2.h.start + w/bmSz.f; }; <<--vertical>> IF bmSz.s<=winH THEN { state2.v.start ¬ pY/bmSz.s; state2.v.next ¬ state2.v.start + MAX[bmSz.s-pY, 0.0]/bmSz.s; } ELSE { h: REAL = winH; state2.v.start ¬ pY/bmSz.s; state2.v.next ¬ state2.v.start + h/bmSz.s; }; XTkBiScrollerFrame.ParentalSetState[biScrollerFrame: biScroller, state: state2]; }; ScrollTo: PUBLIC PROC [scroller: XTk.Widget, pos: Xl.Point] = { <> data: REF BitmapScrollerRec ¬ GetData[scroller]; action: PROC = { data.windowPos ¬ pos; XTkBitmapWidgets.SetBitmap[widget: data.bitmap, bitmap: data.bm, origin: pos]; IF data.scrolledCallBack#NIL THEN data.scrolledCallBack[scroller, pos, data.scrollData]; ShowScrollbars[scroller, data, pos]; }; IF data.scrollTQ=NIL THEN action[] ELSE Xl.CallWithLock[data.scrollTQ, action] }; GetScrollPos: PUBLIC PROC [scroller: XTk.Widget] RETURNS [Xl.Point] = { RETURN [GetData[scroller].windowPos] }; Wait: PUBLIC PROC [scroller: XTk.Widget, server: BOOL ¬ FALSE] = { XTkBitmapWidgets.Wait[GetImplWidget[scroller], server]; }; GetImplData: PUBLIC PROC [scroller: XTk.Widget] RETURNS [REF] = { w: XTk.Widget ~ GetImplWidget[scroller]; RETURN [XTkBitmapWidgets.GetImplData[w]]; }; << >> GetImplWidget: PUBLIC PROC [scroller: XTk.Widget] RETURNS [XTk.Widget] = { data: REF BitmapScrollerRec ¬ GetData[scroller]; RETURN [data.bitmap]; }; GetVisibleBox: PUBLIC PROC [scroller: XTk.Widget] RETURNS [b: SF.Box] = { data: REF BitmapScrollerRec ¬ GetData[scroller]; b.min.f ¬ -data.windowPos.x; b.min.s ¬ -data.windowPos.y; b.max.f ¬ b.min.f+data.bitmap.actual.size.width; b.max.s ¬ b.min.f+data.bitmap.actual.size.height; }; << >> END.