BSTest.Mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Last Edited by: Spreitzer, May 4, 1985 3:42:51 pm PDT
Last tweaked by Mike Spreitzer on March 20, 1992 7:42 am PST
DIRECTORY Atom, BiScrollers, Geom2D, Imager, ImagerBackdoor, Process, Rope, TIPUser, ViewerClasses, ViewerOps;
BSTest: CEDAR PROGRAM
IMPORTS Atom, BiScrollers, Geom2D, Imager, ImagerBackdoor, Process, Rope, TIPUser, ViewerOps
= {OPEN BiScrollers;
Data: TYPE = REF DataRep;
DataRep: TYPE = RECORD [
style: BiScrollerStyle,
moving: BOOL ¬ FALSE,
x, y: REAL ¬ 0.0];
Delta: TYPE = REF DeltaRep;
DeltaRep: TYPE = RECORD [
drawOld, drawNew: BOOL,
oldX, oldY: REAL];
className: ROPE ¬ "BS Test ";
InStyle: PROC [style: BiScrollerStyle, preferIntegers, delay: BOOL ¬ FALSE] RETURNS [class: BiScrollerClass] = {
className ¬ className.Concat["I"];
class ¬ style.NewBiScrollerClass[[
flavor: Atom.MakeAtom[className],
extrema: Extrema,
paint: Paint,
notify: Notify,
bsUserAction: IF delay THEN ForkDelayAndDo ELSE NIL,
finish: LIST[$Exit],
menu: bsMenu,
icon: fileCabinet,
tipTable: TIPUser.InstantiateNewTIPTable["BSTest.tip"],
mayStretch: TRUE,
offsetsMustBeIntegers: TRUE,
preferIntegerCoefficients: preferIntegers
]];
};
ForkDelayAndDo: PROC [bs: BiScroller, input: LORA, device, user, display: REF ANY]
~ TRUSTED {Process.Detach[FORK DelayAndDo[bs, input, device, user, display]]};
DelayAndDo: PROC [bs: BiScroller, input: LORA, device, user, display: REF ANY] ~ {
Process.PauseMsec[1000];
DoBSUserAction[bs, input, device, user, display];
RETURN};
Extrema: PROC [clientData: REF ANY, direction: Vec] RETURNS [min, max: Vec] --ExtremaProc-- = {
d: Data ¬ NARROW[clientData];
[min, max] ¬ Geom2D.ExtremaOfRect[[d.x, d.y, 23, 47], direction];
};
whats: LORA ¬ NIL;
log: BOOL ¬ FALSE;
Paint: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ¬ FALSE] --ViewerClasses.PaintProc-- = {
DrawAt: PROC [x, y: REAL] = {
Imager.MaskRectangle[context: context, r: [x, y + 00, 13, 47]];
Imager.MaskRectangle[context: context, r: [x, y + 45, 23, 01]];
};
d: Data ¬ NARROW[BiScrollers.ClientDataOfViewer[self]];
IF log THEN whats ¬ CONS[whatChanged, whats];
IF whatChanged # NIL THEN {
da: Delta ¬ NARROW[whatChanged];
Imager.SetColor[context, invertingGray];
IF da.drawOld AND NOT clear THEN DrawAt[da.oldX, da.oldY];
IF da.drawNew THEN DrawAt[d.x, d.y]}
ELSE DrawAt[d.x, d.y];
};
invertingGray: Imager.Color ¬ ImagerBackdoor.MakeStipple[5A5AH, TRUE];
inputs: LIST OF LORA ¬ NIL;
Notify: PROC [self: Viewer, input: LIST OF REF ANY, device, user, display: REF ANY] --ViewerClases.NotifyProc-- = {
bs: BiScroller ¬ BiScrollers.QuaBiScroller[self];
d: Data ¬ NARROW[bs.ClientDataOf[]];
IF log THEN inputs ¬ CONS[input, inputs];
SELECT input.first FROM
$Track => {
cc: ClientCoords ¬ NARROW[input.rest.first];
D: Delta ¬ NEW [DeltaRep ¬ [d.moving, TRUE, d.x, d.y]];
d.x ¬ cc.x; d.y ¬ cc.y; d.moving ¬ TRUE;
ViewerOps.PaintViewer[self, client, FALSE, D];
d.style.SetButtonsCapturedness[bs, TRUE];
};
$End => {
cc: ClientCoords ¬ NARROW[input.rest.first];
D: Delta ¬ NEW [DeltaRep ¬ [d.moving, FALSE, d.x, d.y]];
d.x ¬ cc.x; d.y ¬ cc.y; d.moving ¬ FALSE;
ViewerOps.PaintViewer[self, client, FALSE, D];
ViewerOps.PaintViewer[self, client, FALSE, NIL];
d.style.SetButtonsCapturedness[bs, FALSE];
};
$Exit => {
D: Delta ¬ NEW [DeltaRep ¬ [d.moving, FALSE, d.x, d.y]];
d.moving ¬ FALSE;
ViewerOps.PaintViewer[self, client, FALSE, D];
d.style.SetButtonsCapturedness[bs, FALSE];
};
ENDCASE => ERROR;
};
Create: PROC [class: BiScrollerClass, info: ViewerClasses.ViewerRec] RETURNS [bs: BiScroller] = {
info.data ¬ NEW [DataRep ¬ [style: class.style]];
bs ¬ class.style.CreateBiScroller[class: class, info: info];
};
Start: PROC ~ {
buttonedStyle: BiScrollerStyle ~ GetStyle["Buttonned"];
buttonedClass: BiScrollerClass ~ InStyle[buttonedStyle, FALSE, TRUE];
buttoned: BiScroller ~ Create[buttonedClass, [name: "Buttonned Test", iconic: FALSE]];
buttonlessStyle: BiScrollerStyle ~ GetStyle["Buttonless"];
buttonlessClass: BiScrollerClass ~ InStyle[buttonlessStyle, FALSE, TRUE];
buttonless: BiScroller ~ Create[buttonlessClass, [name: "Buttonless Test", iconic: FALSE]];
RETURN};
Start[];
}.