PDA

View Full Version : Faster CRT updates



jdarling
09-11-2007, 01:20 PM
Its been a long time since I had to do any console work outside of the typical log screen, but have found myself in a position that requires some high speed console updates. I started with the typical FPC CRT unit but find its performance less then satisfactory.

The last time I had to do something like this was back in the old TP and BP days when you could simply perform direct memory writes. After some trial and error I came to the realization that you can't do that anymore :(.

So, I was wondering, does anyone know of a library or have code to share for fast updates? I'd like it to be pure pascal as a solution, but if I have to I guess I could use open curses or ncurses.

waran
09-11-2007, 02:08 PM
You can, of course, still do direct memory writes. The problem here is that
whilst DOS-Windows allow that, the NT-Windows won't (Application will crash).

You could run your app in kernel-mode.

Robert Kosek
09-11-2007, 02:40 PM
Look at the "Enhanced" CRT stuff in: http://valkyrie.chaosforge.org/ :D

You could also abstract it to include things like double-buffering and virtual windows if you wanted.

jdarling
09-11-2007, 06:39 PM
Thanks Robert thats exactly the pointer that I needed :). Looking around turned up the Video library and that gave me all the information I needed to implement a much faster rendering routine :).

Robert Kosek
09-11-2007, 06:54 PM
No problem Jeremy. You going for a virtual console, or a double buffered console implementation?

jdarling
09-11-2007, 07:53 PM
Heck, I don't know just needed a fast wrapper around screen displays. Seems using the Video unit gives you double buffering by default though, so I guess I went for double buffered :). My implementation follows in case anyone is curious:unit uScreen;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Video;

type
{
While you can create multiple versions of screen it is not a good idea,
instead think of it as a singleton object!

Structure of a screen cell
Bit: 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0
Binary Value: 128 | 64| 32| 16 | 8 | 4 | 2 | 1
Usage: Blink | Back Color | Fore Color
NOTE: Bit 3 (bin value 8) carries a special meaning in fore colors
as the high color indicator (also known as light)

Generic formula to take a Back Color and a Fore Color and come up with a
screen color:
((BackColor and $07) shl 4) or (ForeColor and $0f) or (Blink shl 7)

The next byte after the attribute byte is the character to be displayed
at that screen location. This is all contained nicely in the TScreenCell
record. See Screen.MakeAttribute for a convient attribute builder (no
support for blink).
}
PScreenCell = ^TScreenCell;
TScreenCell = packed record
Character : Char;
Attributes : Byte;
end;

{ TScreen }

TScreen = class
private
FScreenSize : DWord;
FClearCell : TScreenCell;
function GetCell(x, y : word): PScreenCell;
function GetClearCell: PScreenCell;
function GetCols: Word;
function GetRows: Word;
function GetScanLine(y : word): pointer;
public
constructor Create;
destructor Destroy; override;

procedure SetSize(const NewCols, NewRows : Word); // Resize the console window

procedure HideCursor; // Hides the console cursor
procedure ShowCursor; // Shows the console cursor

procedure Clear; // Clear the screen NOTE: Clear does not call update
procedure Update; // Display any changes that have been made

// Write a string to the screen starting at x, y and wrapping when necessary to the next line
procedure Write(const x, y : Word; Msg : AnsiString; ForeColor : byte = 7; BackColor : byte = 0);
// Set a cell on the screen to the given character and attributes
procedure SetCell(const x, y : Word; const ch : Char; const attr : Word);
// Create a valid attribute byte from the fore and back colors specified
function MakeAttribute(const ForeColor, BackColor : Byte) : Byte;

property Rows : Word read GetRows; // Number of rows on the screen
property Cols : Word read GetCols; // Number of cols on the screen
property Cell[x, y : word] : PScreenCell read GetCell; // Direct access to screen cell
property ScanLine[y : word] : pointer read GetScanLine;// Direct access to screen row
property ClearCell : PScreenCell read GetClearCell; // Default clear information
end;

var
Screen : TScreen;

implementation

var
FVideoInfo : TVideoMode;

{ TScreen }

function TScreen.GetCols: Word;
begin
result := FVideoInfo.Col;
end;

function TScreen.GetCell(x, y : word): PScreenCell;
begin
result := PScreenCell(@(VideoBuf^[(x-1)+(y-1)*FVideoInfo.Col]));
end;

function TScreen.GetClearCell: PScreenCell;
begin
result := @FClearCell;
end;

function TScreen.GetRows: Word;
begin
result := FVideoInfo.Row;
end;

function TScreen.GetScanLine(y : word): pointer;
begin
result := @(VideoBuf^[(y-1)*FVideoInfo.Col]);
end;

constructor TScreen.Create;
begin
InitVideo;
FVideoInfo.Col := 80;
FVideoInfo.Row := 25;
FVideoInfo.Color := true;
SetVideoMode(FVideoInfo);
FScreenSize:= FVideoInfo.Col * FVideoInfo.Row;
FClearCell.Character:= #32;
FClearCell.Attributes:= 7;
HideCursor;
end;

destructor TScreen.Destroy;
begin
ShowCursor;
inherited Destroy;
end;

procedure TScreen.SetSize(const NewCols, NewRows: Word);
var
oldInfo : TVideoMode;
begin
oldInfo := FVideoInfo;
FVideoInfo.Col := NewCols;
FVideoInfo.Row := NewRows;
if not SetVideoMode(FVideoInfo) then
begin
//SetVideoMode(oldInfo);
FVideoInfo := oldInfo;
end;
FScreenSize:= FVideoInfo.Col * FVideoInfo.Row;
end;

procedure TScreen.HideCursor;
begin
SetCursorType(crHidden);
end;

procedure TScreen.ShowCursor;
begin
SetCursorType(crUnderLine);
end;

procedure TScreen.Clear;
begin
FillWord(VideoBuf^, FScreenSize, Word(FClearCell));
end;

procedure TScreen.Update;
begin
UpdateScreen(False);
end;

procedure TScreen.Write(const x, y: Word; Msg: AnsiString; ForeColor: byte;
BackColor: byte);
var
pc1, // Holds the current cell pointer for the screen
pc2 : PChar; // Holds the source string to be placed on the screen
fb : Byte; // Holds the fill byte for the attribute part of the screen cell
i, // Generic indexer
l : Integer;// Length of the message in case a #0 has been embedded in it
begin
pc1 := scanline[y];
inc(pc1, (x-1)*2);
pc2 := PChar(Msg);
fb := ((BackColor and $07) shl 4) or (ForeColor and $0f);
i := 0;
l := Length(Msg);
if l > FScreenSize - ((x-1)+(y-1)*FVideoInfo.Col) then
l := FScreenSize - ((x-1)+(y-1)*FVideoInfo.Col);
while i < l do
begin
pc1^ := pc2^;
inc(pc1);
pc1^ := Char(fb);
inc(pc1);
inc(pc2);
inc(i);
end;
end;

procedure TScreen.SetCell(const x, y: Word; const ch: Char; const attr: Word);
begin
VideoBuf^[(x-1)+(y-1)*FVideoInfo.Col] := ord(ch)+(attr shl 8);
end;

function TScreen.MakeAttribute(const ForeColor, BackColor: Byte): Byte;
begin
result := ((BackColor and $07) shl 4) or (ForeColor and $0f);
end;

initialization
Screen := TScreen.Create;

finalization
if assigned(Screen) then
Screen.Free;
Screen := nil;

end.

arthurprs
10-11-2007, 01:08 AM
Im using http://math.ubbcluj.ro/~sberinde/wingraph/ to show tons of runtime info

very good

jdarling
12-11-2007, 12:24 PM
I looked at WinGraph but its focus is on Graphics and not Text. Great piece of work though, and I plan on looking at it for a future project.