DIRECTORY
Arpa USING [Address, nullAddress],
ArpaICMP USING [AllocBuffer, CreateHandle, DestroyHandle, FreeBuffer, GetBodyBytes, Handle, Receive, Send, SetBodyBytes],
ArpaICMPBuf USING [Body, Buffer, maxEchoDataBytes],
ArpaName USING [AddressToName, NameToAddress, ReplyStatus],
Atom USING [GetPName],
Basics USING [Card16FromH, Card32FromF, FFromCard32, FWORD, HFromCard16],
BasicTime
USING [
GetClockPulses, GMT, Now, Period, Pulses, PulsesToMicroseconds, Unpacked, Unpack],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Create],
Convert USING [Error, IntFromRope, RopeFromInt],
ConvertExtras USING [RopeFromArpaAddress],
IO USING [Flush, PutF, PutFR, PutRope, STREAM, Value],
Labels USING [Create],
Loader USING [BCDBuildTime],
Rope USING [ROPE],
Rules USING [Create],
TypeScript USING [ChangeLooks, Create],
ViewerClasses USING [Viewer],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, ComputeColumn, CreateViewer, MoveViewer, OpenIcon, SetOpenHeight],
ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection],
VFonts
USING [FontHeight, StringWidth];
ArpaICMPEchoTool:
CEDAR
MONITOR
IMPORTS ArpaICMP, ArpaName, Atom, Basics, BasicTime, Buttons, Commander, Containers, Convert, ConvertExtras, IO, Labels, Loader, Rules, TypeScript, ViewerIO, ViewerOps, ViewerTools, VFonts
= BEGIN
FWORD: TYPE ~ Basics.FWORD;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
Viewer layout parameters
buttonHeight: INTEGER = VFonts.FontHeight[] + 3;
buttonWidth: INTEGER ← ButtonWidth["Target"];
ClientData: TYPE = REF ClientDataRep;
ClientDataRep:
TYPE =
RECORD [
log: STREAM ← NIL,
in: STREAM ← NIL,
pleaseStop: BOOLEAN ← FALSE,
user: PROCESS ← NIL,
where: Arpa.Address ← Arpa.nullAddress,
echo: REF BOOL ← NEW [BOOL ← TRUE],
miss: REF BOOL ← NEW [BOOL ← TRUE],
late: REF BOOL ← NEW [BOOL ← TRUE],
fixedLength: REF BOOL ← NEW [BOOL ← FALSE],
addrLookup: REF BOOL ← NEW [BOOL ← FALSE],
target, length, timeout, delay, pause: Viewer ← NIL,
good: INT ← 0,
minDelay, maxDelay: INT ← 0,
delayHist: ARRAY DelayRange OF INT ← ALL[0] ];
DelayRange:
TYPE = {
d1, d1a, d2, d2a, d3, d3a, d4, d4a, d5, d5a, d6, d6a, d7, d7a, d8, d8a, d9, d9a,
d10, d14, d20, d28, d50, d70, d100, d140, d200, d280, d500, d700,
d1000, d1400, d2000, d2800, d5000, d7000, d10000, d14000, d20000, d28000, d50000, more};
delayTime:
ARRAY DelayRange
OF
INT = [
d1: 1000, d1a: 1500, d2: 2000, d2a: 2500,
d3: 3000, d3a: 3500, d4: 4000, d4a: 4500,
d5: 5000, d5a: 5500, d6: 6000, d6a: 6500,
d7: 7000, d7a: 7500, d8: 8000, d8a: 8500,
d9: 9000, d9a: 9500,
d10: 10000, d14: 14000, d20: 20000, d28: 28000, d50: 50000, d70: 70000,
d100: 100000, d140: 140000, d200: 200000, d280: 280000, d500: 500000, d700: 700000,
d1000: 1000000, d1400: 1400000, d2000: 2000000, d2800: 2800000, d5000: 5000000, d7000: 7000000,
d10000: 10000000, d14000: 14000000, d20000: 20000000, d28000: 28000000, d50000: 50000000, more: LAST[INT]];
Create: Commander.CommandProc =
TRUSTED {
data: ClientData ← NEW[ClientDataRep ← []];
viewer, buttons, log: Viewer ← NIL;
viewer ← ViewerOps.CreateViewer [
flavor: $Container,
info: [name: "ICMP EchoTool", column: right, iconic: TRUE, scrollable: FALSE]];
ViewerOps.AddProp[viewer, $ICMPEcho, data];
log ← TypeScript.Create[
[name: "ArpaICMPEchoTool.log", wy: 27+4, parent: viewer, border: FALSE], FALSE];
[data.in, data.log] ← ViewerIO.CreateViewerStreams [
name: "ArpaICMPEchoTool.log", backingFile: "ArpaICMPEchoTool.log", viewer: log, editedStream: FALSE];
Containers.ChildXBound[viewer, log];
Containers.ChildYBound[viewer, log];
CreateButtons[data, viewer, log];
TypeScript.ChangeLooks[log, 'f];
IO.PutF[data.log, "ICMP EchoTool of %G.\n", [time[Loader.BCDBuildTime[Create]]]];
ViewerOps.OpenIcon[viewer]; };
CreateButtons:
ENTRY
PROC[data: ClientData, parent, log: Viewer] = {
child: Viewer ← NIL;
kids: Viewer = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
child ← MakeBool[name: "!", init: data.echo, clientData: data, parent: kids, sibling: child, x: 2, y: 1];
child ← MakeBool[name: "?", init: data.miss, clientData: data, parent: kids, sibling: child];
child ← MakeBool[name: "#", init: data.late, clientData: data, parent: kids, sibling: child];
child ← MakeBool[name: "AddrLookup", init: data.addrLookup, clientData: data, parent: kids, sibling: child];
child ← MakeBool[name: "FixLength", init: data.fixedLength, clientData: data, parent: kids, sibling: child];
child ← data.length ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Length:",
data: Convert.RopeFromInt[MIN[100, ArpaICMPBuf.maxEchoDataBytes]],
prev: data.length,
newline: FALSE,
dataWidth: ButtonWidth["9999"] ];
child ← data.timeout ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Timeout:",
data: Convert.RopeFromInt[5000],
prev: data.timeout,
newline: FALSE ];
child ← MakeRule[kids, child];
child ← data.target ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Target:",
data: "Target",
prev: data.target ];
child ← MakeRule[kids, child];
child ← MakeLabel[kids, child, "What:"];
child ← MakeButton[kids, child, data, "Time", TimeProc];
child ← MakeButton[kids, child, data, "Ping", PingProc];
child ← MakeButton[kids, child, data, "Start", StartProc];
child ← MakeButton[kids, child, data, "Hist", HistProc];
child ← MakeButton[kids, child, data, "Stop", StopProc];
child ← MakeRule[kids, child];
{
kidsY: INTEGER = 2;
kidsH: INTEGER = child.wy + child.wh + 2;
ViewerOps.MoveViewer[viewer: log, x: 0, y: kidsY + kidsH, w: log.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE];
IF FALSE THEN ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 12 * buttonHeight];
IF ~parent.iconic THEN ViewerOps.ComputeColumn[parent.column];
ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH]; };
};
StartProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Start[data]; };
PingProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Start[data, TRUE]; };
Start:
PROC [data: ClientData, justOnce:
BOOL ←
FALSE] = {
target: ROPE = ViewerTools.GetContents[data.target];
IF data.user # NIL THEN Stop[data];
Report[data, "\nEchoing to ", target, " "];
IF ~FindPath[data, target] THEN RETURN;
data.pleaseStop ← FALSE;
data.user ← FORK User[data, justOnce];
IF justOnce THEN TRUSTED { JOIN data.user; data.user ← NIL };
};
HistProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Stop[data];
PrintDelayHist[data]; };
StopProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Stop[data]; };
Stop:
PROC [data: ClientData] =
TRUSTED {
data.pleaseStop ← TRUE;
IF data.user # NIL THEN JOIN data.user;
data.user ← NIL; };
User:
PROC [data: ClientData, justOnce:
BOOL] = {
start, finish: BasicTime.GMT;
sent, mashed, missed, late, bogus: INT ← 0;
bytes: INT ← 0;
packetNumber: CARDINAL ← 0;
fixedLength: BOOL = data.fixedLength^;
lengthText: ROPE = ViewerTools.GetContents[data.length];
maxLength: CARDINAL ← ArpaICMPBuf.maxEchoDataBytes;
lengthCard: CARDINAL ← MIN[100, ArpaICMPBuf.maxEchoDataBytes];
handle: ArpaICMP.Handle ← ArpaICMP.CreateHandle[];
timeoutText: ROPE = ViewerTools.GetContents[data.timeout];
timeoutMin: CARDINAL ← 100;
timeoutMax: CARDINAL ← 60000;
timeout: INT;
timeout ← Convert.IntFromRope[timeoutText ! Convert.Error => {
IO.PutF[data.log, "Can't parse Timeout field.\n"];
timeout ← 0;
CONTINUE; } ];
timeout ← MAX[timeout, timeoutMin];
timeout ← MIN[timeout, timeoutMax];
IF fixedLength
THEN {
temp: INT;
temp ← Convert.IntFromRope[lengthText ! Convert.Error => {
IO.PutF[data.log, "Can't parse Length field.\n"];
lengthCard ← 0;
CONTINUE; } ];
temp ← MIN[temp, maxLength];
lengthCard ← temp;
IO.PutF[data.log, "Packet length is %G bytes.\n", [integer[lengthCard]]]; };
InitDelayHist[data];
data.good ← 0;
start ← BasicTime.Now[];
UNTIL data.pleaseStop
DO
FOR cycle:
CARDINAL
IN [0..maxLength]
UNTIL data.pleaseStop
DO
packetStart, packetStop: BasicTime.Pulses;
buf: ArpaICMPBuf.Buffer ← ArpaICMP.AllocBuffer[handle];
length: CARDINAL ← IF fixedLength THEN lengthCard ELSE cycle;
bodyBytes: CARDINAL ← BYTES[ArpaICMPBuf.Body.echo] - ArpaICMPBuf.maxEchoDataBytes + length;
IF justOnce THEN data.pleaseStop ← TRUE;
TRUSTED { buf.hdr2 ← [any[icmpType~echo, icmpCode~0, checksum~[0, 0]]] };
buf.body.echo.sequenceNum ← Basics.HFromCard16[packetNumber ← packetNumber.SUCC];
FOR k:
CARDINAL
IN [0..length)
DO
buf.body.echo.data[k] ← k MOD 100H;
ENDLOOP;
ArpaICMP.SetBodyBytes[buf, bodyBytes];
packetStart ← BasicTime.GetClockPulses[];
ArpaICMP.Send[handle, buf, data.where];
ArpaICMP.FreeBuffer[handle, buf];
sent ← sent + 1;
UNTIL (buf ← ArpaICMP.Receive[handle, timeout]) =
NIL
DO
SELECT
TRUE
FROM
buf.hdr2.icmpType # echoReply => {
bogus ← bogus + 1;
IO.PutF[data.log, "Wrong Type: %G.\n", [cardinal[buf.hdr2.icmpType.ORD]] ]; };
(Basics.Card16FromH[buf.body.echoReply.sequenceNum] # packetNumber)
OR (ArpaICMP.GetBodyBytes[buf].bodyBytes # bodyBytes) =>
BEGIN late ← late + 1; IF data.late^ THEN IO.PutRope[data.log, "#"]; END;
ENDCASE => {
packetStop ← BasicTime.GetClockPulses[];
AddToDelayHist[data, BasicTime.PulsesToMicroseconds[packetStop-packetStart]];
FOR k:
CARDINAL
IN [0..length)
DO
IF buf.body.echoReply.data[k] # k
MOD 100H
THEN {
IO.PutRope[data.log, "~"];
mashed ← mashed + 1;
GOTO Evil; };
ENDLOOP;
IF data.echo^ THEN IO.PutRope[data.log, "!"];
data.good ← data.good + 1;
bytes ← bytes + length;
EXIT; };
ArpaICMP.FreeBuffer[handle, buf]; buf ← NIL;
ENDLOOP;
IF buf #
NIL
THEN { ArpaICMP.FreeBuffer[handle, buf]; buf ← NIL }
ELSE { missed ← missed + 1; IF data.miss^ THEN IO.PutRope[data.log, "?"]; };
ENDLOOP;
IF ~data.echo^ THEN IO.PutRope[data.log, "."] ELSE IO.PutRope[data.log, "\n"];
ENDLOOP;
IO.PutRope[data.log, "\n"];
finish ← BasicTime.Now[];
ArpaICMP.DestroyHandle[handle];
BEGIN
packetsPerSecond, msPerPacket: REAL;
seconds: LONG CARDINAL ← BasicTime.Period[from: start, to: finish];
IF seconds = 0 THEN seconds ← 1;
packetsPerSecond ← REAL[sent]/REAL[seconds];
IF data.good = 0 THEN msPerPacket ← 0
ELSE msPerPacket ← 1000.0*seconds/data.good;
IO.PutF[data.log, "%G packets sent in %G seconds =>\n\t", [integer[sent]], [cardinal[seconds]]];
IO.PutF[data.log, "%1.2F packets/second.\n", [real[packetsPerSecond]] ];
IO.PutF[data.log, "%G bytes received in %G seconds =>\n\t", [integer[bytes]], [cardinal[seconds]]];
IO.PutF[data.log, "%1.0F bits/second => ", [real[8.0*bytes/seconds]] ];
IO.PutF[data.log, "%G ms/packet.\n", [real[msPerPacket]] ];
PrintPercent[data, data.good, sent, "Packets echoed OK"];
PrintPercent[data, mashed, sent, "Packets with bad data"];
PrintPercent[data, missed, sent, "Packets missed"];
PrintPercent[data, late, sent, "Late Packets"];
PrintPercent[data, bogus, sent, "Packets with wrong type"];
IO.Flush[data.log];
END;
};
InitDelayHist:
PROC [data: ClientData] = {
data.minDelay ← INT.LAST;
data.maxDelay ← INT.FIRST;
data.delayHist ← ALL[0]; };
AddToDelayHist:
PROC [data: ClientData, micro:
INT] = {
FOR d: DelayRange
IN DelayRange
DO
-- Slow but clean
IF delayTime[d] < micro THEN LOOP;
data.delayHist[d] ← data.delayHist[d] + 1;
EXIT;
REPEAT FINISHED => ERROR;
ENDLOOP;
data.minDelay ← MIN[data.minDelay, micro];
data.maxDelay ← MAX[data.maxDelay, micro]; };
PrintDelayHist:
PROC [data: ClientData] = {
total: INT ← 0;
IF data.good = 0 THEN RETURN;
IO.PutF[data.log, " Incremental Cumulative Microseconds\n"];
FOR d: DelayRange
IN DelayRange
DO
IF data.delayHist[d] = 0 THEN LOOP;
total ← total + data.delayHist[d];
IO.PutF[data.log, "%8G", [integer[data.delayHist[d]]]];
IO.PutF[data.log, "%7.2F%%", [real[100.0*data.delayHist[d]/data.good]]];
IO.PutF[data.log, "%8G", [integer[total]]];
IO.PutF[data.log, "%7.2F%%", [real[100.0*total/data.good]]];
IO.PutF[data.log, "%9G\n", [integer[delayTime[d]]]];
ENDLOOP;
IO.PutF[data.log, "The min delay was %G microseconds.\n", [integer[data.minDelay]]];
IO.PutF[data.log, "The max delay was %G microseconds.\n", [integer[data.maxDelay]]]; };
TimeProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
target: ROPE = ViewerTools.GetContents[data.target];
Time[data, target]; };
Time:
PROC [data: ClientData, target:
ROPE] =
TRUSTED {
handle: ArpaICMP.Handle;
buf: ArpaICMPBuf.Buffer;
packetStart: BasicTime.Pulses;
Report[data, "\nGetting Time from ", target, " "];
IF ~FindPath[data, target] THEN RETURN;
handle ← ArpaICMP.CreateHandle[];
buf ← ArpaICMP.AllocBuffer[handle];
buf.hdr2 ← [any[icmpType~timestamp, icmpCode~0, checksum~[0, 0]]];
buf.body.timestamp.sequenceNum ← [0, 0];
buf.body.timestamp.originateTimestamp ← Basics.FFromCard32[SecondsSinceMidnight[]];
buf.body.timestamp.receiveTimestamp ← LOOPHOLE[CARD32.LAST];
buf.body.timestamp.transmitTimestamp ← LOOPHOLE[CARD32.LAST];
packetStart ← BasicTime.GetClockPulses[];
ArpaICMP.SetBodyBytes[buf, BYTES[ArpaICMPBuf.Body.timestamp]];
ArpaICMP.Send[handle, buf, data.where];
ArpaICMP.FreeBuffer[handle, buf];
UNTIL (buf ← ArpaICMP.Receive[handle, 10000]) =
NIL
DO
SELECT
TRUE
FROM
(buf.hdr2.icmpType # timestampReply) => IO.PutRope[data.log, "Wrong Type"];
(ArpaICMP.GetBodyBytes[buf].bodyBytes # BYTES[ArpaICMPBuf.Body.timestamp]) => IO.PutRope[data.log, "Wrong Length"];
ENDCASE => {
now: BasicTime.GMT ← BasicTime.Now[];
packetStop: BasicTime.Pulses ← BasicTime.GetClockPulses[];
microseconds: LONG CARDINAL ← BasicTime.PulsesToMicroseconds[packetStop-packetStart];
IO.PutF[data.log, "Orig time is %G.\n", [rope[NetTimeToRope[Basics.Card32FromF[buf.body.timestampReply.originateTimestamp]]]]];
IO.PutF[data.log, "Recv time is %G.\n", [rope[NetTimeToRope[Basics.Card32FromF[buf.body.timestampReply.receiveTimestamp]]]]];
IO.PutF[data.log, "Tran time is %G.\n", [rope[NetTimeToRope[Basics.Card32FromF[buf.body.timestampReply.transmitTimestamp]]]]];
IO.PutF[data.log, "Flight time was %G ms.\n", [integer[microseconds/1000]]];
EXIT; };
ArpaICMP.FreeBuffer[handle, buf]; buf ← NIL;
ENDLOOP;
ArpaICMP.DestroyHandle[handle]; };
SecondsSinceMidnight:
PROC
RETURNS [ms:
INT] = {
secondsPerDay: INT ← 86400;
now: BasicTime.Unpacked ← BasicTime.Unpack[BasicTime.Now[]];
ms ← secondsPerDay;
IF now.dst = yes THEN ms ← ms - 3600;
ms ← ms + LONG[now.hour]*3600;
ms ← ms + LONG[(now.minute + now.zone)]*60;
ms ← ms + now.second;
ms ← ms MOD secondsPerDay;
ms ← ms * 1000; };
NetTimeToRope:
PROC [ms:
INT]
RETURNS [rope:
ROPE] = {
seconds, fraction: INT;
IF ms < 0 THEN RETURN["Unknown"];
seconds ← ms/1000;
fraction ← ms MOD 1000;
RETURN[IO.PutFR["%R.%03G", [integer[seconds]], [integer[fraction]] ]]; };
PrintPercent:
PROC [data: ClientData, x, sent:
INT, name:
ROPE] = {
IF x = 0 THEN RETURN;
IO.PutF[data.log, "%8G %7.2F%% %G\n", [integer[x]], [real[100.0*x/sent]], [rope[name]] ]; };
FindPath:
PROC [data: ClientData, target:
ROPE]
RETURNS [
BOOLEAN] =
TRUSTED {
where: Arpa.Address;
status: ArpaName.ReplyStatus;
source: Arpa.Address;
[where, status, source] ← ArpaName.NameToAddress[target];
SELECT status
FROM
bogus => {Report[data, ": not a valid name (", ArpaName.AddressToName[source].name, ").\n"]; RETURN[FALSE]};
down => {Report[data, "Name servers not responding.\n"]; RETURN[FALSE]};
other => {Report[data, ": no address for this name (", ArpaName.AddressToName[source].name, ").\n"]; RETURN[FALSE]};
ENDCASE;
IF where = Arpa.nullAddress THEN {Report[data, ": unable to lookup name.\n"]; RETURN[FALSE]; };
data.where ← where;
IF data.addrLookup^ THEN Report[data, "= ", ArpaName.AddressToName[data.where].name];
Report[data, " = ", ConvertExtras.RopeFromArpaAddress[data.where], ".\n"];
RETURN[TRUE]; };
Report:
PROC [data: ClientData, r1,r2,r3,r4:
ROPE ←
NIL] =
TRUSTED {
IF r1 # NIL THEN {IO.PutRope[data.log, r1]};
IF r2 # NIL THEN {IO.PutRope[data.log, r2]};
IF r3 # NIL THEN {IO.PutRope[data.log, r3]};
IF r4 # NIL THEN {IO.PutRope[data.log, r4]}; };
MakeRule:
PROC [parent, sibling: Viewer]
RETURNS [child: Viewer] = {
child ← Rules.Create[
info: [parent: parent, border:
FALSE,
wy: IF sibling = NIL THEN 0 ELSE sibling.wy + sibling.wh + 2, wx: 0, ww: parent.ww, wh: 1],
paint: FALSE ];
Containers.ChildXBound[parent, child]; };
ButtonWidth:
PROC [r:
ROPE]
RETURNS [width:
INT] = {
RETURN[VFonts.StringWidth[r] + 2*3]};
MakeButton:
PROC [parent, sibling: Viewer, data:
REF
ANY, name:
ROPE, proc: Buttons.ButtonProc]
RETURNS[child: Viewer] = {
child ← Buttons.Create[
info: [name: name, parent: parent, border:
TRUE,
wy: sibling.wy, wx: sibling.wx + buttonWidth - 1, ww: buttonWidth],
proc: proc,
clientData: data,
fork: TRUE,
paint: FALSE]; };
SelectorProc: TYPE = PROC [parent: Viewer, clientData: REF, value: ATOM];
Selector: TYPE = REF SelectorRec;
SelectorRec:
TYPE =
RECORD [
value: REF ATOM,
change: PROC [parent: Viewer, clientData: REF, value: ATOM],
clientData: REF,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
MakeSelector:
PROC
[name: ROPE, values: LIST OF ATOM, init: REF ATOM ← NIL, change: SelectorProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]
RETURNS [child: Viewer] = {
selector: Selector ←
NEW [SelectorRec ← [
value: IF init # NIL THEN init ELSE NEW [ATOM ← values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
child ← Labels.Create[info: [name: name, parent: parent, border: FALSE, wx: x, wy: y] ];
FOR a:
LIST
OF
ATOM ← values, a.rest
UNTIL a =
NIL
DO
child ← Buttons.Create[
info: [name: Atom.GetPName[a.first], parent: parent, border: TRUE, wx: child.wx + child.ww + 2, wy: child.wy],
proc: SelectorHelper, clientData: selector, fork: TRUE, paint: TRUE];
IF last = NIL THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP; };
SelectorHelper: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a:
LIST
OF
ATOM ← selector.values, a.rest
UNTIL a =
NIL
DO
IF self = buttons.first
THEN {
selector.value^ ← a.first;
IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first];
Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack]; }
ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite];
buttons ← buttons.rest;
ENDLOOP; };
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, init: REF BOOL, change: BoolProc ← NIL, clientData: REF ← NIL, parent, sibling: Viewer, x, y: INTEGER ← 0]
RETURNS [child: Viewer] = {
bool: Bool ←
NEW [BoolRec ← [
value: IF init # NIL THEN init ELSE NEW [BOOL ← TRUE],
change: change,
clientData: clientData,
button: NIL ] ];
IF x = 0 THEN x ← sibling.wx + sibling.ww + 10;
IF y = 0 THEN y ← sibling.wy;
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 = {
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^]; };
MakeLabel:
PROC [parent, sibling: Viewer, name:
ROPE]
RETURNS [child: Viewer] = {
child ← Labels.Create[
info: [name: name, parent: parent, border:
FALSE,
wy: sibling.wy + sibling.wh + (IF sibling.class.flavor = $Button THEN -1 ELSE 2),
wx: 2],
paint: FALSE ]; };
MakeLabeledText:
PROC [
parent, sibling: Viewer, name, data: ROPE, prev: Viewer,
newline: BOOL ← TRUE, labelWidth: INT ← 0, dataWidth: INT ← 50] RETURNS [child: Viewer] = {
x: INTEGER = IF newline THEN 2 ELSE sibling.wx + sibling.ww + 10;
y: INTEGER = IF newline THEN sibling.wy + sibling.wh + 1 ELSE sibling.wy;
IF labelWidth = 0 THEN labelWidth ← ButtonWidth[name];
child ← ViewerTools.MakeNewTextViewer[
info: [parent: parent, wh: buttonHeight, ww: dataWidth, scrollable:
FALSE,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: x + labelWidth + 2, wy: y],
paint: FALSE ];
Containers.ChildXBound[parent, child];
[] ← Buttons.Create[
info: [name: name, parent: parent, wh: buttonHeight, border: FALSE, wx: x, wy: y],
proc: LabeledTextProc, clientData: child, fork: FALSE, paint: FALSE];
RETURN[child]; };
LabeledTextProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
text: Viewer = NARROW[clientData];
SELECT mouseButton
FROM
red => ViewerTools.SetSelection[text, NIL];
yellow => NULL;
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
ENDCASE => ERROR; };
Commander.Register["ArpaICMPEchoTool", Create, "Echo ICMP packets to the Arpa Internet."];
END.