Demos/atlantis_addie
Watch
1
0
Fork
You've already forked atlantis_addie
 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Upload New File

Browse source
This commit is contained in:
Frater 2021-10-22 20:07:31 +00:00
commit 9ac1db7e10
1 changed files with 523 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

523
GRAPHV2.PAS Normal file
View 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.