
<<CSegDebugInterface.mesa >>
<<Last Edited by: Sweet, December 19, 1985 4:39:17 pm PST>>

DIRECTORY
Buttons,
Commander,
Containers,
Convert,
CSegDebugDefs,
IO,
Labels,
Menus,
PrincOps,
RESOut USING [cancelAction, Complain],
Rope,
Rules,
SafeStorage,
TypeScript,
VFonts,
ViewerClasses,
ViewerIO,
ViewerOps,
ViewerTools;

CSegDebugInterface: CEDAR PROGRAM 
IMPORTS 
Buttons, Containers, Convert, CSegDebugDefs, Labels, RESOut, Rope, Rules, SafeStorage, TypeScript, VFonts, ViewerIO, ViewerOps, 
ViewerTools 
EXPORTS CSegDebugDefs =
BEGIN
OPEN CSegDebugDefs;

entryHeight: CARDINAL = 15;    -- how tall to make each line of items
entryVSpace: CARDINAL = 2;     -- vertical leading space between lines
entryHSpace: CARDINAL = 5;     -- min horizontal space between items in a line
ROPE: TYPE = Rope.ROPE;

PromptRec: TYPE = RECORD [handle: CSegDebugDefs.Handle, cell: ViewerClasses.Viewer, radix: INT _ 8];
PromptHandle: TYPE = REF PromptRec;
CmdRec: TYPE = RECORD [handle: CSegDebugDefs.Handle, cmd: CSegDebugDefs.CmdIndex];
CmdHandle: TYPE = REF CmdRec;

MakeTool: Commander.CommandProc = BEGIN
rule: Rules.Rule;
my: Handle _ NEW[DataRec];
my.en _ VFonts.CharWidth['n];
my.outer _ Containers.Create[[-- construct the outer container
name: "CSegDebug",    -- name displayed in the caption
iconic: TRUE,            -- so tool will be iconic (small) when first created
column: left,                -- initially in the left column
scrollable: FALSE ]];        -- inhibit user from scrolling contents
my.msg _ Labels.Create[ [
name: NIL,
wx: 0, wy: my.height,
wh: 2*entryHeight,
parent: my.outer,
border: FALSE]];
my.height _ my.height + 2*entryHeight + 2;    -- interline spacing
Containers.ChildXBound[my.outer, my.msg];
rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
Containers.ChildXBound[my.outer, rule];
MakeCommands[my];
rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
Containers.ChildXBound[my.outer, rule];
my.height _ my.height + 2;    -- interline spacing
MakeTypescript[my];
my.charsOnLine _ 0;
ViewerOps.PaintViewer[my.outer, all];                -- reflect above change
END;

MakeCommands: PROC [handle: Handle] = BEGIN    
cmdy: INT _ handle.height + entryVSpace;
cmdx: INT _ 0;
col1: INT = 1;
col2: INT = col1 + 18;
col3: INT = col2 + 15;
col4: INT = col3 + 12;
col5: INT = col4 + 11;
NewLine: PROC = {cmdy _ cmdy + entryHeight + entryVSpace; cmdx _ 0};

NextPlace: PROC [at: CARDINAL] RETURNS [CARDINAL] = {
pat: INT = at * handle.en;
cmdx _ MAX[cmdx, pat];
RETURN [cmdx]};

MakeCmd: PROC [at: CARDINAL, name: ROPE, cmd: CSegDebugDefs.CmdIndex] = {
b: Cmd _ Buttons.Create[
info: [
name: Rope.Concat[name, "!"], 
wx: NextPlace[at],
wy: cmdy,
<<-- default the width so that it will be computed for us>>
wh: entryHeight,    -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE],
proc: OtherCmd,
clientData: NEW [CmdRec _ [handle: handle, cmd: cmd]]];
cmdx _ cmdx + b.ww + entryHSpace};

MakeBool: PROC [at: CARDINAL, name: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = {
b: Cmd;
flag _ NEW[BOOL _ initial];
b _ Buttons.Create[
info: [
name: name, 
wx: NextPlace[at],
wy: cmdy,
<<-- default the width so that it will be computed for us>>
wh: entryHeight,    -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: FALSE],
proc: ToggleBool,
clientData: flag];
Buttons.SetDisplayStyle[
button: b,
style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite];
cmdx _ cmdx + b.ww + entryHSpace};

NamedCell: PROC [at: CARDINAL, name: ROPE, width: CARDINAL, initial: ROPE _ NIL, radix: INT _ 8]
RETURNS [v: ViewerClasses.Viewer] = {
ph: PromptHandle _ NEW[PromptRec _ [handle: handle, radix: radix, cell: NIL]];
b: Buttons.Button _ Buttons.Create[
info: [
name: Rope.Concat[name, ": "], 
wx: NextPlace[at],
wy: cmdy,
wh: entryHeight,
parent: handle.outer,
border: FALSE],
proc: SimplePrompt,
clientData: ph];
cmdx _ cmdx + b.ww + entryHSpace;
v _ ViewerTools.MakeNewTextViewer[
info: [
wx: cmdx,
wy: cmdy,
ww: width*handle.en,
wh: entryHeight,
parent: handle.outer,
data: initial,
scrollable: FALSE,
border: FALSE]];
ph.cell _ v;
cmdx _ cmdx + v.ww + entryHSpace};

MakeCmd[col1, "gfi", gfi]; 
handle.cmd.gfVal _ NamedCell[col1+4, "gf", 8];
handle.cmd.bpcVal _ NamedCell[col2, "bpc", 7];
handle.cmd.nVal _ NamedCell[col3, "n", 4, "10", 10];
MakeCmd[col4, "code", code]; 
MakeCmd[col4+6, "oct", octal]; 
MakeCmd[col5, "prefix", prefix];
NewLine[];

MakeCmd[col1, "dspLf", dspLf];
MakeCmd[col1+6, "goLf", goLf];
MakeCmd[col2, "wpc", wpc]; 
MakeCmd[col2, "ep?", findEp];
MakeCmd[col2, "bkup", back];
handle.autoNext _ MakeBool[col3, "auto", TRUE];
MakeCmd[col3+5, "next", next];
MakeCmd[col4, "bytes", bytes];
MakeCmd[col4, "ascii", ascii];
MakeCmd[col5, "evi", evi];
MakeCmd[col5+4, "link", link];
MakeCmd[col5+9, "pd", pd];
NewLine[];

MakeCmd[col1, "stop", stop];
MakeCmd[col1+5, "find", find];
handle.cmd.keyString _ NamedCell[col1+10, "key", col3-col1-11, NIL, 0];
handle.cmd.rangeVal _ NamedCell[col3, "rng", 5, "100", 10];
MakeCmd[col4, "num->mop", numMop];
MakeCmd[col5, "mop->num", mopNum];
handle.height _ cmdy + entryHeight + entryVSpace;    -- interline spacing
END;

CellInt: PUBLIC PROC [handle: Handle, n: NumberCell] RETURNS [INT] = {
contents: Rope.ROPE _ ViewerTools.GetContents[n];
RETURN [GetNumber[handle, contents]]};

CellCard: PUBLIC PROC [handle: Handle, n: NumberCell] RETURNS [CARDINAL] = {
contents: Rope.ROPE _ ViewerTools.GetContents[n];
i: INT _ GetNumber[handle, contents];
IF ~ (i IN [0..CARDINAL.LAST]) THEN 
RESOut.Complain[h: handle, msg: "number out of range"];
RETURN [CARDINAL[i]]};

GetNumber: PUBLIC PROC [handle: Handle, contents: Rope.ROPE] RETURNS [v: INT _ 0] = {
ENABLE SafeStorage.NarrowFault => GO TO bad;
neg: BOOL _ FALSE;
first: CARDINAL _ 0;
IF Rope.Length[contents] = 0 THEN RETURN;
FOR i: CARDINAL IN [0..CARDINAL[Rope.Length[contents]]) DO
c: CHAR = Rope.Fetch[contents, i];
SELECT  c FROM
IN [IO.NUL..IO.SP] => NULL;
'- => {neg _ TRUE; first _ i+1; EXIT};
ENDCASE => {first _ i; EXIT};
ENDLOOP;
v _ Convert.CardFromWholeNumberLiteral[contents, first !
Convert.Error => {
SELECT reason FROM
$empty => RESOut.Complain[h: handle, msg: "number is blank."]; 
$syntax => RESOut.Complain[h: handle, msg: "number syntax error."];
$overflow => RESOut.Complain[h: handle, msg: "number overflowed."];
ENDCASE; -- above cases won't return (they raise cancelAction)
GO TO bad}];
IF neg THEN v _ -v;
EXITS
bad => RETURN [0];
};

MakeTypescript: PROC [handle: Handle] = BEGIN    
handle.height _ handle.height + entryVSpace;    -- space down from the top of the viewer
handle.ts _ TypeScript.Create[
info: [name: "ListTool.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];
[handle.in, handle.out] _ ViewerIO.CreateViewerStreams [
name: "ListTool.ts", viewer: handle.ts, backingFile: "ListTool.ts", editedStream: FALSE];
Containers.ChildXBound[handle.outer, handle.ts];
Containers.ChildYBound[handle.outer, handle.ts];
END;

SetCell: PRIVATE PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer, radix: CARDINAL] = {
ENABLE RESOut.cancelAction => GO TO dont;
SELECT button FROM
blue =>  ViewerTools.SetSelection[cell];
red, yellow => {
r: ROPE = ViewerTools.GetSelectionContents[];
i: INT = GetNumber[handle, r];
IF button = yellow THEN radix _ 8;
ViewerTools.SetContents[cell, Convert.RopeFromInt[from: i, base: radix, showRadix: TRUE]]};
ENDCASE;
EXITS
dont => RETURN;
};

SetTextCell: PRIVATE PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer] = {
ENABLE RESOut.cancelAction => GO TO dont;
SELECT button FROM
blue =>  ViewerTools.SetSelection[cell];
red => {
r: ROPE = ViewerTools.GetSelectionContents[];
ViewerTools.SetContents[cell, r]};
ENDCASE;
EXITS
dont => RETURN;
};

SimplePrompt: Buttons.ButtonProc  = {
ph: PromptHandle _ NARROW[clientData];
IF ph.radix = 0 THEN SetTextCell[ph.handle, mouseButton, ph.cell]
ELSE SetCell[ph.handle, mouseButton, ph.cell, ph.radix];
};

GetSelectionValue: PUBLIC PROC [handle: Handle] RETURNS [UNSPECIFIED] = {
r: ROPE = ViewerTools.GetSelectionContents[];
i: INT = GetNumber[handle, r];
IF ~(i IN [0..CARDINAL.LAST]) THEN 
RESOut.Complain[h: handle, msg: "Selected number too large"];
RETURN [CARDINAL[i]]};

GetLongSelectionValue: PUBLIC  PROC [handle: Handle] RETURNS [INT] = {
r: ROPE = ViewerTools.GetSelectionContents[];
RETURN [GetNumber[handle, r]]};

OtherCmd: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ 
FALSE, control: BOOL _ FALSE] --  = {
ENABLE RESOut.cancelAction, ABORTED => GO TO dont;
ch: CmdHandle = NARROW[clientData];
RESOut.Complain[h: ch.handle, msg: NIL, abort: FALSE];
IF ch.cmd = stop THEN ch.handle.stopFlag _ TRUE
ELSE {
ch.handle.stopFlag _ FALSE;
CSegDebugDefs.DoCommand[ch.handle, ch.cmd, mouseButton]};
EXITS
dont => RETURN;
};

ToggleBool: Buttons.ButtonProc  = {
switch: REF BOOL _ NARROW [clientData]; 
switch^ _ ~switch^;
Buttons.SetDisplayStyle[
 button: NARROW[parent], 
 style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];
};

[] _ MakeTool[NIL];
END.
<<>>