
    <<X11BounceDemo.mesa>>
        <<Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi, May 2, 1988 2:42:29 pm PDT >>
        <<Christian Jacobi, April 29, 1992 12:04 pm PDT >>
        <<Willie-s, November 25, 1991 4:49 pm PST>>
        <<>>
    DIRECTORY
        Commander,
        Imager,
        ImagerBackdoor,
        ImagerSample,
        IO,
        Process,
        Random,
        Real,
        SF,
        Xl,
        XTk,
        XTkBitmapWidgets,
        XTkContainers,
        XTkSlider,
        XTkWidgets;

    X11BounceDemo: CEDAR MONITOR
        IMPORTS Commander, Imager, ImagerBackdoor, IO, Process, Random, Real, Xl, XTk, XTkBitmapWidgets, XTkContainers, XTkSlider, 
        XTkWidgets = 
    BEGIN

    Widget: TYPE = XTkWidgets.Widget;
    <<>>
    Instance: TYPE = REF InstanceRec;
    InstanceRec: TYPE = RECORD [
        sz: INT ¬ 8,    --size of bouncing blobs
        log: IO.STREAM ¬ NIL,
        doWait: REF ¬ NIL,
        key: REF ANY ¬ NIL,
        squares: INT ¬ 0,
        counter: INT ¬ 0,
        shell: Widget ¬ NIL,
        squaresSizeSlider: Widget ¬ NIL,
        bitmapSizeSlider: Widget ¬ NIL,
        edit: Widget ¬ NIL,
        count: Widget ¬ NIL,
        normalizedBitmapSize: REAL ¬ 0,
        bitmap: Widget ¬ NIL
        ];

    SquaresSizeHit: XTkSlider.SliderProc = {
        i: Instance ¬ NARROW[clientData];
        i.sz ¬ Real.Round[MAX[i.bitmap.actual.size.width*contents / 2.0, 1.0]]
        };

    BitmapSizeHit: XTkSlider.SliderProc = {
        IF reason=set OR reason=abort THEN {
            i: Instance ¬ NARROW[clientData];
            i.normalizedBitmapSize ¬ contents;
            Xl.Enqueue[slider.rootTQ, SafeResize, i]
            };
        };

    SafeResize: Xl.EventProcType = {
        i: Instance ¬ NARROW[clientData];
        outer: INT ¬ Real.Round[i.shell.actual.size.width*i.normalizedBitmapSize];
        g: Xl.Geometry ¬ i.bitmap.actual;
        g.size.width ¬ MAX[outer-2*i.bitmap.actual.borderWidth, 1];
        IF g.size.width#i.bitmap.actual.size.width THEN XTk.NoteAndStartReconfigure[i.bitmap, g];
        };

    ShellResized: XTk.WidgetNotifyProc = {
        i: Instance ¬ NARROW[registerData];
        s: REAL ¬ i.shell.actual.size.width;
        IF s>=1.0 THEN {
            s ¬ (i.bitmap.actual.size.width+2*i.bitmap.actual.borderWidth)/s;
            XTkSlider.SetContents[i.bitmapSizeSlider, s];
            };
        };

    MoreHit: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        i.squares ¬ i.squares + 1;
        TRUSTED {Process.Detach[FORK RunOneBlob[i]]};
        IO.PutRope[i.log, "add square\n"];
        };

    HideHit: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        mapping: XTk.Mapping ¬ SELECT i.edit.actualMapping FROM
            mapped => unmapped,
            ENDCASE => mapped;
        XTk.NoteMappingChange[widget: i.edit, mapping: mapping];
        XTk.NoteMappingChange[widget: i.count, mapping: mapping];
        XTk.StartReconfigureChildren[i.edit.parent];
        IO.PutRope[i.log, "visibility change\n"];
        Xl.Flush[i.shell.connection];
        };

    countw: INT ¬ 0;

    MoreButtonsHit: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        container: Widget ¬ widget.parent;
        x: Widget ¬ XTkWidgets.CreateButton[
            text: IO.PutFR1["destroy self button: %g ", IO.int[countw ¬ countw+1]], 
            hitProc: DestroyOne, registerData: i 
            ];
        XTkWidgets.AppendChild[container, x];
        IO.PutRope[i.log, "create button\n"];
        };

    DestroyOne: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        XTk.DestroyWidget[widget];
        IO.PutRope[i.log, "destroyed button\n"];
        };

    ResetHit: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        i.squares ¬ 0;
        i.key ¬ NEW[INT];
        IO.PutRope[i.log, "reset\n"];
        };

    CounterHit: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        b: BOOL ¬ TRUE;
        FOR i1: INT IN [0..1000] DO 
            FOR i2: INT IN [0..1000] DO 
                b ¬ NOT b 
                ENDLOOP 
            ENDLOOP;
        XTkWidgets.SetText[widget, IO.PutFR1["count %g", IO.int[i.counter ¬ i.counter+1]]];
        IO.PutRope[i.log, "counted\n"];
        };

    SetWait: XTkWidgets.ButtonHitProcType = {
        i: Instance ¬ NARROW[registerData];
        i.doWait ¬ callData;
        IO.PutRope[i.log, "changed wait mode\n"];
        };

    debugLastInstance: Instance;

    CreateDemoWidget: Commander.CommandProc = {
        i: Instance ¬ debugLastInstance ¬ NEW[InstanceRec];
        shell: Widget ¬ i.shell ¬ XTkWidgets.CreateShell[
            className: $X11BounceDemo, windowHeader: "X11BounceDemo tool",
            standardMigration: TRUE
            ];
        bitmap: Widget ¬ i.bitmap ¬ XTkBitmapWidgets.CreateBitmapWidget[
            widgetSpec: [geometry: [size: [150, 400], borderWidth: 1]],
            notify: BitmapChanged, data: i
            ];
        header: Widget ¬ XTkWidgets.CreateLabel[
            widgetSpec: [geometry: [borderWidth: 3]],
            text: "bounce demo tool"
            ];
        toggle: Widget ¬ XTkWidgets.CreateChoices[
            choices: LIST [
                ["wait: ", NIL], 
                ["local", $local], 
                ["remote", $remote], 
                ["don't", $dont]
                ],
            hitProc: SetWait, registerData: i
            ];
        logWidget: Widget ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: [size: [-1, 100]]]];
        moreSquares: Widget ¬ XTkWidgets.CreateButton[
            text: "more squares", hitProc: MoreHit, registerData: i
            ];
        reset: Widget ¬ XTkWidgets.CreateButton[
            text: "stop squares", hitProc: ResetHit, registerData: i
            ];
        squaresSizeSlider: Widget ¬ i.squaresSizeSlider ¬ XTkSlider.CreateSlider[
            widgetSpec: [geometry: [borderWidth: 1]],
            contents: 0.1, sliderProc: SquaresSizeHit, clientData: i
            ];
        bitmapSizeSlider: Widget ¬ i.bitmapSizeSlider ¬ XTkSlider.CreateSlider[
            widgetSpec: [geometry: [borderWidth: 1]],
            contents: 0.1, sliderProc: BitmapSizeHit, clientData: i
            ];
        moreButtons: Widget ¬ XTkWidgets.CreateButton[
            text: "more buttons", hitProc: MoreButtonsHit, registerData: i
            ];
        hide: Widget ¬ XTkWidgets.CreateButton[text: "hide n seek",
            hitProc: HideHit, registerData: i
            ];
        count: Widget ¬ i.count ¬ XTkWidgets.CreateButton[text: "count to 320000",
            hitProc: CounterHit, registerData: i
            ];
        edit: Widget ¬ i.edit ¬ XTkWidgets.CreateField[text: "edit me"];
        controls: Widget ¬ XTkWidgets.CreateYStack[[], LIST[XTkWidgets.HRule[], moreSquares, reset, squaresSizeSlider, XTkWidgets.HRule[], 
        hide, edit, count, moreButtons]];
        action: Widget ¬ XTkWidgets.CreateXStack[[], LIST[bitmap, controls]];
        upper: Widget ¬ XTkWidgets.CreateYStack[[], LIST[header, toggle, XTkWidgets.HRule[], logWidget, bitmapSizeSlider]];
        contents: Widget ¬ XTkWidgets.CreateYStack[[], LIST[upper, action]];
        i.log ¬ XTkWidgets.CreateStream[logWidget];
        XTkContainers.SetVaryingSize[bitmap, FALSE];
        XTk.RegisterNotifier[contents, XTk.postConfigureKey, ShellResized, i];
        XTk.RegisterNotifier[contents, XTk.postWindowCreationKey, ShellResized, i];
        XTkWidgets.SetShellChild[shell, contents];
        XTkWidgets.RealizeShell[shell];
        };

    RunOneBlob: PROC [i: Instance] = {
        key: REF ¬ i.key;
        ct: Imager.Context ¬ XTkBitmapWidgets.CreateContext[i.bitmap];
        dx: REAL ¬ Random.ChooseInt[min: -100, max: 100];
        dy: REAL ¬ Random.ChooseInt[min: -100, max: 100];
        dx ¬ dx/20.0; dy ¬ dy/20.0;
        IF ct#NIL THEN {
            oldBox, newBox: Imager.Box ¬ [1, 1, 0, 0];
            r: Imager.Rectangle ¬ ImagerBackdoor.GetBounds[ct];
            x: REAL ¬ r.x+ r.w/2; y: REAL ¬ r.y+ r.h/2;
            Process.SetPriority[Process.priorityBackground];
            WHILE key=i.key AND Xl.Alive[i.bitmap.connection] AND i.bitmap.fastAccessAllowed=ok DO
                x ¬ x+dx;
                IF dx>0 
                    THEN {IF x>r.x+r.w THEN {dx¬-dx; x ¬ x+2*dx}}
                    ELSE {IF x<r.x THEN {dx¬-dx; x ¬ x+2*dx}};
                y ¬ y+dy;
                IF dy>0 
                    THEN {IF y>r.y+r.h THEN {dy¬-dy; y ¬ y+2*dy}}
                    ELSE {IF y<r.y THEN {dy¬-dy; y ¬ y+2*dy}};
                newBox ¬ [xmin: x-i.sz, ymin: y-i.sz, xmax: x+i.sz, ymax: y+i.sz];
                Imager.SetColor[ct, Imager.white]; Imager.MaskBox[ct, oldBox];
                Imager.SetColor[ct, Imager.black]; Imager.MaskBox[ct, newBox];
                oldBox ¬ newBox;
                SELECT i.doWait FROM
                    $local => XTkBitmapWidgets.Wait[i.bitmap, FALSE]; 
                    $remote => XTkBitmapWidgets.Wait[i.bitmap, TRUE]; 
                    ENDCASE => {};
                Process.Yield[]; 
                ENDLOOP
            };
        };

    BitmapChanged: XTkBitmapWidgets.BitmapEventProc = {
        i: Instance ¬ NARROW[data];
        i.key ¬ NEW[INT];
        SELECT reason FROM
            createWindow, resize, map => {
                fsz: REAL ¬ i.sz;
                XTkBitmapWidgets.CreateAndSetBitmap[widget: widget, size: [widget.actual.size.height, widget.actual.size.width], bpp: 1]; 
                XTkSlider.SetContents[i.squaresSizeSlider, fsz/MAX[i.bitmap.actual.size.width, 1]];
                FOR n: INT IN [0..i.squares) DO
                    TRUSTED {Process.Detach[FORK RunOneBlob[i]]}
                    ENDLOOP;
                IO.PutRope[i.log, "resized\n"];
                };
            ENDCASE => {}
        };

    Commander.Register["X11BounceDemo", CreateDemoWidget, "Create widget demo instance"];
    END.