[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]
unit graphic;
{ By Nelson Chu 1993,94,95,96 - DOS mini version, to be included in SWAG.
{ This uint contains functions & procedures that I ususally need for
writing graphical programs in standard VGA mode. There may be some code
that are not useful. I just release it so that I don't have to include
the needed routines in my every other programs to SWAG. }
interface
type ScreenType=array[0..199,0..319] of byte;
pScreenType=^ScreenType;
palrecordtype = record { the Palette type, consists }
R,G,B:byte; end;
PALType=array[0..255] of palrecordtype;{ of 3 fields :
Red, Green & Blue values }
sintable = array[0..255] of shortint;
var vs,screen:pScreenType;
sine:sintable;
procedure SetCRTMode(Mode:word);
procedure FadeOut(pal:paltype; low,high,delay:byte);
procedure FadeIn(pal:paltype; low,high,delay:byte);
procedure LoadPAL(FileName:string; var pal:paltype; mix:boolean);
procedure HVline(x1,y1,len:word;color:byte;HV:boolean; screen:pScreenType);
procedure blacken(low,high:byte); {set all color's palette to zero}
procedure setcolor(c,r,g,b:byte);
procedure vSync;
procedure clearScreen(scr:pScreenType);
function VideoOK:boolean; {check for a VGA or MCGA}
Function VGA : Boolean;
procedure GetPal(var pal:palType; b,e:byte);
procedure Setpal(apal:paltype; b,e:byte);
procedure pset(x,y:word; color:byte);{pascal}
Procedure asmPset(Scr:pscreentype;x:Integer;y,Col:Byte);{asm}
{use direct array reference is faster, since every time you call the above
two proc., time wasted on pushing/poping registers.}
procedure copyscreen(ss,ds:pscreentype);
procedure fillbox(x1,y1,x2,y2:word; c: byte; screen:pscreentype);
procedure RotatePal(Var Pal : PALType; beginRec, endRec : byte);
procedure calSine(var sinbl:sintable);
procedure copybox(ss,ds:pscreentype; sx, sy, w, h, dx, dy:word);
implementation
procedure copyright; assembler;
label there;
asm
jmp there;
db 13,10,"Graphic Unit(Mini DOS version 1.3) by Nelson Chu 93-96",13,10
there:
end;
PROCEDURE dmove( var S, D; Cnt : Word ); ASSEMBLER;
ASM
MOV DX,DS
LDS SI,[S]
LES DI,[D]
MOV CX,[Cnt]
CLD
SHR CX,2
DB 66h
REP MOVSW
ADC CX,CX
REP MOVSB
MOV DS,DX
END;
procedure SetCRTMode(Mode:word); assembler; { as the name implies, it sets }
asm { the CRT's mode by calling int 10 }
mov ax,Mode;
int 10h
end;
procedure vSync; assembler; { used for smooth output }
label
l1, l2;
asm
{ cli}
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
{ sti}
end;
procedure FadeOut(pal:paltype; low,high,delay:byte);
var i,j:byte;
begin
for i:=31 downto 1 do
begin
Port[$3c8]:=low;
for j:= 0 to delay do;
vSync;
for j:=low to high do
begin
Port[$3c9]:=(pal[j].R*i) div 32;
Port[$3c9]:=(pal[j].G*i) div 32;
Port[$3c9]:=(pal[j].B*i) div 32;
end;
end;
end;
procedure FadeIn(pal:paltype; low,high,delay:byte);
var i,j:byte;
begin
for i:= 1 to 31 do
begin
Port[$3c8]:=low;
for j:= 0 to delay do;
vSync;
for j:=low to high do
begin
Port[$3c9]:=(pal[j].R*i) div 32;
Port[$3c9]:=(pal[j].G*i) div 32;
Port[$3c9]:=(pal[j].B*i) div 32;
end;
end;
end;
Function VGA : Boolean; Assembler;
Asm
MOV AH,1Ah
INT 10h
CMP AL,1Ah
MOV AL,True
JE @OUT
DEC AX
@OUT:
end;
function VideoOK:boolean;
var result:byte;
begin
asm
mov ah,$1a
xor al,al
int $10
mov result,bl
end;
{ VGA mono;VGA color }
{ vvvvvvv }
if result in [$07,$08,$0a..$0c] then videoOK:=true else videoOK:=false;
{ ^^^^^^^^ }
{ MCGA digital color; MCGA analog color; }
end; { MCGA analog mono }
procedure LoadPAL(FileName:string; var pal:paltype; mix:boolean);
var
Fil:file of PALType;
i:byte;
begin
assign(Fil,FileName);
reset(Fil);
read(Fil,PAL);
close(Fil);
if mix then
for i := 0 to 255 do
begin
Port[$3c8]:=i;
Port[$3c9]:=PAL[i].R;
Port[$3c9]:=PAL[i].G;
Port[$3c9]:=PAL[i].B;
end;
end;
procedure setcolor(c,r,g,b:byte);
begin
Port[$3c8]:=c;
Port[$3c9]:=R;
Port[$3c9]:=G;
Port[$3c9]:=B;
end;
procedure Setpal(apal:paltype; b,e:byte);
var i:byte;
begin
Port[$3c8]:=b; {auto incremented}
for i := b to e do
begin Port[$3c9]:=aPAL[i].R;
Port[$3c9]:=aPAL[i].G;
Port[$3c9]:=aPAL[i].B; end;
end;
procedure GetPal(var pal:palType; b,e:byte);
var i:byte;
begin
port[$3c7]:=b; {auto incremented}
For i:= b to e do
begin Pal[i].R:=port[$3c9];
Pal[i].G:=port[$3c9];
Pal[i].B:=port[$3c9]; end;
end;
procedure HVline(x1,y1,len:word;color:byte;HV:boolean; screen:pScreenType);
{ (x1,y1) is the upper-left coordinate; HV determine whelter it's H or V }
var a,b:word;
begin
a:=x1;b:=y1;
if HV then fillchar( screen^[b,a], len, char(color))
else while len>0 do begin screen^[b,a]:=color; inc(b); dec(len); end;
end;
procedure blacken(low,high:byte);
var d:byte;
begin
for d:=low to high do
begin
Port[$3c8]:=d;
Port[$3c9]:=0;
Port[$3c9]:=0;
Port[$3c9]:=0;
end;
end;
procedure RotatePal(Var Pal : PALType; beginRec, endRec : byte);
var TRGB : palrecordtype;
begin TRGB:=Pal[beginRec];
Move(Pal[beginRec+1],Pal[beginRec],(endRec-beginRec)*3);
Pal[endRec]:=TRGB;
end;
procedure clearScreen(scr:pScreenType);
begin
fillchar(scr^,64000,#0);
end;
Procedure asmPset(Scr:pscreentype;x:Integer;y,Col:Byte);assembler;
Asm les di,Scr; xor bh,bh; mov bl,y; shl bx,6; add bh,y;
add bx,x; add bx,di; mov al,Col; mov es:[bx],al; end;
procedure pset(x,y:word; color:byte);
begin
screen^[y,x]:=color;
end;
procedure copyscreen(ss,ds:pscreentype);
begin
dmove(ss^,ds^,64000);
end;
procedure fillbox(x1,y1,x2,y2:word; c: byte; screen:pscreentype);
var a: byte; s:word;
begin
s:=x2-x1+1; for a:= y1 to y2 do fillchar(screen^[a,x1], s, c);
end;
procedure copybox(ss,ds:pscreentype; sx, sy, w, h, dx, dy:word);
var a:word;
begin
for a:=0 to h-1 do
move(ss^[sy+a,sx], ds^[dy+a, dx], w);
end;
procedure calSine(var sinbl:sintable);
var a:byte;
begin
for a:=0 to 255 do sinbl[a]:=trunc( sin(a*pi/128)*127);
end;
begin
Screen:=Ptr(SegA000,0000);
copyright;
calSine(sine);
end.
{ At last I can contribute something to SWAG. I waited to be a university
student in Hong Kong for long. We have our Internet account as we become
one of their menbers. Only then can I e-mail my programs to you...}
[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]