home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip_2004-07_cd1.bin / tema / aos / files / Oberon.exe / Oberon / Docu.exe / Docu / Portraits.Mod (.txt) < prev    next >
Oberon Text  |  2000-02-29  |  12KB  |  280 lines
  1. Oberon10.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. (* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
  4. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
  5. MODULE Portraits; (** portable *)    (*JM/ JG 26.7.94*)
  6.     IMPORT Display, Display3, Effects, Gadgets, Oberon, Objects, Skeleton;
  7.     CONST border = 4;
  8.     TYPE
  9.         Portrait = POINTER TO PortraitDesc;
  10.         PortraitDesc = RECORD (Gadgets.FrameDesc)
  11.             time*: LONGINT    (* time of selection *)
  12.         END;
  13.     PROCEDURE SetMask (F: Display.Frame; Q: Display3.Mask);
  14.         VAR M: Display3.OverlapMsg;
  15.     BEGIN M.M := Q; M.x := 0; M.y := 0; M.F := F; M.dlink := NIL; M.res := -1;
  16.         F.handle(F, M)
  17.     END SetMask;
  18.     PROCEDURE SetContentMask (F: Portrait);
  19.         VAR Q: Display3.Mask;
  20.     BEGIN
  21.         IF F.mask = NIL THEN SetMask(F.dsc, NIL)
  22.         ELSE Display3.Copy(F.mask, Q); Q.x := 0; Q.y := 0;
  23.             Display3.Intersect(Q, F.dsc.X, F.dsc.Y, F.dsc.W, F.dsc.H);
  24.             Q.x := -F.dsc.X; Q.y := -(F.dsc.Y + F.dsc.H - 1); Display3.Shift(Q);
  25.             SetMask(F.dsc, Q)
  26.         END
  27.     END SetContentMask;
  28.     PROCEDURE ToContent (F: Portrait; x, y: INTEGER; VAR M: Display.FrameMsg);
  29.         VAR Mdlink, Fdlink: Objects.Object; tx, ty: INTEGER;
  30.     BEGIN
  31.         tx := M.x; ty := M.y;
  32.         M.x := x; M.y := y + F.H - 1;
  33.         Fdlink := F.dlink; Mdlink := M.dlink;
  34.         F.dlink := M.dlink; M.dlink := F; F.dsc.handle(F.dsc, M);
  35.         F.dlink := Fdlink; M.dlink := Mdlink;
  36.         M.x := tx; M.y := ty
  37.     END ToContent;
  38.     PROCEDURE Modify (F: Portrait; VAR M: Display.ModifyMsg);
  39.         VAR N: Display.ModifyMsg;
  40.     BEGIN
  41.         N.id := Display.extend; N.F := F.dsc; N.mode := Display.state;
  42.         N.X := border; N.Y := -M.H + 1 + border;
  43.         N.W := M.W - 2 * border; N.H := M.H - 2 * border;
  44.         N.dX := N.X - F.dsc.X; N.dY := N.Y - F.dsc.Y;
  45.         N.dW := N.W - F.dsc.W; N.dH := N.H - F.dsc.H;
  46.         N.x := 0; N.y := 0; N.res := -1; Objects.Stamp(N);
  47.         F.dsc.handle(F.dsc, N);
  48.         Gadgets.framehandle(F, M)
  49.     END Modify;
  50.     PROCEDURE ModifyContent (F: Portrait; VAR M: Display.ModifyMsg);
  51.         VAR N: Display.ModifyMsg;
  52.     BEGIN
  53.         IF M.stamp # F.stamp THEN F.stamp := M.stamp;
  54.             N.id := Display.extend; N.F := F; N.mode := Display.display;
  55.             N.X := F.X + M.dX; N.Y := F.Y + M.dY;
  56.             N.W := M.W + 2 * border; N.H := M.H + 2 * border;
  57.             N.dX := N.X - F.X; N.dY := N.Y - F.Y;
  58.             N.dW := N.W - F.W; N.dH := N.H - F.H;
  59.             Display.Broadcast(N)
  60.         END
  61.     END ModifyContent;
  62.     PROCEDURE Restore (F: Portrait; Q: Display3.Mask; x, y, w, h: INTEGER; VAR M: Display.DisplayMsg);
  63.         VAR N: Display.DisplayMsg;
  64.         PROCEDURE ClipAgainst (VAR x, y, w, h: INTEGER; x1, y1, w1, h1: INTEGER);
  65.             VAR r, t, r1, t1: INTEGER;
  66.         BEGIN
  67.             r := x + w - 1; r1 := x1 + w1 - 1; t := y + h - 1; t1 := y1 + h1 - 1;
  68.             IF x < x1 THEN x := x1 END; IF y < y1 THEN y := y1 END;
  69.             IF r > r1 THEN r := r1 END; IF t > t1 THEN t := t1 END;
  70.             w := r - x + 1; h := t - y + 1
  71.         END ClipAgainst;
  72.     BEGIN
  73.         Display3.Rect3D(Q, Display3.topC, Display3.bottomC, x, y, w, h, 1, Display.replace);
  74.         Display3.Rect(Q, Display3.groupC, Display.solid, x + 1, y + 1, w - 2, h - 2, border - 2, Display.replace);
  75.         Display3.Rect3D(Q, Display3.bottomC, Display3.topC,
  76.         x + border - 1, y + border - 1, w - (border - 1) * 2, h - (border - 1) * 2, 1, Display.replace);
  77.         IF M.id = Display.area THEN
  78.             N.F := F.dsc; N.u := M.u; N.v := M.v; N.w := M.w; N.h := M.h;
  79.             ClipAgainst(N.u, N.v, N.w, N.h, F.dsc.X, F.dsc.Y, F.dsc.W, F.dsc.H);
  80.             DEC(N.u, border); INC(N.v, border)
  81.         END;
  82.         IF Gadgets.transparent IN F.dsc(Gadgets.Frame).state THEN
  83.             Display3.ReplConst(Q, Display3.groupC, x + border, y + border, w - 2*border, h - 2*border, Display.replace)
  84.         END;
  85.         N.device := M.device; N.id := M.id; N.F := F.dsc; N.dlink := M.dlink; N.res := -1;
  86.         Objects.Stamp(N); ToContent(F, x, y, N);
  87.         IF Gadgets.selected IN F.state THEN
  88.             Display3.FillPattern(Q, Display3.white, Display3.selectpat, x, y, x, y, w, h, Display.paint)
  89.         END
  90.     END Restore;
  91.     PROCEDURE Copy* (VAR M: Objects.CopyMsg; from, to: Portrait);
  92.         VAR N: Objects.CopyMsg;
  93.     BEGIN
  94.         Gadgets.CopyFrame(M, from, to);
  95.         N.id := Objects.shallow; Objects.Stamp(N);
  96.         from.dsc.handle(from.dsc, N); to.dsc := N.obj(Gadgets.Frame)
  97.     END Copy;
  98.     PROCEDURE Attributes (F: Portrait; VAR M: Objects.AttrMsg);
  99.     BEGIN
  100.         IF (M.id = Objects.get) & (M.name = "Gen") THEN
  101.             M.s := "Portraits.New"; M.class := Objects.String; M.res := 0
  102.         ELSE Gadgets.framehandle(F, M)
  103.         END
  104.     END Attributes;
  105.     PROCEDURE RemoveObj (obj: Display.Frame);
  106.         VAR M: Display.ControlMsg;
  107.     BEGIN M.id := Display.remove; M.F := obj; Display.Broadcast(M)
  108.     END RemoveObj;
  109.     PROCEDURE PutObj (F: Portrait; obj: Display.Frame);
  110.         VAR M: Display.ModifyMsg;
  111.     BEGIN
  112.         F.dsc := obj; SetMask(F.dsc, NIL);
  113.         M.id := Display.extend; M.mode := Display.display; M.F := F;
  114.         M.X := F.X; M.Y := F.Y;
  115.         M.W := F.dsc.W + border * 2; M.H := F.dsc.H + border * 2;
  116.         M.dX := M.X - F.X; M.dY := M.Y - F.Y;
  117.         M.dW := M.W - F.W; M.dH := M.H - F.H;
  118.         Display.Broadcast(M)
  119.     END PutObj;
  120.     PROCEDURE TrackSelectChild (F: Portrait; VAR M: Oberon.InputMsg; child: Display.Frame);
  121.         VAR S: Display.SelectMsg; keysum: SET; C: Objects.CopyMsg;
  122.     BEGIN
  123.         IF Gadgets.selected IN child(Gadgets.Frame).state THEN S.id := Display.reset
  124.         ELSE S.id := Display.set
  125.         END;
  126.         S.F := child; S.sel := F; S.res := -1; Display.Broadcast(S);
  127.         Gadgets.Update(child);
  128.         keysum := {};
  129.         REPEAT
  130.             Effects.TrackMouse(M.keys, M.X, M.Y, Effects.Arrow); keysum := keysum + M.keys;
  131.         UNTIL M.keys = {};
  132.         IF (keysum = {0, 1}) & (S.id = Display.set) THEN (* MR copy to focus *)
  133.             Objects.Stamp(C);
  134.             C.id := Objects.shallow; C.obj := NIL; child.handle(child, C);
  135.             IF C.obj # NIL THEN Gadgets.Integrate(C.obj) END
  136.         ELSE F.time := Oberon.Time()
  137.         END;
  138.         M.res := 0
  139.     END TrackSelectChild;
  140.     PROCEDURE Handle* (F: Objects.Object; VAR M: Objects.ObjMsg);
  141.         VAR x, y, w, h: INTEGER; F1: Portrait; Q: Display3.Mask; obj: Objects.Object; SM: Display.SelectMsg;
  142.     BEGIN
  143.         WITH F: Portrait DO
  144.             IF M IS Display.FrameMsg THEN
  145.                 WITH M: Display.FrameMsg DO
  146.                     IF (M.F = NIL) OR (M.F = F) THEN
  147.                         x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H;
  148.                         IF M IS Display.DisplayMsg THEN
  149.                             WITH M: Display.DisplayMsg DO
  150.                                 IF M.device = Display.screen THEN
  151.                                     IF (M.id = Display.full) OR (M.F = NIL) THEN
  152.                                         Gadgets.MakeMask(F, x, y, M.dlink, Q);
  153.                                         Restore(F, Q, x, y, w, h, M)
  154.                                     ELSIF M.id = Display.area THEN
  155.                                         Gadgets.MakeMask(F, x, y, M.dlink, Q);
  156.                                         Display3.AdjustMask(Q, x + M.u, y + h - 1 + M.v, M.w, M.h);
  157.                                         Restore(F, Q, x, y, w, h, M)
  158.                                     END
  159.                                 ELSIF M.device = Display.printer THEN
  160.                                 END
  161.                             END
  162.                         ELSIF M IS Oberon.InputMsg THEN
  163.                             WITH M: Oberon.InputMsg DO
  164.                                 IF (M.id = Oberon.track) & ~(Gadgets.selected IN F.state) THEN
  165.                                     IF Effects.Inside(M.X, M.Y, x + border, y + border, w - 2*border, h - 2*border) THEN
  166.                                         ToContent(F, x, y, M);
  167.                                         (* If child does not respond, the container may exercise parental control
  168.                                             of mouse events. In this case, of MR key events. *)
  169.                                         IF (M.res < 0) & (M.keys = {0}) THEN
  170.                                             TrackSelectChild(F, M, F.dsc)
  171.                                         END
  172.                                     ELSE Gadgets.framehandle(F, M)
  173.                                     END
  174.                                 ELSE Gadgets.framehandle(F, M)
  175.                                 END
  176.                             END
  177.                         ELSIF M IS Oberon.ControlMsg THEN
  178.                             WITH M: Oberon.ControlMsg DO
  179.                                 ToContent(F, x, y, M);
  180.                                 IF M.id = Oberon.neutralize THEN
  181.                                     IF Gadgets.selected IN F.dsc(Gadgets.Frame).state THEN
  182.                                         SM.id := Display.reset; SM.F := F.dsc; SM.sel := F; SM.res := -1;
  183.                                         F.dsc.handle(F.dsc, SM); Gadgets.Update(F.dsc)
  184.                                     END
  185.                                 END
  186.                             END
  187.                         ELSIF M IS Display.ModifyMsg THEN Modify(F, M(Display.ModifyMsg))
  188.                         ELSIF M IS Display.LocateMsg THEN
  189.                             WITH M: Display.LocateMsg DO
  190.                                 IF (M.loc = NIL) & Effects.Inside(M.X, M.Y, x, y, w, h) THEN
  191.                                     ToContent(F, x, y, M);
  192.                                     IF M.loc = NIL THEN
  193.                                         M.loc := F; M.u := M.X - x; M.v := M.Y - (y + h - 1); M.res := 0
  194.                                     END
  195.                                 END
  196.                             END
  197.                         ELSIF M IS Display3.OverlapMsg THEN
  198.                             WITH M: Display3.OverlapMsg DO
  199.                                 F.mask := M.M; SetContentMask(F)
  200.                             END
  201.                         ELSIF M IS Display.SelectMsg THEN
  202.                             WITH M: Display.SelectMsg DO
  203.                                 IF M.id = Display.get THEN
  204.                                     ToContent(F, x, y, M);
  205.                                     IF (F.time > M.time) & (Gadgets.selected IN F.dsc(Gadgets.Frame).state) THEN 
  206.                                         M.time := F.time; M.obj := F.dsc ; M.sel := F
  207.                                     END
  208.                                 ELSE Gadgets.framehandle(F, M)
  209.                                 END
  210.                             END
  211.                         ELSIF M.F # NIL THEN Gadgets.framehandle(F, M)
  212.                         ELSE ToContent(F, x, y, M)
  213.                         END
  214.                     ELSE (* message perhaps for content *)
  215.                         IF M IS Display3.UpdateMaskMsg THEN
  216.                             WITH M: Display3.UpdateMaskMsg DO
  217.                                 IF M.F = F.dsc THEN SetContentMask(F)
  218.                                 ELSE ToContent(F, M.x + F.X, M.y + F.Y, M)
  219.                                 END
  220.                             END
  221.                         ELSIF M IS Display.ControlMsg THEN
  222.                             WITH M: Display.ControlMsg DO
  223.                                 IF (M.id = Display.remove) & (M.F = F.dsc) THEN
  224.                                     Skeleton.New; PutObj(F, Objects.NewObj(Display.Frame))
  225.                                 ELSE ToContent(F, M.x + F.X, M.y + F.Y, M)
  226.                                 END
  227.                             END
  228.                         ELSIF M IS Display.ModifyMsg THEN
  229.                             IF M.F = F.dsc THEN ModifyContent(F, M(Display.ModifyMsg))
  230.                             ELSE ToContent(F, M.x + F.X, M.y + F.Y, M)
  231.                             END
  232.                         ELSIF M IS Display.ConsumeMsg THEN
  233.                             WITH M: Display.ConsumeMsg DO
  234.                                 IF (M.id = Display.drop) & (M.F = F.dsc) & (F.dsc IS Skeleton.Frame) THEN
  235.                                     RemoveObj(M.obj(Display.Frame));
  236.                                     PutObj(F, M.obj(Display.Frame));
  237.                                     M.res := 0
  238.                                 ELSE ToContent(F, M.x + F.X, M.y + F.Y, M)
  239.                                 END
  240.                             END
  241.                         ELSE ToContent(F, M.x + F.X, M.y + F.Y, M)
  242.                         END
  243.                     END
  244.                 END
  245.             ELSIF M IS Objects.AttrMsg THEN Attributes(F, M(Objects.AttrMsg))
  246.             ELSIF M IS Objects.BindMsg THEN
  247.                 F.dsc.handle(F.dsc, M); Gadgets.framehandle(F, M)
  248.             ELSIF M IS Objects.CopyMsg THEN
  249.                 WITH M: Objects.CopyMsg DO
  250.                     IF M.stamp = F.stamp THEN M.obj := F.dlink (*non-first arrival*)
  251.                     ELSE (*first arrival*)
  252.                         NEW(F1); F.stamp := M.stamp; F.dlink := F1; Copy(M, F, F1); M.obj := F1
  253.                     END
  254.                 END
  255.             ELSIF M IS Objects.FileMsg THEN
  256.                 WITH M: Objects.FileMsg DO
  257.                     IF M.id = Objects.store THEN
  258.                         Gadgets.WriteRef(M.R, F.lib, F.dsc)
  259.                     ELSIF M.id = Objects.load THEN
  260.                         Gadgets.ReadRef(M.R, F.lib, obj);
  261.                         IF (obj # NIL) & (obj IS Gadgets.Frame) THEN F.dsc := obj(Gadgets.Frame)
  262.                         ELSE Skeleton.New; F.dsc := Objects.NewObj(Gadgets.Frame)
  263.                         END
  264.                     END;
  265.                     Gadgets.framehandle(F, M)
  266.                 END
  267.             ELSE Gadgets.framehandle(F, M)
  268.             END
  269.         END
  270.     END Handle;
  271.     PROCEDURE New*;
  272.         VAR F: Portrait;
  273.     BEGIN
  274.         NEW(F); F.handle := Handle; F.W := 50; F.H := 50;
  275.         Skeleton.New; F.dsc := Objects.NewObj(Display.Frame);
  276.         Objects.NewObj := F
  277.     END New;
  278. END Portraits.
  279. Gadgets.Insert Portraits.New ~
  280.