Oberon/ETH Oberon/2.3.7/DisplayBackdrop.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE DisplayBackdrop;	(* pjm *) (* Display a backdrop in the user track filler *) IMPORT Modules, Objects, Display, Viewers, Texts, Oberon, Effects, Display3, Colors, Images, ImageGadgets, ColorModels; VAR oldhandle: Objects.Handler; fill: Display.Frame; f: ImageGadgets.Frame; color: Display.Color; PROCEDURE Restore(x, y, w, h: INTEGER); VAR fx, fy: INTEGER; m: Display3.Mask; BEGIN IF f.W >= fill.W THEN fx := 0 ELSE fx := (fill.W-f.W) DIV 2 END; IF f.H >= Display.Height THEN fy := 0 ELSE fy := (Display.Height-f.H) DIV 2 END; NEW(f.mask); Display3.Open(f.mask); Display3.Add(f.mask, x, y, w, h); Display3.Copy(f.mask, m); Display3.Subtract(m, fx, fy, f.W, f.H); Oberon.RemoveMarks(x, y, w, h); Display3.ReplConst(m, color, x, y, w, h, Display.replace); ImageGadgets.Restore(f, 0, 0, f.W, f.H, fx, fy, f.mask) END Restore; PROCEDURE Handler(v: Objects.Object; VAR m: Objects.ObjMsg); BEGIN WITH v: Viewers.Viewer DO 		IF m IS Display.DisplayMsg THEN WITH m: Display.DisplayMsg DO 				IF (m.device = Display.screen) & ((m.F = v) OR (m.F = NIL)) THEN Restore(v.X, v.Y, v.W, v.H) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Display.ControlMsg THEN WITH m: Display.ControlMsg DO 				IF (m.id = Display.restore) & (v.W > 0) & (v.H > 0) THEN Restore(v.X, v.Y, v.W, v.H) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Display.ModifyMsg THEN WITH m: Display.ModifyMsg DO 				IF (m.F = v) & (m.id = Display.extend) THEN Restore(v.X, m.Y, v.W, v.Y - m.Y) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Oberon.InputMsg THEN WITH m: Oberon.InputMsg DO 				IF m.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Effects.Arrow, m.X, m.Y) 				ELSE oldhandle(v, m) 				END END ELSE oldhandle(v, m) 		END END END Handler; PROCEDURE Close*; VAR ctrl: Display.ControlMsg; BEGIN IF fill # NIL THEN fill.handle := oldhandle; IF (fill.W > 0) & (fill.H > 0) THEN ctrl.id := Display.restore; ctrl.F := NIL;  ctrl.x := 0;  ctrl.y := 0;  ctrl.res := -1; fill.handle(fill, ctrl) END; fill := NIL; f := NIL END END Close; PROCEDURE Open*;	(* name [color] *) VAR bot, alt, max: Display.Frame; done: BOOLEAN;  name: ARRAY 32 OF CHAR; m: Images.Image; s: Texts.Scanner;  r, g, b: REAL;  ok: BOOLEAN; BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); IF s.class = Texts.Name THEN COPY(s.s, name); color := 12; Texts.Scan(s); IF s.class = Texts.Int THEN color := s.i 		ELSIF s.class = Texts.Name THEN ColorModels.StrToRGB(s.s, r, g, b, ok); IF ok THEN IF Display.TrueColor(0) THEN color := Display.RGB(ENTIER(r*255), ENTIER(g*255), ENTIER(b*255)) ELSE color := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, SHORT(ENTIER(r*255)), SHORT(ENTIER(g*255)), SHORT(ENTIER(b*255))) END END ELSE (* skip *) END; NEW(m); Images.Load(m, name, done); IF done THEN IF fill # NIL THEN Close END; NEW(f); ImageGadgets.Init(f, m); Viewers.Locate(0, 0, fill, bot, alt, max); oldhandle := fill.handle; fill.handle := Handler; IF (fill.W > 0) & (fill.H > 0) THEN Restore(fill.X, fill.Y, fill.W, fill.H) END END END END Open; BEGIN fill := NIL; Modules.InstallTermHandler(Close) END DisplayBackdrop. DisplayBackdrop.Open chagall1.jpg Black DisplayBackdrop.Open chapmanspeak.bmp RoyalBlue DisplayBackdrop.Open tafelbird.bmp DeepSkyBlue DisplayBackdrop.Open ArlesCloitre5.jpg DarkGoldenRod DisplayBackdrop.Open sunflowers.bmp DarkGoldenRod DisplayBackdrop.Close System.Free DisplayBackdrop ~