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. °PrintLabels.mesa; Last Edited by: Sweet, October 11, 1984 1:58:42 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. default the width so that it will be computed for us -- default the width so that it will be computed for us -- default the width so that it will be computed for us -- force the selection into the user input field force the selection into the user input field compute number of lines one should SkipWhitespace before calling (and check for eof) copied from IOSearchImpl because it didn't handle empty tokens properly Κk– "Cedar" style˜Iproc– "Cedar" stylešœ™J™6unitšΟk ˜ Lšœ˜Jšœ˜Jšœ œ˜(Jšœ œ/˜?J˜Jšœ˜Jšœ˜J˜J˜J˜Jšœ˜Jšœœ˜J˜ J˜ J˜J˜J˜ J˜Jšœœ˜-Jšœ œ˜%Jšœ œ˜,Jšœ œ0˜A—šœ œœ˜Jšœ.œ…˜Ό—Lšœœ˜Jšœ½™½šœ"˜'Jšœ˜Jšœ œ˜emphasisšœΟcœ˜>Jšœž ˜7Jšœœž4˜DJšœž˜0Jšœ œœž'˜>—Jšœž!˜4JšœP˜PJšœ'˜'Jšœ)ž˜=Jšœ˜Jšœ)ž˜@Jšœ˜J˜J˜—Jšœ œ˜Jšœ œ˜Jšœ œ˜Jšœœ˜J˜šΟn œœ˜&Jšœœ2˜>š Ÿœœœœ œ˜Zšœ2˜2J˜J˜ J˜ —˜(˜J˜'J˜%J˜,J˜—J˜#—J˜—Jšœ*˜*Jšœ8˜8Jšœ˜—šŸœœœ˜.Jšœ-ž(˜Ušœ˜JšœMœ˜V—šœ<˜Jšœ%˜%Jšœœ ˜6šœ#˜#šœ˜Jšœ˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœ˜Jšœœ˜—Jšœ ˜ Jšœž)˜:—Jšœ˜šœ$˜$Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ ˜ Jšœ œ˜Jšœœ˜—J˜Jšœ˜—šŸœœ œ˜5šœ#˜#šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ ˜ Jšœž(œ˜>—Jšœ˜—šŸœœ œ œœœœ˜DJ˜Jšœœœ ˜šœ˜šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ˜Jšœž(œ˜<—J•StartOfExpansion[]š œ,œ œœœ˜lJšœ˜—J˜Jšœ ˜ J˜Jšœ%œ˜,Jšœ ˜ Jšœ<˜