Паскаль / do11 / tmtp390d / SOURCE / Mcgalib

(***********************************************)
(* *)
(* MCGA/VGA 13h Mode Graphic Library *)
(* Revision 2.0 *)
(* Copyright (c) 1998 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(* *)
(* Targets: *)
(* MS-DOS 32-bit protected mode *)
(* *)
(***********************************************)

{$ifndef __DOS__}
The MCGALib unit can be compiled for MS-DOS target only
{$endif}

unit MCGALib;

{$w-,r-,q-,i-,t-,x+,v-}

interface

procedure mSetMode320x200;
procedure mSetTextMode;
function mGetPixAddr (X, Y: Word): Pointer;
procedure mFillScr (Color: Byte);
procedure mPutScr (Buffer: Pointer);
procedure mGetScr (Buffer: Pointer);
procedure mSetScreenAddr (Addr: Pointer);
function mGetScreenAddr: Pointer;
procedure mPutPixel (X, Y: DWord; Color: Byte);
procedure mPutPoint (X, Y: LongInt; Color: Byte);
procedure mDrawLine (X1, Y1, X2, Y2: LongInt; Color: Byte);
function mGetPixel (X, Y: DWord): Byte;
procedure mSetPal (Color, R, G, B: Byte);
procedure mGetPal (Color: Byte; var R, G, B: Byte);
procedure mSetPalette (Buffer: Pointer; Start: Byte; Num: Word);
procedure mGetPalette (Buffer: Pointer; Start: Byte; Num: Word);
procedure mRotatePalette (Buffer: Pointer; Start, Num: Word);
function mPaletteFadeIn (Buffer: Pointer; Start, Num: Word; Stop: Byte): Boolean;
function mPaletteFadeOut (Buffer: Pointer; Start, Num: Word; Stop: Byte): Boolean;
procedure mRetrace;
procedure mCliRetrace;
procedure mBIOStext (X, Y: LongInt; Text: String; Color: Byte);
procedure mFilledBox (X1, Y1, X2, Y2: LongInt; Color: Byte);
procedure mDrawRectangle (X1, Y1, X2, Y2: LongInt; Color: Byte);
procedure mPutLine (X1, X2, Y: LongInt; Buffer: Pointer);
procedure mPutLineTransp (X1, X2, Y: LongInt; Msk: Byte; Buffer: Pointer);
procedure mGetLine (X1, X2, Y: LongInt; Buffer: Pointer);
procedure mStretch (Param: Byte);
procedure mOrPixel (X: DWord; Y: DWord; Color: Byte);
procedure mXorPixel (X: DWord; Y: DWord; Color: Byte);
procedure mAndPixel (X: DWord; Y: DWord; Color: Byte);
procedure mPutSprite (X1, Y1, X2, Y2: LongInt; Buffer: Pointer);
procedure mPutSpriteTransp (X1, Y1, X2, Y2: LongInt; Msk: Byte; Buffer: Pointer);
procedure mGetSprite (X1, Y1, X2, Y2: LongInt; Buffer: Pointer);
procedure mDrawHLine (X1, X2, Y: LongInt; Color: Byte);
procedure mFilledTriangle (X0, Y0, X1, Y1, X2, Y2: LongInt; Color: Byte);
procedure mFilledPolygon (var Vert; NumVert: DWord; Color: Byte);
procedure mBlur (ScrAddr: Pointer);
procedure mDrawEllipse (X, Y, A, B: LongInt; Color: Byte);
procedure mFilledEllipse (X, Y, A, B: LongInt; Color: Byte);
procedure mCircle (X,Y: LongInt; Radius: DWord; Color: Byte);
procedure mFilledCircle (X,Y: LongInt; Radius: DWord; Color: Byte);

implementation

(****************************************************
* Size of memory buffer for ellipse/circle drawing *
****************************************************)
const BufferSize = $FFFF;

(**********************************
* Internal variables declaration *
**********************************)
var
AdjUp: DWord:= -2;
AdjDown: DWord:= -4;
WholeStep: DWord:= -6;
XAdvance: DWord:= -8;
ScrAddr: Pointer;
Buffer: Pointer;
PixListLen: DWord;

procedure GetBuffer;
begin
if Buffer=nil then GetMem(Buffer,BufferSize);
end;

procedure mSetMode320x200;
assembler;
asm
mov eax,0A0000h
add eax,_zero
mov [ScrAddr],eax
mov eax,13h
int 10h
call GetBuffer
end;

procedure FreeBuffer;
begin
if Buffer<>nil then FreeMem(Buffer,BufferSize);
end;

procedure mSetTextMode;
assembler;
asm
mov eax,03h
int 10h
call FreeBuffer
end;

function mGetPixAddr (X, Y: Word): Pointer;
code;
asm
movzx eax,[Y]
shl eax,6
movzx edi,[X]
add edi,eax
shl eax,2
add eax,edi
add eax,[ScrAddr]
ret
end;

procedure mFillScr (Color: Byte);
code;
asm
mov edi,[ScrAddr]
cld
movzx eax,[Color]
push ecx
mov ecx,3E80h
mov ah,al
push eax
shl eax,16
pop eax
rep stosd
pop ecx
ret
end;

procedure mPutScr (Buffer: Pointer);
code;
asm
mov edi,0A0000h
mov esi,[Buffer]
push ecx
mov ecx,3E80h
cld
rep movsd
pop ecx
ret
end;

procedure mGetScr (Buffer: Pointer);
code;
asm
mov esi,0A0000h
mov edi,[Buffer]
push ecx
mov ecx,3E80h
cld
rep movsd
pop ecx
ret
end;

procedure mSetScreenAddr (Addr: Pointer);
code;
asm
mov eax,[Addr]
mov [ScrAddr],eax
ret
end;

function mGetScreenAddr: Pointer;
code;
asm
mov eax,[ScrAddr]
ret
end;

procedure mPutPixel (X, Y: DWord; Color: Byte);
code;
asm
mov eax,[Y]
shl eax,6
mov edi,[X]
add edi,eax
shl eax,2
add edi,eax
add edi,[ScrAddr]
mov al,[Color]
mov [edi],al
ret
end;

procedure mPutPoint (X, Y: LongInt; Color: Byte);
code;
asm
cmp [X],0
jl @@Quit
cmp [X],319
jg @@Quit
cmp [Y],0
jl @@Quit
cmp [Y],199
jg @@Quit
mov eax,[Y]
shl eax,6
mov edi,[X]
add edi,eax
shl eax,2
add edi,eax
add edi,[ScrAddr]
mov al,[Color]
mov [edi],al
@@Quit:
ret
end;

procedure DrawLine (X1, Y1, X2, Y2: LongInt; Color: Byte);
assembler;
asm
cld
xor edi,edi
mov eax,[Y1]
cmp eax,[Y2]
jle @@TopBottom
xchg [Y2],eax
mov [Y1],eax
mov ebx,[X1]
xchg [X2],ebx
mov [X1],ebx
@@TopBottom:
mov dx,320
mul dx
mov esi,[X1]
mov edi,esi
add edi,eax
mov ecx,[Y2]
sub ecx,[Y1]
mov edx,[X2]
sub edx,esi
jnz @@NotVertical
mov al,[Color]
add edi,[ScrAddr]
@@VLoop:
mov [edi],al
add edi,320
dec ecx
jns @@VLoop
jmp @@Done
@@Horizontal:
mov al,[Color]
mov ah,al
and ebx,ebx
jns @@DirSet
sub edi,edx
@@DirSet:
mov ecx,edx
inc ecx
shr ecx,1
add edi,[ScrAddr]
rep stosw
adc ecx,ecx
rep stosb
jmp @@Done
@@Diagonal:
mov al,[Color]
add ebx,320
add edi,[ScrAddr]
@@DLoop:
mov [edi],al
add edi,ebx
dec ecx
jns @@DLoop
jmp @@Done
@@NotVertical:
mov ebx,1
jns @@LeftToRight
neg ebx
neg edx
@@LeftToRight:
and ecx,ecx
jz @@Horizontal
cmp ecx,edx
jz @@Diagonal
cmp edx,ecx
jae @@XMajor
jmp @@YMAjor
@@XMajor:
and ebx,ebx
jns @@DFSet
std
@@DFSet:
mov eax,edx
sub edx,edx
div ecx
mov ebx,edx
add ebx,ebx
mov [AdjUp],ebx
mov esi,ecx
add esi,esi
mov [AdjDown],esi
sub edx,esi
mov esi,ecx
mov ecx,eax
shr ecx,1
inc ecx
push ecx
add edx,esi
test al,1
jnz @@XMajorDone
sub edx,esi
and ebx,ebx
jnz @@XMajorDone
dec ecx
@@XMajorDone:
mov [WholeStep],eax
mov al,[Color]
add edi,[ScrAddr]
rep stosb
add edi,320
cmp esi,1
jna @@XMajorDraw
dec edx
shr esi,1
jnc @@XMajorFullOdd
@@XMajorFullLoop:
mov ecx,[WholeStep]
add edx,ebx
jnc @@XMajorNoExtra
inc ecx
sub edx,[AdjDown]
@@XMajorNoExtra:
rep stosb
add edi,320
@@XMajorFullOdd:
mov ecx,[WholeStep]
add edx,ebx
jnc @@XMajorNoExtra2
inc ecx
sub edx,[AdjDown]
@@XMajorNoExtra2:
rep stosb
add edi,320
dec esi
jnz @@XMajorFullLoop
@@XMajorDraw:
pop ecx
rep stosb
cld
jmp @@Done
@@YMajor:
mov [XAdvance],ebx
mov eax,ecx
mov ecx,edx
sub edx,edx
div cx
mov ebx,edx
add ebx,ebx
mov [AdjUp],ebx
mov esi,ecx
add esi,esi
mov [AdjDown],esi
sub edx,esi
mov esi,ecx
mov ecx,eax
shr ecx,1
inc ecx
push ecx
add edx,esi
test al,1
jnz @@YMajorDone
sub edx,esi
and ebx,ebx
jnz @@YMajorDone
dec ecx
@@YMajorDone:
add edi,[ScrAddr]
mov [WholeStep],eax
mov al,[Color]
mov ebx,[XAdvance]
inc ecx
@@YMajorFirstLoop:
mov [edi],al
add edi,320
dec ecx
jnz @@YMajorFirstLoop
add edi,ebx
cmp esi,1
jna @@YMajorDraw
dec edx
shr esi,1
jnc @@YMajorFullOdd
@@YMajorFullLoop:
mov ecx,[WholeStep]
add edx,[AdjUp]
jnc @@YMajorNoExtra
inc ecx
sub edx,[AdjDown]
@@YMajorNoExtra:
@@YMajorRunLoop:
mov [edi],al
add edi,320
dec ecx
jnz @@YMajorRunLoop
add edi,ebx
@@YMajorFullOdd:
mov ecx,[WholeStep]
add edx,[AdjUp]
jnc @@YMajorNoExtra2
inc ecx
sub edx,[AdjDown]
@@YMajorNoExtra2:
@@YMajorRunLoop2:
mov [edi],al
add edi,320
dec ecx
jnz @@YMajorRunLoop2
add edi,ebx
dec esi
jnz @@YMajorFullLoop
@@YMajorDraw:
pop ecx
@@YMajorLastLoop:
mov [edi],al
add edi,320
dec ecx
jnz @@YMajorLastLoop
@@Done:
end;

function ClipLine (var x1,y1,x2,y2: LongInt; left,top,right,bottom: LongInt): Boolean;
var outcode1,outcode2: LongInt:=0; // Outcodes for the two endpoints
outcodeOut: LongInt:=0; // Outcode of endpoint outside
x,y,dx,dy: Real;
procedure SETOUTCODES(var outcode: LongInt; x,y: Real);
begin
outcode:= 0;
if (y > bottom) then outcode:= outcode or 1;
if (y < top) then outcode:= outcode or 2;
if (x > right) then outcode:= outcode or 4;
if (x < left) then outcode:= outcode or 8;
end;
begin
{ Set up the initial 4 bit outcodes }
SETOUTCODES(outcode1,x1,y1);
SETOUTCODES(outcode2,x2,y2);
if (outcode1 and outcode2)<>0 then begin
Result:=false;
exit;
end;
if ((outcode1 or outcode2))=0 then begin
Result:=true;
exit;
end;
dx:= x2 - x1; // Compute dx and dy once only
dy:= y2 - y1;

repeat
(* Determine which endpoint is currently outside of clip rectangle *)
(* and pick it to be clipped. *)

if (outcode2)<>0 then outcodeOut:= outcode2 else outcodeOut:= outcode1;

(* Clip the endpoint to *)
(* one of the appropriate boundaries... *)

if (outcodeOut and 1)<>0 then begin
x:= x1 + dx*(bottom-1-y1)/dy;
y:= bottom-1;
end
else if (outcodeOut and 2)<>0 then begin
x:= x1 + dx*(top-y1)/dy;
y:= top;
end
else if (outcodeOut and 4)<>0 then begin
y:= y1 + dy*(right-1-x1)/dx;
x:= right-1;
end
else begin
y:= y1 + dy*(left-x1)/dx;
x:= left;
end;

if (outcodeOut = outcode1) then begin
x1:=Round(x); y1:=Round(y);
SETOUTCODES(outcode1,x,y);
end
else begin
x2:=Round(x); y2:=Round(y);
SETOUTCODES(outcode2,x,y);
end;

if (outcode1 and outcode2)<>0 then begin
Result:=false;
exit;
end;
if ((outcode1 or outcode2))=0 then begin
Result:=true;
exit;
end;
until false;
end;

procedure mDrawLine (X1, Y1, X2, Y2: LongInt; Color: Byte);
begin
if ClipLine(X1,Y1,X2,Y2,0,0,319,199) then DrawLine(X1,Y1,X2,Y2,Color);
end;

function mGetPixel (X, Y: DWord): Byte;
code;
asm
mov eax,[Y]
shl eax,6
mov edi,[X]
add edi,eax
shl eax,2
add edi,eax
add edi,[ScrAddr]
mov al,[edi]
ret
end;

procedure mSetPal (Color, R, G, B: Byte);
assembler;
asm
mov al,[Color]
mov edx,03C8h
out dx,al
inc edx
mov al,[R]
out dx,al
mov al,[G]
out dx,al
mov al,[B]
out dx,al
end;

procedure mGetPal (Color: Byte; var R, G, B: Byte);
assembler;
asm
mov al,[Color]
mov dx,03C7h
out dx,al
inc dx
inc dx
mov esi,[R]
in al,dx
mov [esi],al
mov edi,[G]
in al,dx
mov [edi],al
mov edi,[B]
in al,dx
mov [edi],al
end;

procedure mSetPalette (Buffer: Pointer; Start: Byte; Num: Word);
assembler;
asm
movzx ecx,[Num]
or ecx,0
jz @@Quit
cld
mov esi,[Buffer]
movzx eax,[Start]
@@PalLp:
mov edx,03C8h
out dx,al
inc eax
inc edx
outsb
outsb
outsb
loop @@PalLp
@@Quit:
end;

procedure mGetPalette (Buffer: Pointer; Start: Byte; Num: Word);
assembler;
asm
movzx ecx,[Num]
or ecx,0
jz @@Quit
cld
mov edi,[Buffer]
movzx eax,[Start]
@@PalLp:
mov edx,03C7h
out dx,al
mov edx,03C9h
inc eax
insb
insb
insb
loop @@PalLp
@@Quit:
end;

procedure mRotatePalette (Buffer: Pointer; Start, Num: Word);
var R,G,B: Byte;
LastCol: Word;
begin
LastCol:=Start+Num-1;
if (Num<2) or (LastCol>255) then exit;
R:=Byte((Buffer+LastCol*3)^);
G:=Byte((Buffer+LastCol*3+1)^);
B:=Byte((Buffer+LastCol*3+2)^);
Move((Buffer+Start*3)^,(Buffer+Start*3+3)^,(Num-1)*3);
Byte((Buffer+Start*3)^):=R;
Byte((Buffer+Start*3+1)^):=G;
Byte((Buffer+Start*3+2)^):=B;
mSetPalette(Buffer+Start*3,Start,Num);
end;

function mPaletteFadeIn (Buffer: Pointer; Start, Num: Word; Stop: Byte): Boolean;
var R,G,B: Byte;
Counter: Word;
EndCntr: Word;
C: Boolean;
begin
C:=false;
Counter:=Start*3;
EndCntr:=Start+Num*3;
repeat
R:=Byte((Buffer+Counter)^);
G:=Byte((Buffer+Counter+1)^);
B:=Byte((Buffer+Counter+2)^);
if R<Stop then begin inc(R); C:=true; end;
if G<Stop then begin inc(G); C:=true; end;
if B<Stop then begin inc(B); C:=true; end;
Byte((Buffer+Counter)^):=R;
inc(Counter);
Byte((Buffer+Counter)^):=G;
inc(Counter);
Byte((Buffer+Counter)^):=B;
inc(Counter);
until Counter>=EndCntr;
mSetPalette(Buffer+Start*3,Start,Num);
Result:=C;
end;

function mPaletteFadeOut (Buffer: Pointer; Start, Num: Word; Stop: Byte): Boolean;
var R,G,B: Byte;
Counter: Word;
EndCntr: Word;
C: Boolean;
begin
C:=false;
Counter:=Start*3;
EndCntr:=Start+Num*3;
repeat
R:=Byte((Buffer+Counter)^);
G:=Byte((Buffer+Counter+1)^);
B:=Byte((Buffer+Counter+2)^);
if R>Stop then begin dec(R); C:=true; end;
if G>Stop then begin dec(G); C:=true; end;
if B>Stop then begin dec(B); C:=true; end;
Byte((Buffer+Counter)^):=R;
inc(Counter);
Byte((Buffer+Counter)^):=G;
inc(Counter);
Byte((Buffer+Counter)^):=B;
inc(Counter);
until Counter>=EndCntr;
mSetPalette(Buffer+Start*3,Start,Num);
Result:=C;
end;

procedure mRetrace;
code;
asm
push edx
mov edx,03DAh
@@VSync:
in al,dx
test eax,8
jz @@VSync
@@NoVSync:
in al,dx
test eax,8
jnz @@NoVSync
pop edx
ret
end;

procedure mCliRetrace;
code;
asm
pushf
push edx
cli
mov edx,03DAh
@@VSync:
in al,dx
test eax,8
jz @@VSync
@@NoVSync:
in al,dx
test eax,8
jnz @@NoVSync
pop edx
popf
ret
end;

procedure mBIOStext (X, Y: LongInt; Text: String; Color: Byte);
assembler;
asm
mov eax,[X]
mov dl,al
mov eax,[Y]
mov dh,al
mov ah,02h
xor bh,bh
int 10h
cld
mov bl,[Color]
mov esi,[Text]
xor cx,cx
mov cl,[esi]
and cx,cx
jz @@Quit
inc esi
mov ah,0Eh
@@Cont:
lodsb
int 10h
loop @@Cont
@@Quit:
end;

procedure mFilledBox (X1, Y1, X2, Y2: LongInt; Color: Byte);
var i: DWord;
begin
for i:=Y1 to Y2 do mDrawHLine(X1,X2,i,Color);
end;

procedure mDrawRectangle (X1, Y1, X2, Y2: LongInt; Color: Byte);
begin
mDrawLine(X1,Y1,X2,Y1,Color);
mDrawLine(X2,Y1,X2,Y2,Color);
mDrawLine(X2,Y2,X1,Y2,Color);
mDrawLine(X1,Y2,X1,Y1,Color);
end;

procedure mPutLine (X1, X2, Y: LongInt; Buffer: Pointer);
assembler;
asm
mov esi,[Buffer]
cmp [Y],0
jl @@Quit
cmp [Y],199
jg @@Quit
cmp [X2],0
jl @@Quit
cmp [X1],319
jg @@Quit
cmp [X1],0
jge @@Next1
mov ebx,[X1]
sub esi,ebx
mov [X1],0
@@Next1:
cmp [X2],319
jle @@Next2
mov [X2],319
@@Next2:
mov eax,[Y]
shl eax,6
mov edi,[X1]
add edi,eax
shl eax,2
add edi,eax
add edi,[ScrAddr]
mov ecx,[X2]
mov ebx,[X1]
sub ecx,ebx
inc ecx
push ecx
and ecx,3
cld
rep movsb
pop ecx
shr ecx,2
rep movsd
@@Quit:
end;

procedure mPutLineTransp (X1, X2, Y: LongInt; Msk: Byte; Buffer: Pointer);
assembler;
asm
mov esi,[Buffer]
cmp [Y],0
jl @@Quit
cmp [Y],199
jg @@Quit
cmp [X2],0
jl @@Quit
cmp [X1],319
jg @@Quit
cmp [X1],0
jge @@Next1
mov ebx,[X1]
sub esi,ebx
mov [X1],0
@@Next1:
cmp [X2],319
jle @@Next2
mov [X2],319
@@Next2:
mov eax,[Y]
shl eax,6
mov edi,[X1]
add edi,eax
shl eax,2
add edi,eax
add edi,[ScrAddr]
mov ecx,[X2]
mov ebx,[X1]
sub ecx,ebx
inc ecx
mov bl,[Msk]
cld
@@Loop:
lodsb
cmp bl,al
jz @@Next3
mov [edi],al
@@Next3:
inc edi
loop @@Loop
@@Quit:
end;

procedure mGetLine (X1, X2, Y: LongInt; Buffer: Pointer);
assembler;
asm
mov edi,[Buffer]
cmp [Y],0
jl @@Quit
cmp [Y],199
jg @@Quit
cmp [X2],0
jl @@Quit
cmp [X1],319
jg @@Quit
cmp [X1],0
jge @@Next1
mov ebx,[X1]
sub edi,ebx
mov [X1],0
@@Next1:
cmp [X2],319
jle @@Next2
mov [X2],319
@@Next2:
mov eax,[Y]
shl eax,6
mov esi,[X1]
add esi,eax
shl eax,2
add esi,eax
add esi,[ScrAddr]
mov ecx,[X2]
mov ebx,[X1]
sub ecx,ebx
inc ecx
push ecx
and ecx,3
cld
rep movsb
pop ecx
shr ecx,2
rep movsd
@@Quit:
end;

procedure mStretch (Param: Byte);
assembler;
asm
mov bl,[Param]
mov al,09h
mov dx,3D4h
out dx,al
mov dx,3D5h
in al,dx
and al,0E0h
add al,bl
out dx,al
end;

procedure mOrPixel (X: DWord; Y: DWord; Color: Byte);
var Addr: Pointer;
begin
addr:=mGetPixAddr (X,Y);
byte(addr^):=byte(addr^) or Color;
end;

procedure mXorPixel (X: DWord; Y: DWord; Color: Byte);
var Addr: Pointer;
begin
addr:=mGetPixAddr(X,Y);
byte(addr^):=byte(addr^) xor Color;
end;

procedure mAndPixel (X: DWord; Y: DWord; Color: Byte);
var Addr: Pointer;
begin
addr:=mGetPixAddr(X,Y);
byte(addr^):=byte(addr^) and Color;
end;

procedure mPutSprite (X1, Y1, X2, Y2: LongInt; Buffer: Pointer);
var i: LongInt;
begin
for i:=Y1 to Y2 do begin
mPutLine(X1,X2,i,Buffer);
inc(Buffer,X2-X1+1);
end;
end;

procedure mPutSpriteTransp (X1, Y1, X2, Y2: LongInt; Msk: Byte; Buffer: Pointer);
var i: LongInt;
begin
for i:=Y1 to Y2 do begin
mPutLineTransp(X1,X2,i,Msk,Buffer);
inc(Buffer,X2-X1+1);
end;
end;

procedure mGetSprite(X1, Y1, X2, Y2: LongInt; Buffer: Pointer);
var i: LongInt;
begin
for i:=Y1 to Y2 do begin
mGetLine(X1,X2,i,Buffer);
inc(Buffer,X2-X1+1);
end;
end;

procedure mDrawHLine (X1, X2, Y: LongInt; Color: Byte);
assembler;
asm
mov ecx,[X2]
mov ebx,[X1]
mov edx,[Y]
cmp edx,0
jl @Quit
cmp edx,199
jg @Quit
cmp ecx,0
jl @Quit
cmp ebx,319
jg @Quit
cmp ebx,0
jge @Next1
mov ebx,0
@Next1: cmp ecx,319
jle @Next2
mov ecx,319
@Next2: push ecx
shl edx,6
mov edi,ebx
add edi,edx
shl edx,2
add edi,edx
cld
pop ecx
mov al,byte ptr [Color]
mov ah,al
push ax
shl eax,16
pop ax
add edi,[ScrAddr]
sub ecx,ebx
inc ecx
push ecx
and ecx,3
rep stosb
pop ecx
shr ecx,2
rep stosd
@Quit:
end;

procedure mFilledTriangle(X0,Y0,X1,Y1,X2,Y2: LongInt; Color: Byte);
assembler;
var DX01,DY01,DX02,DY02,DX12,DY12,DP01,DP02,DP12,XA01,XA02,XA12: DWord;
asm
mov eax,[X0]
mov ebx,[Y0]
mov ecx,[X1]
mov edx,[Y1]
cmp ebx,edx
jl @Y0lY1
je @Y0eY1
xchg eax,ecx
xchg ebx,edx
@Y0lY1: cmp edx,[Y2]
jg @Skip1
jmp @sorted
@Skip1: xchg ecx,[X2]
xchg edx,[Y2]
cmp ebx,edx
jge @Skip2
jmp @sorted
@Skip2: je @bot
xchg eax,ecx
xchg ebx,edx
jmp @sorted
@Y0eY1: cmp ebx,[Y2]
jl @bot
jg @Next
jmp @Quit
@Next: xchg eax,[X2]
xchg ebx,[Y2]
jmp @sorted
@bot: cmp eax,ecx
jl @botsorted
jg @bota
jmp @Quit
@bota: xchg eax,ecx
@botsorted:
@boty0ok:
mov esi,[Y2]
@boty2ok:
mov [X0],eax
mov [Y0],ebx
mov [X1],ecx
mov [Y1],edx
mov ebx,[Y2]
sub ebx,[Y0]
mov [DY02],ebx
mov eax,[X2]
sub eax,[X0]
mov [DX02],eax
mov ecx,eax
cdq
idiv ebx
cmp ecx,0
jge @bot02
dec eax
@bot02: mov [XA02],eax
imul ebx
sub ecx,eax
mov [DP02],ecx
mov ebx,[Y2]
sub ebx,[Y1]
mov [DY12],ebx
mov eax,[X2]
sub eax,[X1]
mov [DX12],eax
mov ecx,eax
cdq
idiv ebx
cmp ecx,0
jge @bot12
dec eax
@bot12: mov [XA12],eax
imul ebx
sub ecx,eax
mov [DP12],ecx
xor eax,eax
xor ebx,ebx
mov ecx,[Y0]
mov esi,[X0]
mov edi,[X1]
dec edi
@botloop:
inc ecx
add eax, [DP02]
jle @botshortl
sub eax, [DY02]
inc esi
@botshortl:
add esi,[XA02]
add ebx,[DP12]
jle @botshortr
sub ebx,[DY12]
inc edi
@botshortr:
add edi,[XA12]
push edi
push esi
cmp ecx,[Y2]
jl @botloop
jmp @lineloop
@sorted:
@y0ok: mov esi,[Y2]
@y2ok: mov [X0],eax
mov [Y0],ebx
mov [X1],ecx
mov [Y1],edx
mov ebx,edx
sub ebx,[Y0]
mov [DY01],ebx
mov eax,[X1]
sub eax,[X0]
mov [DX01],eax
mov ecx,eax
cdq
idiv ebx
cmp ecx,0
jge @psl01
dec eax
@psl01: mov [XA01],eax
imul ebx
sub ecx,eax
mov [DP01],ecx
mov ebx,[Y2]
sub ebx,[Y0]
mov [DY02],ebx
mov eax,[X2]
sub eax,[X0]
mov [DX02],eax
mov ecx,eax
cdq
idiv ebx
cmp ecx,0
jge @psl02
dec eax
@psl02: mov [XA02],eax
imul ebx
sub ecx,eax
mov [DP02],ecx
mov ebx,[Y2]
sub ebx,[Y1]
jle @constcomputed
mov [DY12],ebx
mov eax,[X2]
sub eax,[X1]
mov [DX12],eax
mov ecx,eax
cdq
idiv ebx
cmp ecx,0
jge @psl12
dec eax
@psl12: mov [XA12],eax
imul ebx
sub ecx,eax
mov [DP12],ecx
@ConstComputed:
mov eax,[DX01]
imul [DY02]
mov ebx,eax
mov eax,[DX02]
imul [DY01]
cmp ebx,eax
jg @pt1rt
jl @pt1lt
jmp @Quit
@pt1lt: xor eax,eax
xor ebx,ebx
mov ecx,[Y0]
mov esi,[X0]
mov edi,esi
dec esi
@ltloop:
inc ecx
add eax,[DP02]
jle @ltshortl
sub eax,[DY02]
inc esi
@ltshortl:
add esi,[XA02]
add ebx,[DP01]
jle @ltshortr
sub ebx,[DY01]
inc edi
@ltshortr:
add edi,[XA01]
push esi
push edi
cmp ecx,[Y1]
jl @ltloop
jmp @lbstart
@lbloop:
inc ecx
add eax,[DP02]
jle @lbshortl
sub eax,[DY02]
inc esi
@lbshortl:
add esi,[XA02]
add ebx,[DP12]
jle @lbshortr
sub ebx,[DY12]
inc edi
@lbshortr:
add edi,[XA12]
push esi
push edi
@lbstart:
cmp ecx,[Y2]
jl @lbloop
jmp @lineloop
@pt1rt: xor eax,eax
xor ebx,ebx
mov ecx,[Y0]
mov esi,[X0]
mov edi,esi
dec edi
@rtloop:
inc ecx
add eax,[DP02]
jle @rtshortl
sub eax,[DY02]
inc esi
@rtshortl:
add esi,[XA02]
add ebx,[DP01]
jle @rtshortr
sub ebx, [DY01]
inc edi
@rtshortr:
add edi,[XA01]
push edi
push esi
cmp ecx,[Y1]
jl @rtloop
jmp @rbstart
@rbloop:
inc ecx
add eax,[DP02]
jle @rbshortl
sub eax,[DY02]
inc esi
@rbshortl:
add esi,[XA02]
add ebx,[DP12]
jle @rbshorts
sub ebx,[DY12]
inc edi
@rbshorts:
add edi,[XA12]
push edi
push esi
@rbstart:
cmp ecx,[Y2]
jl @rbloop
@lineloop:
pop eax
pop edx
cmp eax,edx
jg @drawnext
push eax
push edx
push dword ptr [Y2]
mov al,[Color]
push eax
call mDrawHLine
@drawnext:
dec [Y2]
dec [DY02]
jnz @lineloop
@Quit:
end;

(*****************************************************
* Only convex polygones will be displayed correctly *
*****************************************************)
procedure mFilledPolygon (var Vert; NumVert: DWord; Color: Byte);
assembler;
var X, Y, Count: DWord;
asm
mov eax,[NumVert]
cmp eax,3
jl @@Quit
@@Pass: sub eax,3
mov [Count],eax
mov edi,[Vert]
mov eax,[edi]
mov [X],eax
mov eax,[edi+4]
mov [Y],eax
@@Next: add edi,8
push edi
push [X]
push [Y]
push dword ptr [edi+8]
push dword ptr [edi+12]
push dword ptr [edi]
push dword ptr [edi+4]
movzx eax,[Color]
push eax
call mFilledTriangle
pop edi
dec [Count]
jns @@Next
@@Quit:
end;

(**************************************************************
* Size of virtual screen must be 320 * 201 + 1 = 64321 bytes *
**************************************************************)
procedure mBlur (ScrAddr: Pointer);
assembler;
asm
mov edi,[ScrAddr]
inc edi
mov ecx,0F9FFh
xor ebx,ebx
@lp1: movzx eax,byte ptr [edi]
mov bl,byte ptr [edi-1]
add eax,ebx
mov bl,byte ptr [edi+1]
add eax,ebx
mov bl,byte ptr [edi+320]
add eax,ebx
shr eax,2
jz @lp2
dec eax
@lp2: mov [edi],al
inc edi
loop @lp1
end;

procedure GenerateEOctant (MinorAjast,Threshold,MajorSquared,MinorSquared:
LongInt);
code;
asm
mov [PixListLen],0
mov eax,[MajorSquared]
shl eax,1
mov edx,eax
mov eax,[MinorSquared]
shl eax,1
mov esi,eax
mov edi,[Buffer]
xor ecx,ecx
mov ebx,[Threshold]
@@GenLoop:
add ebx,ecx
mov byte ptr [edi],0
add ebx,[MinorSquared]
js @@MoveMajor
mov eax,edx
sub [MinorAjast],eax
sub ebx,[MinorAjast]
mov byte ptr [edi],1
@@MoveMajor:
inc edi
inc [PixListLen]
mov eax,BufferSize
cmp eax,[PixListLen]
jle @@Quit
@@Cont: add ecx,esi
cmp ecx,[MinorAjast]
jb @@GenLoop
@@Quit: ret
end;

function CalcSquared(A,B: LongInt; var Aq,Bq,ABq,BAq: DWord): Boolean;
assembler;
asm
mov ebx,2
mov eax,[A]
mul eax
jc @@Error
mov edi,[Aq]
mov [edi],eax
mul dword ptr [B]
jc @@Error
mul ebx
jc @@Error
mov edi,[ABq]
mov [edi],eax
mov eax,[B]
mul eax
jc @@Error
mov edi,[Bq]
mov [edi],eax
mul dword ptr [A]
jc @@Error
mul ebx
jc @@Error
mov edi,[BAq]
mov [edi],eax
mov eax,1
jmp @@Quit
@@Error:xor eax,eax
@@Quit:
end;

procedure mDrawEllipse (X, Y, A, B: LongInt; Color: Byte);
var ASquared,BSquared,ABSquared,BASquared: DWord;
TempPtr: Pointer;
procedure DrawVOctant(X,Y: LongInt; DrawLen: DWord; YDir,
HMoveDir: LongInt; Buffer: Pointer);
var CX,CY,I: LongInt;
DrawList: Pointer;
begin
DrawList:=Buffer;
CX:=X; CY:=Y;
for I:=1 to DrawLen do begin
mPutPoint(CX,CY,Color);
if Byte(DrawList^)=1 then Inc(CX,HMoveDir);
Inc(CY,YDir);
Inc(DrawList);
end;
end;
procedure DrawHOctant (X,Y: LongInt; DrawLen: DWord; YDir,
HMoveDir: LongInt; Buffer: Pointer);
var CX,CY,I: LongInt;
DrawList: Pointer;
begin
DrawList:=Buffer;
CX:=X; CY:=Y;
for I:=1 to DrawLen do begin
mPutPoint(CX,CY,Color);
if Byte(DrawList^)=1 then Inc(CY,YDir);
Inc(CX,HMoveDir);
Inc(DrawList);
end;
end;
begin
if (A=0) or (B=0) then exit;
if not CalcSquared(A,B,ASquared,BSquared,ABSquared,BASquared) then exit;
TempPtr:=Buffer;
Inc(TempPtr);
GenerateEOctant(ABSquared,ASquared div 4 - ASquared*B,ASquared,BSquared);
DrawHOctant(X,Y-B,PixListLen,1,-1,Buffer);
DrawHOctant(X+1,Y-B+Byte(Buffer^),PixListLen-1,1,1,TempPtr);
DrawHOctant(X,Y+B,PixListLen,-1,-1,Buffer);
DrawHOctant(X+1,Y+B-Byte(Buffer^),PixListLen-1,-1,1,TempPtr);
GenerateEOctant(BASquared,BSquared div 4 - BSquared*A,BSquared,ASquared);
DrawVOctant(X-A,Y,PixListLen,-1,1,Buffer);
DrawVOctant(X-A+Byte(Buffer^),Y+1,PixListLen-1,1,1,TempPtr);
DrawVOctant(X+A,Y,PixListLen,-1,-1,Buffer);
DrawVOctant(X+A-Byte(Buffer^),Y+1,PixListLen-1,1,-1,TempPtr);
end;

procedure mFilledEllipse (X, Y, A, B: LongInt; Color: Byte);
var ASquared,BSquared,ABSquared,BASquared: DWord;
TempPtr: Pointer;
procedure FilledVOctant(X,Y: LongInt; DrawLen: DWord; YDir,
HMoveDir: LongInt; Buffer: Pointer);
var CX,CL,CY,I: LongInt; DrawList: Pointer;
begin
DrawList:=Buffer;
CX:=X; CY:=Y; CL:=CX+A shl 1;
for I:=1 to DrawLen do begin
mDrawHLine(CX,CL,CY,Color);
if Byte(DrawList^)=1 then begin Inc(CX,HMoveDir); dec(CL,1); end;
Inc(CY,YDir);
Inc(DrawList);
end;
end;
procedure FilledHOctant (X,Y: LongInt; DrawLen: DWord; YDir,
HMoveDir: LongInt; Buffer: Pointer);
var CX,CY,CL,I: LongInt;
DrawList: Pointer;
begin
DrawList:=Buffer;
CX:=X; CY:=Y; CL:=CX;
mDrawHLine(CX,CL,CY,Color);
for I:=1 to DrawLen do begin
if Byte(DrawList^)=1 then begin
inc(CY,YDir); mDrawHLine(CX,CL,CY,Color);
end;
Inc(CX,HMoveDir);
Inc(CL,1);
Inc(DrawList);
end;
end;
begin
if (A=0) or (B=0) then exit;
if not CalcSquared(A,B,ASquared,BSquared,ABSquared,BASquared) then exit;
TempPtr:=Buffer;
Inc(TempPtr);
GenerateEOctant(ABSquared,ASquared div 4 - ASquared*B,ASquared,BSquared);
FilledHOctant(X,Y-B,PixListLen,1,-1,Buffer);
FilledHOctant(X,Y+B,PixListLen,-1,-1,Buffer);
GenerateEOctant(BASquared,BSquared div 4 - BSquared*A,BSquared,ASquared);
FilledVOctant(X-A,Y,PixListLen,-1,1,Buffer);
FilledVOctant(X-A+Byte(Buffer^),Y+1,PixListLen-1,1,1,TempPtr);
end;

procedure mCircle (X,Y: LongInt; Radius: DWord; Color: Byte);
begin
mDrawEllipse(X,Y,Radius,Round(Radius*0.82),Color);
end;

procedure mFilledCircle (X,Y: LongInt; Radius: DWord; Color: Byte);
begin
mFilledEllipse(X,Y,Radius,Round(Radius*0.82),Color);
end;

begin
Buffer:=nil;
end.