Results 1 to 8 of 8

Thread: Faster CRT updates

  1. #1

    Faster CRT updates

    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.

  2. #2

    Faster CRT updates

    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.

  3. #3

    Faster CRT updates

    Look at the "Enhanced" CRT stuff in: http://valkyrie.chaosforge.org/

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

  4. #4

    Faster CRT updates

    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 .

  5. #5

    Faster CRT updates

    No problem Jeremy. You going for a virtual console, or a double buffered console implementation?

  6. #6

    Faster CRT updates

    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:[pascal]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 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 ;
    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.[/pascal]

  7. #7

    Faster CRT updates

    Im using http://math.ubbcluj.ro/~sberinde/wingraph/ to show tons of runtime info

    very good
    From brazil (:

    Pascal pownz!

  8. #8

    Faster CRT updates

    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.

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •