<> <> DIRECTORY Ascii, Buttons, Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Container, Create], Convert, FS, IO, MessageWindow, PrintLabelsDefs, RefText, Rope, Rules USING [Create, Rule], SafeStorage, SirPress, TSFont, TSTypes, TypeScript, VFonts, ViewerClasses USING [Viewer, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [CreateViewer, PaintViewer], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; PrintLabels: CEDAR PROGRAM IMPORTS Buttons, Commander, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, SafeStorage, SirPress, TSFont, TSTypes, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN OPEN PrintLabelsDefs; <> MakeTool: Commander.CommandProc = BEGIN rule: Rules.Rule; my: Handle _ NEW[MyRec]; my.outer _ Containers.Create[[-- construct the outer container name: "Label Printer", -- 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; faceNormal: CARDINAL = 0; faceItalic: CARDINAL = 1; faceBold: CARDINAL = 2; faceBoldItalic: CARDINAL = 3; LookupFonts: PROC [handle: Handle] = { family: ROPE _ ViewerTools.GetContents[handle.cmd.fontFamily]; DoFont: PROC [class: FontClass, family: ROPE, size: INT, face: CARDINAL _ faceNormal] = { handle.fontCode[class] _ handle.press.GetFontCode[ family: family, size: size, face: face]; handle.fontInfo[class] _ TSFont.Lookup[ (SELECT face FROM faceItalic => Rope.Concat[family, "I"], faceBold => Rope.Concat[family, "B"], faceBoldItalic => Rope.Concat[family, "BI"], ENDCASE => family), TSTypes.IntDimn[size, TSTypes.bp]]; }; DoFont[body, family, handle.dim.fontSize]; DoFont[bodyBold, family, handle.dim.fontSize, faceBold]; }; MakeTypescript: PROC [handle: Handle] = BEGIN handle.height _ handle.height + entryVSpace; -- space down from the top of the viewer handle.ts _ TypeScript.Create[ info: [name: "PrintDir.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "PrintDir.ts", viewer: handle.ts, backingFile: "PrintDir.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["Print", DoIt]; handle.boldNames _ Bool["bold name", FALSE]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50, "///FUMC/"]; NewLine[]; handle.cmd.pressFile _ LabeledItem["press", 50, "///FUMC/"]; NewLine[]; handle.cmd.fontFamily _ LabeledItem["font family", 20, "Helvetica"]; handle.cmd.fontSize _ LabeledItem["fontSize", 5, "10"]; handle.cmd.lineHeight _ LabeledItem["lineHeight", 5, "12"]; handle.cmd.scale _ LabeledItem["scale", 5, "100"]; handle.cmd.dx _ LabeledItem["dx", 5, "27"]; handle.cmd.dy _ LabeledItem["dy", 5, "0"]; 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.pressFile]; Val: PROC [v: ViewerClasses.Viewer, default: INT] RETURNS [n: INT] = { n _ Convert.IntFromRope[ViewerTools.GetContents[v] ! SafeStorage.NarrowFault => {n _ default; GO TO gub}; Convert.Error => { MessageWindow.Append[message: "invalid number", clearFirst: TRUE]; n _ default; GO TO gub}; ]; EXITS gub => NULL; }; 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.press _ SirPress.Create[outputStream: handle.out, fileNameForHeaderPage: pName]; handle.dim.fontSize _ Val[handle.cmd.fontSize, 10]; handle.dim.lineHeight _ Val[handle.cmd.lineHeight, 12]; handle.dim.scale _ Val[handle.cmd.scale, 100]; handle.dim.dx _ Val[handle.cmd.dx, 27]; handle.dim.dy _ Val[handle.cmd.dy, 0]; handle.press.SetPageSize[110, 85]; LookupFonts[handle]; handle.row _ 0; handle.col _ 0; } ELSE handle.press _ NIL; handle.tsOut.PutText["Processing:"]; WHILE ~handle.eof DO ProcessEntry[handle]; ENDLOOP; IF handle.press # NIL THEN { handle.press.WritePage[]; handle.press.ClosePress[]; handle.press _ NIL}; EXITS done => NULL; END; -- of Enable 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; Points: TYPE = INT; PBox: TYPE = RECORD [x,y,w,h: Points]; LineY: PROC [h: Handle, box: PBox, line, of: CARDINAL] RETURNS [Points] = BEGIN bottom: Points; line _ of-1-line; -- count from top bottom _ (box.h- of*h.dim.lineHeight)/2; RETURN [box.y + bottom + line*(h.dim.lineHeight)]; END; LJLine: PROC [h: Handle, s: ROPE, box: PBox, line, of: CARDINAL] = BEGIN PT: PROC [t: ROPE, x, y: INT] = { SirPress.PutText[p: h.press, textString: t, xCoordinateOfLeftEdge: x, yCoordinateOfBaseline: y, unit: SirPress.pt]}; y: Points = LineY[h: h, box: box, line: line, of: of]; PT[t: s, x: box.x, y: y]; END; pageWidth: Points = 612; pageHeight: Points = 792; LWidth: Points = pageWidth/3; LHeight: Points = 72; PressEntry: PROC [h: Handle, e: Entry] = { box: PBox; eLines: CARDINAL _ 1; line: CARDINAL _ 0; flagged: BOOLEAN; SF: PROC [class: FontClass] = {h.press.SetFontFromCode[h.fontCode[class]]}; PTH: PROC [t: ROPE] = { SirPress.PutTextHere[p: h.press, textString: t]}; PL: PROC [t: ROPE] = { line _ line + 1; LJLine[h: h, s: t, box: box, line: line, of: eLines]}; Scale: PROC [d: Points] RETURNS [Points] = {RETURN [(d*h.dim.scale)/ 100]}; Flag: PROC = { IF flagged THEN RETURN; flagged _ TRUE; h.tsOut.Put[[character['\n]], [rope[e.name[0]]]]}; IF e.mailing = NIL THEN RETURN; IF h.row = 11 THEN {h.row _ 0; h.col _ h.col + 1}; IF h.col = 3 THEN {h.press.WritePage[]; h.col _ 0}; box.x _ h.dim.dx + h.col * LWidth; box.y _ h.dim.dy + 10*72 - Scale[h.row*LHeight]; box.w _ LWidth - h.dim.dx; box.h _ IF h.row = 0 THEN 72 - 18 ELSE 72; <> FOR i: CARDINAL IN [0..4) DO IF e.addr[i] = NIL THEN EXIT; eLines _ eLines + 1; ENDLOOP; IF e.town # NIL THEN eLines _ eLines + 1; SF[IF h.boldNames^ THEN bodyBold ELSE body]; LJLine[h: h, s: e.mailing, box: box, line: 0, of: eLines]; SF[body]; FOR i: CARDINAL IN [0..4) DO IF e.addr[i] = NIL THEN EXIT; PL[e.addr[i]]; ENDLOOP; IF e.town = NIL THEN PTH[" "] ELSE SELECT TRUE FROM Rope.Equal[e.town, "PA"] => PL["Palo Alto, CA "]; Rope.Equal[e.town, "MP"] => PL["Menlo Park, CA "]; Rope.Equal[e.town, "S"] => PL["Stanford, CA "]; Rope.Equal[e.town, "LA"] => PL["Los Altos, CA "]; Rope.Equal[e.town, "LAH"] => PL["Los Altos Hills, CA "]; Rope.Equal[e.town, "C"] => PL["Cupertino, CA "]; Rope.Equal[e.town, "Svl"] => PL["Sunnyvale, CA "]; Rope.Equal[e.town, "A"] => PL["Atherton, CA "]; Rope.Equal[e.town, "EPA"] => PL["Palo Alto, CA "]; Rope.Equal[e.town, "RC"] => PL["Redwood City, CA "]; Rope.Equal[e.town, "MV"] => PL["Mountain View, CA "]; Rope.Equal[e.town, "SC"] => PL["Santa Clara, CA "]; Rope.Equal[e.town, "SJ"] => PL["San Jose, CA "]; Rope.Equal[e.town, "W"] => PL["Woodside, CA "]; Rope.Equal[e.town, "PV"] => PL["Portola Valley, CA "]; Rope.Equal[e.town, "LG"] => PL["Los Gatos, CA "]; Rope.Equal[e.town, "SF"] => PL["San Francisco, CA "]; Rope.Equal[e.town, "SM"] => PL["San Mateo, CA "]; ENDCASE => {Flag[]; PL["???? "]}; IF e.zip # NIL THEN PTH[e.zip]; h.row _ h.row + 1; }; Entry: TYPE = RECORD [ caller: [0..100) _ 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]; 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; 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.press # NIL THEN PressEntry[handle, e]; EXITS done => NULL; }; 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 "]; }; 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}; Quit2: PROC [handle: Handle, st: STREAM, reason: ROPE _ NIL] = { loc: INT = st.GetIndex[]; st.Close[]; 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: "PrintLabels", proc: MakeTool, doc: "Make 33 up labels" ]; [ ] _ MakeTool[NIL]; -- and create an instance END.