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 =
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.