DIRECTORY
BasicTime USING [GetClockPulses, PulsesToMicroseconds],
Buttons USING [Button, ButtonProc, Create],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, Container, Create],
Convert USING [Error, IntFromRope, RopeFromReal],
Graphics USING [Context, DrawBox, SetStipple],
Labels USING [Create, Label, Set],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
MessageWindow USING [Append, Blink],
Process USING [Detach, Pause, SecondsToTicks, Ticks],
Rope USING [Cat, ROPE, Length],
Rules USING [Create, Rule],
SafeStorage USING [NarrowFault, NWordsAllocated],
VFonts USING [CharWidth, StringWidth],
ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass, SetOpenHeight],
ViewerTools USING [MakeNewTextViewer, GetContents, SetSelection];
SampleTool: CEDAR PROGRAM				
IMPORTS BasicTime, Buttons, Commander, Containers, Convert, Graphics, Labels, Menus, MessageWindow, Process, Rope, Rules, SafeStorage, VFonts, ViewerOps, ViewerTools =
BEGIN
entryHeight: CARDINAL = 15;	-- how tall to make each line of items
entryVSpace: CARDINAL = 8; 	-- vertical leading space between lines
entryHSpace: CARDINAL = 10; 	-- horizontal space between items in a line
Handle: TYPE = REF SampleToolRec;	-- a REF to the data for a particular instance of the sample tool; multiple instances can be created.
SampleToolRec: TYPE = RECORD [	-- the data for a particular tool instance
outer: Containers.Container _ NIL,	-- handle for the enclosing container
height: CARDINAL _ 0,		-- height measured from the top of the container
fact: FactorialViewer,		-- the factorial viewer's state
graph: GraphViewer ];		-- the bar graph viewer's state
MakeSampleTool: Commander.CommandProc = BEGIN
my: Handle _ NEW[SampleToolRec];
myMenu: Menus.Menu _ Menus.CreateMenu[];
Menus.AppendMenuEntry[	-- add our command to the menu
menu: myMenu,
entry: Menus.CreateEntry[
name: "MyMenuEntry",	-- name of the command
proc: MyMenuProc			-- proc associated with command
]
];
my.outer _ Containers.Create[[-- construct the outer container		(note 3.1)
name: "Sample Tool",	-- name displayed in the caption
iconic: TRUE,			-- so tool will be iconic (small) when first created
column: left,				-- initially in the left column
menu: myMenu,		-- displaying our menu command
scrollable: FALSE ]];		-- inhibit user from scrolling contents
MakeFactorial[my];		-- build each (sub)viewer in turn
MakeGraph[my];
ViewerOps.SetOpenHeight[my.outer, my.height];	-- hint our desired height
ViewerOps.PaintViewer[my.outer, all];				-- reflect above change
END;
MyMenuProc: Menus.MenuProc = BEGIN
MessageWindow.Append[
message: "You just invoked the sample menu item with the ",
clearFirst: TRUE];
IF control THEN MessageWindow.Append[
message: "Control-",
clearFirst: FALSE];
IF shift THEN MessageWindow.Append[
message: "Shift-",
clearFirst: FALSE];
MessageWindow.Append[
message: SELECT mouseButton FROM
red		=> "Red",
yellow	=> "Yellow",
ENDCASE	=> "Blue",
clearFirst: FALSE];
MessageWindow.Append[message: " mouse button.", clearFirst: FALSE];
MessageWindow.Blink[ ];
END;

FactorialViewer: TYPE = RECORD [
input: ViewerClasses.Viewer _ NIL,	-- the Text Box for user input
result: Labels.Label _ NIL ];	-- result of the computation
MakeFactorial: PROC [handle: Handle] = BEGIN			 --(note 3.2)
promptButton, computeButton: Buttons.Button;
initialData: Rope.ROPE = "5";
initialResult: Rope.ROPE = "120";
handle.height _ handle.height + entryVSpace;	-- space down from the top of the viewer
promptButton _ Buttons.Create[
info: [
name: "Type an integer in [0..34]:", 
wy: handle.height,
wh: entryHeight,	-- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE ],
proc: Prompt,
clientData: handle];	-- this will be passed to our button proc
handle.fact.input _ ViewerTools.MakeNewTextViewer[ [
parent: handle.outer,
wx: promptButton.wx + promptButton.ww + entryHSpace,
wy: handle.height+2,
ww: 15*VFonts.CharWidth['0],	-- fifteen digits worth of width
wh: entryHeight,
data: initialData,	-- initial contents
scrollable: FALSE,
border: FALSE]];
computeButton _ Buttons.Create[
info: [
name: "Compute Factorial",
wx: handle.fact.input.wx + handle.fact.input.ww + entryHSpace,
wy: handle.height,
ww:,	-- default the width so that it will be computed for us      (note 3.3)
wh: entryHeight,	-- specify rather than defaulting so line is uniform
parent: handle.outer,
border: TRUE],
clientData: handle,	-- this will be passed to our button proc
proc: ComputeFactorial];
handle.fact.result _ Labels.Create[ [
name: initialResult,	-- initial contents
wx: computeButton.wx + computeButton.ww + entryHSpace,
wy: handle.height,
ww: 20*VFonts.CharWidth['0],	-- 20 digits worth of width
wh: entryHeight,
parent: handle.outer,
border: FALSE]];
handle.height _ handle.height + entryHeight + entryVSpace;	-- interline spacing
END;
Prompt: Buttons.ButtonProc = BEGIN
handle: Handle _ NARROW[clientData];	-- get our data
ViewerTools.SetSelection[handle.fact.input];		-- force the selection
END;
ComputeFactorial: Buttons.ButtonProc = BEGIN
handle: Handle _ NARROW[clientData];	-- get our data
contents: Rope.ROPE _ ViewerTools.GetContents[handle.fact.input];
inputNumber: INT_ 0;
resultNumber: REAL _ 1.0;
inputError: BOOL_ FALSE;
IF Rope.Length[contents]=0 THEN inputNumber _ 0
ELSE inputNumber _ Convert.IntFromRope[contents
! SafeStorage.NarrowFault => {inputNumber_ -1; CONTINUE};
 Convert.Error => {SELECT reason FROM
     $empty => MessageWindow.Append[ -- I guess this should not happen when
                                                -- the length of the content is not zero.
                    message: "SampleTool: input is blank.",
                    clearFirst: TRUE ]; 
     $syntax => MessageWindow.Append[
                    message: "SampleTool: input syntax error.",
                    clearFirst: TRUE ];
     $overflow => MessageWindow.Append[
                    message: "SampleTool: input overflowed.",
                    clearFirst: TRUE ];
     ENDCASE;
   inputError_ TRUE;
    MessageWindow.Blink[ ];
    CONTINUE};
 ];        --(note 3.4)
IF inputError THEN RETURN;
IF inputNumber NOT IN [0..34] THEN {
MessageWindow.Append[
message: "I can only compute the factorial for integers in the range of 0 ... 34.",
clearFirst: TRUE ];
MessageWindow.Blink[ ] }
ELSE {
  FOR n: INT IN [2..inputNumber] DO
  resultNumber _ resultNumber*n;
ENDLOOP;
   Labels.Set[handle.fact.result, Convert.RopeFromReal[resultNumber]] };
END;
GraphViewer: TYPE = RECORD [viewer: ViewerClasses.Viewer _ NIL];
MakeGraph: PROC [handle: Handle] = BEGIN			 --(note 3.6)
xIncr: INTEGER;		-- temporarily used for labelling graph below
xTab: INTEGER = 10;
label: Rope.ROPE _ "1";		-- used to place labels on the graph
rule: Rules.Rule _ Rules.Create[ [	-- create a bar to separate sections 1 and 2
parent: handle.outer,
wy: handle.height,
ww: handle.outer.cw,
wh: 2]];
Containers.ChildXBound[handle.outer, rule];	-- constrain rule to be width of parent
handle.height _ handle.height + entryVSpace;	-- spacing after rule
[ ] _ Labels.Create[[
name: "Words Allocated Per Second", parent: handle.outer,
wx: xTab, wy: handle.height, border: FALSE ]];
handle.height _ handle.height + entryHeight + 2;	-- interline spacing
handle.graph.viewer _ CreateBarGraph[
parent: handle.outer,
x: xTab, y: handle.height, w: 550, h: entryHeight,
fullScale: 5.0 ];	-- orders of magnitude
handle.height _ handle.height + entryHeight + 2;	-- interline spacing
xIncr _ handle.graph.viewer.ww/5;	-- so we can space labels at equal fifths
FOR i: INTEGER IN [0..5) DO	-- place the labels, 1, 10, 100, 1000, 10000 along the graph
[ ] _ Labels.Create[[name: label, parent: handle.outer,
wx: xTab+i*xIncr - VFonts.StringWidth[label]/2,
wy: handle.height, border: FALSE ]];
label _ label.Cat["0"];			-- concatenate another zero each time
ENDLOOP;
handle.height _ handle.height + entryHeight + entryVSpace;	-- extra space at end
TRUSTED {Process.Detach[FORK MeasureProcess[handle]]};	-- start the update process
END;
MeasureProcess: PROC [handle: Handle] = BEGIN		 --(note 3.7)
updateInterval: Process.Ticks = Process.SecondsToTicks[1];
mark, nextMark: LONG CARDINAL;
words, nextWords, deltaWords, deltaTime: REAL;
mark _ BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]];
words _ SafeStorage.NWordsAllocated[ ];
UNTIL handle.graph.viewer.destroyed DO
nextMark _ BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]];
deltaTime _ (nextMark - mark) * 1.0E-6;
nextWords _ SafeStorage.NWordsAllocated[ ];
deltaWords _ nextWords - words;
SetBarGraphValue[handle.graph.viewer, deltaWords/deltaTime];
words _ nextWords; 
mark _ nextMark; 
Process.Pause[updateInterval];
ENDLOOP;
END;
GraphData: TYPE = REF GraphDataRec; 
GraphDataRec: TYPE = RECORD [
value: REAL _ 0,	-- current value being displayed (normalized)
scale: REAL ];		-- "full scale"
PaintGraph: ViewerClasses.PaintProc = BEGIN			 --(note 3.8)
myGray: CARDINAL = 122645B;	-- every other bit
data: GraphData _ NARROW[self.data];
Graphics.SetStipple[context, myGray];
Graphics.DrawBox[context, [0, 0, data.value, self.ch]]; 

END;
CreateBarGraph: PROC [x, y, w, h: INTEGER, parent: ViewerClasses.Viewer,
	fullScale: REAL]
RETURNS [barGraph: ViewerClasses.Viewer] = BEGIN		 --(note 3.9)
instanceData: GraphData _ NEW[GraphDataRec];
instanceData.scale _ fullScale;
barGraph _ ViewerOps.CreateViewer[
flavor: $BarGraph,	-- the class of viewer registered in the start code below
info: [
parent: parent,
wx: x, wy: y, ww: w, wh:h,
data: instanceData,
scrollable: FALSE]
];
END;
SetBarGraphValue: PROC [barGraph: ViewerClasses.Viewer, newValue: REAL] = BEGIN
my: GraphData _ NARROW[barGraph.data];
Log10: --Fast-- PROC [x: REAL] RETURNS [lx: REAL] = BEGIN
sqrt10: REAL = 3.162278; 
t: REAL;
lx _ 0; 
WHILE x > 10 DO x _ x/10; lx _ lx+1 ENDLOOP;	-- scale to [1..10]
IF x > sqrt10 THEN {x _ x/sqrt10; lx _ lx+0.5};	-- scale to [1..1/sqrt10]
t _ (x-1)/(x+1);
lx _ lx + 0.86304*t + 0.36415*(t*t*t)	-- magic cubic approximation
END;
my.value _ Log10[1+newValue] * barGraph.cw / my.scale; 
ViewerOps.PaintViewer[viewer: barGraph, hint: client, clearClient: TRUE];
END; 
graphClass: ViewerClasses.ViewerClass _ 			--[3.1]
NEW[ViewerClasses.ViewerClassRec _ [paint: PaintGraph]];
Commander.Register[key: "SampleTool", proc: MakeSampleTool,
doc: "Create a sample viewers tool" ];
ViewerOps.RegisterViewerClass[$BarGraph, graphClass];
[ ] _ MakeSampleTool[NIL];	-- and create an instance
END.

CHANGE LOG

Changed by S. Chen on May 4, 1984 8:53:19 pm PDT
ShowTime.Microseconds -> LONG CARDINAL;
ShowTime.GetMark -> BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]];
UserExec.CommandProc -> Commander.CommandProc;
UserExec.RegisterCommand[name: ... , proc: ... , briefDoc: ... ] ->
  Commander.Register[key: ... , proc: ... , doc: ... ];
Convert.ValueToRope[[real[resultNumber]]] -> Convert.RopeFromReal[resultNumber];
MakeSampleTool[NIL, NIL]_ MakeSampleTool[NIL];
Added errors handling for the errors that might be generated by Convert.IntFromRope, e.g., syntax error, overflow; 
Changed a message to inform the user the allowed input range when it is exceeded; 
The factorial is computed and displayed only if there is no input error and if the input is an integer in [0..34].
Changed the label "Type a number:" to "Type an integer in [0..34]:"
Widened the width of the space for user's input.

Changed by Bob Hagmann on May 8, 1984 10:27:29 am PDT
deleted last TRUSTED declaration on a procedure


>SampleTool.mesa; Written by Scott McGregor on June 9, 1982 9:51 am
Last edited by Mitchell on August 16, 1982 4:16 pm
Last edited by McGregor on March 1, 1983 10:33 am
Last edited by S. Chen on May 4, 1984 8:53:28 pm PDT
Last edited by Bob Hagmann on May 8, 1984 10:27:07 am PDT
The Containers interface is used to create an outer envelope or "container" for the different sections below.  For uniformity, we define some standard distances between entries in the tool.
this procedure is called whenever the user clicks the entry labelled "MyMenuEntry" in the tool menu.
default the width so that it will be computed for us --
force the selection into the user input field
the bar graph reflecting collector activity
Forked as a separate process.  Updates the bar graph at periodic intervals.
this section creates the viewer class for a logarithmic bar graph. 
private data structure for instances of BarChart viewers
use this routine to set the bar graph to new values
truncated for values of [1..inf), 3-4 good digits
algorithm from Abramowitz: Handbook of Math Functions, p. 68
graphClass is a record containing the procedures and data common to all BarGraph viewer instances (class record).
Register a command with the UserExec that will create an instance of this tool.
Register the BarGraph class of viewer with the Window Manager
Κ
Θ–

"Cedar" style˜Iproc–

"Cedar" styleš
œB™BKš
œ2™2Kš
œ1™1Kš
œ4™4Kš
œ9™9
unitš
Οk	˜	Jšœ
œ(˜7Jšœœ˜+Jšœ
œ˜(Jšœœ"˜2Jšœœ$˜1Jšœ	œ ˜.Jšœœ˜"Jšœœ<˜GJšœœ˜$Jšœœ(˜5Jšœœœ
˜Jšœœ˜Jšœœ ˜1Jšœœ˜&Jšœœ2˜EJšœ
œA˜PJšœœ0˜A—šœœ
œ˜Jšœ 
˜§
—Lš
˜Jš
œ½
™½
Jšœ
œΟc&˜BJšœ
œž'˜CJšœ
œž+˜HLšœœœžΠckž]˜‡
šœœœž+˜IJšœœž%˜HJšœœž0˜GJšœž˜7Jšœž˜6—šœ(˜-Jšœ
œ˜ Iemphasisš
œ(˜(šœž˜5Jš
œ
˜
š
œ˜Jšœž˜+Jšœž˜2Jš
œ
˜
—Jš
œ˜—šœžœΟa
˜JJšœž ˜5Jšœœž4˜DJšœž˜0Jšœž˜-Jšœœ
œž'˜>—Jšœž!˜5Jš
œ˜Jšœ.ž˜HJšœ)ž˜@Jšœ
˜—Lšœ˜"š
žd™dš
œ˜Jš
œ;˜;Jšœœ˜—šœ	œ˜%Jš
œ˜Jšœœ˜—šœœ˜#Jš
œ˜Jšœœ˜—š
œ˜šœ	œ
˜ Jš
œ˜Jš
œ˜Jšœ˜—Jšœœ˜—Jšœ<œ˜CJš
œ˜Jšœ
˜—K˜šœœœ˜ Jšœœž˜AJšœœž˜:—šΟn
œœœžΠac
˜<Jš
œ,˜,Jšœœ˜Jšœœ	˜!Jšœ-ž(˜Uš
œ˜š
œ˜Jš
œ%˜%Jš
œ˜Jš
œ7™7Jšœž4˜EJš
œ˜Jšœœ˜—Jš
œ
˜
Jšœž)˜>—š
œ4˜4Jš
œ˜Jš
œ4˜4Jš
œ˜Jšœž ˜=Jš
œ˜Jšœž˜&Jšœœ
˜Jšœœ˜—š
œ˜š
œ˜Jš
œ˜Jš
œ>˜>Jš
œ˜Jšœž= 
˜LJšœž4˜EJš
œ˜Jšœœ˜—Jšœž)˜=Jš
œ˜—š
œ%˜%Jšœž˜(Jš
œ6˜6Jš
œ˜Jšœž˜8Jš
œ˜Jš
œ˜Jšœœ˜—Jšœ;ž˜OJšœ
˜—Lšœ˜"š
œ-™-Jšœœž˜4Jšœ.ž˜DJšœ
˜—šœ'˜,Jšœœž˜4Jšœœ.˜AJšœ
œ˜Jšœœ˜Jšœœœ
˜Jšœœ˜/I
cšœ[œœœ&ž'œ0ž*œ\œ‹
œŠ
œ	œœ"œž’
˜œJšœœ
œ
˜šœ
œ
œ	œ˜$š
œ˜Jš
œS˜SJšœœ˜—Jš
œ˜—š	œœœ
œ˜*Jš
œ ˜ Jšœ
˜—Jš
œH˜HJšœ
˜—Lš
œ+™+Jšœ
œœ!œ˜@š‘	œœœž’
˜8Mšœœž-˜>Jšœœ˜Jšœœ	ž$˜=šœ#ž,˜OJš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜—Lšœ,ž'˜SJšœ-ž˜Bš
œ˜Jš
œ9˜9Jšœ%œ˜.—Jšœ1ž˜Eš
œ%˜%Jš
œ˜Jš
œ2˜2Jšœž˜(—Jšœ1ž˜EJšœ"ž)˜Kšœœ
œž<˜Xš
œ7˜7Jš
œ/˜/Jšœœ˜$—Jšœž%˜?Jšœ
˜—Jšœ;ž˜PJšœœž˜RJšœ
˜—Lš‘œœœž’
˜<š
œK™KJš
œ:˜:Jšœœ
œ
˜Jšœ)œ
˜.Mš
œB˜BJš
œ'˜'šœ˜&Jš
œF˜FJš
œ'˜'Jš
œ+˜+Jš
œ˜Jš
œ<˜<Jš
œ˜Jš
œ˜Jš
œ˜Jšœ
˜—Jšœ
˜—Lš
œC™CMš
œ8™8Jšœœœ˜$šœœœ˜Jšœœž-˜>Jšœœž˜—šœ&œž’
˜;Kšœœž˜.Kšœœ˜$Kš
œ%˜%Kš
œ9˜9Jšœ
˜—Lš‘œœœ,œ
˜Zšœ$œž’
˜?Jšœœ˜,Jš
œ˜š
œ"˜"Jšœž9˜L
codeš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jšœœ
˜—Jš
œ˜—Jšœ
˜—Lš
œ3™3š‘œœ,œ˜OJšœœ˜&Lš
‘œžœ
œœœœ˜9Jš
œ1™1š
œ<™<Jšœœ
˜Jšœœ
˜Jš
œ˜Jšœœœž˜@Jšœœž˜IJš
œ˜Jšœ&ž˜BJšœ
˜—Lš
œ7˜7JšœCœ˜IJšœ˜—Lš
œq™qšœ+ž’˜2Jšœ5˜8—Kš
œO™Oš
œ;˜;Jš
œ&˜&—Mš
œ=™=Jš
œ5˜5Mšœœž˜4I	modheaderšœ˜Pšœ
œ
˜Nšœ
œ!œœ
œέœœœ±˜‚N˜š
œ5˜5Nšœ
Οsœ˜/—P˜J˜—…—,ϊ=