[_CDCSL_93-16_]<1>Cedar>release>SortLabels>SortLabelsImpl.mesa

SortLabelsImpl.mesa

Last Edited by: Sweet, July 2, 1985 4:31:15 pm PDT

Last Edited by: Swinehart, February 26, 1990 7:54:39 am PST

Tim Diebert: June 28, 1989 10:50:01 am PDT

Jules Bloomenthal November 14, 1992 11:03 am PST

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

pdl means "page description language"

Declarations

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𡤀,

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𡤀]; -- 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

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;

Procedures

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: [

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: [

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: 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: [

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};

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[ [

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

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];

};

StopIt: 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

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

force the selection into the user input field

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;

};

various initializations

handle.item ← NEW[EntrySeqBody[Val[handle.cmd.size, 5000]]];

handle.stopFlag ← FALSE;

do the work

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];

extract zip

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] = {

one should SkipWhitespace before calling (and check for eof)

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};

Utilities

copied from IOSearchImpl because it didn't handle empty tokens as I wanted

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;

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];

};

copied from IOSearchImpl because I wanted a bigger scratch buffer

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];

};

Sort by various keys

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];

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};

PDL Output Routines

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;

Imager.TranslateT[context, [lWidth*col, 11.0-row-h.fudge]];

DoPdlEntry[h, e1, context, lWidth*col, 11.0-row-h.fudge];

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;

find last name

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;

find title

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];

one could be a lot more clever, but this works quick enough

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]];

};

Initialization

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.