-- SortLabels.mesa
--   Edited by Sweet,  2-Oct-82 21:45:30

DIRECTORY
  AltoFileDefs,
  Ascii,
  GPsortDefs USING [CompareProcType, GetProcType, PutProcType, Sort],
  Inline,
  IODefs,
  ImageDefs,
  MiscDefs,
  OutputDefs,
  PressDefs,
  PressUtilities,
  SegmentDefs,
  StreamDefs,
  String;

SortLabels: PROGRAM 
  IMPORTS  
    GPsortDefs, ImageDefs, Inline, IODefs, MiscDefs, OutputDefs, PressDefs,
    PressUtilities, SegmentDefs, StreamDefs, String =
  BEGIN OPEN IODefs, PressDefs, String, StreamDefs;

  in: StreamHandle;

  Label: TYPE = 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: 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: 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: STRING, box: POINTER TO MBox, line, of: CARDINAL, lead: Mica _ 1] =
    BEGIN
    y: Mica = LineY[box: box, line: line, of: of, lead: lead];
    PutText[pfd, s, box.x, y];
    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
    [] _ PressUtilities.FindFontWidths[
      family: "Helvetica"L,
      points: outPointSize,
      weight: medium,
      slope: regular,
      widths: LOOPHOLE[@TextCharWidth]];
    TextCharHeight _ PointsToMicas[outPointSize];
    END;

  commandStream: StreamHandle;

  SetUpCommands: PROCEDURE =
    BEGIN
    cfa: POINTER TO AltoFileDefs.CFA _ MiscDefs.CommandLineCFA[];
    cfile: SegmentDefs.FileHandle _ SegmentDefs.InsertFile[@cfa.fp,Read];
    commandStream _ NIL;
    commandStream _ CreateByteStream[cfile,Read
      ! SegmentDefs.InvalidFP => CONTINUE];
    IF commandStream # NIL THEN
      BEGIN
      JumpToFA[commandStream,@cfa.fa];
      WHILE commandStream.get[commandStream
              ! StreamError => GOTO nocommands] <= SP DO
        NULL ENDLOOP;
      SetIndex[commandStream,ModifyIndex[GetIndex[commandStream],-1]];
      EXITS nocommands =>
        BEGIN commandStream.destroy[commandStream]; commandStream _ NIL END;
      END;
    END;

  ReadName: PROCEDURE [s: STRING] =
    BEGIN
    c: CHARACTER;
    IF commandStream = NIL THEN ReadID[s]
    ELSE
      BEGIN
      s.length _ 0;
      DO
        IF (c_commandStream.get[commandStream
              ! StreamError => GOTO endoffile]) <= SP THEN
          BEGIN IF s.length # 0 THEN EXIT END
  	ELSE BEGIN String.AppendChar[s,c]; WriteChar[c] END;
        REPEAT endoffile =>
          BEGIN commandStream.destroy[commandStream]; commandStream _ NIL END;
        ENDLOOP;
      END;
    END;

  GetFile: PROCEDURE [prompt: STRING, access: AccessOptions, switches: STRING _ NIL] RETURNS [StreamHandle] =
    BEGIN
    name: STRING _ [40];
    WriteString[prompt];
    ReadName[name];
    IF switches # NIL THEN FOR i:CARDINAL IN[0..name.length) DO
      IF name[i] = '/ THEN
	BEGIN
	FOR j: CARDINAL IN (i..name.length) DO
	  String.AppendChar[switches,name[j]] ENDLOOP;
	name.length _ i;
	EXIT;
	END;
      ENDLOOP;
    WriteChar[CR];
    IF name.length = 0 THEN ImageDefs.StopMesa[];
    RETURN[NewByteStream[name,access]]
    END;

  ReadLabel: PROC =
    BEGIN
    StartLabel[];
    DO
      ReadLine[];
      IF line.length = 0 AND (buffer.count # 0 OR in.endof[in]) THEN EXIT;
      IF line.length # 0 THEN AddLine[];
      ENDLOOP;
    IF ~slashSeen THEN buffer.last _ buffer.count;
    END;

  ReadLine: PROC =
    BEGIN
    c: CHARACTER;
    n: CARDINAL _ 0;
    line.length _ 0;
    BEGIN
    DO
      c _ in.get[in ! StreamError => EXIT];
      IF c = CR THEN EXIT;
      IF n = line.maxlength-1 THEN GO TO tooLong;
      line[n] _ c;
      n _ n + 1;
      ENDLOOP;
    line.length _ n;
    EXITS
      tooLong => {
	IODefs.WriteLine["Line truncated:"L];
	IODefs.WriteLine[line];
	line.length _ n};
    END;
    END;

  line: STRING _ [200];
  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: 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 {IODefs.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: 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: STRING = FindFlag[p1, 'B];
    s2: 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: STRING = FindFlag[p1, c];
    s2: 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 [STRING] =
    BEGIN
    FOR i: CARDINAL IN [p.last..p.count) DO
      s: 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: 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: 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;

  DoIt: PROC =
    BEGIN
    c: CHARACTER;
    switches: STRING _ [20];
      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]]};
	
      in _ GetFile["input: "L, StreamDefs.Read, switches !
	SegmentDefs.FileNameError => 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, port].out _ GPsortDefs.Sort;
      buffer _ LOOPHOLE[OutToSort, SortStarter][
        get: LOOPHOLE[@OutToSort, GPsortDefs.GetProcType],
        put: Put,
        compare: Compare,
        expectedItemSize: 100, 
        maxItemSize: 500, 
        reservedPages: 90];
    -- go through list of names, calling OutToSort
      DO
	ReadLabel[];
	IF buffer.count = 0 THEN EXIT;
	buffer _ OutToSort[nextRP];
        ENDLOOP;
      in.destroy[in];
      -- shut down the sort package (and call Put many times)
      OutputDefs.OpenOutput["Labels",".list"L];
      IF makePress THEN InitPressThings[];
      LOOPHOLE[OutToSort, SortStopper][];
      OutputDefs.CloseOutput[];
      IF makePress THEN {
	WritePage[pfd];
	ClosePressFile[pfd]};
      IODefs.WriteLine["--done"L];
      EXITS
        cantFind => WriteLine[" file not found"L];
        badSwitch => WriteLine[" bad switch"L];
      END;
    END;

  port: TYPE = MACHINE DEPENDENT RECORD [in, out: UNSPECIFIED];
  
  OutToSort: PORT [len: RelLabel] RETURNS [POINTER];
  SortStarter: TYPE = PORT [
    get: GPsortDefs.GetProcType, put: GPsortDefs.PutProcType,
    compare: GPsortDefs.CompareProcType, expectedItemSize: CARDINAL,
    maxItemSize: CARDINAL, reservedPages: CARDINAL] RETURNS [POINTER];
  SortStopper: TYPE = PORT [len: CARDINAL _ 0];
  

  SetUpCommands[];
  DoIt[];
  ImageDefs.StopMesa[];
  END.