QText Fast VGA text mode routines

qtext.pas

{
Quick Text routines 2.01d
(c) 1995 SSG

updates:
--------
18th Feb 95 - 02:02 - Success...this was my first attempt to write a text
                      mode engine... 
18th Feb 95 - 12:38 - Workin' w/o any bugs..
18th Feb 95 - 13:12 - Boosted code & fixed some bugs...
18th Feb 95 - 13:35 - Fixed a little bug in incy...
 2nd Mar 95 - 12:27 - Added qIsKey function...
 2nd Mar 95 - 13:18 - Fixed a little bug in writer routine...
14th May 95 - 20:44 - Rewritten and optimized all the code...
23rd Nov 95 - 20:22 - Fixed a minor bug..
23rd Nov 95 - 20:35 - Muhahaha...
23rd Nov 95 - 20:41 - Fixed a bug in qwrite
 2nd Mar 96 - 14:31 - Added qCenter...
21st Dec 96 - 01:54 - Added qblink...
21st Dec 96 - 03:23 - Added qerase...
 8th Jun 97 - 17:55 - Added qPaint...
 9th Jun 97 - 11:39 - Fixed a bug...
13th Aug 97 - 22:24 - added qclreol...
 8th Sep 97 - 19:13 - added vesasup..
}

{$R-,S-,O-,N-,E-}

unit QText;

interface

const

  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;

  DarkGray     =  8;
  LightBlue    =  9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;

  qAttr  : byte = 7;

procedure qWrite(const s:string);
procedure qWriteln(s:string);
procedure qCenter(s:string);
procedure qLocate(x,y:byte);
procedure qSetColor(fc,bc:byte);
procedure qCls;
procedure qClrEOL;
procedure qSetFC(fc:byte);
procedure qSetBC(bc:byte);
procedure qSetBlink(ablink:boolean);
procedure qNL;
procedure qScrollUp;
procedure qSetMode(amode:byte);
procedure qCursor(enable:boolean);
procedure qVGABlink(enable:boolean);
procedure qErase(x1,y1,x2,y2:byte);
procedure qPaint(x1,y1,x2,y2,attr:byte);
procedure qSetFont(var font);

function qSetVESAMode(width,height:byte):boolean;
function qGetVESAMode:word;
function qWhere:word;
function qX:byte;
function qY:byte;
function qXSize:byte;
function qYSize:byte;

function qGetKey:word;
function qGetChar:char;
function qIsKey:boolean;

implementation

uses

  XVESA;

function qGetVESAMode;
begin
  if not VESAInstalled then qGetVESAMode := $FFFF else qGetVESAMode := VESAGetMode;
end;

function qSetVESAMode;
var
  mi:TVESAModeInfo;
  w:word;
begin
  qSetVESAMode := false;
  for w:=$100 to $1ff do begin
    if VESAGetModeInfo(w,mi) then begin
      if mi.Attr and vmaGraphics = 0 then begin
        if (width=mi.XSize) and (height=mi.YSize) then begin
          qSetVESAMode := true;
          VESASetMode(w);
          exit;
        end;
      end;
    end;
  end;
end;

procedure qClrEOL;
begin
  qErase(qX,qY,qXSize-1,qY);
end;

procedure qSetFont(var font);assembler;
asm
  jmp  @Init
@Init:
  mov  ax,SegA000
  mov  es,ax
  push ds
  lds  si,font
  xor  di,di

  mov  dx,3dah
  in   al,dx
  xor  al,al
  mov  dx,3c0h
  out  dx,al

  mov  dx,3c4h
  mov  ax,0402h
  out  dx,ax
  mov  ax,0704h
  out  dx,ax

  mov  dx,3ceh
  mov  ax,0204h
  out  dx,ax
  mov  ax,0005h
  out  dx,ax
  mov  ax,0406h
  out  dx,ax

  mov  cx,256
@loop1:
  push cx
  mov  cx,10h
  rep  movsb
  add  di,10h
  pop  cx
  loop @loop1

  mov  dx,3c4h
  mov  ax,0302h
  out  dx,ax
  mov  ax,0304h
  out  dx,ax

  mov  dx,3ceh
  mov  ax,0004h
  out  dx,ax
  mov  ax,1005h
  out  dx,ax
  mov  ax,0e06h
  out  dx,ax

  mov  dx,3dah
  in   al,dx
  mov  dx,3c0h
  mov  al,20h
  out  dx,al

  pop  ds
end;

const

  wXSize = $4a;
  wYSize = $84;
  wMode  = $49;

  cursor : boolean = true;

procedure qPaint;
var
  x,y:byte;
begin
  for x:=x1 to x2 do for y:=y1 to y2 do
    Mem[SegB800:(y*qXSize)+(x*2)+1] := attr;
end;

procedure qErase;assembler;
asm
  call qXSize
  cld
  xor  dh,dh
  mov  dl,al
  xor  ah,ah
  mul  y1
  mov  bl,x1
  xor  bh,bh
  add  ax,bx
  shl  ax,1
  mov  di,ax
  xor  ah,ah
  mov  al,x2
  sub  ax,bx
  inc  ax
  mov  bx,ax {line length}
  sub  dx,ax {words to skip}
  shl  dx,1
  mov  ah,y1
  mov  al,y2
  sub  al,ah
  inc  al
  xor  ah,ah
  mov  cx,ax
  push SegB800
  pop  es
  mov  ah,qAttr
  mov  al,32
@loop:
  push cx
  mov  cx,bx
  rep  stosw
  add  di,dx
  pop  cx
  loop @loop
end;

procedure qSetBlink;assembler;
asm
  mov al,qAttr
  and al,$7f
  mov ah,ablink
  shl ah,7
  or  al,ah
  mov qAttr,al
end;

procedure qVGABlink;assembler;
asm
  mov  dx,3dah
  in   al,dx {reset flip/flop of attribute controller}
  mov  dx,3c0h
  mov  al,10h
  out  dx,al
  mov  al,enable
  mov  ah,4
  or   al,al
  je   @skip
  or   ah,8
@skip:
  mov   al,ah
  out   dx,al
end;

procedure qCursor;assembler;
asm
  mov  ah,1
  mov  ch,14
  xor  cl,cl
  mov  cursor,false
  cmp  enable,false
  je   @skip
  mov  cl,15
  mov  cursor,true
@skip:
  int  10h
end;

function qXSize;assembler;
asm
  mov ax,seg0040
  mov es,ax
  mov al,byte ptr es:wXSize
end;

function qYSize;assembler;
asm
  mov ax,seg0040
  mov es,ax
  mov al,byte ptr es:wYSize
  inc al
end;

function qIsKey;assembler;
asm
  xor bh,bh
  mov ah,1
  int 16h
  je  @Fuck
  inc bh
@Fuck:
  mov al,bh
end;

procedure qSetMode;assembler;
asm
  xor ah,ah
  mov al,amode
  int 10h
  mov qAttr,7
end;

procedure qScrollUp;assembler;
asm
  cld
  push ds
  mov  ax,seg @Data
  mov  ds,ax
  mov  ah,qAttr
  push ax
  mov  ax,Seg0040
  mov  es,ax
  mov  dl,byte ptr es:wXSize
  mov  dh,byte ptr es:wYSize
  push SegB800
  pop  ds
  xor  ah,ah
  mov  al,dl
  shl  ax,1
  mov  si,ax
  xor  di,di
  shr  ax,1
  mul  dh
  mov  cx,ax
  rep  movsw

  mov  bx,seg @Data
  mov  ds,bx
  mov  di,ax
  shl  di,1
  pop  ax
  xor  al,al
  xor  ch,ch
  mov  cl,dl
  rep  stosw
  pop  ds
end;

procedure qWrite(const s:string);assembler;
asm
  jmp  @Init
@XSize:
  db   0
@IncY:
  cmp  bh,dh
  jb   @Incit
  push es
  pusha
  call qScrollUp
  popa
  pop  es
  push ax
  xor  ah,ah
  mov  al,bl
  shl  ax,1
  sub  di,ax
  pop  ax
  jmp  @XOk
@Incit:
  push dx
  xor  dh,dh
  shl  dx,1
  add  di,dx
  pop  dx
  inc  bh
  jmp  @XOk
@Init:
  cld
  push ds
  call qWhere
  mov  bx,ax
  mov  ax,seg @data
  mov  ds,ax
  mov  ax,seg0040
  mov  es,ax
  mov  dh,byte ptr es:wYSize
  mov  dl,byte ptr es:wXSize
  mov  ah,qAttr

  push SegB800
  pop  es

  lds  si,s
  mov  cl,ds:[si]
  or   cl,cl
  jz   @Exit
  push ax
  xor  ch,ch
  inc  si
  xor  di,di
  xor  ah,ah
  mov  al,bh
  mul  dl
  mov  di,ax
  xor  ah,ah
  mov  al,bl
  add  di,ax
  shl  di,1
  pop  ax
@Loop:
  lodsb
  cmp  al,32
  jae  @WriteIt
  cmp  al,8
  jne  @Other
  or   bl,bl
  jz   @Other
  dec  bl
  sub  di,2
  jmp  @XOk
@Other:
  cmp  al,13
  jne  @Another
  push ax
  mov  al,bl
  shl  al,1
  xor  ah,ah
  sub  di,ax
  xor  bl,bl
  pop  ax
  jmp  @Xok
@Another:
  cmp  al,10
  jne  @XOk
  jmp  @IncY
@WriteIt:
  stosw
  inc  bl
  cmp  bl,dl
  jbe  @XOk
  xor  bl,bl
  jmp  @IncY
@XOk:
  loop @Loop
  mov  ah,2
  mov  dx,bx
  xor  bh,bh
  int  10h
@Exit:
  pop  ds
end;

procedure qNL;assembler;
asm
  call qWhere
  mov  bx,seg0040
  mov  es,bx
  mov  bl,byte ptr es:wYSize
  xor  al,al
  cmp  ah,bl
  jb   @Exit
  dec  ah
  push ax
  call qScrollUp
  pop  ax
@Exit:
  inc  ah
  mov  dx,ax
  xor  bh,bh
  mov  ah,2
  int  10h
end;

function qGetChar;assembler;
asm
  xor ah,ah
  int 16h
end;

function qGetKey;assembler;
asm
  xor ah,ah
  int 16h
end;

function qX;assembler;
asm
  call qWhere
end;

function qY;assembler;
asm
  call qWhere
  mov  al,ah
end;

procedure qSetBC;assembler;
asm
  and  qAttr,$0F
  mov  al,bc
  shl  al,4
  or   qAttr,al
end;

procedure qSetFC;assembler;
asm
  and  qAttr,$F0
  mov  al,fc
  or   qAttr,al
end;

function qWhere;assembler;
asm
  mov  ah,3
  xor  bh,bh
  int  10h
  mov  ax,dx
end;

procedure qWriteln(s:string);
begin
  qWrite(s+#13#10);
end;

procedure qLocate(x,y:byte);assembler;
asm
  mov  ah,2
  xor  bh,bh
  mov  dh,y
  mov  dl,x
  int  10h
end;

procedure qSetColor(fc,bc:byte);assembler;
asm
  mov  al,bc
  shl  al,4
  or   al,fc
  mov  qAttr,al
end;

procedure qCls;assembler;
asm
  cld
  mov  ax,seg0040
  mov  es,ax
  xor  ah,ah
  mov  al,byte ptr es:wXSize
  mov  bl,byte ptr es:wYSize
  inc  bl
  mul  bl
  mov  cx,ax
  xor  di,di

  push SegB800
  pop  es

  xor  al,al
  mov  ah,qAttr
  rep  stosw
  mov  ah,2
  xor  bh,bh
  xor  dx,dx
  int  10h
end;

procedure qCenter;
begin
  qLocate(((qXSize-length(s)) div 2)-1,qY);
  qWrite(s);
end;

end.