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 {$INCLUDE a_modes.inc}
  17 {.$MODE OBJFPC}
  18 unit conbuf;
  19
  20 interface
  21
  22
  23 procedure cbufPut (const s: AnsiString);
  24 procedure cbufPutChars (buf: PChar; count: Integer);
  25
  26 function cbufLastChange (): LongWord;
  27
  28 function cbufWalkStart (): LongWord;
  29 function cbufWalkEnd (pos: LongWord): LongWord;
  30 procedure cbufPrev (var pos: LongWord); inline;
  31 procedure cbufNext (var pos: LongWord); inline;
  32
  33 function cbufAt (const pos: LongWord): Char; inline;
  34
  35 // get last line
  36 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
  37 // move one line up; `sp` and `ep` MUST be valid values from previous call to `cbufLastLine()`
  38 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
  39
  40 procedure cbufClear ();
  41
  42 var
  43   conbufDumpToStdOut: Boolean = false;
  44   conbufConPrefix: Boolean = true;
  45
  46
  47 implementation
  48
  49
  50 // ////////////////////////////////////////////////////////////////////////// //
  51 //const ConBufSize = 64;
  52 const ConBufSize = 256*1024;
  53
  54 // each line in buffer ends with '\n'; we don't keep offsets or lengthes, as
  55 // it's fairly easy to search in buffer, and drawing console is not a common
  56 // thing, so it doesn't have to be superfast.
  57 var
  58   cbuf: packed array [0..ConBufSize-1] of Char;
  59   cbufhead: LongWord = 0;
  60   cbuftail: LongWord = 0; // `cbuftail` points *at* last char
  61   changeCount: LongWord = 1;
  62
  63
  64 function cbufLastChange (): LongWord; begin result := changeCount; end;
  65
  66
  67 // ////////////////////////////////////////////////////////////////////////// //
  68 var
  69   needCon: Boolean = true;
  70
  71 procedure cbufPutChars (buf: PChar; count: Integer);
  72 var
  73   np: LongWord;
  74   ch, och: Char;
  75 begin
  76   if count > 0 then
  77   begin
  78     if conbufDumpToStdOut then
  79     begin
  80       for np := 0 to count-1 do
  81       begin
  82         if needCon then
  83         begin
  84           if conbufConPrefix then write(stdout, 'CON: ');
  85           needCon := false;
  86         end;
  87         write(stdout, buf[np]);
  88         needCon := (buf[np] = #10);
  89       end;
  90     end;
  91     Inc(changeCount);
  92     if changeCount = 0 then changeCount := 1;
  93     while count > 0 do
  94     begin
  95       Dec(count);
  96       ch := buf^;
  97       Inc(buf);
  98       np := (cbuftail+1) mod ConBufSize;
  99       if np = cbufhead then
 100       begin
 101         // we have to make some room; delete top line for this
 102         while true do
 103         begin
 104           och := cbuf[cbufhead];
 105           cbufhead := (cbufhead+1) mod ConBufSize;
 106           if (cbufhead = np) or (och = #10) then break;
 107         end;
 108       end;
 109       cbuf[np] := ch;
 110       cbuftail := np;
 111     end;
 112   end;
 113 end;
 114
 115
 116 procedure cbufPut (const s: AnsiString);
 117 begin
 118   if length(s) > 0 then cbufPutChars(@s[1], length(s));
 119 end;
 120
 121
 122 // ////////////////////////////////////////////////////////////////////////// //
 123 // warning! don't modify conbuf while the range is active!
 124 function cbufWalkStart (): LongWord; begin result := cbuftail; end;
 125 function cbufWalkEnd (pos: LongWord): LongWord; begin result := cbufhead; end;
 126 procedure cbufPrev (var pos: LongWord); inline; begin pos := (pos+ConBufSize-1) mod ConBufSize; end;
 127 procedure cbufNext (var pos: LongWord); inline; begin pos := (pos+1) mod ConBufSize; end;
 128
 129 function cbufAt (const pos: LongWord): Char; inline; begin result := cbuf[pos mod ConBufSize]; end;
 130
 131
 132 // ////////////////////////////////////////////////////////////////////////// //
 133 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
 134 var
 135   pos, pp: LongWord;
 136 begin
 137   if cbufhead = cbuftail then
 138   begin
 139     sp := cbufhead;
 140     ep := cbufhead+1;
 141     exit;
 142   end;
 143   pos := cbuftail;
 144   ep := pos;
 145   while pos <> cbufhead do
 146   begin
 147     pp := (pos+ConBufSize-1) mod ConBufSize;
 148     if cbuf[pp] = #10 then break;
 149     pos := pp;
 150   end;
 151   sp := pos;
 152 end;
 153
 154
 155 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
 156 var
 157   pos, pp: LongWord;
 158 begin
 159   if sp = cbufhead then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 160   pos := (sp+ConBufSize-1) mod ConBufSize;
 161   if (pos = cbufhead) or (cbuf[pos] <> #10) then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 162   ep := pos;
 163   while pos <> cbufhead do
 164   begin
 165     pp := (pos+ConBufSize-1) mod ConBufSize;
 166     if cbuf[pp] = #10 then break;
 167     pos := pp;
 168   end;
 169   sp := pos;
 170   result := true;
 171 end;
 172
 173
 174 procedure cbufClear ();
 175 begin
 176   cbuf[0] := #10;
 177   cbufhead := 0;
 178   cbuftail := 0;
 179   Inc(changeCount);
 180   if changeCount = 0 then changeCount := 1;
 181 end;
 182
 183
 184 begin
 185   cbuf[0] := #10;
 186 end.