
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[];

}.
   ─  
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
 Э╩  ХNewlineDelimiter
Ц(cedarcode) styleЩ codeЩKЪЬ
╧eЬ1Щ<KЩ5KЩ<ЧKШ KЪ╧k	ЬeШnKШ Ъ╨bxЬЮЬЮШKЪЮЬUШ\KЪЬЮЬШЧKШ KЪЬЮЬЮЬ	ШЪЬ	ЮЬЮЬШKЪЬШKЪЬЮЬЮЬШKЪЬЮЬШЧKШ KЪЬЮЬЮЬ
ШЪЬ
ЮЬЮЬШKЪЬЮЬШKЪЬЮЬШЧKШ KЪЬЮЬШKШ Ъ
╧nЬЮЬ1ЮЬЮЬЮЬШpKШ"Ш"KШ!KШKШKШKЪ	ЬЮЬЮЬЮЬЮЬШ4KЪЬЮЬШKШKШKЪЬ7Ш7KЪЬЮЬШKЪЬЮЬШKЪЬ)Ш)KШЧKШЧKШ Ъ
аЬЮЬЮЬЮЬЮЬШRKЪЬЮЬЮЬ0ШNЧKШ Ъ
а
ЬЮЬЮЬЮЬЮЬШRKЪЬШKШ1KЪЮЬШЧKШ ЪаЬЮЬЮЬЮЬЮЬ╧cЬШ_KЪЬ
ЮЬШKШAKШЧKШ KЪЬЮЬЮЬШKЪЬЮЬЮЬШKШ ЪаЬЮЬ6ЮЬЮЬ	ЮЬЮЬЮЬЮЬбЬШУЪаЬЮЬЮЬШKЪЬ?Ш?KЪЬ?Ш?KШЧKЪЬ
ЮЬ'Ш7KЪЮЬЮЬ	ЮЬШ-ЪЮЬЮЬЮЬШKЪЬЮЬШ KШ(KЪЮЬЮЬЮЬЮЬШ:KЪЮЬЮЬШ$ЧKЪЮЬШKШЧKШ KЪЬ@ЮЬШFKШ KЪ	ЬЮЬЮЬЮЬЮЬШKШ ЪаЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬбЬШsKШ1KЪЬ
ЮЬШ$KЪЮЬЮЬ
ЮЬШ)ЪЮЬЮШШKЪЬЮЬШ,KЪ╨gkЬ
ЮЬЮЬШ7KЪЬ#ЮЬШ(KЪЬ$ЮЬвЬШ.KЪЬ#ЮЬШ)KШЧШ	KЪЬЮЬШ,KЪвЬ
ЮЬЮЬШ8KЪЬ#ЮЬШ)KЪЬ$ЮЬвЬШ.KЪЬ$ЮЬЮЬШ0KЪЬ#ЮЬШ*KШЧШ
KЪвЬ
ЮЬЮЬШ8KЪЬЮЬШKЪЬ$ЮЬвЬШ.KЪЬ#ЮЬШ*KШЧKЪЮЬЮЬШЧKШЧKШ ЪаЬЮЬ9ЮЬШaKЪЬЮЬ"Ш1KШ<KШЧKШ ЪаЬЮЬШKЪЬ7Ш7KЪЬ8ЮЬЮЬШEKЪЬNЮЬШVKЪЬ:Ш:KЪЬ<ЮЬЮЬШIKЪЬSЮЬШ[KЪЮЬШЧKШ KШKШ KШЧ ЕЧ    ║  Г  