<<>> <> <> <> <> <> <> <<>> DIRECTORY Ascii, Basics, Buttons, Commander, Containers, Convert, FS, Imager, ImagerFont, ImagerInterpress, IO, Labels, MessageWindow, PFS, PieViewers, Process, Real, RefText, Rope, Rules, SafeStorage, TiogaFileOps, TypeScript, VFonts, ViewerClasses, ViewerIO, ViewerOps, ViewerTools; SortLabelsImpl: CEDAR MONITOR IMPORTS Buttons, Commander, Containers, Convert, FS, IO, Imager, ImagerFont, ImagerInterpress, Labels, MessageWindow, PFS, PieViewers, Process, Real, RefText, Rope, Rules, SafeStorage, TiogaFileOps, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools ~ BEGIN <> <> entryHeight: INT = 15; -- how tall to make each line of items entryVSpace: INT = 4; -- vertical leading space between lines entryHSpace: INT = 10; -- horizontal space between items in a line ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; dash: CHAR = Ascii.ControlV; Handle: TYPE = REF MyRec; MyRec: TYPE = MONITORED RECORD [ -- the data for a particular tool instance outer: Containers.Container _ NIL, -- handle for the enclosing container height: INT _ 0, -- height measured from the top of the container cmd: CommandViewer, -- the commands dim: DimRecord _ TRASH, entries: LIST OF REF Entry, entryTail: LIST OF REF Entry, entryCount: INT_0, consumer: PROCESS _ NIL, notEmpty: CONDITION, notTooFull: CONDITION, in: IO.STREAM, eof: BOOLEAN _ FALSE, out: IO.STREAM, item: EntrySeq, root, prevLast: TiogaFileOps.Ref, busy: BOOL _ FALSE, stopFlag: BOOL, row, col: INT, pages: INT, pie: PieViewers.PieViewer, pdlOut: ImagerInterpress.Ref, font: ImagerFont.Font, byLastName, zip, textP, pdlP, tiogaOut, proof, nProof: REF BOOL, flagZip, showNames: REF BOOL, textOutput, pdlOutput: BOOL, doByLastName, doZip, doTioga, doProof, numberProof: BOOL, -- so they won't change while we're running tsIn, tsOut: STREAM, ts: ViewerClasses.Viewer, fudge: REAL _ .32, noFudge: REAL _ .05, maxLines: NAT _ 5, numEntries: INT_0]; -- the typescript DimRecord: TYPE = RECORD [fontSize, leftMargin, lineHeight: INT]; Entry: TYPE = RECORD [zip: INT _ 0, dataLength: INT, text: ROPE]; EntrySeqBody: TYPE = RECORD [count: INT _ 0, e: SEQUENCE max: INT OF REF Entry]; EntrySeq: TYPE = REF EntrySeqBody; CommandViewer: TYPE = RECORD [ workingDir, inputFile, outputFile, pdlFile, size, fontFamily, fontSize, status, leftMargin: ViewerClasses.Viewer ]; 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: "Label Sorter", -- name displayed in the caption iconic: TRUE, column: left, 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; <> MakeTypescript: PROC [handle: Handle] = BEGIN handle.height _ handle.height + entryVSpace; -- space down from the top of the viewer handle.ts _ TypeScript.Create[ info: [name: "SortLabels.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "SortLabels.ts", viewer: handle.ts, backingFile: "SortLabels.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: FALSE ], 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}; Cmd["DoIt!", DoIt]; Cmd["STOP!", StopIt]; handle.byLastName _ Bool["sort by last name", TRUE]; handle.zip _ Bool["sort by zip", FALSE]; handle.cmd.size _ LabeledItem["expected # of items", 10, "7500"]; NewLine[]; handle.showNames _ Bool["display questionable names", FALSE]; handle.flagZip _ Bool["display missing zips", TRUE]; handle.nProof _ Bool["number proofs", FALSE]; handle.pie _ PieViewers.Create[parent: handle.outer, x: wx, y: handle.height, total: 1]; wx _ wx + 16 + entryHSpace; handle.cmd.status _ Labels.Create[ [ name: NIL, -- initial contents wx: wx, wy: handle.height, ww: VFonts.StringWidth["Writing"]+6, wh: entryHeight, parent: handle.outer, border: FALSE]]; NewLine[]; handle.cmd.workingDir _ LabeledItem["working directory", 50, PFS.RopeFromPath[PFS.GetWDir[]]]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50]; NewLine[]; handle.textP _ Bool["do text output", FALSE]; handle.tiogaOut _ Bool["tioga", FALSE]; handle.cmd.outputFile _ LabeledItem["text output", 50]; NewLine[]; handle.pdlP _ Bool["do label output", FALSE]; handle.proof _ Bool["proof", FALSE]; handle.numEntries _ 0; handle.cmd.pdlFile _ LabeledItem["label output", 50]; NewLine[]; handle.cmd.fontFamily _ LabeledItem["font family", 20, "Terminal"]; handle.cmd.fontSize _ LabeledItem["font size", 5, "8"]; handle.cmd.leftMargin _ LabeledItem["left margin", 5, "18"]; 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]; }; StopIt: 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 handle.stopFlag _ TRUE; END; EnterTool: ENTRY PROC [h: Handle] RETURNS [BOOL] = { IF h.busy THEN { MessageWindow.Append[message: "Already sorting labels", clearFirst: TRUE]; RETURN[FALSE]}; h.busy _ TRUE; RETURN[TRUE]; }; ExitTool: ENTRY PROC [h: Handle] = {h.busy _ FALSE}; 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 total: REAL; IF ~EnterTool[handle] THEN RETURN; BEGIN ENABLE { UNWIND => {IF handle.in # NIL THEN handle.in.Close[]; handle.in _ NIL; ExitTool[handle]}; Problem, ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}; }; iName: ROPE _ ViewerTools.GetContents[handle.cmd.inputFile]; oName: ROPE _ ViewerTools.GetContents[handle.cmd.outputFile]; pName: ROPE _ ViewerTools.GetContents[handle.cmd.pdlFile]; wDir: ROPE = ViewerTools.GetContents[handle.cmd.workingDir]; 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; }; <> handle.item _ NEW[EntrySeqBody[Val[handle.cmd.size, 5000]]]; handle.stopFlag _ FALSE; <> IF iName = NIL THEN { handle.tsOut.Put[[rope["specify input file"]], [character['\n]]]; ExitTool[handle]; RETURN; }; handle.textOutput _ handle.textP^; handle.pdlOutput _ handle.pdlP^; iName _ FS.ExpandName[iName, wDir ! FS.Error => Quit[handle, "bad input file"]].fullFName; IF handle.textOutput THEN IF oName # NIL AND Rope.Length[oName] # 0 THEN oName _ FS.ExpandName[oName, wDir ! FS.Error => Quit[handle, "bad text output file"]].fullFName ELSE Quit[handle, "specify text output file"]; IF handle.pdlOutput THEN IF pName # NIL AND Rope.Length[pName] # 0 THEN pName _ FS.ExpandName[pName, wDir ! FS.Error => Quit[handle, "bad label output file"]].fullFName ELSE Quit[handle, "specify label output"]; IF ~handle.textOutput AND ~handle.pdlOutput THEN { handle.tsOut.Put[[rope["specify either text or label output file (or both)"]], [character['\n]]]; ExitTool[handle]; RETURN; }; handle.in _ OpenFile[iName]; IF handle.in # NIL THEN handle.eof _ FALSE ELSE Quit[handle, "no input file"]; total _ handle.in.GetLength[]; handle.in.SetIndex[0]; handle.doTioga _ handle.tiogaOut^; handle.doZip _ handle.zip^; handle.doByLastName _ handle.byLastName^; handle.doProof _ handle.proof^; handle.maxLines _ 7; handle.numberProof _ handle.nProof^; handle.numEntries _ 0; handle.pages _ 0; handle.row _ 0; handle.col _ 0; handle.entryCount _ 0; handle.entries _ handle.entryTail _ NIL; handle.consumer _ NIL; IF handle.pdlOutput THEN { ipHeader: ROPE ~ "Interpress/Xerox/2.0 "; family: ROPE _ ViewerTools.GetContents[handle.cmd.fontFamily]; fontPattern: ROPE _ "Xerox/XC1-1-1/%g"; IF family.Find["/"] < 0 THEN family _ IO.PutFR1[fontPattern, IO.rope[family]]; handle.pdlOut _ ImagerInterpress.Create[fileName: pName, header: ipHeader]; handle.dim.fontSize _ Val[handle.cmd.fontSize, 8]; handle.dim.leftMargin _ Val[handle.cmd.leftMargin, 18]; handle.dim.lineHeight _ handle.dim.fontSize; handle.font _ ImagerFont.FindScaled[family, handle.dim.fontSize/Imager.pointsPerInch]; }; Labels.Set[handle.cmd.status, "reading"]; WHILE ~handle.eof DO IF handle.stopFlag THEN {handle.tsOut.PutText["input aborted, no output"]; GO TO done}; EnterItem[handle ! IO.EndOfStream => EXIT]; PieViewers.Set[handle.pie, 1 - handle.in.GetIndex[] / total]; ENDLOOP; PieViewers.Set[handle.pie, 0]; IF handle.doByLastName OR handle.doZip THEN { Labels.Set[handle.cmd.status, "sorting"]; SortEntries[handle]}; total _ handle.item.count; Labels.Set[handle.cmd.status, "writing"]; IF handle.textOutput THEN { IF handle.doTioga THEN { handle.root _ TiogaFileOps.CreateRoot[]; handle.prevLast _ NIL} ELSE handle.out _ FS.StreamOpen[fileName: oName, accessOptions: $create]; }; FOR i: INT IN [0..handle.item.count) DO IF handle.stopFlag THEN {handle.tsOut.PutText["output truncated"]; EXIT}; WriteEntry[handle, handle.item[i]]; PieViewers.Set[handle.pie, 1 - i/total]; handle.item[i] _ NIL; ENDLOOP; PieViewers.Set[handle.pie, 0]; IF handle.pdlOutput THEN WriteEntry[handle, NIL]; IF handle.textOutput AND handle.doTioga THEN { Labels.Set[handle.cmd.status, "storing"]; TiogaFileOps.Store[handle.root, oName]}; Labels.Set[handle.cmd.status, NIL]; EXITS done => NULL; END; -- of Enable IF handle.in # NIL THEN {handle.in.Close[]; handle.in _ NIL}; IF handle.out # NIL THEN {handle.out.Close[]; handle.out _ NIL}; handle.tsOut.PutF1["\n %g entries\n", [integer[handle.item.count]]]; IF handle.pdlOutput THEN handle.tsOut.PutF1["%g label pages\n", [integer[handle.pages]]]; handle.item _ NIL; ExitTool[handle]; END; Problem: ERROR = CODE; OpenFile: PROC [name: ROPE] RETURNS [st: STREAM] = { st _ FS.StreamOpen[name, $read ! FS.Error => IF error.group # bug THEN CONTINUE]}; EnterItem: PROC [handle: Handle] = { flagged: BOOLEAN _ FALSE; Flag: PROC [msg: ROPE _ NIL] = { IF flagged THEN RETURN; flagged _ TRUE; IF msg # NIL THEN handle.tsOut.PutRope[msg]; handle.tsOut.Put[[character['\n]], [rope[e.text]]]}; e: REF Entry; ch: CHAR; zip: INT _ 0; i, len: INT; st: STREAM = handle.in; IF handle.eof THEN RETURN; IF st = NIL THEN { MessageWindow.Append[ message: "Please open a file first", clearFirst: TRUE]; MessageWindow.Blink[ ]; ERROR ABORTED}; [] _ st.SkipWhitespace[]; e _ ReadEntry[handle, st]; <> len _ Rope.Length[e.text]; FOR i IN [0..len) DO IF Rope.Fetch[e.text, i] = '[ THEN { len _ i; EXIT}; ENDLOOP; i _ len - 1; WHILE i >= 0 AND Rope.Fetch[e.text, i] <= Ascii.SP DO i _ i - 1 ENDLOOP; e.dataLength _ i+1; WHILE i >= 0 AND Rope.Fetch[e.text, i] IN ['0..'9] DO i _ i - 1 ENDLOOP; IF Rope.Fetch[e.text, i] = '- THEN { -- 9 digit zip, throw away final 4 i _ i-1; WHILE i >= 0 AND Rope.Fetch[e.text, i] IN ['0..'9] DO i _ i - 1 ENDLOOP}; i _ i+1; WHILE i < len AND (ch _ Rope.Fetch[e.text, i]) IN ['0..'9] DO zip _ zip*10 + ch.ORD - '0.ORD; i _ i + 1; ENDLOOP; IF handle.flagZip^ AND (zip = 0 OR zip > 99999) THEN Flag["**** zip ****"]; e.zip _ zip; IF handle.item.count = handle.item.max THEN GrowItemRec[handle]; handle.item[handle.item.count] _ e; handle.item.count _ handle.item.count + 1; }; GrowItemRec: PROC [h: Handle] = { n: INT; new: EntrySeq; IF h.item = NIL THEN n _ 1000 ELSE n _ MAX[(5*h.item.max)/4, h.item.max + 100]; new _ NEW[EntrySeqBody[n]]; IF h.item # NIL THEN { FOR i: INT IN [0..h.item.count) DO new[i] _ h.item[i]; ENDLOOP; new.count _ h.item.count}; h.item _ new}; ReadEntry: PROC [handle: Handle, st: STREAM] RETURNS [e: REF Entry] = { <> prevCr: BOOL _ FALSE; DoubleCrBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = { SELECT char FROM '\n => IF prevCr THEN {prevCr _ FALSE; RETURN[break]} ELSE prevCr _ TRUE; ENDCASE => prevCr _ FALSE; RETURN[other] }; e _ NEW [Entry]; e.text _ GetTokenRope[handle.in, DoubleCrBreak].token; }; WriteEntry: PROC [handle: Handle, e: REF Entry] = { flagged: BOOLEAN _ FALSE; IF e=NIL THEN { IF handle.pdlOutput THEN WritePdlEntry[handle, NIL]; RETURN; }; -- finish up. IF handle.textOutput THEN { IF handle.doTioga THEN { handle.prevLast _ TiogaFileOps.InsertAsLastChild[handle.root, handle.prevLast]; TiogaFileOps.SetContents[handle.prevLast, e.text]} ELSE { handle.out.PutRope[e.text]; handle.out.PutChar['\n]}; }; IF handle.pdlOutput THEN { IF ~handle.doProof AND Rope.Length[e.text] # e.dataLength THEN e.text _ Rope.Substr[e.text, 0, e.dataLength]; WritePdlEntry[handle, e]; }; }; Quit: PROC [handle: Handle, reason: ROPE _ NIL] = { loc: INT; IF handle.in = NIL THEN loc _ 0 ELSE { loc _ 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[300]; { 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]; }; <> <<>> CompareProc: PROC [h: Handle, r1, r2: REF Entry] RETURNS [Basics.Comparison] = { t1, t2: ROPE; IF r1 = NIL THEN -- make NIL be greater than anything IF r2 = NIL THEN RETURN [equal] ELSE RETURN[greater] ELSE IF r2 = NIL THEN RETURN[less]; IF h.doZip THEN SELECT r1.zip FROM > r2.zip => RETURN[greater]; < r2.zip => RETURN[less]; ENDCASE; t1 _ r1.text; IF t1.Length[]>0 AND t1.Fetch[0] = '$ THEN t1 _ t1.Substr[start: 1]; t2 _ r2.text; IF t2.Length[]>0 AND t2.Fetch[0] = '$ THEN t2 _ t2.Substr[start: 1]; SELECT Rope.Compare[t1, t2, FALSE] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; RETURN[equal]}; SortEntries: PROC [h: Handle] = { Greater: PROC [r1, r2: REF Entry] RETURNS [BOOL] = { RETURN[CompareProc[h, r1, r2] = greater]}; IF ~h.doZip AND ~h.doByLastName THEN RETURN; Sort[h.item, h.item.count, Greater]; }; Sort: PROC [ a: EntrySeq, n: INT, greater: PROC [r1, r2: REF Entry] RETURNS [BOOL]] = { i: INT; temp: REF Entry; SiftUp: PROC [l, u: INT] = { s: INT; key: REF Entry _ a[l-1]; DO s _ l*2; IF s > u THEN EXIT; IF s < u AND greater[a[s+1-1], a[s-1]] THEN s _ s+1; IF greater[key, a[s-1]] THEN EXIT; a[l-1] _ a[s-1]; l _ s; ENDLOOP; a[l-1] _ key}; FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP; FOR i DECREASING IN [2..n] DO SiftUp[1, i]; temp _ a[1-1]; a[1-1] _ a[i-1]; a[i-1] _ temp; ENDLOOP}; <> WritePdlEntry: ENTRY PROC [h: Handle, e: REF Entry] = { ENABLE UNWIND => NULL; lE: LIST OF REF Entry _ LIST[e]; IF h.entryCount > 10 THEN WHILE h.entryCount > 3 DO WAIT h.notTooFull; ENDLOOP; IF h.entries = NIL AND h.entryCount#0 THEN ERROR; h.entryCount _ h.entryCount + 1; IF h.entries=NIL THEN h.entries _ h.entryTail _ lE ELSE { h.entryTail.rest _ lE; h.entryTail _ lE; }; IF h.consumer=NIL THEN TRUSTED { IF e#NIL THEN Process.Detach[h.consumer _ FORK PdlConsume[h, TRUE]]; }; NOTIFY h.notEmpty; }; PdlConsume: PROC[h: Handle, active: BOOL] = { GetNextEntry: ENTRY PROC[h: Handle, peek: BOOL_FALSE] RETURNS [e: REF Entry] = { IF ~active THEN RETURN[NIL]; WHILE h.entries=NIL DO WAIT h.notEmpty; ENDLOOP; e _ h.entries.first; IF ~peek THEN { h.entries _ h.entries.rest; h.entryCount _ h.entryCount-1; }; IF e=NIL THEN active_FALSE; h.numEntries _ h.numEntries + 1; IF h.entryCount <= 3 THEN NOTIFY h.notTooFull; }; PdlConsumeEntries: PROC[context: Imager.Context] = { Imager.SetFont[context, h.font]; FOR row: INT IN [0..11) WHILE active DO FOR col: INT IN [0..3) WHILE active DO e1: REF Entry; IF (e1_GetNextEntry[h]) = NIL THEN RETURN; <> DoPdlEntry[h, e1, context, lWidth*col, 11.0-row-h.fudge]; ENDLOOP; ENDLOOP; []_GetNextEntry[h, TRUE]; -- Set inactive if last entry filled the page }; FOR page: INT _ 1, page+1 WHILE active DO h.pages _ page; ImagerInterpress.DoPage[self: h.pdlOut, action: PdlConsumeEntries, scale: mpi]; IF ~active THEN EXIT; -- Strange control structure keeps page count right ENDLOOP; h.consumer _ NIL; ImagerInterpress.Close[h.pdlOut]; h.pdlOut _ NIL; }; fudge: REAL _ 0.32; pageHeight: REAL _ 11.0; pageWidth: REAL _ 8.5; lWidth: REAL _ pageWidth/3; maxLineWidth: REAL _ lWidth - 0.35; labelHeight: REAL _ 1.0; mpi: REAL _ Imager.metersPerInch; scale: REAL _ Imager.metersPerInch; clipX: REAL _ 0.0; clipY: REAL _ 0.0; clipW: REAL _ lWidth-0.3; clipH: REAL _ -labelHeight+.05; DoPdlEntry: PROC [h: Handle, e: REF Entry, context: Imager.Context, x, y: REAL] = { charWidth: REAL ~ ImagerFont.RopeEscapement[h.font, " "].x; -- assume fixed pitch doubleWide: BOOL _ FALSE; eLines: INT _ 1; text: ROPE _ e.text; textWidth: REAL; this: ROPE; len, index, nLines: INT _ 0; first: BOOL _ TRUE; tooWide: BOOL _ FALSE; k: INT _ 0; lw: INT _ 0; extend, strangeName: BOOL_FALSE; WHILE (len _ text.Length[])>0 DO IF h.doProof THEN { ch: CHAR; index _ Rope.SkipTo[text, 0, IF first THEN "(=\n" ELSE "\n"]; ch _ IF index < len THEN Rope.Fetch[text, index] ELSE 'X; this _ Rope.Substr[base: text, start: 0, len: index]; IF extend THEN {this _ IO.PutFR1["..%g", IO.rope[this]]; extend _ FALSE}; IF first THEN IF h.numberProof THEN this _ IO.PutFR["%g (%g)", IO.rope[this], IO.int[h.numEntries]] ELSE this _ IO.PutFR1["%g", IO.rope[this]]; SELECT ch FROM '(, '= => extend _ TRUE; '\n => index _ index+1; ENDCASE; } ELSE { ch: CHAR; index _ Rope.SkipTo[text, 0, IF first THEN "(\n" ELSE "\n"]; ch _ IF index < len THEN Rope.Fetch[text, index] ELSE 'X; this _ Rope.Substr[base: text, len: index]; IF first THEN [this, strangeName] _ MailingName[this]; SELECT ch FROM '( => { index _ Rope.SkipTo[text, index+1, "\n"]; index_index+1; }; '\n => index _ index + 1; ENDCASE; }; nLines _ nLines + 1; textWidth _ ImagerFont.RopeEscapement[h.font, this].x; tooWide _ tooWide OR (textWidth > maxLineWidth); IF nLines<=h.maxLines THEN { IF textWidth > maxLineWidth THEN { -- trim the rope down so that it fits charsInLine: INT ~ Real.Floor[maxLineWidth/charWidth]; this _ Rope.Substr[base: this, start: 0, len: charsInLine]; }; Imager.SetXY[context, [x+0.2+(h.dim.leftMargin/Imager.pointsPerInch), y-(h.dim.lineHeight*nLines)/Imager.pointsPerInch]]; Imager.ShowRope[context, this]; }; text _ Rope.Substr[base: text, start: index]; first _ FALSE; ENDLOOP; IF nLines>h.maxLines THEN h.tsOut.PutF1["\n**** too many lines:\n%g", IO.rope[e.text]]; IF tooWide THEN h.tsOut.PutF1["\n**** too wide:\n%g", IO.rope[e.text]]; IF strangeName AND h.showNames^ THEN h.tsOut.PutF1["\n**** no comma:\n%g", IO.rope[e.text]]; }; MailingName: PROC [n: ROPE, flipName: BOOL _ TRUE] RETURNS [r: ROPE, strangeName: BOOL_FALSE] = { len: INT _ Rope.Length[n]; ln2, t1, t2, f1, f2: INT _ 0; slashSeen: BOOL _ FALSE; last, title, first: ROPE; <> ln2 _ 0; IF flipName THEN { WHILE ln2 < len DO SELECT Rope.Fetch[n, ln2] FROM ', => EXIT; '= => { [r, strangeName] _ MailingName[Rope.Substr[n, ln2+1, len - ln2 - 1], FALSE]; RETURN; }; ENDCASE; ln2 _ ln2 + 1; REPEAT FINISHED => RETURN[n, TRUE]; ENDLOOP; last _ Rope.Substr[n, 0, ln2]} ELSE last _ NIL; <> t1 _ ln2+1; WHILE t1 < len AND Rope.Fetch[n, t1] = ' DO t1 _ t1 + 1 ENDLOOP; t2 _ t1; WHILE t2 < len DO SELECT Rope.Fetch[n, t2] FROM '= => { [r, strangeName] _ MailingName[Rope.Substr[n, ln2+1, len - ln2 - 1], FALSE]; RETURN[r, strangeName]; }; ' => EXIT; '/ => slashSeen _ TRUE; ENDCASE; t2 _ t2 + 1; ENDLOOP; title _ IF t1 = t2 THEN NIL ELSE Rope.Substr[n, t1, t2-t1]; <> IF slashSeen THEN SELECT TRUE FROM Rope.Equal[title, "M/M", FALSE] => title _ "Mr & Mrs"; Rope.Equal[title, "Dr/M", FALSE] => title _ "Dr & Mrs"; Rope.Equal[title, "Dr/Dr", FALSE] => title _ "Dr & Dr"; Rope.Equal[title, "R/Adm/M", FALSE] => title _ "R/Adm & Mrs"; Rope.Equal[title, "R/Adm", FALSE] => NULL; Rope.Equal[title, "LtC/M", FALSE] => title _ "Lt/Col & Mrs"; Rope.Equal[title, "Judge/M", FALSE] => title _ "Judge & Mrs"; Rope.Equal[title, "Col/M", FALSE] => title _ "Col & Mrs"; Rope.Equal[title, "Rev/M", FALSE] => title _ "Rev & Mrs"; Rope.Equal[title, "Prof/M", FALSE] => title _ "Prof & Mrs"; Rope.Equal[title, "Capt/M", FALSE] => title _ "Capt & Mrs"; Rope.Equal[title, "Admiral/M", FALSE] => title _ "Admiral & Mrs"; Rope.Equal[title, "Gen/M", FALSE] => title _ "Gen & Mrs"; ENDCASE => strangeName _ TRUE; f1 _ t2+1; WHILE f1 < len AND Rope.Fetch[n, f1] = ' DO f1 _ f1 + 1 ENDLOOP; f2 _ f1; WHILE f2 < len DO SELECT Rope.Fetch[n, f2] FROM '= => RETURN [Rope.Substr[n, f2+1, len - f2 - 1]]; '( => { -- make sure no = follows FOR i: INT IN (f2..len) DO IF Rope.Fetch[n, i] = '= THEN { [r, strangeName] _ MailingName[Rope.Substr[n, i+1, len - i - 1], FALSE]; RETURN[r, strangeName]; }; ENDLOOP; EXIT}; ENDCASE; f2 _ f2 + 1; ENDLOOP; WHILE f2 > f1 AND Rope.Fetch[n, f2-1] = ' DO f2 _ f2 - 1 ENDLOOP; first _ IF f1 = f2 THEN NIL ELSE Rope.Substr[n, f1, f2-f1]; RETURN [Rope.Cat[title, " ", first, " ", last]]; }; <> usage: ROPE ¬ "Sort labels, producing new source file or press file with 33 up labels (or both) Source file has entries (separated by blank lines) of the form Last, Title First Other Address TownAndState Zipcode At least 6 lines will fit in Gacha 8. For proof printing, the first line is printed as-is. For non-proof, the Last name is put last and if the title has one of several special forms (see below), it is expanded. Entries that don't fit within a label are displayed in the log window and printed across two label spaces. One can optionally display entries that have no comma in the first line (for corporate labels, this can be legitimate, but it's helpful for finding typos). Entries with difficult to encode names can have the non-proof label first line given explicitly after an =. e.g., Smith, The Family=The Smith Family Optional info can appear in parentheses, but is surpressed for non-proof labels Smith, Mrs. Joseph (Susie) Finally, the entry can be followed by extra non-label information if it begins on a line with a left bracket '[ (but before the blank line separating entries). The text output has the option of a plain text file, or a Tioga node per entry. Either is acceptable input to the program. The expandable titles (ad hoc to handle the Children's Health Council) are M/M => Mr & Mrs Dr/M => Dr & Mrs Dr/Dr => Dr & Dr R/Adm/M => R/Adm & Mrs R/Adm => R/Adm LtC/M => Lt/Col & Mrs Judge/M => Judge & Mrs Col/M => Col & Mrs Rev/M => Rev & Mrs Prof/M => Prof & Mrs Capt/M => Capt & Mrs Admiral/M => Admiral & Mrs Gen/M => Gen & Mrs Non-obvious switches and their meaning: number proofs: if TRUE (inverted), then put sequence numbers on proof entries "; Commander.Register["SortLabels", MakeTool, usage]; END.