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 {$IFDEF HEADLESS}
  64 var
  65   needCon: Boolean = true;
  66 {$ENDIF}
  67 procedure cbufPutChars (buf: PChar; count: Integer);
  68 var
  69   np: LongWord;
  70   ch, och: Char;
  71 begin
  72   if count > 0 then
  73   begin
  74 {$IFDEF HEADLESS}
  75     //write(stderr, 'CON: ');
  76     for np := 0 to count-1 do
  77     begin
  78       if needCon then begin write(stdout, 'CON: '); needCon := false; end;
  79       write(stdout, buf[np]);
  80       needCon := (buf[np] = #10);
  81     end;
  82 {$ENDIF}
  83     Inc(changeCount);
  84     if changeCount = 0 then changeCount := 1;
  85     while count > 0 do
  86     begin
  87       Dec(count);
  88       ch := buf^;
  89       Inc(buf);
  90       np := (cbuftail+1) mod ConBufSize;
  91       if np = cbufhead then
  92       begin
  93         // we have to make some room; delete top line for this
  94         while true do
  95         begin
  96           och := cbuf[cbufhead];
  97           cbufhead := (cbufhead+1) mod ConBufSize;
  98           if (cbufhead = np) or (och = #10) then break;
  99         end;
 100       end;
 101       cbuf[np] := ch;
 102       cbuftail := np;
 103     end;
 104   end;
 105 end;
 106
 107
 108 procedure cbufPut (const s: AnsiString);
 109 begin
 110   if length(s) > 0 then cbufPutChars(@s[1], length(s));
 111 end;
 112
 113
 114 // ////////////////////////////////////////////////////////////////////////// //
 115 // warning! don't modify conbuf while the range is active!
 116 function cbufWalkStart (): LongWord; begin result := cbuftail; end;
 117 function cbufWalkEnd (pos: LongWord): LongWord; begin result := cbufhead; end;
 118 procedure cbufPrev (var pos: LongWord); begin pos := (pos+ConBufSize-1) mod ConBufSize; end;
 119 procedure cbufNext (var pos: LongWord); begin pos := (pos+1) mod ConBufSize; end;
 120
 121 function cbufAt (const pos: LongWord): Char; begin result := cbuf[pos mod ConBufSize]; end;
 122
 123
 124 // ////////////////////////////////////////////////////////////////////////// //
 125 procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
 126 var
 127   pos, pp: LongWord;
 128 begin
 129   if cbufhead = cbuftail then
 130   begin
 131     sp := cbufhead;
 132     ep := cbufhead+1;
 133     exit;
 134   end;
 135   pos := cbuftail;
 136   ep := pos;
 137   while pos <> cbufhead do
 138   begin
 139     pp := (pos+ConBufSize-1) mod ConBufSize;
 140     if cbuf[pp] = #10 then break;
 141     pos := pp;
 142   end;
 143   sp := pos;
 144 end;
 145
 146
 147 function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
 148 var
 149   pos, pp: LongWord;
 150 begin
 151   if sp = cbufhead then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 152   pos := (sp+ConBufSize-1) mod ConBufSize;
 153   if (pos = cbufhead) or (cbuf[pos] <> #10) then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
 154   ep := pos;
 155   while pos <> cbufhead do
 156   begin
 157     pp := (pos+ConBufSize-1) mod ConBufSize;
 158     if cbuf[pp] = #10 then break;
 159     pos := pp;
 160   end;
 161   sp := pos;
 162   result := true;
 163 end;
 164
 165
 166 procedure cbufClear ();
 167 begin
 168   cbuf[0] := #10;
 169   cbufhead := 0;
 170   cbuftail := 0;
 171   Inc(changeCount);
 172   if changeCount = 0 then changeCount := 1;
 173 end;
 174
 175
 176 begin
 177   cbuf[0] := #10;
 178 end.