src/shared/conbuf.pas

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