PrintLabels.mesa;
Last Edited by: Sweet, October 11, 1984 1:58:42 am PDT
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;
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.
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,
default the width so that it will be computed for us --
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,
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: 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,
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: 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
force the selection into the user input field
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
force the selection into the user input field
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;
compute number of lines
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] = {
one should SkipWhitespace before calling (and check for eof)
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};
copied from IOSearchImpl because it didn't handle empty tokens properly
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.