-- UnparserBufferImpl.mesa, 
-- last edited December 7, 1982 10:08 pm 
-- Last Edited by: Gnelson, December 29, 1982 11:33 am

DIRECTORY IO, UnparserBuffer, Rope, Atom, RefText; 

UnparserBufferImpl: PROGRAM
  IMPORTS IO, Rope, Atom, RefText
  EXPORTS UnparserBuffer
  = BEGIN OPEN UnparserBuffer;
  
  -- The comments here apply to any handle. 
  
  -- n : INT = 256;   both queues and the stack will have n elements
  
  -- bl, cl, br, cr, sr, srx: INTEGER;   in [0, n).
     
   -- c: ARRAY [0 .. n) OF CHAR;  a queue with pointers cl, cr
   -- b: ARRAY [0 .. n) OF    a queue with pointers bl, br
   -- RECORD [type: {setb, breakpoint},  
   --             united: BOOL,   relevant only if type = breakpoint
   --             offset: INTEGER,  relevant only if type = breakpoint
   --             insert: Rope.ROPE,  relevant only if type = breakpoint
   --             p: [0 .. n)];   index in c of following buffer char
   -- s: ARRAY [0 .. n) OF INTEGER;   a stack with pointer sr
   
   -- The indentations of the setbs that have been removed from the
   -- buffer but whose matching endbs have not yet been processed
   -- are stored in s[0], s[1], ... s[sr-1].  Furthermore, for i < srx, the
   -- setb whose indentation is stored in s[i] has been broken; for 
   -- srx <= i < sr, s[i] is the indentation of a setb on the "current line"
   -- that may or may not be broken.  
   
   -- indentation: INTEGER;
   
   -- margin: PUBLIC INTEGER;
   
   -- bufferWidth: INTEGER;
   
   -- output: PUBLIC IO.STREAM;
   
   -- Width: PROC [c: CHAR] RETURNS [INTEGER] = {RETURN [1]};
   
   NewHandle: PUBLIC PROC RETURNS [Handle] =
     {h: Handle _ NEW[HandleRec];
      h.EachLine _ IndentAndPrint;
      h.buffer _ RefText.New[100];
      RETURN [h]};
    
   Init: PUBLIC PROC [h: Handle] =
     {h.bufferIndent _ 
      h.bufferWidth _
      h.bl _ h.cl _ h.br _ h.cr _ h.sr _ h.srx _ h.indentation _ 0;
      -- now do a setb
      h.s[0] _ 0;
      h.sr _ 1};
         
   Right: PROC [m: INTEGER] RETURNS [INTEGER] = INLINE
     {IF m + 1 = n THEN RETURN [0] ELSE RETURN [m + 1]};
   
   Left: PROC [m: INTEGER] RETURNS [INTEGER] = INLINE
     {IF m = 0 THEN RETURN [n - 1] ELSE RETURN [m - 1]};
      
   Setb: PUBLIC PROC[h: Handle] =
     {OPEN h;
      IF bl = br AND cl = cr
      THEN {s[sr] _ indentation;
               sr _ sr + 1;
               IF sr = n THEN ERROR} -- Setb's too deeply nested
      ELSE {b[br] _ [setb, FALSE, 0, NIL, cr];
              br _ Right[br];
              IF br = bl THEN ERROR}}; -- Too many active Setbs and Bps
   
   Endb: PUBLIC PROC[h: Handle] =
     {OPEN h;
      WHILE bl # br AND b[Left[br]].type = breakpoint
      DO br _ Left[br] ENDLOOP;
      IF bl # br 
      THEN br _ Left[br]
      ELSE {WHILE cl # cr 
              DO OutputChar[h] ENDLOOP;
              IF sr = 0 
              THEN ERROR -- Endb with no matching Setb
              ELSE {IF srx = sr THEN srx _ srx - 1;
                      sr _ sr - 1}}};
   
    OutputChar: PROC[h: Handle] = 
      {OPEN h;
       RefText.AppendChar[buffer, c[cl]]; 
       indentation _ indentation + width[c[cl]];
       bufferWidth _ bufferWidth - width[c[cl]];
       cl _ Right[cl]};
     
    Bp: PUBLIC PROC[h: Handle, united: BOOL, offset: INTEGER, insert: Rope.ROPE _ NIL] =
      {OPEN h;
       b[br] _ [breakpoint, united, offset, insert, cr];
       br _ Right[br];
       IF br = bl THEN ERROR; -- Too many active Setbs and Bps
       LeftLoop[h]};
       
     Charb: PUBLIC PROC [h: Handle, ch: CHAR] =
       {OPEN h;
        c[cr] _ ch;
        cr _ Right[cr];
        IF cr = cl THEN ERROR; -- Too many characters
        bufferWidth _ bufferWidth + width[ch];
        LeftLoop[h]};
      
      Ropeb: PUBLIC PROC[h: Handle, r: Rope.ROPE] =
        {FOR i: INT IN [0 .. Rope.Length[r])
         DO Charb[h, Rope.Fetch[r, i]] ENDLOOP};
      
      Atomb: PUBLIC PROC[h: Handle, a: ATOM] = {Ropeb[h, Atom.GetPName[a]]};
      
     LeftLoop: PROC[h: Handle] = 
      {OPEN h;
       DO SELECT TRUE FROM
       
         cl # cr AND (bl = br OR b[bl].p # cl)  =>  OutputChar[h];
         
         bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = setb
         => {s[sr] _ indentation;
              sr _ sr + 1;
              IF sr = n THEN ERROR; -- Too many nested Setb
              bl _ Right[bl]};
         
         bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = breakpoint
         AND (srx = sr AND b[bl].united OR indentation + bufferWidth > margin)
         => {Breakline[h, s[sr-1] + b[bl].offset, b[bl].insert]; srx _ sr; bl _ Right[bl]};    
         
         bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = breakpoint
         AND Right[bl] # br AND b[Right[bl]].type = breakpoint
         AND ~ b[Right[bl]].united
         => bl _ Right[bl]
       
       ENDCASE => EXIT ENDLOOP};
       
    Breakline: PROC[h: Handle, indent: INTEGER, insert: Rope.ROPE] =
      {c: CHAR;
       h.EachLine[h]; 
       h.buffer.length _ 0;
       h.bufferIndent _ indent;
       h.indentation _ indent;
       FOR i: INTEGER IN [0 .. Rope.Length[insert]) DO
       c _ Rope.Fetch[insert, i];
       RefText.AppendChar[h.buffer, c]; 
       h.indentation _ h.indentation + h.width[c]
       ENDLOOP};
       
    Newlineb: PUBLIC PROC[h: Handle, offset: INTEGER, insert: Rope.ROPE _ NIL] = 
      {m: INTEGER = h.margin;
       Bp[h, TRUE, offset, insert];
       h.margin _ -1;
       LeftLoop[h];
       h.margin _ m};
   
   IndentAndPrint: PUBLIC PROC[h: Handle] =
     {OPEN h;
      i: INTEGER;
      FOR i IN [0 .. bufferIndent) DO IO.PutChar[output, IO.SP] ENDLOOP;
      FOR i IN [0 .. buffer.length) DO IO.PutChar[output, buffer[i]] ENDLOOP;
      IO.PutChar[output, IO.CR]};
                     
    END.