Contributor: WILLIAM ARTHUR BARATH
Unit Hardware;
{$o+}
{ This source is Copyright 1994 by William Arthur Barath
Permission to use parts of this program is freely granted
for NON-COMMERCIAL programs, however, if you want to use
any of this in a commercial program, you are required to
either give me visible credit in your program's startup,
or send me 10ドル.}
{**************************************************************************
**}
Interface
{**************************************************************************
**}
Type
Tpointer= Record
pOfs,pSeg:Word;
end;
Var
Timer : Word Absolute 0000ドル:046ドルc;
Procedure Wait(t:Word);
{waits for a specified number of ticks to pass. 18/second}
Procedure VideoMode(M:Word);
{set the current video display adapter display mode}
Procedure GetRGB(reg:Word;Var R;Var G;Var B);
Procedure SetRGB(register:Word;Red,Green,Blue:Byte);
{set the color of the specified DAC register; RGB in 0..63}
Procedure WaitHBL;
{Wait for _start_ of horizontal blanking interval}
Procedure WaitVBL;
{Wait for _start_ of vertical blanking interval}
Procedure WaitBeamPos(Line:Word);
{wait for the CRT to display the given raster line}
Function Readkey:Char;
{similar to CRT unit}
Function Keypressed:Boolean;
{similar to CRT unit}
procedure beep(n,d:Byte);
{Like Sound in CRT unit}
Procedure OutTextXYB(Var s:String;x,y,c:Byte);
{Place string at Text cursor positions on Graphics screen}
{Uses the BIOS; big numbers, slow, on Text column and row.}
{**************************************************************************
**}
Implementation
{**************************************************************************
**}
Procedure Wait(t:Word);
Var LastTick:Word;
Begin
LastTick:=Timer;
Repeat UNTIL (Timer-LastTick)>T;
end;
Procedure VideoMode(M:Word);Assembler;
asm
mov ax,m
Xor ah,ah
int 10h
end;
Procedure GetRGB(reg:Word;Var R;Var G;Var B);assembler;
asm
Mov ax,1015h {Function 10; palette functions}
Mov bx,reg { 15; read color register}
Int 10h {Video BIOS services}
Les di,r
Mov es:[di],dh {write red value}
Les di,g
Mov es:[di],ch {green value}
Les di,b
Mov es:[di],cl {blue value}
end;
procedure SetRGB(Register:Word;red,green,blue : byte); assembler;
asm
Mov dx,03c8h
Mov al,Byte PTR Register
Out dx,al
Inc dx
Mov al,red
Out dx,al
Mov al,green
Out dx,al
Mov al,blue
Out dx,al
end;
Procedure WaitHBL;assembler;
asm
Mov dx,03dah {offset to input port 1}
@1:
In al,dx
test al,01h {to make sure we get the most H. retrace,}
Jz @1 {we wait 'til we're displaying raster}
@2:
In al,dx
test al,01h {then exit when H. retrace is starting}
Jnz @2
end;
Procedure WaitVBL;assembler;
asm
Mov dx,03dah {offset to input port 1}
@1:
In al,dx
test al,08h {to make sure we get the most V. retrace,}
Jnz @1 {we wait 'til we're displaying raster}
@2:
In al,dx
test al,08h {then exit when V. retrace is starting}
Jz @2
end;
Procedure WaitBeamPos(Line:Word);assembler;
asm
Call WaitVBL;
Mov cx,Line
@l:
Call WaitHBL;
Loop @l
end;
Function Readkey:Char;Assembler;
asm
Xor ax,ax
Int 16h
Cmp al,00h
Jnz @1
Mov al,ah
Or al,80ドル
@1:
end;
Function KeyWaiting:Word;Assembler;
asm
Mov ax,0100h
int 16h
end;
Function Keypressed:Boolean;Assembler;
asm
Mov ax,0100h;
int 16h;
Mov al,False;
jz @1;
Inc al;
@1:
end;
procedure beep(n,d:Byte);
Var t:Word;
Begin
t:=timer;While t=timer do;
asm
mov al,0B6h
out 43h,al
in al,61h
or al,3
out 61h,al
mov dx,42h
mov al,d
out dx,al
mov al,n
out dx,al
end;
t:=timer;While t=timer do;
asm
in al,61h
and al,0FCh
out 61h,al
end;
end;
Procedure OutTextXYB(Var s:String;x,y,c:Byte);Assembler;
asm
Push bp
Mov ah,13h {BIOS write string at cursor}
Xor bh,bh {set display page 0}
Mov bl,c {attribute to write with; color of foreground}
Mov al,01h {write mode: update cursor, use set attribute}
Mov dl,x {set up position}
Mov dh,y
Les bp,s {set up pointer to string}
Mov cl,es:[bp] {set up length of string for write}
Xor ch,ch
Inc bp {adjust pointer to first character of string}
Int 10h {call the function}
Pop bp
end;
end.