BSTest.Mesa
Last Edited by: Spreitzer, May 4, 1985 3:42:51 pm PDT
Last tweaked by Mike Spreitzer on November 3, 1989 3:51:05 pm 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.Cat["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]
~ TRUSTED {Process.Detach[FORK DelayAndDo[bs, input]]};
DelayAndDo:
PROC [bs: BiScroller, input:
LORA] ~ {
Process.PauseMsec[1000];
DoBSUserAction[bs, input];
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]
--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[];
}.