MODULE WMNavigator; (** AUTHOR "staubesv"; PURPOSE "Viewport in a window for navigation"; *) (* STATUS: First draft - NOT STABLE!!! *) IMPORT Modules, Kernel, Locks, Displays, Raster, Strings, XML, WMRectangles, WMGraphics, WMGraphicUtilities, WMWindowManager, WMComponents; TYPE Level = RECORD x, y, width, height : LONGINT; END; OnDrawnProc = PROCEDURE {DELEGATE}; ViewPort* = OBJECT (WMWindowManager.ViewPort); VAR backbuffer- : WMGraphics.Image; deviceRect : WMRectangles.Rectangle; width, height : LONGINT; canvas : WMGraphics.BufferCanvas; state : WMGraphics.CanvasState; internnavig, navig : BOOLEAN; fx, fy, inffx, inffy, factor, intfactor : REAL; lock : Locks.Lock; onDrawn : OnDrawnProc; zoomLevel : ARRAY 7 OF Level; currentZoomLevel : LONGINT; PROCEDURE &New*; BEGIN NEW(backbuffer); Raster.Create(backbuffer, 1280, 1024, Raster.DisplayFormat(Displays.color8888)); range.l := 0; range.t := 0; range.r := range.l + 1280; range.b := range.t + 1024; width := 1280; height := 1024; deviceRect.l := 0; deviceRect.t := 0; deviceRect.r := 1280; deviceRect.b := 1024; width0 := 1280; height0 := 1024; desc := "Graphics adapter view"; NEW(canvas, backbuffer); canvas.SetFont(WMGraphics.GetDefaultFont()); canvas.SaveState(state); factor := 1; intfactor := 1; fx := factor; fy := factor; inffx := 1 ; inffy := inffx; internnavig := FALSE; NEW(lock); onDrawn := NIL; currentZoomLevel := 0; SetZoomLevels(1280, 1024); END New; PROCEDURE SetZoomLevels(width, height : LONGINT); VAR i : LONGINT; BEGIN FOR i := 0 TO LEN(zoomLevel)-1 DO zoomLevel[i].width := (i + 1) * width; zoomLevel[i].height :=(i + 1) * height ; zoomLevel[i].x := (zoomLevel[i].width - width) DIV 2; zoomLevel[i].y := (zoomLevel[i].height - height) DIV 2; END; END SetZoomLevels; PROCEDURE SetZoomLevel(level, xg, yg : LONGINT); BEGIN IF (level < 0) THEN level := 0; ELSIF (level >= LEN(zoomLevel)) THEN level := LEN(zoomLevel)-1; END; SetRange(xg - zoomLevel[level].x, yg - zoomLevel[level].y, zoomLevel[level].width, zoomLevel[level].height, TRUE); currentZoomLevel := level; END SetZoomLevel; PROCEDURE ChangeZoom(dz, xg, yg : LONGINT); BEGIN SetZoomLevel(currentZoomLevel + dz, xg, yg); END ChangeZoom; PROCEDURE ReInit(width, height, format : LONGINT; onDrawn : OnDrawnProc); VAR tf : REAL; BEGIN SELF.onDrawn := onDrawn; IF (width # SELF.width) OR (height # SELF.height) THEN lock.Acquire; SELF.width := width; SELF.height := height; IF (width > 0) & (height > 0) THEN NEW(backbuffer); Raster.Create(backbuffer, width, height, Raster.DisplayFormat(format)); deviceRect.l := 0; deviceRect.t := 0; deviceRect.r := width; deviceRect.b := height; width0 := width; height0 := height; NEW(canvas, backbuffer); canvas.SetFont(WMGraphics.GetDefaultFont()); canvas.SaveState(state); factor := width / (range.r - range.l); tf := height / (range.b - range.t); IF factor > tf THEN factor := tf END; fx := factor; fy := factor; inffx := 1 / factor; inffy := inffx; intfactor := factor; range.r := range.l + inffx * width; range.b := range.t + inffy * height; SetZoomLevels(width, height); ELSE canvas := NIL; END; lock.Release; END; END ReInit; PROCEDURE GetWMCoordinates*(CONST r : WMRectangles.Rectangle) : WMRectangles.Rectangle; VAR rect : WMRectangles.Rectangle; BEGIN rect.l := ENTIER(range.l + r.l * inffx); rect.r := ENTIER(range.l + r.r * inffx + 0.5); rect.t := ENTIER(range.t + r.t * inffy); rect.b := ENTIER(range.t + r.b * inffy + 0.5); RETURN rect; END GetWMCoordinates; PROCEDURE GetWMPosition(x, y : LONGINT; VAR xg, yg : LONGINT); BEGIN xg := ENTIER(range.l + x * inffx); yg := ENTIER(range.t + y * inffy); END GetWMPosition; (** Return the modifier keys that are pressed in the view *) PROCEDURE GetKeyState*(VAR state : SET); BEGIN state := {}; END GetKeyState; (** Set the observed range. *) PROCEDURE SetRange*(x, y, w, h : REAL; showTransition : BOOLEAN); VAR sx, sy, sx2, sy2, dx, dy, dx2, dy2, x2, y2 : REAL; i, steps : LONGINT; CONST Steps = 16; PROCEDURE Set(x, y, w, h : REAL); VAR tf : REAL; BEGIN range.l := x; range.t := y; factor := (width) / w; tf := (height) / h; IF factor > tf THEN factor := tf END; fx := factor; fy := factor; inffx := 1 / factor; inffy := inffx; range.r := x + width * inffx; range.b := y + height * inffy; intfactor := factor; manager.RefreshView(SELF); IF onDrawn # NIL THEN onDrawn(); END; END Set; BEGIN IF w = 0 THEN w := 0.001 END; IF h = 0 THEN h := 0.001 END; IF showTransition THEN sx := range.l; sy := range.t; sx2 := range.r; sy2 := range.b; x2 := x + w; y2 := y + h; steps := Steps; IF (sx = x) & (sy = y) & (sx2 - sx = w) & (sy2- sy = h) THEN steps := 1 END; dx := (x - sx) / steps; dy := (y - sy) / steps; dx2 := (x2 - sx2) / steps; dy2 := (y2 - sy2) / steps; internnavig := TRUE; navig := TRUE; FOR i := 1 TO steps-1 DO Set(sx + dx * i, sy + dy * i, (sx2 + dx2 * i) - (sx + dx * i), (sy2 + dy2 * i) - (sy + dy * i)) END; internnavig := FALSE; navig := FALSE END; Set(x, y, w, h) END SetRange; (** r in wm coordinates *) PROCEDURE Update*(r : WMRectangles.Rectangle; top : WMWindowManager.Window); BEGIN lock.Acquire; Draw(WMRectangles.ResizeRect(r, 1), top.prev);(* assuming the src-domain is only 1 *) lock.Release; END Update; PROCEDURE Refresh*(top : WMWindowManager.Window); BEGIN Update(WMRectangles.MakeRect(ENTIER(range.l)-1, ENTIER(range.t)-1, ENTIER(range.r) + 1, ENTIER(range.b) + 1), top) END Refresh; PROCEDURE DrawWindow(window : WMWindowManager.Window) : BOOLEAN; VAR title : Strings.String; BEGIN ASSERT(window # NIL); IF (window.isVisible & ~(WMWindowManager.FlagNavigation IN window.flags)) THEN title := window.GetTitle(); RETURN (title = NIL) OR ((title^ # "Mouse Cursor")); ELSE RETURN FALSE; END; END DrawWindow; (* in wm coordinates *) PROCEDURE Draw(r : WMRectangles.Rectangle; top : WMWindowManager.Window); VAR cur : WMWindowManager.Window; wr, nr : WMRectangles.Rectangle; PROCEDURE InternalDraw(r : WMRectangles.Rectangle; cur : WMWindowManager.Window); VAR nr, cb, dsr : WMRectangles.Rectangle; width, height : LONGINT; BEGIN ASSERT(cur.isVisible); IF cur.useAlpha & (cur.prev # NIL) THEN Draw(r, cur.prev) ELSE WHILE (cur # NIL) DO (* draw r in wm coordinates in all the windows from cur to top *) IF DrawWindow(cur) THEN cb := cur.bounds; nr := r; WMRectangles.ClipRect(nr, cb); dsr.l := ENTIER((nr.l - range.l) * fx) ; dsr.t := ENTIER((nr.t - range.t) * fy); dsr.r := ENTIER((nr.r - range.l) * fx + 0.5); dsr.b := ENTIER((nr.b - range.t) * fy + 0.5); IF (~WMRectangles.RectEmpty(dsr)) & (WMRectangles.Intersect(dsr, deviceRect)) THEN canvas.SetClipRect(dsr); (* Set clip rect to dsr, clipped at current window *) (* range can not be factored out because of rounding *) canvas.ClipRectAsNewLimits(ENTIER((cur.bounds.l - range.l) * fx), ENTIER((cur.bounds.t - range.t) * fy)); width := ENTIER((cb.r - range.l)* fx) - ENTIER((cb.l - range.l) * fx); height := ENTIER((cb.b - range.t) * fy) - ENTIER((cb.t - range.t) * fy); IF navig THEN cur.Draw(canvas, width, height, WMGraphics.ScaleBox); ELSE cur.Draw(canvas, width, height, WMGraphics.ScaleBilinear); END; canvas.RestoreState(state); END; END; cur := cur.next END; END END InternalDraw; BEGIN IF (canvas # NIL) THEN cur := top; IF (cur # NIL) & (~WMRectangles.RectEmpty(r)) THEN IF DrawWindow(cur) THEN wr := cur.bounds; IF ~WMRectangles.IsContained(wr, r) THEN IF WMRectangles.Intersect(r, wr) THEN (* r contains wr calculate r - wr and recursively call for resulting rectangles*) (* calculate top rectangle *) IF wr.t > r.t THEN WMRectangles.SetRect(nr, r.l, r.t, r.r, wr.t); Draw(nr, cur.prev) END; (* calculate bottom rectangle *) IF wr.b < r.b THEN WMRectangles.SetRect(nr, r.l, wr.b, r.r, r.b); Draw(nr, cur.prev) END; (* calculate left rectangle *) IF wr.l > r.l THEN WMRectangles.SetRect(nr, r.l, MAX(r.t, wr.t), wr.l, MIN(r.b, wr.b)); Draw(nr, cur.prev) END; (* calculate left rectangle *) IF wr.r < r.r THEN WMRectangles.SetRect(nr, wr.r, MAX(r.t, wr.t), r.r, MIN(r.b, wr.b)); Draw(nr, cur.prev) END; (* calculate overlapping *) nr := r; WMRectangles.ClipRect(nr, wr); IF ~WMRectangles.RectEmpty(nr) THEN InternalDraw(nr, cur) END ELSE Draw(r, cur.prev) END ELSE InternalDraw(r, cur) END ELSE Draw(r, cur.prev); END; END; END; IF (onDrawn # NIL) THEN onDrawn(); END; END Draw; END ViewPort; TYPE Navigator = OBJECT(WMComponents.VisualComponent) VAR viewPort : ViewPort; selectedWindow : WMWindowManager.Window; timer : Kernel.Timer; alive, dead, refresh, doRefresh : BOOLEAN; offsetX, offsetY : LONGINT; lastX, lastY : LONGINT; PROCEDURE &Init*; VAR style : WMWindowManager.WindowStyle; BEGIN Init^; NEW(viewPort); NEW(timer); alive := TRUE; dead := FALSE; refresh := TRUE; doRefresh := FALSE; manager.AddView(viewPort); style := manager.GetStyle(); IF (style # NIL) THEN fillColor.Set(style.desktopColor); END; END Init; PROCEDURE Finalize*; BEGIN Finalize^; BEGIN {EXCLUSIVE} alive := FALSE; END; BEGIN {EXCLUSIVE} AWAIT(dead); END; manager.RemoveView(viewPort); END Finalize; PROCEDURE PropertyChanged*(sender, data : ANY); BEGIN PropertyChanged^(sender, data); IF (data = bounds) THEN RecacheProperties; END; END PropertyChanged; PROCEDURE RecacheProperties*; BEGIN RecacheProperties^; viewPort.ReInit(bounds.GetWidth(), bounds.GetHeight(), Displays.color8888, Refresh); viewPort.manager.RefreshView(viewPort); Invalidate; END RecacheProperties; PROCEDURE PointerLeave*; BEGIN PointerLeave^; END PointerLeave; PROCEDURE PointerDown*(x, y: LONGINT; keys: SET); VAR xg, yg : LONGINT; rect : WMRectangles.Rectangle; title : Strings.String; BEGIN PointerDown^(x, y, keys); IF (0 IN keys) THEN viewPort.GetWMPosition(x, y, xg, yg); selectedWindow := manager.GetPositionOwner(xg, yg); IF (selectedWindow # NIL) THEN title := selectedWindow.GetTitle(); IF (title # NIL) & ((title^ = "Old background") OR (title^ = "New background")) THEN selectedWindow := NIL; RETURN; END; manager.lock.AcquireRead; offsetX := (xg - selectedWindow.bounds.l); offsetY := (yg - selectedWindow.bounds.t); manager.lock.ReleaseRead; ELSE offsetX := 0; offsetY := 0; END; ELSIF (keys = {1}) THEN manager.GetPopulatedArea(rect); manager.lock.AcquireWrite; viewPort.SetRange(rect.l, rect.t, rect.r - rect.l, rect.b - rect.t, TRUE); manager.lock.ReleaseWrite; END; END PointerDown; PROCEDURE PointerMove*(x, y: LONGINT; keys: SET); VAR xg, yg : LONGINT; BEGIN lastX := x; lastY := y; PointerMove^(x, y, keys); IF (0 IN keys) THEN IF (selectedWindow # NIL) THEN viewPort.GetWMPosition(x, y, xg, yg); manager.SetWindowPos(selectedWindow, xg - offsetX, yg - offsetY); END; END; END PointerMove; PROCEDURE WheelMove*(dz: LONGINT); VAR xg, yg : LONGINT; BEGIN WheelMove^(dz); viewPort.GetWMPosition(lastX, lastY, xg, yg); viewPort.ChangeZoom(dz, xg, yg); END WheelMove; PROCEDURE PointerUp*(x, y: LONGINT; keys: SET); BEGIN PointerUp^(x, y, keys); selectedWindow := NIL; END PointerUp; PROCEDURE Refresh; BEGIN {EXCLUSIVE} refresh := TRUE; END Refresh; PROCEDURE Draw*(canvas : WMGraphics.Canvas); VAR r0, r1, res : WMWindowManager.RealRect; rect : WMRectangles.Rectangle; BEGIN IF (viewPort.backbuffer.width = bounds.GetWidth()) & (viewPort.backbuffer.height = bounds.GetHeight()) THEN canvas.DrawImage(0, 0, viewPort.backbuffer,WMGraphics.ModeSrcOverDst); ELSE canvas.ScaleImage(viewPort.backbuffer, WMRectangles.MakeRect(0, 0, viewPort.backbuffer.width, viewPort.backbuffer.height), WMRectangles.MakeRect(0, 0, bounds.GetWidth(), bounds.GetHeight()), WMGraphics.ModeSrcOverDst, 1) END; r0 := viewport.range; r1 := viewPort.range; IF (r0.l > r1.l) THEN res.l := r0.l; ELSE res.l := r1.l; END; IF (r0.t > r1.t) THEN res.t := r0.t; ELSE res.t := r1.t; END; IF (r0.r < r1.r) THEN res.r := r0.r; ELSE res.r := r1.r; END; IF (r0.b < r1.b) THEN res.b := r0.b; ELSE res.b := r1.b; END; rect := WMRectangles.MakeRect(ENTIER(viewPort.fx * (res.l - r1.l)), ENTIER(viewPort.fy * (res.t - r1.t)), ENTIER(viewPort.fx * (res.r - r1.l)), ENTIER(viewPort.fy * (res.b - r1.t))); WMGraphicUtilities.DrawRect(canvas, rect, LONGINT(0FF0000FFH), WMGraphics.ModeCopy); END Draw; BEGIN {ACTIVE} manager.lock.AcquireWrite; viewPort.SetRange(-1280, -1024, 2560, 2048, FALSE); manager.lock.ReleaseWrite; manager.RefreshView(viewPort); Invalidate; LOOP BEGIN {EXCLUSIVE} AWAIT(refresh OR ~alive); doRefresh := refresh; refresh := FALSE; END; timer.Sleep(30); IF ~alive THEN EXIT; END; IF doRefresh THEN doRefresh := FALSE; Invalidate; END; END; BEGIN {EXCLUSIVE} dead := TRUE; END; END Navigator; TYPE Window = OBJECT(WMComponents.FormWindow) PROCEDURE Close*; BEGIN Close^; window := NIL; END Close; END Window; VAR manager : WMWindowManager.WindowManager; viewport : WMWindowManager.ViewPort; window : Window; PROCEDURE GenNavigator*() : XML.Element; VAR n : Navigator; BEGIN NEW(n); RETURN n; END GenNavigator; PROCEDURE Init; BEGIN manager := WMWindowManager.GetDefaultManager(); viewport := WMWindowManager.GetDefaultView(); END Init; PROCEDURE Open*; VAR n : Navigator; BEGIN {EXCLUSIVE} IF (window = NIL) THEN NEW(n); n.alignment.Set(WMComponents.AlignClient); NEW(window, 400, 200, TRUE); window.SetContent(n); WMWindowManager.ExtAddViewBoundWindow(window, 20, 20, NIL, {WMWindowManager.FlagFrame, WMWindowManager.FlagStayOnTop, WMWindowManager.FlagNavigation, WMWindowManager.FlagHidden}); END; END Open; PROCEDURE Close*; BEGIN {EXCLUSIVE} IF (window # NIL) THEN window.Close; window := NIL; END; END Close; BEGIN Modules.InstallTermHandler(Close); Init; END WMNavigator. WMNavigator.Open ~ WMNavigator.Close ~ System.Free WMNavigator ~