Fast PutCharacter Procedure &/or remove cursor procedure 
Author Message
 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 :

|Homepage :
http://www.*-*-*.com/ ;                         |
|_________________________________________________|



Wed, 18 Jun 1902 08:00:00 GMT  
 Fast PutCharacter Procedure &/or remove cursor procedure


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

---- Processor not found. System halted ----



Wed, 18 Jun 1902 08:00:00 GMT  
 Fast PutCharacter Procedure &/or remove cursor procedure

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.
> 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}

    '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',',','.','/',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',

      '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

    cli
    db     $66
    rep    movsw
    sti

    and    ax,3


    mov    cx,ax
    rep    movsb

    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 »



Wed, 18 Jun 1902 08:00:00 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. fast putchar procedure and remove cursor procedure needed for lord II type game

2. Can I get Cursor result from stored procedure ?

3. How to return Cursor from Oracle Stored Procedure

4. Error creating cursor for stored procedure in InterBase

5. Calling a procedure within a procedure

6. HELP - calling a Procedure from with a Procedure??

7. re : main-->procedure coomunication + Menu Procedure

8. Using a Procedure within a Procedure?

9. Procedure as parameter in procedure

10. Extremly fast graphical procedure

11. passing procedures as arguments for another procedure in Turbo pascal

12. passing procedures as arguments for another procedure in Turbo pascal

 

 
Powered by phpBB® Forum Software