Chip 2004 July/Chip_2004-07_cd1.bin/tema/aos/files/Oberon.exe/Oberon/Docu.exe/Docu/Cups.Mod

Oberon Text | 2000-02-29 | 4.4 KB | 120 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/ *)
    Cups.Mod, jm 08.10.93
    Fun example of a coffee cup. Coffee can be poured from one cup
    to another by dropping one into another.
MODULE Cups; (** portable *)
IMPORT Files, Display, Display3, Objects, Gadgets;
    Cup* = POINTER TO CupDesc;
    CupDesc* = RECORD (Gadgets.FrameDesc)
        coffee*: INTEGER;
    END;
PROCEDURE Size(F: Cup): INTEGER;
BEGIN RETURN (F.W - 6) * (F.H - 6)
END Size;
PROCEDURE CupAttr(F: Cup; VAR M: Objects.AttrMsg);
BEGIN
    IF M.id = Objects.get THEN
        IF M.name = "Gen" THEN M.class := Objects.String; COPY("Cups.NewCup", M.s); M.res := 0
        ELSIF M.name = "Coffee" THEN M.class := Objects.Int; M.i := F.coffee; M.res := 0
        ELSE Gadgets.framehandle(F, M)
        END
    ELSIF M.id = Objects.set THEN
        IF M.name = "Coffee" THEN
            IF M.class = Objects.Int THEN
                F.coffee := SHORT(M.i);
                IF F.coffee > Size(F) THEN F.coffee := Size(F) END;
                M.res := 0
            END;
        ELSE Gadgets.framehandle(F, M);
        END
    ELSIF M.id = Objects.enum THEN
        M.Enum("Coffee"); Gadgets.framehandle(F, M)
END CupAttr;
PROCEDURE RestoreCup(F: Cup; M: Display3.Mask; x, y, w, h: INTEGER);
BEGIN
    Display3.ReplConst(M, Display.BG, x, y, w, h, Display.replace);
    Display3.ReplConst(M, Display3.blue, x, y, 2, h, Display.replace);
    Display3.ReplConst(M, Display3.blue, x, y, w, 2, Display.replace);
    Display3.ReplConst(M, Display3.blue, x + w - 2, y, 2, h, Display.replace);
    IF F.coffee > Size(F) THEN F.coffee := Size(F) END;
    Display3.ReplConst(M, Display3.FG, x + 3, y + 3, w - 6, F.coffee DIV (w - 6), Display.replace);
    IF Gadgets.selected IN F.state THEN Display3.FillPattern(M, Display3.white, Display3.selectpat, x, y, x, y, w, h, Display.paint) END
END RestoreCup;
PROCEDURE CopyCup*(VAR M: Objects.CopyMsg; from, to: Cup);
BEGIN to.coffee := from.coffee;
    Gadgets.CopyFrame(M, from, to);
END CopyCup;
PROCEDURE CupHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
VAR x, y, w, h: INTEGER; F0: Cup; R: Display3.Mask; f: Cup; space, take: INTEGER;
BEGIN
    WITH F: Cup DO
        IF M IS Display.FrameMsg THEN
            WITH M: Display.FrameMsg DO
                IF (M.F = NIL) OR (M.F = F) THEN    (* message addressed to this frame *)
                    x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H; (* calculate display coordinates *)
                    IF M IS Display.DisplayMsg THEN
                        WITH M: Display.DisplayMsg DO
                            IF M.device = Display.screen THEN
                                IF (M.id = Display.full) OR (M.F = NIL) THEN
                                    Gadgets.MakeMask(F, x, y, M.dlink, R);
                                    RestoreCup(F, R, x, y, w, h)
                                ELSIF M.id = Display.area THEN
                                    Gadgets.MakeMask(F, x, y, M.dlink, R);
                                    Display3.AdjustMask(R, x + M.u, y + h - 1 + M.v, M.w, M.h);
                                    RestoreCup(F, R, x, y, w, h)
                                END
                            ELSE
                                Gadgets.framehandle(F, M)
                            END
                        END
                    ELSIF M IS Display.ConsumeMsg THEN
                        WITH M: Display.ConsumeMsg DO
                            IF (M.id = Display.drop) & (M.obj IS Cup) THEN
                                f := M.obj(Cup);
                                space := Size(F) - F.coffee;
                                IF f.coffee < space THEN take := f.coffee
                                ELSE take := space
                                END;
                                F.coffee := F.coffee + take; f.coffee := f.coffee - take;
                                Gadgets.Update(F); Gadgets.Update(f);
                                M.res := 0
                            END
                        END
                    ELSE Gadgets.framehandle(F, M)
                    END
                END
            END
        (* Object messages *)
        ELSIF M IS Objects.AttrMsg THEN CupAttr(F, M(Objects.AttrMsg))
        ELSIF M IS Objects.FileMsg THEN
            WITH M: Objects.FileMsg DO
                IF M.id = Objects.store THEN
                    Files.WriteInt(M.R, F.coffee);
                    Gadgets.framehandle(F, M)
                ELSIF M.id = Objects.load THEN
                    Files.ReadInt(M.R, F.coffee);
                    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    (* copy msg arrives again *)
                ELSE (* first time copy message arrives *)
                    NEW(F0); F.stamp := M.stamp; F.dlink := F0; CopyCup(M, F, F0); M.obj := F0
                END
            END
        ELSE    (* unknown msg, framehandler might know it *)
            Gadgets.framehandle(F, M)
        END
END CupHandler;
PROCEDURE NewCup*;
VAR F: Cup;
BEGIN NEW(F); F.W := 30; F.H := 30; F.coffee := Size(F); F.handle := CupHandler; Objects.NewObj := F;
END NewCup;
END Cups.
System.Free Cups ~
Gadgets.Insert Cups.NewCup ~