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, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE a_modes.inc}
  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); inline;
  30 procedure cbufNext (var pos: LongWord); inline;
  31
  32 function cbufAt (const pos: LongWord): Char; inline;
  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 var
  42   conbufDumpToStdOut: Boolean = false;
  43   conbufConPrefix: Boolean = true;
  44   conbufStdOutRawMode: Boolean = false;
  45
  46 implementation
  47
  48
  49 // ////////////////////////////////////////////////////////////////////////// //
  50 //const ConBufSize = 64;
  51 const ConBufSize = 256*1024;
  52
  53 // each line in buffer ends with '\n'; we don't keep offsets or lengthes, as
  54 // it's fairly easy to search in buffer, and drawing console is not a common
  55 // thing, so it doesn't have to be superfast.
  56 var
  57   cbuf: packed array [0..ConBufSize-1] of Char;
  58   cbufhead: LongWord = 0;
  59   cbuftail: LongWord = 0; // `cbuftail` points *at* last char
  60   changeCount: LongWord = 1;
  61
  62
  63 function cbufLastChange (): LongWord; begin result := changeCount; end;
  64
  65
  66 // ////////////////////////////////////////////////////////////////////////// //
  67 var
  68   needCon: Boolean = true;
  69
  70 procedure cbufPutChars (buf: PChar; count: Integer);
  71 var
  72   np: LongWord;
  73   ch, och: Char;
  74 begin
  75   if count > 0 then
  76   begin
  77     if conbufDumpToStdOut then
  78     begin
  79       for np := 0 to count-1 do
  80       begin
  81         if needCon then
  82         begin
  83           if conbufConPrefix then write(stdout, 'CON: ');
  84           needCon := false;
  85         end;
  86         if conbufStdOutRawMode and (buf[np] = #10) then
  87           write(stdout, #13); // force carriage return in raw mode
  88         write(stdout, buf[np]);
  89         needCon := (buf[np] = #10);
  90       end;
  91     end;
  92     Inc(changeCount);
  93     if changeCount = 0 then changeCount := 1;
  94     while count > 0 do
  95     begin
  96       Dec(count);
  97       ch := buf^;
  98       Inc(buf);
  99       np := (cbuftail+1) mod ConBufSize;
 100       if np = cbufhead then
 101       begin
 102         // we have to make some room; delete top line for this
 103         while true do
 104         begin
 105           och := cbuf[cbufhead];
 106           cbufhead := (cbufhead+1) mod ConBufSize;
 107           if (cbufhead = np) or (och = #10) then break;
 108         end;
 109       end;
 110       cbuf[np] := ch;
 111       cbuftail := np;
 112     end;
 113   end;
 114 end;
 115
 116
 117 procedure cbufPut (const s: AnsiString);
 118 begin
 119   if length(s) > 0 then cbufPutChars(@s[1], length(s));
 120 end;
 121
 122
 123 // ////////////////////////////////////////////////////////////////////////// //
 124 // warning! don't modify conbuf while the range is active!
 125 function cbufWalkStart (): LongWord; begin result := cbuftail; end;
 126 function cbufWalkEnd (pos: LongWord): LongWord; begin result := cbufhead; end;
 127 procedure cbufPrev (var pos: LongWord); inline; begin pos := (pos+ConBufSize-1) mod ConBufSize; end;
 128 procedure cbufNext (var pos: LongWord); inline; begin pos := (pos+1) mod ConBufSize; end;
 129
 130 function cbufAt (const pos: LongWord): Char; inline; begin result := cbuf[pos mod ConBufSize]; end;
 131
 132
 133 // ////////////////////////////////////////////////////////////////////////// //
 134 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
 135 var
 136   pos, pp: LongWord;
 137 begin
 138   if cbufhead = cbuftail then
 139   begin
 140     sp := cbufhead;
 141     ep := cbufhead+1;
 142     exit;
 143   end;
 144   pos := cbuftail;
 145   ep := pos;
 146   while pos <> cbufhead do
 147   begin
 148     pp := (pos+ConBufSize-1) mod ConBufSize;
 149     if cbuf[pp] = #10 then break;
 150     pos := pp;
 151   end;
 152   sp := pos;
 153 end;
 154
 155
 156 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
 157 var
 158   pos, pp: LongWord;
 159 begin
 160   if sp = cbufhead then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 161   pos := (sp+ConBufSize-1) mod ConBufSize;
 162   if (pos = cbufhead) or (cbuf[pos] <> #10) then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 163   ep := pos;
 164   while pos <> cbufhead do
 165   begin
 166     pp := (pos+ConBufSize-1) mod ConBufSize;
 167     if cbuf[pp] = #10 then break;
 168     pos := pp;
 169   end;
 170   sp := pos;
 171   result := true;
 172 end;
 173
 174
 175 procedure cbufClear ();
 176 begin
 177   cbuf[0] := #10;
 178   cbufhead := 0;
 179   cbuftail := 0;
 180   Inc(changeCount);
 181   if changeCount = 0 then changeCount := 1;
 182 end;
 183
 184
 185 begin
 186   cbuf[0] := #10;
 187 end.