<<>> <> <> <> <> <> <> <> <> <> <> DIRECTORY Imager USING [Color, Context, MaskRectangleI, SetColor], ImagerBackdoor USING [MakeStipple], InputFocus USING [CaptureButtons, NotifyProc, ReleaseButtons], MultiCursors, Rope USING [ROPE], TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec, TIPTable], UserInputInsertActions, ViewerClasses USING [Viewer], ViewerOps USING [ComputeColumn, MoveBoundary, PaintViewer], ViewerPrivate USING [LockViewerTree, PaintScreen, ReleaseViewerTree], ViewerSpecs USING [bwScreenWidth, captionHeight, iconHeight, iconRows, iconSpacing, openBottomY, openTopY], ViewersWorld, ViewersWorldInstance; ViewerAdjustImpl: CEDAR MONITOR IMPORTS Imager, ImagerBackdoor, InputFocus, MultiCursors, TIPUser, UserInputInsertActions, ViewerOps, ViewerPrivate, ViewerSpecs, ViewersWorld, ViewersWorldInstance EXPORTS ViewerOps = BEGIN AdjustMode: TYPE = {top, bottom, column, none}; Viewer: TYPE = ViewerClasses.Viewer; mode: AdjustMode ¬ none; stickyHeight, adjustBottom: BOOL; xPos, width, minY, maxY: INTEGER; lastPos: TIPUser.TIPScreenCoordsRec ¬ [LAST[INTEGER], LAST[INTEGER], FALSE]; Adjust: PUBLIC ENTRY PROC [viewer: Viewer, sticky: BOOL ¬ TRUE] = { ViewerPrivate.LockViewerTree[]; InputFocus.CaptureButtons[BoundaryAdjustNotify, vaTIP, viewer]; minY ¬ ViewerSpecs.openBottomY; maxY ¬ ViewerSpecs.openTopY; xPos ¬ viewer.wx; width ¬ viewer.ww; stickyHeight ¬ sticky; adjustBottom ¬ FALSE; }; EndAdjust: PROC [device: REF] = { ChangeMode[none, [0, 0, FALSE], device]; InputFocus.ReleaseButtons[]; ViewerPrivate.ReleaseViewerTree[]; }; BoundaryAdjustNotify: InputFocus.NotifyProc = { <> ENABLE UNWIND => EndAdjust[device]; pos: TIPUser.TIPScreenCoordsRec ¬ [-100, -100, FALSE]; cursorName: ATOM ¬ NARROW[device]; FOR list: LIST OF REF ANY ¬ input, list.rest UNTIL list = NIL DO WITH list.first SELECT FROM x: ATOM => SELECT x FROM $Abort => { <> <> <> <> <> <> EndAdjust[cursorName]; IF self.openHeight = 0 THEN ViewerOps.PaintViewer[self, caption] ELSE {self.openHeight ¬ 0; ViewerOps.ComputeColumn[self.column]}; }; $Move => { SELECT mode FROM top => IF pos.mouseX NOT IN [self.wx..self.wx+self.ww) THEN ChangeMode[column, pos, device] ELSE IF pos.mouseY <= self.wy THEN ChangeMode[bottom, pos, device] ELSE Feedback[pos]; bottom => IF pos.mouseX NOT IN [self.wx..self.wx+self.ww) THEN ChangeMode[column, pos, device] ELSE IF pos.mouseY >= self.wy+self.wh THEN ChangeMode[top, pos, device] ELSE Feedback[pos]; column => Feedback[pos]; ENDCASE => { ViewerOps.PaintViewer[self, caption]; ChangeMode[top, pos, device]; }; }; $End => { viewerMinHeight: NAT ~ ViewerSpecs.captionHeight; change: AdjustMode ¬ mode; EndAdjust[cursorName]; SELECT change FROM top => { <> <> self.openHeight ¬ MAX[viewerMinHeight, pos.mouseY-self.wy]; ViewerOps.ComputeColumn[self.column]; }; bottom => { <> <> self.openHeight ¬ MAX[viewerMinHeight, self.wy+self.wh-pos.mouseY]; ViewerOps.ComputeColumn[self.column]; }; column => ViewerOps.MoveBoundary[pos.mouseX, pos.mouseY]; ENDCASE; }; ENDCASE => NULL; z: TIPUser.TIPScreenCoords => pos ¬ Clip[z]; ENDCASE => ERROR; ENDLOOP; }; RestoreCursor: PROC [device: REF] = { vWorld: ViewersWorld.Ref ¬ ViewersWorldInstance.GetWorld[]; handle: UserInputInsertActions.Handle ¬ ViewersWorld.GetInputHandle[vWorld]; UserInputInsertActions.InsertFakePosition[handle, 0, device]; <> }; ChangeMode: PROC [newMode: AdjustMode, pos: TIPUser.TIPScreenCoordsRec, device: REF] = { cursorName: ATOM ¬ NARROW[device]; Feedback[[LAST[INTEGER], LAST[INTEGER], FALSE], TRUE]; SELECT newMode FROM top => {MultiCursors.SetACursor[pointUp, cursorName]; MultiCursors.AddACursorCorner[upperSide, cursorName]}; bottom => {MultiCursors.SetACursor[pointDown, cursorName]; MultiCursors.AddACursorCorner[lowerSide, cursorName]}; column => {MultiCursors.SetACursor[activate, cursorName]}; ENDCASE => RestoreCursor[device]; mode ¬ newMode; IF mode#none THEN Feedback[pos]; }; adjustStipple: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 0A5A5H, xor: TRUE]; Feedback: PROC [pos: TIPUser.TIPScreenCoordsRec, remove: BOOL ¬ FALSE] = { action: PROC [context: Imager.Context] ~ { Show: PROC [x, y: INTEGER] = { IF mode=column THEN { Imager.MaskRectangleI[context, x-1, y, 2, ViewerSpecs.openTopY-y]; Imager.MaskRectangleI[context, 0, y-1, ViewerSpecs.bwScreenWidth, 2]; } ELSE Imager.MaskRectangleI[context, xPos, y-1, width, 2]; }; IF lastPos = pos THEN RETURN; -- no change Imager.SetColor[context, adjustStipple]; IF lastPos.mouseX#LAST[INTEGER] THEN Show[lastPos.mouseX, lastPos.mouseY]; IF remove THEN lastPos ¬ [LAST[INTEGER], LAST[INTEGER], FALSE] ELSE {Show[pos.mouseX, pos.mouseY]; lastPos ¬ pos}; }; IF pos.color # lastPos.color THEN {Feedback[[-100, -100, lastPos.color], TRUE]}; ViewerPrivate.PaintScreen[IF pos.color THEN color ELSE main, action, FALSE]; }; standardLeftWidth: INTEGER ~ 600; -- should be in ViewerSpecs Clip: PROC [position: TIPUser.TIPScreenCoords] RETURNS [TIPUser.TIPScreenCoordsRec] = { OPEN ViewerSpecs; fudge: INTEGER = 15; screenW: INTEGER ~ ViewerSpecs.bwScreenWidth; x: INTEGER ¬ position.mouseX; y: INTEGER ¬ position.mouseY; IF NOT position.color THEN { <> IF ABS[x-(screenW/2)] < fudge THEN x ¬ (screenW/2) ELSE IF ABS[x-standardLeftWidth] < fudge THEN x ¬ standardLeftWidth; IF mode=column THEN { IF y<=openBottomY THEN adjustBottom ¬ TRUE; -- must move below column to adjust bottom IF adjustBottom THEN { rowHeight: INTEGER = iconHeight+iconSpacing; <> IF y>rowHeight THEN { rows: INTEGER = MIN[(y+iconHeight/2), maxY]/rowHeight; y ¬ MIN[rows, iconRows]*rowHeight; }; } ELSE y ¬ openBottomY; -- pin y if not adjusting bottom } ELSE y ¬ MIN[maxY, MAX[minY, y]]; }; RETURN [[x, y, position.color]] }; vaTIP: TIPUser.TIPTable ¬ TIPUser.InstantiateNewTIPTable["ViewerAdjust.tip"]; END.