home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2004 July
/
Chip_2004-07_cd1.bin
/
tema
/
aos
/
files
/
Oberon.exe
/
Oberon
/
Docu.exe
/
Docu
/
ViewSkeleton.Mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
2000-02-29
|
6KB
|
162 lines
Oberon10.Scn.Fnt
Syntax10.Scn.Fnt
(* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE ViewSkeleton; (** portable *) (* jt, 13.12.94 *)
IMPORT Display, Display3, Fonts, Gadgets, Oberon, Objects;
TYPE
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD (Gadgets.ViewDesc)
(* view is adjusted to model size, no border *)
END;
PROCEDURE ToModel (F: Frame; x, y: INTEGER; VAR M: Display.FrameMsg);
VAR obj: Display.Frame;
BEGIN
IF (F.obj # NIL) & (F.obj IS Display.Frame) THEN
obj := F.obj(Display.Frame);
M.x := x - obj.X; M.y := y + F.H - (obj.Y + obj.H);
Gadgets.Send(F, x, y, obj, M)
END
END ToModel;
PROCEDURE Restore (F: Frame; x, y: INTEGER; dlink: Objects.Object);
VAR R: Display3.Mask; M: Display.DisplayMsg;
BEGIN
Gadgets.MakeMask(F, x, y, dlink, R); (* simplified *)
IF F.obj = NIL THEN
Display3.ReplConst(R, Display3.green, x, y, F.W, F.H, Display.replace);
Display3.String(R, Display3.FG, x + 3, y + 3, Fonts.Default,
"empty view", Display3.textmode)
ELSE
M.device := Display.screen; M.id := Display.full; M.F := NIL;
M.dlink := dlink; M.res := -1; ToModel(F, x, y, M)
END ;
IF Gadgets.selected IN F.state THEN
Display3.FillPattern(R, Display3.blue, Display3.selectpat,
x, y, x, y, F.W, F.H, Display3.paint)
END
END Restore;
PROCEDURE Adjust (F: Frame; X, Y, W, H: INTEGER);
VAR MM: Display.ModifyMsg;
BEGIN
MM.F := F; MM.mode := Display.display;
MM.dX := X - F.X; MM.dY := Y - F.Y; MM.dW := W - F.W; MM.dH := H - F.H;
MM.X := X; MM.Y := Y; MM.W := W; MM.H := H;
Display.Broadcast(MM)
END Adjust;
PROCEDURE Consume (F: Frame; x, y: INTEGER; VAR M: Display.ConsumeMsg);
VAR f: Objects.Object; CM: Display.ControlMsg;
BEGIN f := M.obj;
IF (M.id = Display.drop) & (M.F = F) & (F.obj = NIL) & (f IS Gadgets.Frame) THEN
WITH f: Gadgets.Frame DO
f.slink := NIL;
CM.id := Display.remove; CM.F := f; Display.Broadcast(CM);
F.obj := f; f.X := 0; f.Y := 0; f.mask := NIL;
F.state := f.state*{Gadgets.transparent};
Adjust(F, F.X + M.u, F.Y + F.H - 1 + M.v, f.W, f.H); M.res := 0
END
ELSE ToModel(F, x, y, M)
END;
END Consume;
PROCEDURE UpdateMask (F: Frame; x, y: INTEGER; VAR M: Display3.UpdateMaskMsg);
VAR R: Display3.Mask; O: Display3.OverlapMsg;
BEGIN
IF M.F = F.obj THEN
NEW(R); Display3.Open(R);
Display3.Add(R, 0, -F.obj(Display.Frame).H+1,
F.obj(Display.Frame).W, F.obj(Display.Frame).H);
O.F := F.obj(Display.Frame); O.x := 0; O.y := 0; O.M := R; O.res := -1;
O.dlink := NIL; ToModel(F, x, y, O); M.res := 0
ELSIF M.F = F THEN
NEW(F.mask); Display3.Open(F.mask);
Display3.Add(F.mask, 0, -F.H+1, F.W, F.H);
F.mask.x := 0; F.mask.y := 0
ELSE ToModel(F, x, y, M)
END
END UpdateMask;
PROCEDURE FrameHandler* (F: Objects.Object; VAR M: Objects.ObjMsg);
VAR x, y, u, v: INTEGER; F0: Frame;
BEGIN
WITH F: Frame DO
IF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.s := "ViewSkeleton.NewFrame"; M.class := Objects.String; M.res := 0
ELSE Gadgets.framehandle(F, M)
END
END
ELSIF M IS Objects.CopyMsg THEN
WITH M: Objects.CopyMsg DO
IF M.stamp = F.stamp THEN M.obj := F.dlink
ELSE
NEW(F0); F.stamp := M.stamp; F.dlink := F0;
Gadgets.CopyFrame(M, F, F0); F0.border := F.border; M.obj := F0
END
END
ELSIF M IS Objects.FileMsg THEN Gadgets.framehandle(F, M)
ELSIF M IS Objects.BindMsg THEN Gadgets.framehandle(F, M)
ELSIF M IS Objects.LinkMsg THEN Gadgets.framehandle(F, M)
ELSIF M IS Objects.FindMsg THEN Gadgets.framehandle(F, M)
ELSIF M IS Display.FrameMsg THEN
WITH M: Display.FrameMsg DO
x := M.x + F.X; y := M.y + F.Y;
u := M.x; v := M.y; (* save *)
IF M IS Display.DisplayMsg THEN
WITH M: Display.DisplayMsg DO
IF M.device = Display.screen THEN
IF (M.F = NIL) OR (M.F = F) THEN Restore(F, x, y, M.dlink)
ELSE ToModel(F, x, y, M)
END
ELSIF M.device = Display.printer THEN
END
END
ELSIF M IS Display.ConsumeMsg THEN
Consume(F, x, y, M(Display.ConsumeMsg))
ELSIF M IS Gadgets.UpdateMsg THEN
WITH M: Gadgets.UpdateMsg DO
IF M.obj = F.obj THEN Restore(F, x, y, M.dlink)
ELSE ToModel(F, x, y, M)
END
END
ELSIF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF F.obj # NIL THEN ToModel(F, x, y, M)
ELSE Gadgets.framehandle(F, M)
END
END
ELSIF M IS Oberon.ControlMsg THEN ToModel(F, x, y, M)
ELSIF M IS Display.LocateMsg THEN Gadgets.framehandle(F, M)
ELSIF M IS Display.SelectMsg THEN
Gadgets.framehandle(F, M) (* should be more elaborate *)
ELSIF M IS Display.ModifyMsg THEN
WITH M: Display.ModifyMsg DO
IF M.F = F THEN Gadgets.framehandle(F, M)
ELSIF M.F = F.obj THEN
ToModel(F, x, y, M); Adjust(F, F.X + M.dX, F.Y + M.dY, M.W, M.H)
ELSE ToModel(F, x, y, M)
END
END
ELSIF M IS Display.ControlMsg THEN
IF (M(Display.ControlMsg).id = Display.remove) & (M.F = F.obj) THEN
F.obj := NIL; Gadgets.Update(F)
END
ELSIF M IS Display3.OverlapMsg THEN Gadgets.framehandle(F, M);
ELSIF M IS Display3.UpdateMaskMsg THEN
UpdateMask(F, x, y, M(Display3.UpdateMaskMsg))
ELSE ToModel(F, x, y, M)
END;
M.x := u; M.y := v (* restore *)
END
ELSIF F.obj # NIL THEN F.obj.handle(F.obj, M)
END
END
END FrameHandler;
PROCEDURE InitFrame* (F: Frame);
BEGIN F.W := 100; F.H := 100; F.border := 0; F.handle := FrameHandler
END InitFrame;
PROCEDURE NewFrame*;
VAR F: Frame;
BEGIN NEW(F); InitFrame(F); Objects.NewObj := F;
END NewFrame;
END ViewSkeleton.
Gadgets.Insert ViewSkeleton.NewFrame ~