home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBCS / bb < prev    next >
Encoding:
Text File  |  1993-04-12  |  6.8 KB  |  278 lines
  1.   procedure newbuffer(var t :textbuffer);
  2.   begin
  3.     t.first := nil;
  4.     t.last := nil;
  5.   end; {newbuffer}
  6.  
  7.  
  8.   procedure deletebuffer(var t :textbuffer);
  9.   var step,temp :textnodeptr;
  10.   begin
  11.     step := t.first;
  12.     while (step <> nil) do begin
  13.       freemem(step^.line,length(step^.line^)+1);
  14.       temp := step;
  15.       step := step^.next;
  16.       dispose(temp);
  17.     end; {while}
  18.     newbuffer(t);
  19.   end; {deletebuffer}
  20.  
  21.  
  22.   function emptybuffer(var t :textbuffer) :boolean;
  23.   begin
  24.     emptybuffer := (t.first = nil);
  25.   end; {emptybuffer}
  26.  
  27.  
  28.   function firstline(var t :textbuffer) :textnodeptr;
  29.   begin
  30.     firstline := t.first;
  31.   end; {firstline}
  32.  
  33.  
  34.   function lastline(var t :textbuffer) :textnodeptr;
  35.   begin
  36.     lastline := t.last;
  37.   end; {lastline}
  38.  
  39.  
  40.   function nextline(var t :textbuffer;  pos :textnodeptr) :textnodeptr;
  41.   begin
  42.     nextline := nil;
  43.     if (pos = nil) then exit;
  44.     nextline := pos^.next;
  45.   end; {nextline}
  46.  
  47.  
  48.   function prevline(var t :textbuffer;  pos :textnodeptr) :textnodeptr;
  49.   begin
  50.     prevline := nil;
  51.     if (pos = nil) then exit;
  52.     prevline := pos^.prev;
  53.   end; {prevline}
  54.  
  55.  
  56.   function deleteline(var t :textbuffer;  var pos :textnodeptr) :textnodeptr;
  57.   begin
  58.     deleteline := nextline(t,pos);
  59.     if (pos=nil) or emptybuffer(t) then exit;
  60.     if (pos^.prev <> nil) then pos^.prev^.next := pos^.next;
  61.     if (pos^.next <> nil) then pos^.next^.prev := pos^.prev;
  62.     if (pos = t.first) then t.first := pos^.next; {pos was first node}
  63.     if (pos = t.last) then t.last := pos^.prev;   {pos was last node}
  64.     if (pos^.line <> nil) then freemem(pos^.line,length(pos^.line^)+1);
  65.                                                     {free existing line}
  66.     dispose(pos); pos := nil;
  67.   end;
  68.  
  69.  
  70.   function newnode(line :string) :textnodeptr;
  71.   var temp :textnodeptr;
  72.   begin
  73.     newnode := nil;
  74.     new(temp);
  75.     if (temp=nil) then exit;
  76.     temp^.next := nil;
  77.     temp^.prev := nil;
  78.     getmem(temp^.line,length(line)+1);
  79.     if (temp^.line = nil) then exit;
  80.     temp^.line^ := line;
  81.     newnode := temp;
  82.   end; {newnode}
  83.  
  84.  
  85.   procedure modifytextline(var t: textbuffer; pos: textnodeptr; line: string);
  86.   begin
  87.     if pos = nil then exit;
  88.     if (pos^.line <> nil) then freemem(pos^.line, length(pos^.line^)+1);
  89.     getmem(pos^.line,length(line)+1); { space for new line }
  90.     if (pos^.line = nil) then exit;
  91.     pos^.line^ := line;
  92.   end; {modifytextline}
  93.  
  94.  
  95.   function gettextline(var t: textbuffer;  pos :textnodeptr) :string;
  96.   begin
  97.     gettextline := '';
  98.     if pos=nil then exit;
  99.     gettextline := pos^.line^;
  100.   end; {gettextline}
  101.  
  102.  
  103.   procedure addtoend(var t :textbuffer;  line :string);
  104.   var temp :textnodeptr;
  105.   begin
  106.     temp := newnode(line);
  107.     if (temp=nil) then exit;
  108.  
  109.     if (t.first = nil) then begin
  110.       t.first := temp;
  111.       t.last := t.first;
  112.     end else begin
  113.       t.last^.next := temp;
  114.       temp^.prev := t.last;
  115.       t.last := temp;
  116.     end; {else}
  117.   end; {addtoend}
  118.  
  119.  
  120.   procedure addinsert(var t :textbuffer;  pos :textnodeptr;  line :string);
  121.   var temp :textnodeptr;
  122.   begin
  123.     if (emptybuffer(t) or (pos = nil)) then begin
  124.       addtoend(t,line);
  125.     end else begin
  126.       temp := newnode(line);
  127.       if (temp=nil) then exit;
  128.  
  129.       if (pos^.prev <> nil) then
  130.         pos^.prev^.next := temp;
  131.       temp^.next := pos;
  132.       temp^.prev := pos^.prev;
  133.       pos^.prev := temp;
  134.  
  135.       if (pos = t.first) then   {new front}
  136.         t.first := temp;
  137.     end; {else}
  138.   end; {addinsert}
  139.  
  140.  
  141.   function bufferlength(var t :textbuffer) :word;
  142.   var
  143.     count :word;
  144.     step :textnodeptr;
  145.   begin
  146.     count := 0;
  147.     step := t.first;
  148.     while (step <> nil) do begin
  149.       step := step^.next;
  150.       inc(count);
  151.     end; {while}
  152.  
  153.     bufferlength := count;
  154.   end; {bufferlength}
  155.  
  156.   {- Create a new, wrapped, buffer.  Margin must be reasonable, i.e. not too
  157.    close to 0 or 255 -}
  158.  
  159.  
  160.   procedure wrapbuffer(var t: textbuffer; margin: byte);
  161.   const seperators = [#32..#47,#58..#64,#91..#96,#123..#126];
  162.   var
  163.     w      :  textbuffer;
  164.     tmpst,
  165.     line   :      string;
  166.     source :        word; {can't be Byte, Length may be 255}
  167.     step   : textnodeptr;
  168.     ch     :        char;
  169.  
  170.  
  171.     procedure finishline;
  172.     begin
  173.       addtoend(w, line);
  174.       line := '';
  175.     end; {finishline}
  176.  
  177.  
  178.     procedure addchar(ch: char);
  179.     var
  180.       overflow : string;
  181.       p        :   byte;
  182.  
  183.     begin
  184.       if (length(line) >= margin) then begin  {break the line}
  185.         overflow := '';
  186.           {first remove excess spaces}
  187.         if (line[length(line)]=' ') then
  188.           while (length(line) > 1) and (line[length(line)-1]=' ') do
  189.             dec(line[0]);     {drop last space}
  190.  
  191.         if (length(line) >= margin) then begin
  192.           p := length(line);
  193.           while (p > 0) and not (line[p] in seperators) do
  194.             dec(p);       {look backwards for seperator}
  195.  
  196.           if (p=0) then p := margin;    {no seperator, one huge word}
  197.  
  198.           overflow := copy(line,p+1,length(line)-p);
  199.           line[0] := char(p);
  200.         end; {if}
  201.  
  202.         finishline;
  203.         line := overflow+ch;
  204.       end else begin
  205.         line := line+ch;
  206.       end; {else}
  207.     end; {addchar}
  208.  
  209.  
  210.     procedure tab;
  211.     var count: byte;
  212.     begin
  213.       for count := 1 to 8 - (pred(length(line)) mod 8) do addchar(' ');
  214.     end; {tab}
  215.  
  216.  
  217.   begin
  218.     newbuffer(w);
  219.     step := t.first; line := '';
  220.     while (step <> nil) do begin
  221.       source := 1;
  222.       tmpst := step^.line^;
  223.       while (source <= length(tmpst)) and (step <> nil) do begin
  224.         ch := tmpst[source];
  225.         case ch of
  226.           ^m : begin
  227.             line := line+^m^j;
  228.             finishline;
  229.           end;
  230.           ^i : tab;
  231.           ^j,#141 : {ignore lf and soft-cr};
  232.           else addchar(ch);
  233.         end; {case}
  234.         inc(source);
  235.       end; {while}
  236.       step := step^.next;
  237.     end; {while}
  238.     if (line <> '') then finishline;
  239.     deletebuffer(t);
  240.     t := w;
  241.   end; {wrapbuffer}
  242.  
  243.  
  244.   {- Create a new, unwrapped, buffer.  All the lines except the last one
  245.    in the new buffer will be of length 255 -}
  246.  
  247.  
  248.   procedure unwrapbuffer(var t,w :textbuffer);
  249.   var
  250.     line :string;
  251.     source :word; {can't be Byte, Length may be 255}
  252.     step :textnodeptr;
  253.  
  254.  
  255.     procedure finishline;
  256.     begin
  257.       addtoend(w,line);
  258.       line := '';
  259.     end; {finishline}
  260.  
  261.  
  262.     procedure addchar(ch :char);
  263.     begin
  264.       if (length(line) = 255) then finishline;
  265.       line := line+ch;
  266.     end; {addchar}
  267.  
  268.  
  269.   begin
  270.     newbuffer(w); step := t.first; line := '';
  271.     while (step <> nil) do begin
  272.       for source := 1 to length(step^.line^) do addchar(step^.line^[source]);
  273.       step := step^.next;
  274.     end; {while}
  275.     if (line <> '') then finishline;
  276.   end; {unwrapbuffer}
  277.   { quickbbs message text, credits to p.j. muller }
  278.