-- SortLabels.mesa
-- Edited by Sweet, 29-Sep-81 22:38:39
DIRECTORY
Ascii,
Exec,
Format,
GSort,
Inline,
MDSStorage,
OutputDefs,
PressDefs,
PrintUtilities,
Segments,
Streams,
String;
SortLabels: PROGRAM
IMPORTS
Exec, GSort, Inline, MDSStorage, OutputDefs, PressDefs,
PrintUtilities, Segments, Streams, String =
BEGIN OPEN PressDefs, String, Streams;
in: Streams.Handle;
Label: TYPE = LONG BASE POINTER TO LabelBody;
RelLabel: TYPE = Label RELATIVE POINTER TO StringBody;
LabelBody: TYPE = RECORD [
count, last: [0..256),
lines: ARRAY [0..8) OF RelLabel];
nextRP: RelLabel;
AddLine: PROC =
BEGIN
s: LONG STRING = @buffer[nextRP];
s↑ ← [length: 0, maxlength: line.length, text: NULL];
String.AppendString[s, line];
buffer.lines[buffer.count] ← nextRP;
nextRP ← nextRP + String.WordsForString[line.length];
WHILE s.length # 0 AND s[s.length-1] = Ascii.SP DO
s.length ← s.length - 1;
ENDLOOP;
IF ~slashSeen AND line[0] = '/ THEN {
slashSeen ← TRUE; buffer.last ← buffer.count};
buffer.count ← buffer.count + 1;
END;
StartLabel: PROC =
BEGIN
buffer.count ← 0; buffer.last ← 0;
slashSeen ← FALSE;
nextRP ← LOOPHOLE[SIZE[LabelBody]];
END;
slashSeen: BOOLEAN;
pfdBody: PressFileDescriptor;
pfd: POINTER TO PressFileDescriptor = @pfdBody;
Mica: TYPE = CARDINAL;
MBox: TYPE = RECORD [x,y,w,h: Mica];
CharHeight: Mica;
CharWidth: POINTER TO ARRAY CHARACTER OF Mica;
TextCharWidth: ARRAY CHARACTER OF Mica;
TextCharHeight: Mica;
PointsToMicas: PROC [points: CARDINAL] RETURNS [Mica] =
{RETURN [Inline.LongDiv[Inline.LongMult[points, MicasPerInch],72]]};
StringWidth: PROC [s: LONG STRING] RETURNS [l: Mica] =
BEGIN
l ← 0;
FOR i: CARDINAL IN [0..s.length) DO
l ← l + CharWidth[s[i]];
ENDLOOP;
END;
LineY: PROC [box: POINTER TO MBox, line, of: CARDINAL, lead: Mica ← 0]
RETURNS [Mica] =
BEGIN
h: Mica = CharHeight;
bottom: Mica;
line ← of-1-line; -- count from top
bottom ← (box.h- of*h - (of-1)*lead)/2;
RETURN [box.y + bottom + (line-1)*(h+lead)];
END;
LJLine: PROC [s: LONG STRING, box: POINTER TO MBox, line, of: CARDINAL, lead: Mica ← 1] =
BEGIN
ss: STRING = MDSStorage.String[s.length];
y: Mica = LineY[box: box, line: line, of: of, lead: lead];
String.AppendString[ss, s];
PutText[pfd, ss, box.x, y];
MDSStorage.FreeString[ss];
END;
P1: Mica = PointsToMicas[1];
P2: Mica = PointsToMicas[2];
M1: Mica = MicasPerInch;
M12: Mica = MicasPerInch/2;
M14: Mica = MicasPerInch/4;
M34: Mica = (3*MicasPerInch)/4;
M38: Mica = (3*MicasPerInch)/8;
TextFont: PROC =
BEGIN
SetFont[p: pfd, Name: "Helvetica", PointSize: outPointSize, Face: 0];
CharHeight ← TextCharHeight;
CharWidth ← @TextCharWidth;
END;
outPointSize: CARDINAL ← 10;
DigestFonts: PROC =
BEGIN
[] ← PrintUtilities.FindFontWidths[
family: "Helvetica"L,
points: outPointSize,
weight: medium,
slope: regular,
widths: LOOPHOLE[@TextCharWidth]];
TextCharHeight ← PointsToMicas[outPointSize];
END;
ReadLabel: PROC =
BEGIN
StartLabel[];
DO
ReadLine[];
IF line.length = 0 AND (buffer.count # 0 OR Streams.Ended[in]) THEN EXIT;
IF line.length # 0 THEN AddLine[];
ENDLOOP;
END;
ReadLine: PROC =
BEGIN
c: CHARACTER;
n: CARDINAL ← 0;
line.length ← 0;
BEGIN
DO
c ← Streams.GetByte[in ! Streams.End[] => EXIT];
IF c = Ascii.CR THEN EXIT;
IF n = line.maxlength-1 THEN GO TO tooLong;
line[n] ← c;
n ← n + 1;
ENDLOOP;
line.length ← n;
EXITS
tooLong => {
WriteLine["Line truncated:"L];
WriteLine[line];
line.length ← n};
END;
END;
sline: STRING ← [200];
line: LONG STRING ← sline;
onPage: CARDINAL ← 0;
linesPerPage: CARDINAL ← 72;
Put: PROCEDURE [p: Label, len: CARDINAL] =
BEGIN
IF paginateList THEN {
IF onPage + p.count > linesPerPage THEN {
OutputDefs.PutChar[Ascii.FF]; onPage ← 0};
onPage ← onPage + p.count + 1};
FOR i: CARDINAL IN [0..p.count) DO
OutputDefs.PutString[@p[p.lines[i]]];
OutputDefs.PutCR[];
ENDLOOP;
OutputDefs.PutCR[];
IF makePress THEN PressLabel[p];
END;
row, col: CARDINAL;
LWidth: Mica = (8*M1 + M12)/3;
LHeight: Mica = M1;
yDelta: Mica ← 0;
scaleFactor: CARDINAL ← 100;
Scale: PROC [d: Mica] RETURNS [Mica] = { -- d must be > 0
RETURN [Inline.LongDiv[Inline.LongMult[d, scaleFactor], 100]]};
PressLabel: PROC [p: Label] =
BEGIN
name: STRING = [100];
l1: LONG STRING = @p[p.lines[0]];
comma: CARDINAL ← l1.length;
j: CARDINAL;
box: MBox;
IF row = 11 THEN {row ← 0; col ← col + 1};
IF col = 3 THEN {WritePage[pfd]; col ← 0};
box.x ← M38 + col * LWidth;
box.y ← yDelta + 10*M1 - Scale[row*LHeight];
box.w ← LWidth - M38;
box.h ← M1;
FOR i: CARDINAL IN [0..l1.length) DO
IF l1[i] = ', THEN {comma ← i; EXIT};
ENDLOOP;
j ← comma + 1;
WHILE j < l1.length AND l1[j] = Ascii.SP DO j ← j + 1; ENDLOOP;
FOR i: CARDINAL IN [j..l1.length) DO
String.AppendChar[name, l1[i]];
ENDLOOP;
IF name.length # 0 AND name[name.length-1] # Ascii.SP THEN
String.AppendChar[name, Ascii.SP];
FOR i: CARDINAL IN [0..comma) DO
String.AppendChar[name, l1[i]];
ENDLOOP;
LJLine[s: name, box: @box, line: 0, of: p.last];
FOR i: CARDINAL IN [1..p.last) DO
LJLine[s: @p[p.lines[i]], box: @box, line: i, of: p.last];
ENDLOOP;
row ← row + 1;
END;
InitPressThings: PROC =
BEGIN
InitPressFileDescriptor[pfd, "Labels.press"];
DigestFonts[];
TextFont[];
row ← col ← 0;
END;
OtherComp: ARRAY [0..5) OF CompProc;
flagChar: ARRAY [0..5) OF CHARACTER;
down: ARRAY [0..5) OF BOOLEAN ← ALL[FALSE];
nOthers: CARDINAL ← 0;
CompProc: TYPE = PROCEDURE [p1, p2: Label, c: CHARACTER]
RETURNS [i: INTEGER];
AddCompare: PROC [p: CompProc, c: CHARACTER, sortDown: BOOLEAN] =
BEGIN
IF nOthers = 5 THEN {WriteLine["Too many keys"L]; RETURN};
OtherComp[nOthers] ← p;
flagChar[nOthers] ← c;
down[nOthers] ← sortDown;
nOthers ← nOthers + 1;
END;
Date: TYPE = RECORD [SELECT OVERLAID * FROM
lc => [val: LONG CARDINAL],
ymd => [month, day: [0..256), year: CARDINAL],
ENDCASE];
GetDate: PROC [s: LONG STRING] RETURNS [d: Date] =
BEGIN
i: CARDINAL ← 1;
SB: PROC = {
WHILE i < s.length AND (s[i] = Ascii.SP OR s[i] = Ascii.TAB) DO
i ← i+1;
ENDLOOP};
N: PROC RETURNS [n: CARDINAL ← 0] = {
SB[];
WHILE i < s.length AND s[i] IN ['0..'9] DO
n ← n * 10 + (s[i] - '0);
i ← i+1;
ENDLOOP};
d.val ← 0;
WHILE i < s.length AND s[i] # Ascii.SP AND s[i] # Ascii.TAB DO
i ← i + 1;
ENDLOOP;
d.month ← N[]; SB[];
IF i = s.length OR s[i] # '/ THEN RETURN[[lc[0]]];
i ← i+1;
d.day ← N[]; SB[];
IF i = s.length OR s[i] # '/ THEN RETURN[[lc[0]]];
i ← i+1;
d.year ← N[];
IF d.year = 0 THEN RETURN[[lc[0]]];
IF d.year < 100 THEN d.year ← d.year + 1900;
END;
CompareBirthdays: CompProc = {
s1: LONG STRING = FindFlag[p1, 'B];
s2: LONG STRING = FindFlag[p2, 'B];
d1, d2: Date;
IF s1 = NIL THEN {IF s2 = NIL THEN RETURN[0] ELSE RETURN[-1]};
IF s2 = NIL THEN RETURN[1];
d1 ← GetDate[s1];
d2 ← GetDate[s2];
SELECT d1.val FROM
< d2.val => RETURN[-1];
> d2.val => RETURN[1];
ENDCASE;
RETURN[0]};
CompareFlag: CompProc = {
s1: LONG STRING = FindFlag[p1, c];
s2: LONG STRING = FindFlag[p2, c];
i1, i2: CARDINAL ← 1;
IF s1 = NIL THEN {IF s2 = NIL THEN RETURN[0] ELSE RETURN[-1]};
IF s2 = NIL THEN RETURN[1];
WHILE i1 < s1.length AND s1[i1] # Ascii.SP AND s1[i1] # Ascii.TAB DO
i1 ← i1 + 1;
ENDLOOP;
WHILE i2 < s2.length AND s2[i2] # Ascii.SP AND s2[i2] # Ascii.TAB DO
i2 ← i2 + 1;
ENDLOOP;
WHILE i1 < s1.length AND (s1[i1] = Ascii.SP OR s1[i1] = Ascii.TAB) DO
i1 ← i1 + 1;
ENDLOOP;
WHILE i2 < s2.length AND (s2[i2] = Ascii.SP OR s2[i2] = Ascii.TAB) DO
i2 ← i2 + 1;
ENDLOOP;
DO
IF i1 = s1.length THEN
IF i2 = s2.length THEN RETURN[0]
ELSE RETURN[-1];
IF i2 = s2.length THEN RETURN[1];
SELECT s1[i1] FROM
<s2[i2] => RETURN [-1];
>s2[i2] => RETURN [1];
ENDCASE;
i1 ← i1+1; i2 ← i2+1;
ENDLOOP};
FindFlag: PROC [p: Label, c: CHARACTER] RETURNS [LONG STRING] =
BEGIN
FOR i: CARDINAL IN [p.last..p.count) DO
s: LONG STRING = @p[p.lines[i]];
IF s.length >= 2 AND String.UpperCase[s[1]] = c THEN
RETURN [s];
ENDLOOP;
RETURN[NIL];
END;
FindZip: PROC [p: Label] RETURNS [zip: LONG CARDINAL ← 0] =
BEGIN
s: LONG STRING = @p[p.lines[p.last-1]];
i: INTEGER ← s.length-1;
IF p.last = 0 THEN RETURN;
WHILE i >= 0 AND s[i] = Ascii.SP DO i ← i-1; ENDLOOP;
WHILE i >= 0 AND s[i] IN ['0..'9] DO i ← i-1; ENDLOOP;
i ← i+1;
WHILE i < INTEGER[s.length] AND s[i] IN ['0..'9] DO
zip ← zip*10 + s[i] - '0;
i ← i+1;
ENDLOOP;
END;
CompareZip: CompProc = {
z1: LONG CARDINAL = FindZip[p1];
z2: LONG CARDINAL = FindZip[p2];
SELECT z1 FROM
< z2 => RETURN [-1];
> z2 => RETURN[1];
ENDCASE => RETURN[0]};
CompareNames: PROC [s1, s2: LONG STRING] RETURNS [INTEGER] =
BEGIN
RETURN[String.CompareStrings[s1, s2]];
END;
Compare: PROCEDURE [p1, p2: Label] RETURNS [i: INTEGER] =
BEGIN
FOR c: CARDINAL IN [0..nOthers) DO
i ← OtherComp[c][p1, p2, flagChar[c]];
IF down[c] THEN i ← -i;
IF i # 0 THEN RETURN;
ENDLOOP;
i ← CompareNames[@p1[p1.lines[0]], @p2[p2.lines[0]]];
RETURN
END;
buffer: Label;
makePress, paginateList: BOOLEAN ← FALSE;
eh: Exec.Handle ← NIL;
EOut: Format.StringProc;
WriteLine: PROC [s: LONG STRING] = {EOut[s]; Exec.PutChar[eh, Ascii.CR]};
DoIt: Exec.ExecProc =
BEGIN
c: CHARACTER;
file, switches: LONG STRING ← NIL;
BEGIN
i: CARDINAL;
GetSwitchNumber: PROC RETURNS [n: CARDINAL ← 0] =
BEGIN
i ← i+1;
WHILE switches[i] IN ['0..'9] DO
n ← n * 10 + (switches[i] - '0);
i ← i+1;
ENDLOOP;
i ← i-1; -- since loop increments at bottom
END;
NumberNext: PROC RETURNS [BOOLEAN] = {
RETURN[i+1 < switches.length AND switches[i+1] IN ['0..'9]]};
eh ← h;
EOut ← Exec.OutputProc[eh];
[file, switches] ← Exec.GetToken[eh];
in ← Streams.NewStream[file, Streams.Read !
Segments.FileNameProblem[] => GO TO cantFind];
i ← 0;
WHILE i < switches.length DO
SELECT (c ← switches[i]) FROM
'z, 'Z => AddCompare[CompareZip, 0C, c = 'Z];
'b, 'B => AddCompare[CompareBirthdays, 'B, c = 'B];
's, 'S =>
IF NumberNext[] THEN scaleFactor ← GetSwitchNumber[]
ELSE AddCompare[CompareFlag, 'S, c = 'S];
'y, 'Y =>
IF NumberNext[] THEN yDelta ← GetSwitchNumber[]
ELSE AddCompare[CompareFlag, 'Y, c = 'Y];
'p, 'P =>
IF NumberNext[] THEN outPointSize ← GetSwitchNumber[]
ELSE AddCompare[CompareFlag, 'P, c = 'P];
IN ['a..'y], IN ['A..'Y] =>
AddCompare[CompareFlag, String.UpperCase[c], c IN ['A..'Z]];
'$ => makePress ← TRUE;
'+ => {
paginateList ← TRUE;
IF NumberNext[] THEN
linesPerPage ← GetSwitchNumber[]};
ENDCASE => GO TO badSwitch;
i ← i+1;
ENDLOOP;
LOOPHOLE[OutToSort, GSort.Port].out ← GSort.Sort;
buffer ← LOOPHOLE[OutToSort, GSort.SortStarter][
nextItem: @OutToSort,
put: Put,
compare: Compare,
expectedItemSize: 100];
-- go through list of names, calling OutToSort
DO
ReadLabel[];
IF buffer.count = 0 THEN EXIT;
buffer ← OutToSort[nextRP];
ENDLOOP;
Streams.Destroy[in];
-- shut down the sort package (and call Put many times)
OutputDefs.OpenOutput["Labels",".list"L];
IF makePress THEN InitPressThings[];
LOOPHOLE[OutToSort, GSort.SortStopper][];
OutputDefs.CloseOutput[];
IF makePress THEN {
WritePage[pfd];
ClosePressFile[pfd]};
WriteLine["--done"L];
EXITS
cantFind => WriteLine[" file not found"L];
badSwitch => WriteLine[" bad switch"L];
END;
IF file # NIL THEN [] ← Exec.FreeTokenString[file];
IF switches # NIL THEN [] ← Exec.FreeTokenString[switches];
END;
OutToSort: GSort.SortItemPort;
Exec.AddCommand["Labels.~", DoIt];
END.