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