Original source code back to 1994
This commit is contained in:
commit
6bc455f9af
37 changed files with 3240 additions and 0 deletions
952
SRC/GRAPHVGA.PAS
Normal file
952
SRC/GRAPHVGA.PAS
Normal file
|
|
@ -0,0 +1,952 @@
|
|||
Unit GraphVGA;
|
||||
interface
|
||||
Uses
|
||||
CRT,DOS;
|
||||
Const
|
||||
NormEffect = 0;
|
||||
FadeEffect = 1;
|
||||
noViewEfct = 2;
|
||||
GetMaxX = 319;
|
||||
GetMaxY = 199;
|
||||
CentreX = 160;
|
||||
CentreY = 100;
|
||||
VGA = $13;
|
||||
CGALo = $04;
|
||||
CGAHi = $06;
|
||||
On = True;
|
||||
Off = False;
|
||||
Screen : Pointer = Ptr($0000,$0000);
|
||||
MagicLong : Longint = $11111111;
|
||||
Type
|
||||
Infor = Record
|
||||
X1,Y1,X2,Y2 : Integer;
|
||||
End;
|
||||
PointType = Record
|
||||
X,Y : Integer;
|
||||
End;
|
||||
ColorRGB = Record
|
||||
Rouge : Byte;
|
||||
Vert : Byte;
|
||||
Bleu : Byte;
|
||||
End;
|
||||
RGB = Array[0..$FF] of ColorRGB;
|
||||
ImageInfo = Record
|
||||
SizeX : Word;
|
||||
SizeY : Word;
|
||||
Palette : RGB;
|
||||
Picture : Pointer;
|
||||
Size : Word;
|
||||
End;
|
||||
Var
|
||||
PageW : Pointer;
|
||||
PageWS : Word;
|
||||
PageWO : Word;
|
||||
WriteS : Word;
|
||||
Reg : Registers;
|
||||
RGBPal : RGB;
|
||||
DirectV : Boolean;
|
||||
VgaMode : Boolean;
|
||||
Doub : Boolean;
|
||||
DefSpd : Byte;
|
||||
_CColor : Byte;
|
||||
|
||||
Procedure pause(Speed : Word);
|
||||
|
||||
Procedure SimpleBuffer;
|
||||
|
||||
Procedure DoubleBuffer;
|
||||
|
||||
Procedure SetDColor( c: Byte);
|
||||
|
||||
Function Rad(A : Real) : real;
|
||||
|
||||
Function Deg(A : Real) : Real;
|
||||
|
||||
Procedure WaitVBL;
|
||||
|
||||
Procedure SetRGB(Var Pal : RGB);
|
||||
|
||||
Procedure GetRGB(Var Pal : RGB);
|
||||
|
||||
{ Assembler : }
|
||||
Procedure InitGraph( Mode : Byte );
|
||||
|
||||
Procedure CloseGraph;
|
||||
|
||||
Procedure SetSpeed(Speed : Byte);
|
||||
{ Assembler : }
|
||||
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 DirectVideo(Direct : Boolean);
|
||||
|
||||
Function GetVideo : Boolean;
|
||||
|
||||
Procedure SetColor ( Color, Red, Green, Blue : Byte );
|
||||
|
||||
Procedure SetRGBColor( Color,R,G,B : Byte; Var Pal : RGB);
|
||||
|
||||
{ Assembler }
|
||||
Procedure Line(X1,Y1,X2,Y2 : Integer; Color : byte);
|
||||
|
||||
Procedure PaletteOff;
|
||||
|
||||
{ Assembler }
|
||||
Procedure FadeOut(First,Last : Word; Speed : Byte);
|
||||
|
||||
Procedure FadeIn(first,Last : word; Var Pal : RGB; speed : Byte);
|
||||
|
||||
Procedure FadeFromWhite(first,Last : word; Var Pal : RGB; Speed : Byte);
|
||||
|
||||
Procedure FadeWhite(First,Last : Word; speed : Byte);
|
||||
|
||||
Function expo(A,E : integer) : LongInt;
|
||||
|
||||
Procedure PutImage( Var Im : ImageInfo;
|
||||
Mo : Byte);
|
||||
|
||||
Procedure AllocImage( SX,SY : Word;
|
||||
Var I : imageInfo);
|
||||
|
||||
Procedure FreeImage( Var I : ImageInfo);
|
||||
|
||||
Procedure LoadRIX(N : String; Var Ima : Imageinfo);
|
||||
|
||||
Procedure Comprs(Var Pic : Pointer; Var Taille : Word);
|
||||
|
||||
Procedure UnComprs(Pic : Pointer; ToP : Pointer);
|
||||
|
||||
Implementation
|
||||
{
|
||||
Var
|
||||
PageW : Pointer;
|
||||
PageWS : Word;
|
||||
PageWO : Word;
|
||||
WriteS : Word;
|
||||
Reg : Registers;
|
||||
DirectV : Boolean;
|
||||
VgaMode : Boolean;
|
||||
DefSpd : Byte;
|
||||
_CColor : Byte;
|
||||
}
|
||||
|
||||
Procedure Pause(Speed : Word);
|
||||
Var
|
||||
I : Word;
|
||||
Begin
|
||||
I := 0;
|
||||
Repeat
|
||||
Inc(I);
|
||||
Until I>Speed;
|
||||
End;
|
||||
|
||||
Procedure SetDColor( c: Byte);
|
||||
Begin
|
||||
_CColor := C;
|
||||
End;
|
||||
|
||||
Function Rad(A : Real) : real;
|
||||
Begin
|
||||
Rad := (A*Pi)/180;
|
||||
End;
|
||||
|
||||
Function Deg(A : Real) : Real;
|
||||
Begin
|
||||
Deg := (A*180) /pi;
|
||||
End;
|
||||
|
||||
Procedure WaitVBL; Assembler;
|
||||
Asm
|
||||
{ Wait VBL }
|
||||
Mov DX,$3DA
|
||||
@W: in AL,DX
|
||||
Test AL,$08
|
||||
Jne @W
|
||||
|
||||
@X: in AL,DX
|
||||
test AL,$08
|
||||
Je @X
|
||||
end;
|
||||
|
||||
Procedure SetColor ( Color, Red, Green, Blue : Byte ); Assembler;
|
||||
Asm
|
||||
PushA
|
||||
Mov DX,$3C8
|
||||
Mov AL,[Color]
|
||||
Out DX,AL
|
||||
Inc DX
|
||||
Mov AL,[Red]
|
||||
Out DX,AL
|
||||
Mov AL,[Green]
|
||||
Out DX,AL
|
||||
Mov AL,[Blue]
|
||||
Out DX,AL
|
||||
PopA
|
||||
End;
|
||||
|
||||
Procedure SetRGB(Var Pal : RGB); Assembler;
|
||||
Asm
|
||||
Push DS
|
||||
Push SI
|
||||
Push DX
|
||||
Push CX
|
||||
Push AX
|
||||
|
||||
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
|
||||
|
||||
mov DI,offset [RGBPal]
|
||||
mov ax,seg [rgbPal]
|
||||
mov es,ax
|
||||
Lds SI,[Pal]
|
||||
mov CX,3*$FF
|
||||
rep movsb
|
||||
Pop AX
|
||||
Pop CX
|
||||
Pop DX
|
||||
Pop SI
|
||||
Pop DS
|
||||
End;
|
||||
|
||||
Procedure GetRGB(Var Pal : RGB); Assembler;
|
||||
Asm
|
||||
Push DS
|
||||
Push SI
|
||||
Push DX
|
||||
Push CX
|
||||
Push AX
|
||||
|
||||
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 CH,$00
|
||||
jz @beg
|
||||
|
||||
Pop AX
|
||||
Pop CX
|
||||
Pop DX
|
||||
Pop SI
|
||||
Pop DS
|
||||
End;
|
||||
|
||||
Procedure SetSpeed(Speed : Byte);
|
||||
Begin
|
||||
DefSpd := Speed;
|
||||
End;
|
||||
|
||||
Procedure SimpleBuffer;
|
||||
Begin
|
||||
If not Doub Then Exit;
|
||||
Freemem(PageW,$FFFF);
|
||||
PageWS := $A000;
|
||||
WriteS := $A000;
|
||||
Doub := false;
|
||||
End;
|
||||
|
||||
Procedure DoubleBuffer;
|
||||
Begin
|
||||
If Doub Then Exit;
|
||||
Getmem(pageW,$FFFF);
|
||||
PageWS := Seg(PageW^);
|
||||
WriteS := PageWS;
|
||||
Doub := True;
|
||||
End;
|
||||
|
||||
Procedure InitGraph( Mode : Byte );
|
||||
Begin
|
||||
asm
|
||||
Mov AH,$00
|
||||
Mov AL,&Mode
|
||||
int $10
|
||||
End;
|
||||
DirectV := False;
|
||||
VGAMode := True;
|
||||
DefSpd := 100;
|
||||
Getmem(pageW,$FFFF);
|
||||
PageWS := Seg(PageW^);
|
||||
WriteS := PageWS;
|
||||
Screen := Ptr($A000,0000);
|
||||
FillChar(PageW^,64000,0);
|
||||
Doub := True;
|
||||
_CColor := 15;
|
||||
GetRGB(RGBPal);
|
||||
End;
|
||||
|
||||
Procedure CloseGraph;
|
||||
Begin
|
||||
If Not VGAMode Then
|
||||
Exit;
|
||||
If doub then
|
||||
FreeMem(Pagew,$FFFF);
|
||||
Asm
|
||||
Mov AH,$00
|
||||
Mov AL,$03
|
||||
int $10
|
||||
End;
|
||||
TextMode(CO80);
|
||||
End;
|
||||
|
||||
Procedure PutPixel( X,Y : Integer;
|
||||
C : Byte); Assembler;
|
||||
asm
|
||||
Mov Ax,[X]
|
||||
cmp [X],1
|
||||
jl @exit
|
||||
cmp [X],320
|
||||
jg @exit
|
||||
cmp [Y],1
|
||||
jl @exit
|
||||
cmp [Y],200
|
||||
jg @exit
|
||||
|
||||
mov ax,&WriteS
|
||||
mov Es,ax
|
||||
dec [x] { X-1 }
|
||||
dec [y] { Y-1 }
|
||||
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,$7D00
|
||||
Xor Si,Si
|
||||
xor Di,Di
|
||||
Rep MovsW
|
||||
|
||||
Pop DS
|
||||
@exit:
|
||||
End;
|
||||
|
||||
Procedure DirectVideo(Direct : Boolean);
|
||||
Begin
|
||||
Case Direct Of
|
||||
True : WriteS := $A000;
|
||||
False : WriteS := PageWS;
|
||||
End;
|
||||
directV := Direct;
|
||||
End;
|
||||
|
||||
Function GetVideo : Boolean;
|
||||
Begin
|
||||
GetVideo := DirectV;
|
||||
End;
|
||||
|
||||
Procedure SetRGBColor( Color,R,G,B : Byte; Var Pal : RGB);
|
||||
Begin
|
||||
With Pal[Color] Do
|
||||
Begin
|
||||
Rouge := R;
|
||||
Vert := G;
|
||||
Bleu := B;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure Line(X1,Y1,X2,Y2 : Integer; Color : Byte); Assembler;
|
||||
Asm
|
||||
mov ax,WriteS
|
||||
mov es,ax
|
||||
mov si,x2
|
||||
sub si,x1
|
||||
mov ax,si
|
||||
jns @1
|
||||
neg ax
|
||||
@1: mov di,y2
|
||||
sub di,y1
|
||||
mov bx,di
|
||||
jns @2
|
||||
neg bx
|
||||
@2: cmp ax,bx
|
||||
jge @3
|
||||
jmp @4
|
||||
@3: cmp ax,0
|
||||
je @fin
|
||||
std
|
||||
cmp si,0
|
||||
jge @5
|
||||
cld
|
||||
@5: mov cx,si
|
||||
@bcl1: mov ax,si
|
||||
imul di
|
||||
idiv cx
|
||||
add ax,y1
|
||||
mov bx,ax
|
||||
mov ax,320
|
||||
mul bx
|
||||
add ax,x1
|
||||
add ax,si
|
||||
mov bx,ax
|
||||
mov al,color
|
||||
mov byte ptr es:[bx],al
|
||||
lodsb
|
||||
cmp si,0
|
||||
jnz @bcl1
|
||||
jmp @fin
|
||||
@4: xchg si,di
|
||||
std
|
||||
cmp si,0
|
||||
jge @6
|
||||
cld
|
||||
@6: mov cx,si
|
||||
@bcl2: mov bx,y1
|
||||
add bx,si
|
||||
mov ax,320
|
||||
mul bx
|
||||
mov bx,ax
|
||||
mov ax,di
|
||||
imul si
|
||||
idiv cx
|
||||
add ax,x1
|
||||
add bx,ax
|
||||
mov al,color
|
||||
mov byte ptr es:[bx],al
|
||||
lodsb
|
||||
cmp si,0
|
||||
jnz @bcl2
|
||||
@fin:
|
||||
end;
|
||||
|
||||
Procedure GetIntRGB ( Var Pal : RGB); Assembler;
|
||||
asm
|
||||
Mov AH,10h
|
||||
mov AL,17h
|
||||
Xor BX,BX
|
||||
mov CX,256*3
|
||||
les dx,Pal
|
||||
int 10h
|
||||
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 bl,speed
|
||||
mov si,$40
|
||||
@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
|
||||
|
||||
{ Decremente R,G,B }
|
||||
cmp [r],0
|
||||
je @G1
|
||||
sub [R],bl
|
||||
|
||||
@G1: cmp [g],0
|
||||
je @b1
|
||||
sub [g],bl
|
||||
|
||||
@B1: cmp [B],0
|
||||
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 Si
|
||||
cmp si,-1
|
||||
jne @GB
|
||||
PopA
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure FadeIn(first,Last : word; Var Pal : RGB; Speed : Byte);
|
||||
Var
|
||||
R,G,B : Byte;
|
||||
Begin
|
||||
Asm
|
||||
PushA
|
||||
Push ES
|
||||
mov bl,speed
|
||||
mov di,$40
|
||||
@Gb:
|
||||
Mov cx,[first]
|
||||
call WaitVbl
|
||||
@Rer:
|
||||
{ Get R,G,B }
|
||||
Les 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
|
||||
add [R],bl
|
||||
|
||||
@G1: lodsb
|
||||
cmp [g],al
|
||||
je @b1
|
||||
add [g],bl
|
||||
|
||||
@B1: lodsb
|
||||
cmp [B],al
|
||||
je @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 di
|
||||
cmp di,-1
|
||||
jne @GB
|
||||
Pop ES
|
||||
PopA
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure FadeFromWhite(first,Last : word; Var Pal : RGB; 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;
|
||||
GetRGB(RGBPal);
|
||||
End;
|
||||
|
||||
Function expo(A,E : integer) : LongInt;
|
||||
Var
|
||||
E1 : Byte;
|
||||
T : LongInt;
|
||||
Begin
|
||||
T := A;
|
||||
For E1:= 1 to e-1 do
|
||||
T := A * T;
|
||||
Expo := T;
|
||||
End;
|
||||
|
||||
Procedure PutImage( Var Im : ImageInfo;
|
||||
Mo : Byte);
|
||||
Var
|
||||
X1,Y1 : Word;
|
||||
Y2 : Word;
|
||||
B : Boolean;
|
||||
Begin
|
||||
B := GetVideo;
|
||||
If Mo <> 2 Then PaletteOff;
|
||||
DirectVideo(On);
|
||||
With Im do
|
||||
Begin
|
||||
For Y1:=1 to SizeY do
|
||||
Begin
|
||||
Y2 := (Y1-1)*320;
|
||||
X1 := (Y1-1)*SizeX;
|
||||
move( Mem[Seg(Picture^): Ofs(Picture^)+X1],
|
||||
Mem[WriteS:(Y2)],SizeX);
|
||||
End;
|
||||
DirectVideo(B);
|
||||
Case Mo Of
|
||||
0 : SetRGB(Palette);
|
||||
1 : FadeIn(0,$ff,Palette,1);
|
||||
2 : SETRGB(Palette);
|
||||
3 : ;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure AllocImage( SX,SY : Word;
|
||||
Var I : imageInfo);
|
||||
Var
|
||||
Si : Longint;
|
||||
Begin
|
||||
Si := Longint(SX)*Longint(SY);
|
||||
With I do
|
||||
Begin
|
||||
If SI > 64000 Then
|
||||
SI := 64000;
|
||||
GetMem(Picture,Si);
|
||||
Size := Si;
|
||||
SizeX := Sx;
|
||||
SizeY := Sy;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure FreeImage( Var I : ImageInfo);
|
||||
Begin
|
||||
With I do
|
||||
Begin
|
||||
FreeMem(Picture,Size);
|
||||
Size := 0;
|
||||
SizeX := 0;
|
||||
SizeY := 0;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure LoadRIX(N : String; Var Ima : Imageinfo);
|
||||
Var
|
||||
Header : LongInt;
|
||||
F : file;
|
||||
X,Y : Word;
|
||||
CC : Byte;
|
||||
Xs,YS : Word;
|
||||
Info : Word;
|
||||
Begin
|
||||
Assign(F,N);
|
||||
reset(F,1);
|
||||
BlockRead(F,Header,4);
|
||||
BlockRead(F,Xs,2);
|
||||
BlockRead(F,YS,2);
|
||||
BlockRead(F,Info,2);
|
||||
AllocImage(Xs,Ys,Ima);
|
||||
For Xs:=0 to $Ff do
|
||||
With Ima do
|
||||
BlockRead(F,Palette[Xs],3);
|
||||
BlockRead(f,Ima.Picture^,ima.Size);
|
||||
Close(F);
|
||||
End;
|
||||
|
||||
Procedure Comprs(Var Pic : Pointer; Var Taille : Word);
|
||||
Function scan( X : Word;
|
||||
C : Byte) : Byte;
|
||||
Var
|
||||
I : Word;
|
||||
Ct : Byte;
|
||||
Begin
|
||||
I := X;
|
||||
Ct := 0;
|
||||
While (Mem[WriteS:I] = C) AND (I<64000) AND (Ct<$FF) DO
|
||||
Begin
|
||||
Inc(Ct);
|
||||
Inc(I);
|
||||
End;
|
||||
Scan := Ct-1;
|
||||
End;
|
||||
|
||||
Var
|
||||
I : Word;
|
||||
R : Word;
|
||||
P : Byte;
|
||||
Sc : Byte;
|
||||
Ts : Pointer;
|
||||
Begin
|
||||
getMem(Ts,64000);
|
||||
I := 0;
|
||||
R := 0;
|
||||
Repeat
|
||||
P := Scan(I,Mem[WriteS:I]);
|
||||
If P > 1 Then
|
||||
Begin
|
||||
MemL[seg(Ts^):Ofs(Ts^)+R ] := MagicLong;
|
||||
Mem[seg(Ts^):Ofs(Ts^)+R+4] := P; { Nombre de repetitions }
|
||||
Mem[seg(Ts^):Ofs(Ts^)+R+5] := Mem[WriteS:I]; { Byte a r‚p‚ter }
|
||||
Inc(R,6);
|
||||
Inc(I,P+1);
|
||||
For Sc := I to I+p+1 do
|
||||
Mem[WriteS:I] := 0;
|
||||
End
|
||||
Else
|
||||
Begin
|
||||
Mem[Seg(Ts^):Ofs(Ts^)+R] := Mem[WriteS:I];
|
||||
inc(R);
|
||||
Inc(I);
|
||||
End;
|
||||
Until I>64000;
|
||||
Taille := R;
|
||||
GetMem(Pic,Taille);
|
||||
Move(Ts^,Pic^,Taille);
|
||||
FreeMem(Ts,64000);
|
||||
End;
|
||||
|
||||
Procedure UnComprs(Pic : Pointer; ToP : Pointer);
|
||||
Var
|
||||
I,R : Word;
|
||||
C : Byte;
|
||||
Begin
|
||||
I := 0;
|
||||
R := Ofs(Pic^);
|
||||
Repeat
|
||||
If MemL[seg(Pic^):R ] = MagicLong Then
|
||||
Begin
|
||||
For C:= 0 to Mem[seg(Pic^):R+4] do
|
||||
Begin
|
||||
Mem[Seg(Top^):I] := Mem[seg(Pic^):R+5];
|
||||
Inc(i);
|
||||
End;
|
||||
Inc(R,6);
|
||||
End
|
||||
Else
|
||||
Begin
|
||||
Mem[Seg(Top^):I] := Mem[Seg(Pic^):R];
|
||||
inc(R);
|
||||
Inc(I);
|
||||
End;
|
||||
Until I>64000;
|
||||
End;
|
||||
|
||||
End.
|
||||
Loading…
Reference in a new issue