<> <> <> <> <> DIRECTORY Containers USING [Container], ViewerClasses USING [InitProc, PaintProc, PaintRectangle, ScrollProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec], ViewerLocks USING [CallUnderWriteLock], ViewerOps USING [CreateViewer, EstablishViewerPosition, IsClass, PaintViewer, RegisterViewerClass, ResetPaintCache, UserToScreenCoords]; ContainersImpl: CEDAR PROGRAM IMPORTS ViewerLocks, ViewerOps EXPORTS Containers SHARES ViewerOps = BEGIN Viewer: TYPE = ViewerClasses.Viewer; PaintRectangle: TYPE = ViewerClasses.PaintRectangle; Container: TYPE = Containers.Container; -- = Viewer Create: PUBLIC PROC[info: ViewerClasses.ViewerRec _ [], paint: BOOL _ TRUE] RETURNS [Container] = { RETURN[ViewerOps.CreateViewer[$Container, info, paint]] }; ChildYBound: PUBLIC PROC[container: Container, child: Viewer] = { container.class.set[self: container, data: child, op: $YBound] }; <> ChildXBound: PUBLIC PROC[container: Container, child: Viewer] = { container.class.set[self: container, data: child, op: $XBound] }; <> ContainerData: TYPE = REF ContainerDataRec; ContainerDataRec: TYPE = RECORD [ scrolled: INTEGER _ 0, yBounded: LIST OF Viewer _ NIL, xBounded: LIST OF Viewer _ NIL ]; ContainerHeight: PROC[container: Container] RETURNS[INTEGER] = { child: Viewer = container.child; IF child=NIL THEN RETURN[0] ELSE { min: INTEGER _ child.wy; max: INTEGER _ min+child.wh; FOR v: Viewer _ child.sibling, v.sibling UNTIL v=NIL DO min _ MIN[min, v.wy]; max _ MAX[max, v.wy+v.wh]; ENDLOOP; RETURN[max-min]; }; }; ContainerScroll: ViewerClasses.ScrollProc = { <<[self: Viewer, op: ScrollOp, amount: INTEGER, shift, control: BOOL _ FALSE]>> <> cd: ContainerData = NARROW[self.data]; height: INTEGER = ContainerHeight[self]; incr: INTEGER; IF cd = NIL THEN RETURN; SELECT op FROM query => { top, bottom: INT; IF height=0 THEN RETURN[0, 100]; top _ LONG[100]*MIN[height, -cd.scrolled]/height; bottom _ 100 - (LONG[100]*MAX[height-self.ch+cd.scrolled, 0])/height; RETURN[top, bottom]; }; thumb => { thumbIncr: INT = LONG[amount]*height/100; incr _ -cd.scrolled-(IF amount<5 THEN LONG[0] ELSE thumbIncr); }; up => incr _ -amount; down => incr _ MIN[amount, -cd.scrolled]; ENDCASE => ERROR; IF incr#0 THEN { LockedScroll: PROC = { FOR v: Viewer _ self.child, v.sibling UNTIL v=NIL DO ViewerOps.EstablishViewerPosition[v, v.wx, v.wy+incr, v.ww, v.wh]; ENDLOOP; cd.scrolled _ cd.scrolled+incr; ViewerOps.PaintViewer[self, client]; }; ViewerLocks.CallUnderWriteLock[LockedScroll, self]; }; }; minimumSize: INTEGER = 5; ContainerPaint: ViewerClasses.PaintProc = { cd: ContainerData = NARROW[self.data]; rect: PaintRectangle _ NIL; update: BOOL _ FALSE; vx, vy: INTEGER; IF cd = NIL THEN RETURN; WITH whatChanged SELECT FROM x: PaintRectangle => rect _ x; ENDCASE; FOR l: LIST OF Viewer _ cd.xBounded, l.rest UNTIL l=NIL DO v: Viewer = l.first; IF v.destroyed THEN update _ TRUE -- remember to remove from list ELSE { w: INTEGER = MAX[v.parent.cw-v.wx, minimumSize]; -- new width IF w # v.ww THEN { v.cw _ w-(v.ww-v.cw); v.ww _ w; IF rect#NIL AND rect.flavor=blt THEN { <> IF ViewerOps.IsClass[v, $Text] THEN ViewerOps.PaintViewer[v, all] ELSE { <> [vx, vy] _ ViewerOps.UserToScreenCoords[self, v.wx, v.wy+v.wh]; IF vx >= rect.x AND (vx + v.ww <= rect.x + rect.w) AND vy >= rect.y AND (vy + v.wh <= rect.y + rect.h) THEN ViewerOps.PaintViewer[v, all, FALSE, rect] }; }; }; }; ENDLOOP; FOR l: LIST OF Viewer _ cd.yBounded, l.rest UNTIL l=NIL DO v: Viewer = l.first; IF v.destroyed THEN update _ TRUE -- remember to remove from list ELSE { h: INTEGER = MAX[v.parent.ch-v.wy, minimumSize]; -- new height IF h # v.wh THEN { v.ch _ h-(v.wh-v.ch); v.wh _ h; IF rect#NIL AND rect.flavor=blt THEN { <> <> [vx, vy] _ ViewerOps.UserToScreenCoords[self, v.wx, v.wy+v.wh]; IF vx >= rect.x AND (vx + v.ww <= rect.x + rect.h) AND vy >= rect.y AND (vy + v.wh <= rect.y + rect.h) THEN ViewerOps.PaintViewer[v, all, FALSE, rect]; }; }; }; ENDLOOP; IF cd.xBounded#NIL OR cd.yBounded#NIL THEN ViewerOps.ResetPaintCache[self, FALSE]; IF update THEN { oldx: LIST OF Viewer _ cd.xBounded; oldy: LIST OF Viewer _ cd.yBounded; cd.xBounded _ cd.yBounded _ NIL; FOR l: LIST OF Viewer _ oldx, l.rest UNTIL l=NIL DO child: Viewer = l.first; IF NOT child.destroyed THEN cd.xBounded _ CONS[child, cd.xBounded]; ENDLOOP; FOR l: LIST OF Viewer _ oldy, l.rest UNTIL l=NIL DO child: Viewer = l.first; IF NOT child.destroyed THEN cd.yBounded _ CONS[child, cd.yBounded]; ENDLOOP; }; }; ScrollOffset: PUBLIC PROC[container: Container] RETURNS[offTop: INTEGER] = { cd: ContainerData = NARROW[container.data]; IF cd = NIL THEN RETURN[0] ELSE RETURN[cd.scrolled]; }; ContainerSet: ViewerClasses.SetProc = { cd: ContainerData = NARROW[self.data]; child: Viewer = NARROW[data]; IF cd = NIL THEN RETURN; IF child.parent#self THEN ERROR; SELECT op FROM $YBound => cd.yBounded _ CONS[child, cd.yBounded]; $XBound => cd.xBounded _ CONS[child, cd.xBounded]; ENDCASE => ERROR; }; ContainerInit: ViewerClasses.InitProc = { self.data _ NEW[ContainerDataRec _ []]; }; containerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [ init: ContainerInit, paint: ContainerPaint, set: ContainerSet, scroll: ContainerScroll, <> icon: tool, bltContents: top ]]; ViewerOps.RegisterViewerClass[$Container, containerClass]; -- plug in to Viewers END.