DIRECTORY
Basics USING [DoubleAnd],
BasicTime USING [GetClockPulses],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
CommDriver USING [Buffer, CreateInterceptor, DestroyInterceptor, GetNetworkChain, Interceptor, RecvInterceptor, SendInterceptor],
Containers USING [Create],
Process USING [Detach, Pause],
PupBuffer USING [Buffer],
Rope USING [ROPE],
ViewerClasses USING [Viewer],
ViewerOps USING [ComputeColumn, SetOpenHeight];
Lightning:
CEDAR
PROGRAM
IMPORTS Basics, BasicTime, Buttons, Commander, CommDriver, Containers, Process, ViewerOps = {
Viewer: TYPE = ViewerClasses.Viewer;
Mask:
PROC [number, mask:
LONG
CARDINAL]
RETURNS [
LONG
CARDINAL] = {
RETURN[Basics.DoubleAnd[[lc[number]],[lc[mask]]].lc];
};
Kill:
PROC [counter, mask:
LONG
CARDINAL]
RETURNS [kill:
BOOL] = {
time: LONG CARDINAL ← Mask[BasicTime.GetClockPulses[], mask];
IF time = 0 THEN RETURN[TRUE];
IF Mask[counter, mask] = 0 THEN RETURN[TRUE];
RETURN[FALSE];
};
Info: TYPE = REF InfoRep;
InfoRep:
TYPE =
RECORD [
recvKilled: LONG CARDINAL ← 0,
sendKilled: LONG CARDINAL ← 0,
recvCounter: LONG CARDINAL ← 0,
sendCounter: LONG CARDINAL ← 0,
recvMask: LONG CARDINAL ← 17B,
sendMask: LONG CARDINAL ← 17B,
r: REF BOOL ← NEW[BOOL ← TRUE],
s: REF BOOL ← NEW[BOOL ← TRUE],
arpa: REF BOOL ← NEW[BOOL ← TRUE],
xns: REF BOOL ← NEW[BOOL ← TRUE],
pup: REF BOOL ← NEW[BOOL ← TRUE],
rpc: REF BOOL ← NEW[BOOL ← TRUE],
other: REF BOOL ← NEW[BOOL ← TRUE],
error: REF BOOL ← NEW[BOOL ← TRUE],
raw: REF BOOL ← NEW[BOOL ← TRUE] ];
Recv: CommDriver.RecvInterceptor = {
info: Info ← NARROW[data];
IF ~info.r^ THEN RETURN;
SELECT recv
FROM
arpa, arpaTranslate => IF ~info.arpa^ THEN RETURN;
xns, xnsTranslate => IF ~info.xns^ THEN RETURN;
pup, pupTranslate =>
TRUSTED {
b: PupBuffer.Buffer = LOOPHOLE[buffer];
SELECT b.type.
ORD
FROM
IN [140B..177B] => IF ~info.rpc^ THEN RETURN;
ENDCASE => IF ~info.pup^ THEN RETURN; };
other => IF ~info.other^ THEN RETURN;
error => IF ~info.error^ THEN RETURN;
ENDCASE => NULL; -- I wish the Compiler would catch these.
info.recvCounter ← info.recvCounter.SUCC;
IF ~Kill[info.recvCounter, info.recvMask] THEN RETURN;
info.recvKilled ← info.recvKilled.SUCC;
RETURN[TRUE];
};
Send: CommDriver.SendInterceptor = {
info: Info ← NARROW[data];
IF ~info.s^ THEN RETURN;
SELECT send
FROM
arpa, arpaReturn, arpaTranslate => IF ~info.arpa^ THEN RETURN;
xns, xnsReturn, xnsTranslate => IF ~info.xns^ THEN RETURN;
pup, pupReturn, pupTranslate =>
TRUSTED {
b: PupBuffer.Buffer = LOOPHOLE[buffer];
SELECT b.type.
ORD
FROM
IN [140B..177B] => IF ~info.rpc^ THEN RETURN;
ENDCASE => IF ~info.pup^ THEN RETURN; };
other, otherReturn, otherTranslate => IF ~info.other^ THEN RETURN;
raw => IF ~info.raw^ THEN RETURN;
ENDCASE => NULL; -- I wish the Compiler would catch these.
info.sendCounter ← info.sendCounter.SUCC;
IF ~Kill[info.sendCounter, info.sendMask] THEN RETURN;
info.sendKilled ← info.sendKilled.SUCC;
RETURN[TRUE];
};
Create: Commander.CommandProc = {
TRUSTED { Process.Detach[FORK Worker[]]; };
};
Worker:
PROC = {
info: Info ← NEW[InfoRep ← []];
outer: Viewer = Containers.Create[
info: [name: "Lightning", column: left, scrollable: FALSE, iconic: FALSE]];
child: Viewer ← NIL;
interceptor: CommDriver.Interceptor;
child ← MakeBool[name: "Recv", init: info.r, parent: outer, x: 2, y: 2];
child ← MakeBool[name: "Send", init: info.s, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "ARPA", init: info.arpa, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "XNS", init: info.xns, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Pup", init: info.pup, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "RPC", init: info.rpc, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Oth", init: info.other, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Err", init: info.error, parent: outer, x: child.wx+child.ww+2, y: child.wy];
child ← MakeBool[name: "Raw", init: info.raw, parent: outer, x: child.wx+child.ww+2, y: child.wy];
ViewerOps.SetOpenHeight[outer, 23];
ViewerOps.ComputeColumn[outer.column];
interceptor ← CommDriver.CreateInterceptor[
network: CommDriver.GetNetworkChain[],
sendMask: ALL[TRUE],
sendProc: Send,
recvMask: ALL[TRUE],
recvProc: Recv,
data: info,
promiscuous: FALSE];
UNTIL outer.destroyed DO Process.Pause[10]; ENDLOOP;
CommDriver.DestroyInterceptor[interceptor];
};
BoolProc: TYPE = PROC [parent: Viewer, clientData: REF, value: BOOL];
Bool: TYPE = REF BoolRec;
BoolRec:
TYPE =
RECORD [
value: REF BOOL,
change: BoolProc,
clientData: REF,
button: Viewer ];
MakeBool:
PROC [name: Rope.
ROPE, init:
REF
BOOL, change: BoolProc ←
NIL, clientData:
REF ←
NIL, parent: Viewer, x, y:
INTEGER]
RETURNS [child: Viewer] = {
bool: Bool ←
NEW [BoolRec ← [
value: IF init # NIL THEN init ELSE NEW [BOOL ← TRUE],
change: change,
clientData: clientData,
button: NIL ] ];
child ← Buttons.Create[
info: [name: name, parent: parent, border: TRUE, wx: x, wy: y],
proc: BoolHelper, clientData: bool, fork: TRUE, paint: TRUE];
bool.button ← child;
IF bool.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
};
BoolHelper: Buttons.ButtonProc =
TRUSTED {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
bool: Bool = NARROW[clientData];
bool.value^ ← ~bool.value^;
IF bool.value^ THEN Buttons.SetDisplayStyle[bool.button, $WhiteOnBlack]
ELSE Buttons.SetDisplayStyle[bool.button, $BlackOnWhite];
IF bool.change # NIL THEN bool.change[self.parent, bool.clientData, bool.value^];
};