<> <> <> <> <<>> <> DIRECTORY BiScrollers, Cursors, Geom2D, Imager, ImagerBackdoor, ImagerTransformation, InputFocus, Menus, Real, TIPUser, ViewerClasses, ViewerOps; BiScrollersButtonned: CEDAR MONITOR IMPORTS BiScrollers, Cursors, Geom2D, Imager, ImagerBackdoor, ImagerTransformation, InputFocus, Menus, Real, TIPUser, ViewerOps SHARES ViewerOps = BEGIN OPEN BiScrollers; Number: TYPE = Geom2D.Number; ViewerClass: TYPE = ViewerClasses.ViewerClass; Axis: TYPE = Geom2D.Axis; Vec: TYPE = Geom2D.Vec; Buttonned: TYPE = REF ButtonnedRep; ButtonnedRep: TYPE = RECORD [ class: ButtonnedClass, clientData: REF ANY, container, client: Viewer _ NIL, children: Child _ NIL, t, u: Transform _ Geom2D.id, tp, up: Transform _ Geom2D.id, h, v: Viewer _ NIL, --horizontal and vertical BiScrollBars-- cw, ch: INTEGER _ 0, --of container, last time we looked-- clientWantsActive: BOOL _ FALSE ]; ButtonnedClass: TYPE = REF ButtonnedClassRep; ButtonnedClassRep: TYPE = RECORD [ clientClass: ViewerClass, menu: Menus.Menu]; Child: TYPE = REF ChildObject; ChildObject: TYPE = RECORD [next: Child, where: Vec, it: Viewer]; Range: TYPE = REF RangeObject; RangeObject: TYPE = RECORD [min, max: Number]; BiScrollBar: TYPE = REF BiScrollBarObject; BiScrollBarObject: TYPE = RECORD [ viewer: Viewer _ NIL, parent: BiScroller, axis: Axis, state: State _ Idle, cursors: ARRAY State OF Cursors.CursorType]; State: TYPE = {Idle, Increase, Decrease, Random}; awake: Viewer _ NIL; --who has CapturedButtons indent: INTEGER _ 11; --width of BiScrollBars reset: Cursors.CursorType _ bullseye; grayl: Imager.Color _ ImagerBackdoor.MakeStipple[8421H]; graym: Imager.Color _ ImagerBackdoor.MakeStipple[5A5AH]; grayh: Imager.Color _ ImagerBackdoor.MakeStipple[1248H]; buttonnedStyle: BiScrollerStyle _ NEW [BiScrollerStyleRep _ [ NewBiScrollerClass: NewBiScrollerClass, CreateBiScroller: CreateBiScroller, Destroy: Destroy, GetTransforms: GetTransforms, ChangeTransform: ChangeTransform, AddChild: AddChild, DeleteChild: DeleteChild, SetButtonsCapturedness: SetButtonsCapturedness, ViewportOf: ViewportOf, QuaViewer: QuaViewer, ClientDataOf: ClientDataOf ]]; containerFlavor: ATOM _ $ButtonnedContainer; NewBiScrollerClass: PROC [cc: ClassCommon] RETURNS [bsc: BiScrollerClass] = BEGIN vc: ViewerClass; IF cc.vanilla = NIL THEN cc.vanilla _ GenID; IF cc.bsUserAction = NIL THEN cc.bsUserAction _ DoBSUserAction; IF cc.caption#NIL THEN ERROR--not implemented yet--; vc _ NEW [ViewerClasses.ViewerClassRec _ [ flavor: cc.flavor, notify: NotifyBiScroller, paint: PaintClient, modify: cc.modify, destroy: cc.destroy, copy: cc.copy, set: cc.set, get: cc.get, save: cc.save, adjust: cc.adjust, tipTable: cc.tipTable, icon: cc.icon, cursor: cc.cursor]]; ViewerOps.RegisterViewerClass[flavor: vc.flavor, class: vc]; bsc _ NEW [BiScrollerClassRep _ [ style: buttonnedStyle, common: cc, rep: NEW [ButtonnedClassRep _ [ clientClass: vc, menu: cc.menu ]] ]]; END; CreateBiScroller: PROC [class: BiScrollerClass, info: ViewerClasses.ViewerRec _ [], paint: BOOLEAN _ TRUE] RETURNS [new: BiScroller] = BEGIN bdc: ButtonnedClass _ NARROW[class.rep]; paintFirst: BOOL = paint AND info.iconic; bd: Buttonned _ NEW[ButtonnedRep _ [class: bdc, clientData: info.data, t: Geom2D.id]]; clientInfo: ViewerClasses.ViewerRec; info.data _ new _ NEW [BiScrollerRep _ [ style: class.style, class: class, rep: bd]]; bd.container _ ViewerOps.CreateViewer[flavor: containerFlavor, info: info, paint: paintFirst]; bd.h _ ViewerOps.CreateViewer[flavor: $BiScrollBarX, info: [ name: "X scrolling", parent: bd.container, wx: indent, wy: 0, ww: bd.container.cw-indent, wh: indent, data: NEW[BiScrollBarObject _ [parent: new, axis: X, cursors: [ Increase: scrollLeft, Decrease: scrollRight, Random: pointUp, Idle: scrollLeftRight]]], scrollable: FALSE, border: FALSE], paint: FALSE]; bd.v _ ViewerOps.CreateViewer[flavor: $BiScrollBarY, info: [ name: "Y scrolling", parent: bd.container, wx: 0, wy: indent, ww: indent, wh: bd.container.ch-indent, data: NEW[BiScrollBarObject _ [parent: new, axis: Y, cursors: [ Increase: scrollUp, Decrease: scrollDown, Random: pointRight, Idle: scrollUpDown]]], scrollable: FALSE, border: FALSE], paint: FALSE]; clientInfo _ info; clientInfo.parent _ bd.container; clientInfo.border _ FALSE; clientInfo.menu _ NIL; bd.client _ ViewerOps.CreateViewer[flavor: bdc.clientClass.flavor, info: clientInfo, paint: FALSE]; [] _ ComputeClientBounds[new, bd, FALSE]; ChangeTransform[new, class.common.vanilla[new], ignore, FALSE]; SetBS[bd.container, new]; IF class.common.init # NIL THEN class.common.init[bd.client]; IF paintFirst THEN NULL ELSE IF bd.container.parent=NIL THEN ViewerOps.ComputeColumn[column: ViewerOps.ViewerColumn[bd.container], paint: paint] ELSE IF paint THEN ViewerOps.PaintViewer[bd.container, all]; END; Destroy: PROC [bs: BiScroller] RETURNS [BiScroller] = BEGIN bd: Buttonned _ NARROW[bs.rep]; ViewerOps.DestroyViewer[bd.container]; bd.container _ NIL; RETURN [NIL]; END; AddChild: PROC [to: BiScroller, what: Viewer, x, y: REAL _ 0, useTheseCoords: BOOLEAN _ FALSE, paint: BOOLEAN _ TRUE] = BEGIN bd: Buttonned _ NARROW[to.rep]; my: Vec; c: Child _ NEW [ChildObject _ [ next: bd.children, it: what, where: IF useTheseCoords THEN [x, y] ELSE [what.wx, what.wy] ]]; bd.children _ c; my _ bd.t.Transform[c.where]; ViewerOps.MoveViewer[viewer: what, x: RI[my.x], y: RI[my.y], w: what.ww, h: what.wh, paint: paint]; END; DeleteChild: PROC [of: BiScroller, who: Viewer] = BEGIN bd: Buttonned _ NARROW[of.rep]; Filter: PROC [c: Child] RETURNS [Child] = {IF c = NIL THEN RETURN [NIL]; IF c.it = who THEN RETURN [c.next]; c.next _ Filter[c.next]; RETURN [c]}; bd.children _ Filter[bd.children]; END; QuaViewer: PROC [bs: BiScroller, inner: BOOL _ FALSE] RETURNS [v: Viewer] = {bd: Buttonned _ NARROW[bs.rep]; v _ IF inner THEN bd.client ELSE bd.container}; ClientDataOf: PROC [bs: BiScroller] RETURNS [ra: REF ANY] = {bd: Buttonned _ NARROW[bs.rep]; ra _ bd.clientData}; ViewportOf: PROC [bs: BiScroller] RETURNS [VecList] = BEGIN bd: Buttonned _ NARROW[bs.rep]; RETURN [Geom2D.MapVecs[bd.u, LIST[ [0, 0], [bd.client.cw, 0], [bd.client.cw, bd.client.ch], [0, bd.client.ch]]]]; END; ComputeClientBounds: PROC [bs: BiScroller, bd: Buttonned, adjust: BOOL] RETURNS [changed: BOOL] = { <> IF changed _ (bd.cw # bd.container.cw OR bd.ch # bd.container.ch) THEN { client: Vec --the point that stays fixed, in client coords--; IF adjust THEN { client _ bd.u.Transform[[ bs.class.common.preserve[X]*bd.client.cw, bs.class.common.preserve[Y]*bd.client.ch]]; }; bd.cw _ bd.container.cw; bd.ch _ bd.container.ch; SetViewerPosition[bd.h, indent, 0, bd.cw-indent, indent]; SetViewerPosition[bd.v, 0, indent, indent, bd.ch-indent]; SetViewerPosition[bd.client, indent, indent, bd.cw-indent, bd.ch-indent]; IF adjust THEN { Align[ bs: bs, client: [coord[client.x, client.y]], viewer: [fraction[ bs.class.common.preserve[X], bs.class.common.preserve[Y]]], paint: FALSE]; }; }; }; Awoken: ENTRY PROC [v: Viewer] RETURNS [BOOL] ~ {RETURN [awake=v]}; Awaken: PROC [v: Viewer] RETURNS [tookit, havit: BOOL] ~ { Inner: ENTRY PROC ~ {IF (tookit _ awake = NIL) THEN awake _ v; havit _ awake = v}; Inner[]; IF tookit THEN InputFocus.CaptureButtons[proc: v.class.notify, tip: v.tipTable, viewer: v]; RETURN}; Sleepen: PROC [v: Viewer] RETURNS [lostit, asleep: BOOL] ~ { Inner: ENTRY PROC ~ {IF (lostit _ awake = v) THEN awake _ NIL; asleep _ awake = NIL}; Inner[]; IF lostit THEN InputFocus.ReleaseButtons[]; RETURN}; NotifyBiScroller: PROC [self: Viewer, input: LIST OF REF ANY] --ViewerClasses.NotifyProc-- = { bs: BiScroller _ NARROW[self.data]; bd: Buttonned _ NARROW[bs.rep]; i, o, l: LIST OF REF ANY _ NIL; IF self # bd.client THEN ERROR; IF bs.class.common.notify = NIL THEN RETURN; FOR i _ input, i.rest WHILE i # NIL DO l _ IF l = NIL THEN o _ CONS[i.first, NIL] ELSE l.rest _ CONS[i.first, NIL]; WITH l.first SELECT FROM z: TIPUser.TIPScreenCoords => { IF Awoken[self] THEN { v: Viewer; inClient: BOOL; [v, inClient] _ ViewerOps.MouseInViewer[z]; IF v # bd.client OR NOT inClient THEN { bd.clientWantsActive _ FALSE; SetActive[bd]; bs.class.common.notify[bd.client, bs.class.common.finish]; RETURN}; }; l.first _ NEW [Vec _ bd.u.Transform[[z.mouseX, z.mouseY]]]; }; ENDCASE; ENDLOOP; bs.class.common.notify[self, o]; }; SetActive: PROC [bd: Buttonned] = { ok: BOOL; IF bd.clientWantsActive THEN ok _ Awaken[bd.client].havit ELSE ok _ Sleepen[bd.client].asleep; IF NOT ok THEN ERROR; }; PaintClient: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE] --ViewerClasses.PaintProc-- = { bs: BiScroller _ NARROW[self.data]; bd: Buttonned _ NARROW[bs.rep]; context.ConcatT[bd.t]; quit _ bs.class.common.paint[self, context, whatChanged, clear]; }; SetButtonsCapturedness: PROC [bs: BiScroller, captured: BOOL] = { bd: Buttonned _ NARROW[bs.rep]; bd.clientWantsActive _ captured; SetActive[bd]}; InitBiScrollBar: PROC [self: Viewer] --ViewerClasses.InitProc-- = BEGIN bsb: BiScrollBar _ NARROW[self.data]; bsb.viewer _ self; END; PaintBiScrollBar: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE] --ViewerClasses.PaintProc-- = BEGIN bsb: BiScrollBar _ NARROW[self.data]; Do: PROCEDURE [c: Imager.Color, xmin, ymin, xmax, ymax: Number] = {Imager.SetColor[context, c]; Imager.MaskBox[context, [xmin, ymin, xmax, ymax]]}; IF whatChanged # NIL THEN WITH whatChanged SELECT FROM r: Range => { SELECT bsb.axis FROM X => {Do[grayh, 0, 0, r.min*self.cw, self.ch]; Do[graym, r.min*self.cw, 0, r.max*self.cw, self.ch]; Do[grayl, r.max*self.cw, 0, self.cw, self.ch]}; Y => {Do[grayh, 0, 0, self.cw, r.min*self.ch]; Do[graym, 0, r.min*self.ch, self.cw, r.max*self.ch]; Do[grayl, 0, r.max*self.ch, self.cw, self.ch]}; ENDCASE => ERROR; }; ENDCASE ELSE IF NOT clear THEN Do[Imager.white, 0, 0, self.cw, self.ch]; END; NotifyBiScrollBarProc: TYPE = PROC [bsb: BiScrollBar, bs: BiScroller, bd: Buttonned, mouse: TIPUser.TIPScreenCoords, input: LIST OF REF ANY] RETURNS [LIST OF REF ANY]; WakeUpBiScrollBar: PROC [bsb: BiScrollBar, bs: Buttonned, to: State, indicate: BOOLEAN] ~ { IF NOT Awaken[bsb.viewer].havit THEN ERROR; bsb.state _ to; Cursors.SetCursor[bsb.viewer.class.cursor _ bsb.cursors[to]]; IF indicate THEN Indicate[bsb, bs]; }; Indicate: PROC [bsb: BiScrollBar, bd: Buttonned] = { bs: BiScroller _ bsb.parent; r: Range = NEW[RangeObject]; beginW, endW, beginZ, endZ, deltaW: Number; SELECT bsb.axis FROM X => {[beginW, endW] _ ViewLimitsOfImage[bs, X]; beginZ_0; endZ_bd.client.cw}; Y => {[beginW, endW] _ ViewLimitsOfImage[bs, Y]; beginZ_0; endZ_bd.client.ch}; ENDCASE => ERROR; deltaW _ endW - beginW; IF ABS[deltaW] # 0 THEN r^ _ [ MAX[0.0, MIN[1.0, (beginZ - beginW)/deltaW]], MAX[0.0, MIN[1.0, (endZ - beginW)/deltaW]]] ELSE r^ _ [ IF beginW > beginZ THEN 0.0 ELSE 1.0, IF beginW < endZ THEN 1.0 ELSE 0.0]; ViewerOps.PaintViewer[viewer: bsb.viewer, hint: client, clearClient: FALSE, whatChanged: r]; }; Sleep: PROC [bsb: BiScrollBar] = BEGIN IF NOT Sleepen[bsb.viewer].lostit THEN ERROR; bsb.state _ Idle; Cursors.SetCursor[bsb.viewer.class.cursor _ bsb.cursors[Idle]]; END; Relax: PROC [bsb: BiScrollBar] = { bsb.state _ Idle; Cursors.SetCursor[bsb.viewer.class.cursor _ bsb.cursors[Idle]]; }; IncreaseBiScrollBar: NotifyBiScrollBarProc = BEGIN IF bsb.state # Increase THEN WakeUpBiScrollBar[bsb, bd, Increase, FALSE]; IF input.first = $Idle THEN NULL ELSE IF input.first = $Doit THEN BEGIN Relax[bsb]; Scroll[bs, SELECT bsb.axis FROM X => [0 - mouse.mouseX, 0], Y => [0, bsb.viewer.ch - mouse.mouseY], ENDCASE => ERROR]; END ELSE ERROR; RETURN [input.rest]; END; DecreaseBiScrollBar: NotifyBiScrollBarProc = BEGIN IF bsb.state # Decrease THEN WakeUpBiScrollBar[bsb, bd, Decrease, FALSE]; IF input.first = $Idle THEN NULL ELSE IF input.first = $Doit THEN BEGIN Relax[bsb]; Scroll[bs, SELECT bsb.axis FROM X => [mouse.mouseX, 0], Y => [0, mouse.mouseY - bsb.viewer.ch], ENDCASE => ERROR]; END ELSE ERROR; RETURN [input.rest]; END; ThumbBiScrollBar: NotifyBiScrollBarProc = BEGIN IF bsb.state # Random THEN WakeUpBiScrollBar[bsb, bd, Random, FALSE]; IF input.first = $Idle THEN NULL ELSE IF input.first = $Doit THEN BEGIN cmin, cmax: Number; Foo: PROCEDURE [low, high, mouse: Number] RETURNS [Number] = {RETURN [(mouse-low) / (high-low)]}; SELECT bsb.axis FROM X => {[cmin, cmax] _ ViewLimitsOfImage[bs, X]; Relax[bsb]; Jump[bs, Foo[0, bd.client.cw, mouse.mouseX], X]}; Y => {[cmin, cmax] _ ViewLimitsOfImage[bs, Y]; Relax[bsb]; Jump[bs, Foo[0, bd.client.ch, mouse.mouseY], Y]}; ENDCASE => ERROR; END ELSE ERROR; RETURN [input.rest]; END; Jump: PROC [bs: BiScroller, x: REAL, axis: Axis] ~ { SELECT axis FROM X => bs.class.common.bsUserAction[bs, LIST[$AlignFracs, NEW [Vec _ [x, x]], NEW [Vec _ [0.5, 0.5]], $TRUE, $FALSE]]; Y => bs.class.common.bsUserAction[bs, LIST[$AlignFracs, NEW [Vec _ [x, x]], NEW [Vec _ [0.5, 0.5]], $FALSE, $TRUE]]; ENDCASE => ERROR}; Scroll: PROC [bs: BiScroller, by: Vec] ~ { bs.class.common.bsUserAction[bs, LIST[$Shift, NEW [Vec _ by]]]}; NotifyBiScrollBar: PROC [self: Viewer, input: LIST OF REF ANY] --ViewerClasses.NotifyProc-- = BEGIN ENABLE UNWIND => InputFocus.ReleaseButtons[]; bsb: BiScrollBar _ NARROW[self.data]; bs: BiScroller _ bsb.parent; bsr: Buttonned _ NARROW[bs.rep]; mouse: TIPUser.TIPScreenCoords; WHILE input # NIL DO WITH input.first SELECT FROM x: ATOM => SELECT x FROM $HereToEdge => input _ IncreaseBiScrollBar[bsb, bs, bsr, mouse, input.rest]; $EdgeToHere => input _ DecreaseBiScrollBar[bsb, bs, bsr, mouse, input.rest]; $Thumb => input _ ThumbBiScrollBar[bsb, bs, bsr, mouse, input.rest]; ENDCASE => ERROR; z: TIPUser.TIPScreenCoords => BEGIN v: Viewer; c: BOOLEAN; mouse _ z; IF Awoken[self] THEN BEGIN [v, c] _ ViewerOps.MouseInViewer[mouse]; IF v # self OR NOT c THEN {Sleep[bsb]; ViewerOps.PaintViewer[self, client, TRUE, NIL]; RETURN}; END ELSE WakeUpBiScrollBar[bsb, bsr, Idle, TRUE]; input _ input.rest; END; ENDCASE => ERROR; ENDLOOP; END; RI: PROC [REAL] RETURNS [INT] = Real.Round; GetTransforms: PROC [bs: BiScroller, age: TransformsAge _ current] RETURNS [clientToViewer, viewerToClient: Transform] = { bsr: Buttonned _ NARROW[bs.rep]; SELECT age FROM current => RETURN [clientToViewer: bsr.t, viewerToClient: bsr.u]; previous => RETURN [clientToViewer: bsr.tp, viewerToClient: bsr.up]; ENDCASE => ERROR; }; ChangeTransform: PROC [bs: BiScroller, new: Transform, ageOp: AgeOp, paint: BOOL _ TRUE] = BEGIN bd: Buttonned ~ NARROW[bs.rep]; Doit: ENTRY PROC [t, u: Transform] = { ENABLE UNWIND => NULL; SELECT ageOp FROM remember => {bd.up _ bd.u; bd.tp _ bd.t}; ignore => NULL; ENDCASE => ERROR; bd.u _ u; bd.t _ t; }; activeBar: BiScrollBar _ NIL; FindBar: ENTRY PROC ~ { ENABLE UNWIND => NULL; IF awake#NIL THEN WITH awake.data SELECT FROM x: BiScrollBar => activeBar _ x; ENDCASE => NULL; RETURN}; inv: Transform; IF bs.class.common.offsetsMustBeIntegers THEN new _ new.TranslateTo[[RI[new.c], RI[new.f]]]; IF new.a*new.e - new.b*new.d = 0 THEN RETURN; inv _ new.Invert[]; FOR c: Child _ bd.children, c.next UNTIL c = NIL DO nu: Vec; nu _ new.Transform[c.where]; IF paint THEN ViewerOps.EstablishViewerPosition[c.it, RI[nu.x], RI[nu.y], c.it.ww, c.it.wh] ELSE SetViewerPosition[c.it, RI[nu.x], RI[nu.y], c.it.ww, c.it.wh]; ENDLOOP; Doit[new, inv]; IF paint THEN ViewerOps.PaintViewer[viewer: bd.client, hint: client]; FindBar[]; IF activeBar#NIL AND activeBar.parent = bs THEN Indicate[activeBar, bd]; END; InitContainer: PROC [self: Viewer] --ViewerClasses.InitProc-- = { bs: BiScroller _ NARROW[self.data]; bd: Buttonned _ NARROW[bs.rep]; IF bd.class.menu # NIL AND self.parent = NIL THEN self.menu _ Menus.CopyMenu[bd.class.menu]; IF self.icon = unInit THEN self.icon _ bs.class.common.icon; }; AdjustContainer: PROC [self: Viewer] RETURNS [adjusted: BOOL _ FALSE] --ViewerClasses.AdjustProc-- = { bs: BiScroller _ NARROW[self.data]; bd: Buttonned _ NARROW[bs.rep]; adjusted _ bd.container # NIL AND ComputeClientBounds[bs, bd, TRUE]; }; SaveContainer: PROC [self: Viewer, force: BOOL _ FALSE] --ViewerClasses.SaveProc-- = { bs: BiScroller _ NARROW[self.data]; bd: Buttonned _ NARROW[bs.rep]; IF bs.class.common.save # NIL THEN bs.class.common.save[self, force]; }; Setup: PROCEDURE = BEGIN ViewerOps.RegisterViewerClass[flavor: containerFlavor, class: NEW [ViewerClasses.ViewerClassRec _ [ flavor: containerFlavor, init: InitContainer, adjust: AdjustContainer, save: SaveContainer ]]]; ViewerOps.RegisterViewerClass[flavor: $BiScrollBarX, class: NEW [ViewerClasses.ViewerClassRec _ [ flavor: $BiScrollBarX, init: InitBiScrollBar, notify: NotifyBiScrollBar, paint: PaintBiScrollBar, tipTable: TIPUser.InstantiateNewTIPTable["Knob.tip"], cursor: scrollLeftRight]]]; ViewerOps.RegisterViewerClass[flavor: $BiScrollBarY, class: NEW [ViewerClasses.ViewerClassRec _ [ flavor: $BiScrollBarY, init: InitBiScrollBar, notify: NotifyBiScrollBar, paint: PaintBiScrollBar, tipTable: TIPUser.InstantiateNewTIPTable["Knob.tip"], cursor: scrollUpDown]]]; RegisterStyle["Buttonned", buttonnedStyle]; [] _ SetDefaultStyle["Buttonned"]; END; Setup[]; END.