Board index » delphi » Fast PutCharacter Procedure &/or remove cursor procedure

Fast PutCharacter Procedure &/or remove cursor procedure

I am writing a Lord II type game and need the following things,

I am looking for a very fast put character procedure some thing like :-
Procedure putchar(x, y : byte; character : char; Forecolor, Backcolor :
byte);
Or a Put Block of chars with the abouve individual characterististics.

And I am also looking for a small (doesnt have to be fast because its
only used once)
Cursor remove procedure.

Thank-you,

--
__________________________________________________
|                      Oliver
Batchelor                                                   |
|          Email :
Ba...@netaccess.co.nz                                         |
|Homepage :
http://users.netaccess.co.nz/Batch/                           |
|_________________________________________________|

 

Re:Fast PutCharacter Procedure &/or remove cursor procedure


Oliver Batchelor in <3570A7A8.842F4...@netaccess.co.nz> ...

Quote
>I am looking for a very fast put character procedure some thing like :-
>Procedure putchar(x, y : byte; character : char; Forecolor, Backcolor
:byte);
>Or a Put Block of chars with the abouve individual characterististics.

var VideoBuff:array[1..80,1..25] of record Symb, Attr:byte end absolute
$B800:0000;
procedure putchar(x, y : byte; character : char; Forecolor, Backcolor
:byte);
begin
   with VideoBuff[x,y] do
        begin
             Symb:=byte(character);
             Attr:=ForeColor+BackColor SHL 4;
        end;
end;
It's an fastest algorythm with direct writing in the video memory.
Quote
>And I am also looking for a small ... Cursor remove procedure.

procedure CursorHide; assembler;
asm
    mov ch,32
    mov ah,1
    int 10h
end;
procedure CursorShow; assembler;
asm
    mov cl,12
    mov ch,13
    mov ah,1
    int 10h
end;
Good luck!

Harry Poloscov
olsi...@chat.ru
---- Processor not found. System halted ----

Re:Fast PutCharacter Procedure &/or remove cursor procedure


Quote
Oliver Batchelor wrote:
> I am looking for a very fast put character procedure some thing like :-
> Procedure putchar(x, y : byte; character : char; Forecolor, Backcolor :
> byte);
> Or a Put Block of chars with the abouve individual characterististics.
> And I am also looking for a small (doesnt have to be fast because its
> only used once)
> Cursor remove procedure.

My FASTCRT unit has routines in it that do both of those, as well as a fast
string write, the option for ANSI code parsing, a new keyboard handler, and
a delay routine (without the annoying P2 bug)

DEATHSHADOW -v-v-

Here it is:

--cut--
{ tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
         FASTCRT.PAS - Release 2.1 - Turbo Pascal Version
         High Speed ASM VIDEO/KEYBOARD Interface Routines
             by Jason M. Knight, Paladin Systems North

    History:
      TP6/7 Version August 1995, Last update Feb 98
      GNU Pascal Version January 1997, Last update Feb 98
      FPK Pascal Version Febuary 1998.
  tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt }

unit fastcrt;

interface

uses
  dos;

const
  { screen modes }
  bw40 = 0;
  co40 = 1;
  bw80 = 2;
  co80 = 3;
  mono = 7;
  font8x8 = 256;
  { screen color, fore- and background }
  black = 0;
  blue = 1;
  green = 2;
  cyan = 3;
  red = 4;
  magenta = 5;
  brown = 6;
  lightgray = 7;
  { only foreground }
  darkgray = 8;
  lightblue = 9;
  lightgreen = 10;
  lightcyan = 11;
  lightred = 12;
  lightmagenta = 13;
  yellow = 14;
  white = 15;
  { blink flag }
  blink = $80;
  {key_string constant Identifies key_map values}
  key_string:array[0..127] of string[11]=('Null','Esc','1!','2@','3#','4$',

    '5%','6^','7&','8*','9(','0)','=+','-_','Backspace','Tab','Q','W','E',
    'R','T','Y','U','I','O','P','[{',']}','Enter','Ctrl','A','S',
    'D','F','G','H','J','K','L',';:','"','`~','Left Shift','|\','Z','X',
    'C','V','B','N','M',',<','>.','/?','Right Shift','Print
Screen','Alt','Space',
    'Caps','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10','Num
Lock','Scroll Lock',
    'Home','Up','PgUp','KeyPad -','Left','Center','Right','KeyPad +','End',

'Down','PgDn','Insert','Delete','U84','U85','U86','F11','F12','U89','U90',

'U91','U92','U93','U94','U95','U96','U97','U98','U99','U100','U101','U102',

    'U103','U104','U105','U106','U107','U108','U109','U110','U111','U112',
    'U113','U114','U115','U116','U117','U118','U119','U120','U121','U122',
    'U123','U124','U125','U126','u127');

type
  key_maptype=array[0..127] of boolean;
  pkey_maptype=^key_maptype;

var
  key_map:pkey_maptype;
  vid_mode,vid_seg,vid_page,vid_crtc,
  vid_width,vid_height,vid_size,vid_bytesperline:word;
  vid_cursorx,vid_cursory:integer;
  key_lights,vid_color:byte;
  vid_mono,vid_cursorshowing,vid_blink:boolean;

{ high speed / low level video control routines
  I didn't use the same names as TP for consistancy with my GPC/FPK
version,
  as well as to prevent confusion as to which routines are in use }
procedure vid_blinkingtexton;
procedure vid_blinkingtextoff;
procedure vid_clrscr;
procedure vid_clearEOL;
procedure vid_cursoron;
procedure vid_cursoroff;
procedure vid_gotoxy(x,y:word);
procedure vid_outchar(x,y:word; chr:char);
procedure vid_outstring(x,y:word; st:string);
procedure vid_scrollwindow(x1,y1,x2,y2:word);
procedure vid_scrollscreen;
procedure vid_setbgcolor(b:byte);
procedure vid_setcolor(b:byte);
procedure vid_setmode(m:byte);
procedure vid_textbox(x1,y1,x2,y2:word; s:byte);
{ both of the vid_write routines do direct output to the screen printing
all
  'Non-printing' characters (codes 0..31). Both of the WriteAnsi routines
  parse all valid ANSI codes }
procedure vid_write(st:string);
procedure vid_writeansi(st:string);
procedure vid_writeln(st:string);
procedure vid_writelnansi(st:string);
{ the next 2 routines stop key_read from working, and prevents data from
being
 stored in the keyboard buffer. Allows use of the key_map^ array for games.

 Only has an effect after Key_initmapper; }
procedure Key_BufferOff;
procedure Key_BufferOn;
{ The next 2 routines turn on and off my keyboard ISR. When the ISR is on
  the array key_map^ stores whether keys are being held down. Keypressed
and
  key_read both continue to function normally }
procedure Key_InitMapper;
function Key_pressed:boolean;
function Key_read:char;
{If you run InitMapper, key_term will automatically run on Exit}
procedure Key_term; far;

function time_longint:longint; {returns Time as a longint}
procedure time_delay(ms:longint);

{my own string and numeric conversion routines}
function hex2int(st:string):longint;
function int2hex(l:longint):string;
function real2str(n:real; Dig,Dec:byte):string; {dig,dec = n:dig:dec}
function int2str(n:longint; digits:byte):string; {n:digits}
function str2int(st:string):longint;
function str2real(st:string):real;
function locasestr(np:string):string;
function upcasestr(np:string):string;

implementation

type
  ansiflagtype=record
    Bold,Underscore,Blink,Reverse,Concealed,
    Calc,InQuotes:boolean;
  end;
  pstring=^string;
  lineinfotype=array[0..8] of char;
  keybuftype=array[0..255] of byte;
  pkeybuftype=^keybuftype;

const
  ansi_color:array[0..7] of byte=(0,4,2,6,1,5,3,7);
  BoxHorztop: lineinfotype=('?','','?','','','','','','2');
  BoxHorzbot: lineinfotype=('?','','?','','?','?','','','2');
  BoxVerleft: lineinfotype=('3','o','o','3','Y','?','','','2');
  Boxverright:lineinfotype=('3','o','o','3','T','?','','','2');
  Boxtopleft: lineinfotype=('','','?','?','','','','','2');
  Boxtopright:lineinfotype=('?','?','','?','','','','','2');
  Boxbotleft: lineinfotype=('','','','?','?','?','','','2');
  Boxbotright:lineinfotype=('','?','?','?','?','?','','','2');
  keydecode:array[0..127] of char=
     (' ',#27,'1','2','3','4','5','6','7','8','9','0','-','=',#08,#09,
      'q','w','e','r','t','y','u','i','o','p','[',']',#13,' ','a','s',
      'd','f','g','h','j','k','l',';',#39,'`',' ','\','z','x','c','v',
      'b','n','m',',','.','/',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
      ' ',#27,'!','@','#','$','%','^','&','*','(',')','_','+',#08,#09,
      'Q','W','E','R','T','Y','U','I','O','P','{','}',#13,' ','A','S',
      'D','F','G','H','J','K','L',':','"','~',' ','|','Z','X','C','V',
      'B','N','M','<','>','?',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ');

var
  oldexitproc:pointer;
  ansifilter:pstring;
  savex,savey:word;
  ansi_flags:ansiflagtype;
  key_buf_active,key_caps_lock,key_num_lock,
  key_scroll_lock,key_intactive:boolean;
  keybuf:pkeybuftype;
  key_next,key_bufnumber,key_bufstart,key_bufend:byte;
  oldint9:pointer;
  delayscale:longint;

function time_longint:longint;
var
  h,m,s,n:word;
begin
  gettime(h,m,s,n);
  time_longint:=(longint(longint(longint(longint(h*60)+m)*60+s)*100)+n);
end;

function hex2int(st:string):longint;
var
  t:word;
  l:longint;
begin
  t:=0;
  l:=0;
  while t<length(st) do begin
    inc(t);
    l:=l shl 4;
    case st[t] of
      #48..#57:l:=l+(byte(st[t])-48);
      #65..#70:l:=l+(byte(st[t])-55);
      #97..#102:l:=l+(byte(st[t])-87);
    end;
  end;
  hex2int:=l;
end;

function int2hex(l:longint):string;
var
  b:byte;
  c,a:longint;
  st:string;
begin
  c:=l;
  st:='';
  while c>0 do begin
    b:=c and $0F;
    case b of
      0..9:st:=st+chr(48+b);
      10..15:st:=st+chr(55+b);
    end;
    c:=c shr 4;
  end;
  int2hex:=st;
end;

function real2str(n:real; Dig,Dec:byte):string;
var
  st:string;
begin
  str(n:dig:Dec,st);
  real2str:=st;
end;

function locasestr(np:string):string;
var
  t:word;
  st:string;
begin
  t:=0;
  st:=np;
  while t<length(st) do begin
    inc(t);
    case st[t] of
      'A'..'Z':st[t]:=char(byte(st[t])+32);
    end;
  end;
  locasestr:=st;
end;

function upcasestr(np:string):string;
var
  t:word;
  st:string;
begin
  t:=0;
  st:=np;
  while t<length(st) do begin
    inc(t);
    case st[t] of
      'a'..'z':st[t]:=chr(byte(st[t])-32);
    end;
  end;
  upcasestr:=st;
end;

function str2int(st:string):longint;
var
  t:longint;
  n:word;
begin
  val(st,t,n);
  str2int:=t;
end;

function str2real(st:string):real;
var
  t:real;
  n:word;
begin
  val(st,t,n);
  str2real:=t;
end;

function int2str(n:longint; digits:byte):string;
var
  st:string;
begin
  str(n:digits,st);
  int2str:=st;
end;

procedure jmove(var p1,p2; size:word); assembler; {source dssi,dest esdi}
asm
    mov    ax,size
    mov    cx,ax
    push   ds
    lds    si,p1
    les    di,p2
    shr    cx,2
    jz     @testbyte
    cli
    db     $66
    rep    movsw
    sti
  @testbyte:
    and    ax,3
    jz     @endit
  @dobyte:
    mov    cx,ax
    rep    movsb
  @endit:
    pop    ds
end;

procedure jfillword(var p1; size:word; chr:char; color:byte); assembler;
asm
  mov    cx,size
  shr    cx,1
  mov    al,chr
  mov    ah,color
  les    di,p1
  rep    stosw
end;

procedure hardmove(x,y:byte);
var
  pos:word;
begin
  { write values to bios table }
  mem[$40:$51]:=y;
  mem[$40:$50]:=x;
  pos:=(x+(y*vid_width));
  { position the cursor on the 6845 }
  port[vid_crtc]:=$0e;
  port[vid_crtc+1]:=HI(pos);
  port[vid_crtc]:=$0f;
  port[vid_crtc+1]:=LO(pos);
end;

procedure reset_ansiflags(checkcolor:boolean);
begin
  with ansi_flags do begin
    if checkcolor then begin
      if vid_mono then begin
        if underscore then vid_color:=vid_color and (not($01));
      end else begin
        if bold then vid_color:=vid_color and (not($08));
        if blink then vid_color:=vid_color and (not($80));
      end;
      if reverse then vid_color:=(vid_color shr 4) or (vid_color shl 4);
    end;
    bold:=false;
    Underscore:=false;
    Blink:=false;
    Reverse:=false;
    Concealed:=false;
    calc:=false;
    inquotes:=false;
  end;
end;

procedure vid_cursoroff;
begin
  hardmove(0,vid_height+2);
...

read more »

Other Threads