Upload New File
This commit is contained in:
Frater
parent
28e65dbbff
commit
9ac1db7e10
1 changed files with 523 additions and 0 deletions
523
GRAPHV2.PAS
Normal file
523
GRAPHV2.PAS
Normal file
|
|
@ -0,0 +1,523 @@
|
|||
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.
|
||||
Loading…
Reference in a new issue