src/shared/conbuf.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$MODE OBJFPC}
  17 unit conbuf;
  18
  19 interface
  20
  21
  22 procedure cbufPut (const s: AnsiString);
  23 procedure cbufPutChars (buf: PChar; count: Integer);
  24
  25 function cbufLastChange (): LongWord;
  26
  27 function cbufWalkStart (): LongWord;
  28 function cbufWalkEnd (pos: LongWord): LongWord;
  29 procedure cbufPrev (var pos: LongWord);
  30 procedure cbufNext (var pos: LongWord);
  31
  32 function cbufAt (const pos: LongWord): Char;
  33
  34 // get last line
  35 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
  36 // move one line up; `sp` and `ep` MUST be valid values from previous call to `cbufLastLine()`
  37 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
  38
  39 procedure cbufClear ();
  40
  41
  42 implementation
  43
  44
  45 // ////////////////////////////////////////////////////////////////////////// //
  46 //const ConBufSize = 64;
  47 const ConBufSize = 256*1024;
  48
  49 // each line in buffer ends with '\n'; we don't keep offsets or lengthes, as
  50 // it's fairly easy to search in buffer, and drawing console is not a common
  51 // thing, so it doesn't have to be superfast.
  52 var
  53   cbuf: packed array [0..ConBufSize-1] of Char;
  54   cbufhead: LongWord = 0;
  55   cbuftail: LongWord = 0; // `cbuftail` points *at* last char
  56   changeCount: LongWord = 1;
  57
  58
  59 function cbufLastChange (): LongWord; begin result := changeCount; end;
  60
  61
  62 // ////////////////////////////////////////////////////////////////////////// //
  63 procedure cbufPutChars (buf: PChar; count: Integer);
  64 var
  65   np: LongWord;
  66   ch, och: Char;
  67 begin
  68   if count > 0 then
  69   begin
  70     Inc(changeCount);
  71     if changeCount = 0 then changeCount := 1;
  72     while count > 0 do
  73     begin
  74       Dec(count);
  75       ch := buf^;
  76       Inc(buf);
  77       np := (cbuftail+1) mod ConBufSize;
  78       if np = cbufhead then
  79       begin
  80         // we have to make some room; delete top line for this
  81         while true do
  82         begin
  83           och := cbuf[cbufhead];
  84           cbufhead := (cbufhead+1) mod ConBufSize;
  85           if (cbufhead = np) or (och = #10) then break;
  86         end;
  87       end;
  88       cbuf[np] := ch;
  89       cbuftail := np;
  90     end;
  91   end;
  92 end;
  93
  94
  95 procedure cbufPut (const s: AnsiString);
  96 begin
  97   if length(s) > 0 then cbufPutChars(@s[1], length(s));
  98 end;
  99
 100
 101 // ////////////////////////////////////////////////////////////////////////// //
 102 // warning! don't modify conbuf while the range is active!
 103 function cbufWalkStart (): LongWord; begin result := cbuftail; end;
 104 function cbufWalkEnd (pos: LongWord): LongWord; begin result := cbufhead; end;
 105 procedure cbufPrev (var pos: LongWord); begin pos := (pos+ConBufSize-1) mod ConBufSize; end;
 106 procedure cbufNext (var pos: LongWord); begin pos := (pos+1) mod ConBufSize; end;
 107
 108 function cbufAt (const pos: LongWord): Char; begin result := cbuf[pos mod ConBufSize]; end;
 109
 110
 111 // ////////////////////////////////////////////////////////////////////////// //
 112 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
 113 var
 114   pos, pp: LongWord;
 115 begin
 116   if cbufhead = cbuftail then
 117   begin
 118     sp := cbufhead;
 119     ep := cbufhead+1;
 120     exit;
 121   end;
 122   pos := cbuftail;
 123   ep := pos;
 124   while pos <> cbufhead do
 125   begin
 126     pp := (pos+ConBufSize-1) mod ConBufSize;
 127     if cbuf[pp] = #10 then break;
 128     pos := pp;
 129   end;
 130   sp := pos;
 131 end;
 132
 133
 134 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
 135 var
 136   pos, pp: LongWord;
 137 begin
 138   if sp = cbufhead then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 139   pos := (sp+ConBufSize-1) mod ConBufSize;
 140   if (pos = cbufhead) or (cbuf[pos] <> #10) then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 141   ep := pos;
 142   while pos <> cbufhead do
 143   begin
 144     pp := (pos+ConBufSize-1) mod ConBufSize;
 145     if cbuf[pp] = #10 then break;
 146     pos := pp;
 147   end;
 148   sp := pos;
 149   result := true;
 150 end;
 151
 152
 153 procedure cbufClear ();
 154 begin
 155   cbuf[0] := #10;
 156   cbufhead := 0;
 157   cbuftail := 0;
 158   Inc(changeCount);
 159   if changeCount = 0 then changeCount := 1;
 160 end;
 161
 162
 163 begin
 164   cbuf[0] := #10;
 165 end.