523 lines
No EOL
7.4 KiB
ObjectPascal
523 lines
No EOL
7.4 KiB
ObjectPascal
Unit GraphV2;
|
|
interface
|
|
Uses
|
|
CRT,DOS;
|
|
Const
|
|
NormEffect = 0;
|
|
FadeEffect = 1;
|
|
noViewEfct = 2;
|
|
GetMaxX = 319;
|
|
GetMaxY = 199;
|
|
CentreX = 160;
|
|
CentreY = 100;
|
|
VGA = $13;
|
|
On = True;
|
|
Off = False;
|
|
Screen : Pointer = Ptr($0000,$0000);
|
|
Type
|
|
RGB = Array[0..$300] of byte;
|
|
var
|
|
PageW : Pointer;
|
|
PageWS : Word;
|
|
PageWO : Word;
|
|
WriteS : Word;
|
|
|
|
Procedure WaitVBL;
|
|
|
|
Procedure GetRGB(Pal : Pointer);
|
|
|
|
Procedure SetRGB(Pal : pointer);
|
|
|
|
{ Assembler : }
|
|
Procedure InitGraph( Mode : Byte );
|
|
|
|
Procedure CloseGraph;
|
|
|
|
Procedure PutPixel ( X,Y : Integer;
|
|
C : Byte);
|
|
|
|
Function GetPixel ( X,Y : Integer) : Byte;
|
|
|
|
Function GPixel ( X,Y : Integer) : Byte;
|
|
|
|
Procedure ClearDevice(CColor : Byte);
|
|
|
|
Procedure ViewPage;
|
|
|
|
Procedure PaletteOff;
|
|
|
|
{ Assembler }
|
|
Procedure FadeOut(First,Last : Word; Speed : Byte);
|
|
|
|
Procedure FadeIn(first,Last : word; Pal: pointer; speed : Byte);
|
|
|
|
Procedure FadeFromWhite(first,Last : word; Pal: pointer; Speed : Byte);
|
|
|
|
Procedure FadeWhite(First,Last : Word; speed : Byte);
|
|
|
|
Implementation
|
|
var
|
|
DirectV : Boolean;
|
|
|
|
|
|
Procedure WaitVBL; Assembler;
|
|
Asm
|
|
{ Wait VBL }
|
|
push dx
|
|
push ax
|
|
Mov DX,$3DA
|
|
@W: in AL,DX
|
|
Test AL,$08
|
|
Jne @W
|
|
|
|
@X: in AL,DX
|
|
test AL,$08
|
|
Je @X
|
|
pop ax
|
|
pop dx
|
|
end;
|
|
|
|
Procedure GetRGB( Pal : pointer); Assembler;
|
|
Asm
|
|
Les DI,[Pal]
|
|
cld
|
|
Xor CX,CX
|
|
@Beg:
|
|
Mov DX,$3C8
|
|
Mov AL,CL
|
|
Out DX,AL
|
|
Inc DX
|
|
In AL,DX
|
|
StosB
|
|
In AL,DX
|
|
StosB
|
|
In AL,DX
|
|
StosB
|
|
inc CX
|
|
cmp CX,$100
|
|
jbe @beg
|
|
|
|
End;
|
|
|
|
Procedure SetRGB(Pal : pointer); Assembler;
|
|
Asm
|
|
Push DS
|
|
|
|
Lds SI,[Pal]
|
|
cld
|
|
Xor CX,CX
|
|
Mov DX,$3C8
|
|
@Beg:
|
|
Mov AL,CL
|
|
Out DX,AL
|
|
Inc DX
|
|
LodsB
|
|
Out DX,AL
|
|
Lodsb
|
|
Out DX,AL
|
|
Lodsb
|
|
Out DX,AL
|
|
inc CX
|
|
Dec DX
|
|
cmp CH,$00
|
|
je @beg
|
|
|
|
Pop DS
|
|
End;
|
|
|
|
Procedure InitGraph( Mode : Byte );
|
|
Begin
|
|
asm
|
|
Mov AH,$00
|
|
Mov AL,&Mode
|
|
int $10
|
|
End;
|
|
DirectV := False;
|
|
Getmem(pageW,$FFFF);
|
|
PageWS := Seg(PageW^);
|
|
WriteS := PageWS;
|
|
Screen := Ptr($A000,0000);
|
|
FillChar(PageW^,64000,0);
|
|
End;
|
|
|
|
Procedure CloseGraph;
|
|
Begin
|
|
Asm
|
|
Mov AH,$00
|
|
Mov AL,$03
|
|
int $10
|
|
End;
|
|
TextMode(CO80);
|
|
ClrScr;
|
|
End;
|
|
|
|
Procedure PutPixel( X,Y : Integer;
|
|
C : Byte); Assembler;
|
|
asm
|
|
dec x
|
|
dec y
|
|
cmp X,319 { ; X > 320 Or x <0 }
|
|
ja @exit
|
|
cmp Y,199 { ; Y > 200 or Y < 0}
|
|
ja @exit
|
|
|
|
mov ax,&WriteS
|
|
mov Es,ax
|
|
Imul ax,Y,$140 { Y*320 }
|
|
mov di,X
|
|
add di,ax { Bx := Bx+Ax }
|
|
mov al,c
|
|
stosb
|
|
|
|
@exit:
|
|
End;
|
|
|
|
Function GPixel( X,Y : Integer) : Byte;
|
|
Begin
|
|
GPixel := Mem[WriteS:(Y-1)*320+(X-1)];
|
|
End;
|
|
|
|
Function GetPixel ( X,Y : Integer) : Byte;
|
|
Begin
|
|
GetPixel := Mem[WriteS:(Y-1)*320+(X-1)]
|
|
End;
|
|
|
|
Procedure ClearDevice(CColor : Byte); Assembler;
|
|
Asm
|
|
Mov CX,32000
|
|
Mov AX,[WriteS]
|
|
Mov ES,AX
|
|
Xor DI,DI
|
|
Mov AH,[CColor]
|
|
Mov AL,AH
|
|
Rep StosW
|
|
End;
|
|
|
|
Procedure ViewPage; Assembler;
|
|
Asm
|
|
Cmp &DirectV,0
|
|
jne @exit
|
|
|
|
Push DS
|
|
|
|
Mov AX,$A000
|
|
Mov ES,AX
|
|
Mov AX,&WriteS
|
|
Mov DS,AX
|
|
Mov CX,07D00h
|
|
Xor Si,Si
|
|
xor Di,Di
|
|
Rep MovsW
|
|
|
|
Pop DS
|
|
@exit:
|
|
End;
|
|
|
|
Procedure PaletteOff;
|
|
Var
|
|
INPal : RGB;
|
|
Begin
|
|
fillChar(InPal,sizeOf(RGB),0);
|
|
SetRGB(@InPal);
|
|
End;
|
|
|
|
Procedure FadeOut(First,Last : Word; Speed : Byte);
|
|
Var
|
|
R,G,B : Byte;
|
|
Begin
|
|
Asm
|
|
PushA
|
|
mov bh,speed
|
|
cmp bh,0
|
|
jne @ok
|
|
mov bh,1
|
|
@ok: mov si,$40
|
|
@Gb:
|
|
Mov cx,[First]
|
|
mov bl,bh
|
|
|
|
@@wt:call waitvbl
|
|
dec bl
|
|
jnz @@wt
|
|
|
|
@Rer:
|
|
{ Get R,G,B }
|
|
Mov dx,$3C7
|
|
Mov al,cl
|
|
Out dx,al
|
|
mov dx,$3C9
|
|
|
|
In al,dx
|
|
mov [r],Al
|
|
|
|
In al,dx
|
|
mov [g],Al
|
|
|
|
In al,dx
|
|
mov [b],Al
|
|
|
|
{ Decremente R,G,B }
|
|
cmp [r],0
|
|
je @G1
|
|
dec [R]
|
|
|
|
@G1: cmp [g],0
|
|
je @b1
|
|
dec [g]
|
|
|
|
@B1: cmp [B],0
|
|
je @n1
|
|
dec [B]
|
|
|
|
{ Write to DAC VGA }
|
|
@N1: Mov DX,$3C8
|
|
mov al,cl
|
|
out dx,al
|
|
inc dx
|
|
|
|
mov al,[r]
|
|
out dx,al
|
|
|
|
mov al,[g]
|
|
out dx,al
|
|
|
|
mov al,[b]
|
|
out dx,al
|
|
|
|
inc cx
|
|
cmp cx,[Last]
|
|
jbe @rer
|
|
|
|
dec Si
|
|
cmp si,-1
|
|
jne @GB
|
|
PopA
|
|
End;
|
|
End;
|
|
|
|
Procedure FadeIn(first,Last : word; Pal : pointer; Speed : Byte);
|
|
Var
|
|
R,G,B : Byte;
|
|
Begin
|
|
Asm
|
|
PushA
|
|
Push DS
|
|
mov bh,speed
|
|
cmp bh,0
|
|
jne @ok
|
|
mov bh,1
|
|
@ok: mov di,$40
|
|
@Gb:
|
|
Mov cx,[first]
|
|
|
|
mov bl,bh
|
|
@bcl:call WaitVbl
|
|
dec bl
|
|
jnz @bcl
|
|
@Rer:
|
|
{ Get R,G,B }
|
|
Lds sI,[Pal]
|
|
mov dx,3
|
|
mov ax,cx
|
|
mul dx
|
|
add si,ax
|
|
Mov dx,$3C7
|
|
Mov al,cl
|
|
Out dx,al
|
|
mov dx,$3C9
|
|
|
|
In al,dx
|
|
mov [r],Al
|
|
|
|
In al,dx
|
|
mov [g],Al
|
|
|
|
In al,dx
|
|
mov [b],Al
|
|
|
|
lodsb
|
|
{ Decremente R,G,B }
|
|
cmp [r],al
|
|
je @G1
|
|
inc [R]
|
|
|
|
@G1: lodsb
|
|
cmp [g],al
|
|
je @b1
|
|
inc [g]
|
|
|
|
@B1: lodsb
|
|
cmp [B],al
|
|
je @n1
|
|
inc [B]
|
|
|
|
{ Write to DAC VGA }
|
|
@N1: Mov DX,$3C8
|
|
mov al,cl
|
|
out dx,al
|
|
inc dx
|
|
|
|
mov al,[r]
|
|
out dx,al
|
|
|
|
mov al,[g]
|
|
out dx,al
|
|
|
|
mov al,[b]
|
|
out dx,al
|
|
|
|
inc cx
|
|
cmp cx,[last]
|
|
jbe @rer
|
|
|
|
dec di
|
|
cmp di,-1
|
|
jne @GB
|
|
Pop dS
|
|
PopA
|
|
End;
|
|
End;
|
|
|
|
Procedure FadeFromWhite(first,Last : word; Pal:pointer; Speed : Byte);
|
|
Var
|
|
R,G,B : Byte;
|
|
Begin
|
|
Asm
|
|
PushA
|
|
Push DS
|
|
mov bl,speed
|
|
mov di,$40
|
|
@Gb:
|
|
Mov cx,[first]
|
|
call WaitVbl
|
|
@Rer:
|
|
{ Get R,G,B }
|
|
LDs sI,Pal
|
|
mov dx,3
|
|
mov ax,cx
|
|
mul dx
|
|
add si,ax
|
|
Mov dx,$3C7
|
|
Mov al,cl
|
|
Out dx,al
|
|
mov dx,$3C9
|
|
|
|
In al,dx
|
|
mov [r],Al
|
|
|
|
In al,dx
|
|
mov [g],Al
|
|
|
|
In al,dx
|
|
mov [b],Al
|
|
|
|
lodsb
|
|
{ Decremente R,G,B }
|
|
cmp [r],al
|
|
je @G1
|
|
sub [R],bl
|
|
|
|
@G1: lodsb
|
|
cmp [g],al
|
|
je @b1
|
|
sub [g],bl
|
|
|
|
@B1: lodsb
|
|
cmp [B],al
|
|
je @n1
|
|
sub [B],bl
|
|
|
|
{ Write to DAC VGA }
|
|
@N1: Mov DX,$3C8
|
|
mov al,cl
|
|
out dx,al
|
|
inc dx
|
|
|
|
mov al,[r]
|
|
out dx,al
|
|
|
|
mov al,[g]
|
|
out dx,al
|
|
|
|
mov al,[b]
|
|
out dx,al
|
|
|
|
inc cx
|
|
cmp cx,[last]
|
|
jbe @rer
|
|
|
|
dec di
|
|
cmp di,$FFFF
|
|
jne @GB
|
|
Pop DS
|
|
PopA
|
|
End;
|
|
End;
|
|
|
|
Procedure FadeWhite(First,Last : Word; Speed : Byte);
|
|
Var
|
|
R,G,B : Byte;
|
|
Begin
|
|
Asm
|
|
mov bl,speed
|
|
mov BH,040h
|
|
sub bh,bl
|
|
mov si,40h
|
|
@Gb:
|
|
Mov cx,[First]
|
|
call WaitVbl
|
|
@Rer:
|
|
{ Get R,G,B }
|
|
Mov dx,$3C7
|
|
Mov al,cl
|
|
Out dx,al
|
|
mov dx,$3C9
|
|
|
|
In al,dx
|
|
mov [r],Al
|
|
|
|
In al,dx
|
|
mov [g],Al
|
|
|
|
In al,dx
|
|
mov [b],Al
|
|
|
|
{ Incremente R,G,B }
|
|
cmp r,bh
|
|
jnb @G1
|
|
add R,bl
|
|
|
|
@G1: cmp G,bh
|
|
jnb @b1
|
|
add G,bl
|
|
|
|
@B1: cmp B,bh
|
|
jnb @n1
|
|
add B,bl
|
|
|
|
{ Write to DAC VGA }
|
|
@N1: Mov DX,$3C8
|
|
mov al,cl
|
|
out dx,al
|
|
inc dx
|
|
|
|
mov al,[r]
|
|
out dx,al
|
|
|
|
mov al,[g]
|
|
out dx,al
|
|
|
|
mov al,[b]
|
|
out dx,al
|
|
|
|
inc cx
|
|
cmp cx,[Last]
|
|
jbe @rer
|
|
|
|
dec si
|
|
cmp si,-1
|
|
jne @GB
|
|
End;
|
|
End;
|
|
|
|
End. |