<> <> DIRECTORY Ascii, Buttons, Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Container, Create], Convert, FS, IO, MessageWindow, RefText, Rope, Rules USING [Create, Rule], TypeScript, VFonts, ViewerClasses USING [Viewer, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [CreateViewer, PaintViewer], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; CallerCount: CEDAR PROGRAM IMPORTS Buttons, Commander, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, 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 ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; dash: CHAR = Ascii.ControlV; CallerNumber: TYPE = [0..200); CP: TYPE = RECORD [name, phone: ROPE, recruiter: CallerNumber]; CallerNameRec: TYPE = ARRAY CallerNumber OF CP; DinnerCode: TYPE = {d, h, other}; Entry: TYPE = RECORD [ caller: CallerNumber _ 0, activity, level, dinner, age: CHAR _ ' , phone: ARRAY [0..4) OF ROPE _ ALL[NIL], name: ARRAY [0..4) OF ROPE _ ALL[NIL], addr: ARRAY [0..4) OF ROPE _ ALL[NIL], town: ROPE _ NIL, zip: ROPE _ NIL, mailing: ROPE _ NIL, comment: ROPE _ NIL]; CountArray: TYPE = ARRAY DinnerCode OF CARDINAL; Handle: TYPE = REF MyRec; -- a REF to the data for a particular instance of the sample tool; multiple instances can be created. MyRec: 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 cmd: CommandViewer, -- the commands callerName: REF CallerNameRec, in: STREAM, eof: BOOLEAN _ FALSE, out: STREAM, -- for mailing list file flipNames: REF BOOL, prevCaller: CallerNumber _ 0, dinnerK: CountArray, phoneK: INT, lastPhone: ROPE, tsIn, tsOut: STREAM, ts: ViewerClasses.Viewer ]; -- the typescript PromptRec: TYPE = RECORD [ handle: Handle, viewer: ViewerClasses.Viewer _ NIL]; PromptHandle: TYPE = REF PromptRec; MakeTool: Commander.CommandProc = BEGIN rule: Rules.Rule; my: Handle _ NEW[MyRec]; my.outer _ Containers.Create[[-- construct the outer container name: "Caller Count", -- 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 MakeCommands[my]; -- build each (sub)viewer in turn rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]]; Containers.ChildXBound[my.outer, rule]; my.height _ my.height + entryHeight + 2; -- interline spacing MakeTypescript[my]; ViewerOps.PaintViewer[my.outer, all]; -- reflect above change END; CommandViewer: TYPE = RECORD [ inputFile, outputFile, callers: ViewerClasses.Viewer ]; MakeTypescript: PROC [handle: Handle] = BEGIN handle.height _ handle.height + entryVSpace; -- space down from the top of the viewer handle.ts _ TypeScript.Create[ info: [name: "CallerCount.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "CallerCount.ts", viewer: handle.ts, backingFile: "CallerCount.ts", editedStream: FALSE]; Containers.ChildXBound[handle.outer, handle.ts]; Containers.ChildYBound[handle.outer, handle.ts]; END; MakeCommands: PROC [handle: Handle] = BEGIN initialData: Rope.ROPE = NIL; wx: INT _ 0; NewLine: PROC = {handle.height _ handle.height + entryHeight + entryVSpace; wx _ 0}; LabeledItem: PROC [label: ROPE, width: INT, data: ROPE _ NIL] RETURNS [v: ViewerClasses.Viewer] = { ph: PromptHandle _ NEW [PromptRec _ [handle: handle]]; t: Buttons.Button _ Buttons.Create[ info: [ name: Rope.Concat[label, ":"], wy: handle.height, <> wh: entryHeight, -- specify rather than defaulting so line is uniform wx: wx, parent: handle.outer, border: FALSE ], proc: Prompt, clientData: ph]; -- this will be passed to our button proc wx _ wx + t.ww + entryHSpace; v _ ViewerTools.MakeNewTextViewer[ [ parent: handle.outer, wx: wx, wy: handle.height, ww: width*VFonts.CharWidth['0], wh: entryHeight, data: data, scrollable: FALSE, border: FALSE]]; ph.viewer _ v; wx _ wx + v.ww + entryHSpace}; Cmd: PROC [label: ROPE, proc: Buttons.ButtonProc] = { t: Buttons.Button _ Buttons.Create[ info: [ name: label, wx: wx, wy: handle.height, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: TRUE ], proc: proc, clientData: handle]; -- this will be passed to our button proc wx _ wx + t.ww + entryHSpace}; Bool: PROC [label: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = { t: Buttons.Button; flag _ NEW[BOOL _ initial]; t _ Buttons.Create[ info: [ name: label, wx: wx, wy: handle.height, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: TRUE ], proc: ToggleBool, clientData: flag]; -- this will be passed to our button proc Buttons.SetDisplayStyle[ button: t, style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite, paint: FALSE]; wx _ wx + t.ww + entryHSpace}; NewLine[]; Cmd["Count", DoIt]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50, "///FUMC/"]; NewLine[]; handle.cmd.outputFile _ LabeledItem["output", 50, "///FUMC/"]; NewLine[]; handle.cmd.callers _ LabeledItem["callers", 40, "///FUMC/CallerNames.txt"]; NewLine[]; END; Prompt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> ph: PromptHandle _ NARROW[clientData]; ViewerTools.SetSelection[ph.viewer]; -- force the selection END; ToggleBool: Buttons.ButtonProc = { switch: REF BOOL _ NARROW [clientData]; switch^ _ ~switch^; Buttons.SetDisplayStyle[ button: NARROW[parent], style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite]; }; DoIt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> handle: Handle _ NARROW[clientData]; -- get our data BEGIN ENABLE { UNWIND => {IF handle.in # NIL THEN handle.in.Close[]; handle.in _ NIL}; Problem, ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}}; fName: ROPE = ViewerTools.GetContents[handle.cmd.inputFile]; pName: ROPE = ViewerTools.GetContents[handle.cmd.outputFile]; count: INT _ 0; IF fName = NIL OR pName = NIL THEN { handle.tsOut.Put[[rope["specify input file name"]], [character['\n]]]; RETURN}; handle.in _ OpenFile[fName]; IF handle.in # NIL THEN handle.eof _ FALSE; IF pName # NIL AND Rope.Length[pName] # 0 THEN handle.out _ FS.StreamOpen[fileName: pName, accessOptions: $create]; handle.prevCaller _ 0; handle.dinnerK _ ALL[0]; handle.phoneK _ 0; handle.lastPhone _ NIL; handle.callerName _ ParseCallerNames[handle]; handle.tsOut.PutText["Processing:"]; WHILE ~handle.eof DO ProcessEntry[handle]; count _ count + 1; IF count MOD 50 = 0 THEN handle.tsOut.PutChar['.]; ENDLOOP; EXITS done => NULL; END; -- of Enable IF handle.prevCaller # 0 THEN PrintStats[handle]; IF handle.in # NIL THEN handle.in.Close[]; IF handle.out # NIL THEN handle.out.Close[]; handle.tsOut.Put[[character['\n]], [rope["done"]], [character['\n]]]; END; Problem: ERROR = CODE; MyBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = { RETURN [SELECT char FROM '\\, '|, '}, '\n => break, '\t, '
, ' => sepr, ENDCASE => other]; }; OpenFile: PROC [name: ROPE] RETURNS [st: STREAM] = { st _ FS.StreamOpen[name, $read ! FS.Error => IF error.group # bug THEN CONTINUE]}; ProcessEntry: PROC [handle: Handle] = { e: Entry; dc: DinnerCode; IF handle.eof THEN RETURN; IF handle.in = NIL THEN { MessageWindow.Append[ message: "Please open a file first", clearFirst: TRUE]; MessageWindow.Blink[ ]; ERROR ABORTED}; [] _ handle.in.SkipWhitespace[]; IF handle.in.EndOf[] THEN {handle.eof _ TRUE; GO TO done}; e _ ReadEntry[handle]; IF handle.prevCaller # 0 AND e.caller # handle.prevCaller THEN PrintStats[handle]; dc _ SELECT e.dinner FROM 'd => d, 'h => h, ENDCASE => other; handle.prevCaller _ e.caller; handle.dinnerK[dc] _ handle.dinnerK[dc] + 1; IF e.phone[0] = NIL OR ~Rope.Equal[e.phone[0], handle.lastPhone] THEN { handle.lastPhone _ e.phone[0]; handle.phoneK _ handle.phoneK + 1}; EXITS done => NULL; }; PrintStats: PROC [handle: Handle] = { st: STREAM = handle.out; first: BOOLEAN _ TRUE; t: INT _ 0; st.Put[[cardinal[handle.prevCaller]]]; st.PutChar['\t]; FOR c: DinnerCode IN DinnerCode DO n: INT _ handle.dinnerK[c]; IF first THEN first _ FALSE ELSE st.PutText[", "]; st.Put[[cardinal[n]]]; t _ t + n; ENDLOOP; st.PutChar['\t]; st.Put[[cardinal[t]]]; st.PutChar['\t]; st.Put[[cardinal[handle.phoneK]]]; st.PutChar['\t]; st.PutRope[handle.callerName[handle.prevCaller].name]; handle.dinnerK _ ALL[0]; handle.phoneK _ 0; handle.lastPhone _ NIL; st.PutChar['\n]}; ReadEntry: PROC [handle: Handle] RETURNS [e: Entry] = { <> ENABLE IO.EndOfStream => {handle.eof _ TRUE; Quit[handle, "Syntax error "]}; st: STREAM _ handle.in; ch: CHAR; caller: ROPE; i: CARDINAL; IF (ch _ st.GetChar[]) # '{ THEN Quit[handle, "Syntax error "]; caller _ GetTokenRope[st, MyBreak].token; IF caller # NIL THEN e.caller _ Convert.IntFromRope[caller ! Convert.Error => Quit[handle, "bad caller #"]]; IF (ch _ st.GetChar[]) # '| THEN Quit[handle, "Syntax error "]; BEGIN -- get campaign info IF (ch _ st.GetChar[]) = '| THEN GO TO done; e.activity _ ch; IF (ch _ st.GetChar[]) = '| THEN GO TO done; e.level _ ch; IF (ch _ st.GetChar[]) = '| THEN GO TO done; e.dinner _ ch; IF (ch _ st.GetChar[]) = '| THEN GO TO done; e.age _ ch; IF (ch _ st.GetChar[]) # '| THEN Quit[handle, "Syntax error "]; EXITS done => NULL; END; i _ 0; DO e.phone[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = 2 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit[handle, "Syntax error "]; i _ i + 1; ENDLOOP; i _ 0; DO e.name[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = 3 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit[handle, "Syntax error "]; i _ i + 1; ENDLOOP; i _ 0; DO e.addr[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = 3 THEN Quit[handle, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => GO TO badsyntax; i _ i + 1; ENDLOOP; e.town _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; e.zip _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; e.mailing _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; e.comment _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] # '} THEN Quit[handle, "Syntax error "]; EXITS badsyntax => Quit[handle, "Syntax error "]; }; ParseCallerNames: PROC [h: Handle] RETURNS [n: REF CallerNameRec] = { cnfile: ROPE _ ViewerTools.GetContents[h.cmd.callers]; ch: CHAR; r: INT _ 0; index: INT; c, p: ROPE; st: STREAM; n _ NEW[CallerNameRec _ ALL[[NIL, NIL, 0]]]; st _ OpenFile[cnfile]; IF st = NIL THEN Quit[h, "No caller names"]; WHILE ~st.EndOf[] DO ENABLE IO.Error => Quit[h, "invalid callernames"]; c _ p _ NIL; [] _ st.SkipWhitespace[]; IF st.EndOf[] THEN RETURN; index _ st.GetInt[]; IF NOT (index IN CallerNumber) THEN Quit[h, "Index invalid in callernames"]; IF st.GetChar[] # '\t THEN Quit[h, "Missing tab in callernames"]; c _ GetTokenRope[st, MyBreak].token; BEGIN IF ~st.EndOf[] THEN SELECT (ch _ st.GetChar[]) FROM '\n => GO TO done; '| => NULL; ENDCASE => Quit[h, "Syntax error in callernames"]; p _ GetTokenRope[st, MyBreak].token; IF ~st.EndOf[] THEN SELECT (ch _ st.GetChar[]) FROM '\n => GO TO done; '| => NULL; ENDCASE => Quit[h, "Syntax error in callernames"]; [] _ st.SkipWhitespace[]; IF st.EndOf[] THEN RETURN; r _ st.GetInt[]; IF st.GetChar[] # '\n THEN Quit[h, "Missing CR in callernames"]; EXITS done => NULL; END; n[index] _ [name: c, phone: p, recruiter: r]; ENDLOOP; st.Close[]}; Quit: PROC [handle: Handle, reason: ROPE _ NIL] = { loc: INT = handle.in.GetIndex[]; handle.in.Close[]; handle.in _ NIL; handle.eof _ TRUE; handle.tsOut.Put[[rope[reason]], [integer[loc]], [character['\n]]]; ERROR Problem}; <> GetToken: PROC [stream: STREAM, breakProc: IO.BreakProc, buffer: REF TEXT] RETURNS[token: REF TEXT, charsSkipped: INT] = { quit, include: BOOL _ FALSE; anySeen: BOOL _ FALSE; charsSkipped _ 0; buffer.length _ 0; DO char: CHAR _ stream.GetChar[ ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT]; SELECT breakProc[char] FROM break => {include _ FALSE; quit _ TRUE}; sepr => {include _ FALSE; quit _ anySeen }; other => {include _ TRUE; quit _ FALSE; anySeen _ TRUE}; ENDCASE => ERROR; IF include THEN buffer _ RefText.InlineAppendChar[buffer, char] ELSE IF quit THEN stream.Backup[char] ELSE charsSkipped _ charsSkipped + 1; IF quit THEN EXIT; ENDLOOP; RETURN[buffer, charsSkipped]; }; GetTokenRope: PUBLIC PROC [stream: STREAM, breakProc: IO.BreakProc] RETURNS [token: ROPE, charsSkipped: INT] = { buffer: REF TEXT = RefText.ObtainScratch[100]; { ENABLE UNWIND => RefText.ReleaseScratch[buffer]; tokenText: REF TEXT; [tokenText, charsSkipped] _ GetToken[stream, breakProc, buffer]; token _ IF tokenText.length = 0 THEN NIL ELSE Rope.FromRefText[tokenText]; }; RefText.ReleaseScratch[buffer]; RETURN [token, charsSkipped]; }; Commander.Register[key: "CallerCount", proc: MakeTool, doc: "Count caller's assignment" ]; [ ] _ MakeTool[NIL]; -- and create an instance END.