Original source code back to 1994
This commit is contained in:
commit
6bc455f9af
37 changed files with 3240 additions and 0 deletions
169
SRC/FIRE.PAS
Normal file
169
SRC/FIRE.PAS
Normal file
|
|
@ -0,0 +1,169 @@
|
|||
Unit Fire;
|
||||
Interface
|
||||
Procedure Greetings;
|
||||
Implementation
|
||||
|
||||
{ need a "lot" of memory (3*64Kb=196605 Bytes) 191Kb free conventional mem }
|
||||
Uses
|
||||
CRT,DOS,GRAPHVGA,LibUses;
|
||||
Const
|
||||
MAxC = $40;
|
||||
{ Torche }
|
||||
BaseX = 30;
|
||||
BaseY = 50;
|
||||
MaxX = 20;
|
||||
SizeX = 20;
|
||||
maxXd2 = SizeX shr 1;
|
||||
maxXd3 = SizeX shr 2;
|
||||
AddX = MaxX;
|
||||
MaxY = 30;
|
||||
count1 : Word = 20;
|
||||
debut = (BaseY*320)+BaseX;
|
||||
BaseC = MaxY;
|
||||
|
||||
Var
|
||||
Buffer : Pointer;
|
||||
AddX1 : Integer;
|
||||
Vbuf1 : Word;
|
||||
im, Im2 : ImageInfo;
|
||||
|
||||
Procedure Pixel(VB,MX,My,X,Y : Word; C : Byte);
|
||||
begin
|
||||
If (X<1) OR (X>MX) OR (Y<1) Or (Y>MY) Then
|
||||
exit;
|
||||
Mem[VB:(Y-1)*MX+(x-1)] := C;
|
||||
End;
|
||||
|
||||
Procedure Init;
|
||||
Var
|
||||
X,Y : Word;
|
||||
Begin
|
||||
Simplebuffer;
|
||||
LoadImage(Greetings1,Im);
|
||||
LoadImage(Greetings2,Im2);
|
||||
PutImage(Im,0);
|
||||
Freeimage(Im);
|
||||
GetMem(Buffer,$FFFF);
|
||||
FillChar(Buffer^,$FFFF,0);
|
||||
VBuf1 := seg(Buffer^);
|
||||
End;
|
||||
|
||||
Procedure Outit;
|
||||
Begin
|
||||
FreeMem(Buffer,$FFFF);
|
||||
End;
|
||||
|
||||
Procedure FireTorch;
|
||||
Var
|
||||
X,Y : Word;
|
||||
Begin
|
||||
For X:=1 to Count1 do
|
||||
Pixel(VBuf1,MaxX,MaxY,Random(maxxd2)+(maxxd3),MaxY,MaxC);
|
||||
for X:=1 to count1 shr 1 do
|
||||
Pixel(VBuf1,MaxX,MaxY,Random(SizeX-maxxD2)+MaxxD3,maxy-5,MaxC-12);
|
||||
for X:=1 to count1 shr 2 do
|
||||
Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-13,MaxC-15);
|
||||
for X:=1 to count1 shr 3 do
|
||||
Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-20,MaxC-15); asm
|
||||
cli
|
||||
Push DS
|
||||
mov AX,VBuf1
|
||||
mov DS,AX
|
||||
mov cx,BaseC*MaxX
|
||||
Mov SI,0 {(MaxY-baseC+1)*maxX}
|
||||
@@BCL: xor AX,AX
|
||||
xor BX,BX
|
||||
mov bl,[si-1]
|
||||
add ax,bx
|
||||
mov bl,[si+1]
|
||||
add ax,bx
|
||||
mov bl,[si+MaxX]
|
||||
add ax,bx
|
||||
mov bl,[si-MaxX]
|
||||
add ax,bx
|
||||
|
||||
mov bl,[SI+MaxX-1]
|
||||
add ax,bx
|
||||
mov bl,[SI-MaxX-1]
|
||||
add ax,bx
|
||||
mov bl,[SI-MaxX+1]
|
||||
add ax,bx
|
||||
mov bl,[SI+MaxX+1]
|
||||
add ax,bx
|
||||
|
||||
shr Ax,3
|
||||
or ax,ax
|
||||
je @@ne
|
||||
dec AX
|
||||
@@Ne: mov [SI-AddX],al
|
||||
inc SI
|
||||
dec CX
|
||||
jnz @@BCL
|
||||
Pop DS
|
||||
sti
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure PutTorche(X,Y : Word); Assembler;
|
||||
Asm
|
||||
cli
|
||||
push DS
|
||||
mov DX,VBuf1
|
||||
mov DS,DX
|
||||
Mov AX,0A000h
|
||||
mov ES,AX
|
||||
Xor SI,SI
|
||||
Mov AX,Y
|
||||
Mov BX,320
|
||||
Mul BX
|
||||
Add AX,X
|
||||
Mov DI,AX
|
||||
Mov DX,MaxX
|
||||
mov BX,MaxY-3
|
||||
@@Bcl1: Mov CX,DX
|
||||
Rep Movsb
|
||||
Add DI,320-MaxX
|
||||
dec BX
|
||||
Jnz @@Bcl1
|
||||
pop DS
|
||||
sti
|
||||
end;
|
||||
|
||||
Procedure Greetings;
|
||||
var
|
||||
C : Word;
|
||||
Begin
|
||||
Init;
|
||||
C := 0;
|
||||
While (C <=500) do
|
||||
begin
|
||||
FireTorch;
|
||||
PutTorche(35,80);
|
||||
PutTorche(270,80);
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
inc(C);
|
||||
end;
|
||||
FadeOut(0,$ff,1);
|
||||
PutImage(im2,3);
|
||||
PutTorche(35,80);
|
||||
PutTorche(270,80);
|
||||
FadeIn(0,$FF,Im2.palette,1);
|
||||
FreeImage(Im2);
|
||||
c := 0;
|
||||
While (C <=500) do
|
||||
begin
|
||||
FireTorch;
|
||||
PutTorche(35,80);
|
||||
PutTorche(270,80);
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
inc(C);
|
||||
end;
|
||||
Outit;
|
||||
FadeOut(0,$FF,1);
|
||||
end;
|
||||
|
||||
End.
|
||||
|
||||
|
||||
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.
|
||||
343
SRC/IFFLOAD.PAS
Normal file
343
SRC/IFFLOAD.PAS
Normal file
|
|
@ -0,0 +1,343 @@
|
|||
Unit IFFLOAD;
|
||||
interface
|
||||
USES
|
||||
CRT,DOS,GRAPHVGA;
|
||||
|
||||
Procedure LoadIFF(N : String; Var Vers : ImageInfo);
|
||||
|
||||
Procedure WaitKey;
|
||||
|
||||
Implementation
|
||||
Type
|
||||
CmprInfo = Record
|
||||
Raw : Pointer;
|
||||
Size : Word;
|
||||
End;
|
||||
Char4 = Array[1..4] of Char;
|
||||
Str4 = String[4];
|
||||
rBMHD = Record
|
||||
Len : LongInt;
|
||||
LX : Word;
|
||||
LY : Word;
|
||||
OX : Word;
|
||||
OY : Word;
|
||||
Plan : Byte;
|
||||
Mask : Byte;
|
||||
Cmprs : byte;
|
||||
Dummy : Byte;
|
||||
Trans : Word;
|
||||
AspX : Byte;
|
||||
aspY : Byte;
|
||||
LaX : Word;
|
||||
LaY : Word;
|
||||
End;
|
||||
rCRNG = Record
|
||||
Len : Longint;
|
||||
Dummy : Word;
|
||||
Speed : Word;
|
||||
Actv : Word;
|
||||
LInf : Byte;
|
||||
LSup : Byte;
|
||||
End;
|
||||
rCAMG = record
|
||||
Len : LongInt;
|
||||
Vport : LongInt;
|
||||
end;
|
||||
|
||||
Function SwapLong(L : Longint) : Longint;
|
||||
Var
|
||||
J,I : Byte;
|
||||
L2 : LongInt;
|
||||
Begin
|
||||
J := 3;
|
||||
For I:= 0 to 3 do
|
||||
Begin
|
||||
Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j];
|
||||
Dec(J);
|
||||
End;
|
||||
SwapLong := L2;
|
||||
End;
|
||||
|
||||
Function SwapWord(L : Word) : Word;
|
||||
Var
|
||||
J,I : Byte;
|
||||
L2 : word;
|
||||
Begin
|
||||
J := 1;
|
||||
For I:= 0 to 1 do
|
||||
Begin
|
||||
Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j];
|
||||
Dec(J);
|
||||
End;
|
||||
SwapWord := L2;
|
||||
End;
|
||||
|
||||
Function Char2Str(Source : Char4) : Str4;
|
||||
Var
|
||||
I : Byte;
|
||||
B : Str4;
|
||||
Begin
|
||||
B := '';
|
||||
For I:=1 to 4 do
|
||||
B := B + Source[I];
|
||||
Char2Str := B;
|
||||
End;
|
||||
|
||||
Procedure LoadIFF(N : String; Var Vers : ImageInfo);
|
||||
Var
|
||||
F : File;
|
||||
Size : Longint;
|
||||
Cmp : Boolean;
|
||||
Plan : Byte;
|
||||
TypeR : Char4;
|
||||
Mask : Boolean;
|
||||
ToP : Boolean;
|
||||
|
||||
Procedure FORM;
|
||||
Begin
|
||||
BlockRead(F,Size,4);
|
||||
Size := SwapLong(Size);
|
||||
inc(Size,4);
|
||||
BlockRead(F,TypeR,4);
|
||||
If TypeR = 'ILBM' Then Top := False else
|
||||
If TypeR = 'PBM ' Then Top := True;
|
||||
End;
|
||||
|
||||
Procedure BMHD;
|
||||
Var
|
||||
Chunk : rBMHD;
|
||||
Begin
|
||||
BlockRead(F,Chunk,Sizeof(Chunk));
|
||||
Plan := Chunk.Plan;
|
||||
WIth Vers do
|
||||
Begin
|
||||
SizeX := SwapWord(Chunk.LX);
|
||||
SizeY := SwapWord(Chunk.LY);
|
||||
End;
|
||||
Cmp := Chunk.Cmprs = 1;
|
||||
Mask := Chunk.Mask <> 0;
|
||||
End;
|
||||
|
||||
Procedure CMAP;
|
||||
Var
|
||||
Len : Longint;
|
||||
I : Longint;
|
||||
J : Byte;
|
||||
Begin
|
||||
BlockRead(F,Len,SizeOf(Len));
|
||||
Len := SwapLong(Len);
|
||||
With Vers do
|
||||
Begin
|
||||
FillChar(Palette,$ff*3,0);
|
||||
BlockRead(F,Palette,Len);
|
||||
For J:=0 to $FF do
|
||||
Begin
|
||||
Palette[J].Rouge := Palette[J].Rouge Shr 2;
|
||||
Palette[J].Vert := Palette[J].Vert Shr 2;
|
||||
Palette[J].Bleu := Palette[J].Bleu shr 2;
|
||||
end;
|
||||
End;
|
||||
end;
|
||||
|
||||
Procedure CRNG;
|
||||
Var
|
||||
Chunk : rCRNG;
|
||||
Begin
|
||||
BlockRead(F,Chunk,SizeOf(Chunk));
|
||||
End;
|
||||
|
||||
Procedure CAMG;
|
||||
Var
|
||||
Chunk : rCAMG;
|
||||
Begin
|
||||
BlockRead(F,Chunk,SizeOf(Chunk));
|
||||
End;
|
||||
|
||||
Procedure Put(P : Pointer; S : Word);
|
||||
Var
|
||||
X,Y : Word;
|
||||
T : Word;
|
||||
Os : ShortInt;
|
||||
Sp : Word;
|
||||
SW : Word;
|
||||
OW : Word;
|
||||
Bits : Boolean;
|
||||
Buf : Pointer;
|
||||
Pl : Byte;
|
||||
Bc : Byte;
|
||||
Begin
|
||||
T := 0;
|
||||
Pl := 0;
|
||||
Sp := Seg(P^);
|
||||
GetMem(Buf,64000);
|
||||
Ow := 0;
|
||||
SW := Seg(Buf^);
|
||||
Ow := Ofs(Buf^);
|
||||
FillChar(Buf^,64000,0);
|
||||
With Vers do
|
||||
Begin
|
||||
For Y:=0 to 199 do
|
||||
For Pl := 0 to Plan do
|
||||
Begin
|
||||
X := 0;
|
||||
For BC:=0 to 39 do
|
||||
For Os := 7 DownTo 0 do
|
||||
Begin
|
||||
Bits:=(Mem[SP:(Y*SizeX+(pl*40))+BC] AND (1 Shl Os))<>0;
|
||||
If Bits Then
|
||||
Mem[SW:Ow+((Y*320)+x)] :=
|
||||
Mem[SW:OW+((Y*320)+x)] + (1 Shl Pl);
|
||||
inc(X);
|
||||
End;
|
||||
End;
|
||||
end;
|
||||
Move(Mem[Seg(Buf^):Ofs(Buf^)],
|
||||
Mem[Seg(Vers.Picture^):Ofs(Vers.Picture^)],64000);
|
||||
FreeMem(Buf,64000);
|
||||
End;
|
||||
|
||||
Procedure Decomprs( RAW : Pointer;
|
||||
Len : Word);
|
||||
Var
|
||||
SegR : Word;
|
||||
SegD : Word;
|
||||
Begin
|
||||
segR := Seg(Raw^);
|
||||
With Vers do
|
||||
Begin
|
||||
Size := 64000;
|
||||
GetMem(Picture,Size);
|
||||
SegD := seg(Picture^);
|
||||
End;
|
||||
Asm
|
||||
Push DS
|
||||
Xor SI,SI
|
||||
Xor DI,DI
|
||||
Mov AX,[SegR]
|
||||
Mov DS,AX
|
||||
Mov AX,[SegD]
|
||||
mov ES,ax
|
||||
|
||||
@encore:
|
||||
lodsb
|
||||
cmp al,-128
|
||||
je @suivant
|
||||
cmp al,-1
|
||||
jle @copie
|
||||
{ Prendre al+1 Octets }
|
||||
xor cx,cx
|
||||
mov cl,al
|
||||
inc cx
|
||||
rep Movsb
|
||||
jmp @suivant
|
||||
{ Recopie [Si+1] 1-al fois }
|
||||
@Copie: xor CX,CX
|
||||
mov cl,1
|
||||
sub cl,al
|
||||
lodsb
|
||||
rep stosb
|
||||
|
||||
@suivant:cmp SI,[Len]
|
||||
jbe @encore
|
||||
|
||||
Pop DS
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure BODY;
|
||||
Var
|
||||
Len : Longint;
|
||||
P : Pointer;
|
||||
Begin
|
||||
BlockRead(F,Len,4);
|
||||
Len := SwapLong(Len);
|
||||
GetMem(P,Len);
|
||||
BlockRead(F,P^,Len);
|
||||
If Cmp Then
|
||||
Decomprs(P,Len)
|
||||
Else
|
||||
With Vers do
|
||||
begin
|
||||
Size := Word(Len);
|
||||
GetMem(Picture,Size);
|
||||
Move(P^,Picture^,Size);
|
||||
End;
|
||||
Case ToP of
|
||||
False : Put(Vers.Picture,Vers.Size);
|
||||
True :{ Move(Ptr(Seg(Vers.picture^),Ofs(Vers.picture^))^,
|
||||
Ptr(Seg(Vers.picture^),Ofs(Vers.picture^)+8)^,64000)};
|
||||
End;
|
||||
FreeMem(P,Len);
|
||||
End;
|
||||
|
||||
Procedure Unknow;
|
||||
Var
|
||||
L : Longint;
|
||||
P : LongInt;
|
||||
Begin
|
||||
BlockRead(F,L,4);
|
||||
L := SwapLong(L);
|
||||
P := FilePos(F);
|
||||
Seek(F,P+L);
|
||||
End;
|
||||
|
||||
Procedure DPPS;
|
||||
Var
|
||||
L : Longint;
|
||||
P : LongInt;
|
||||
Begin
|
||||
BlockRead(F,L,4);
|
||||
L := SwapLong(L);
|
||||
P := FilePos(F);
|
||||
Seek(F,P+L);
|
||||
Top := True;
|
||||
End;
|
||||
|
||||
Procedure TINY;
|
||||
Var
|
||||
Len : Longint;
|
||||
P : Longint;
|
||||
Begin
|
||||
BlockRead(F,Len,4);
|
||||
Len := SwapLong(Len);
|
||||
P := FilePos(F);
|
||||
If (Len Mod 2) <> 0 Then
|
||||
Inc(Len);
|
||||
Seek(F,P+Len);
|
||||
End;
|
||||
|
||||
Var
|
||||
Hdr : Char4;
|
||||
S : Str4;
|
||||
I : byte;
|
||||
begin
|
||||
Assign(F,N);
|
||||
reset(F,1);
|
||||
Top := False;
|
||||
Size := 12;
|
||||
While (FilePos(F) < Size) AND NOT Eof(f) do
|
||||
Begin
|
||||
Blockread(F,Hdr,SizeOf(Hdr));
|
||||
S := Char2Str(Hdr);
|
||||
I := 0;
|
||||
If S = 'FORM' Then FORM Else
|
||||
If S = 'BMHD' Then BMHD Else
|
||||
If S = 'CMAP' Then CMAP Else
|
||||
If S = 'CRNG' Then CRNG Else
|
||||
If S = 'TINY' Then TINY Else
|
||||
If S = 'BODY' Then BODY Else
|
||||
Unknow;
|
||||
End;
|
||||
Close(F);
|
||||
End;
|
||||
|
||||
Procedure WaitKey;
|
||||
Var
|
||||
C: Char;
|
||||
Begin
|
||||
repeat
|
||||
Until KeyPressed;
|
||||
C := readKey;
|
||||
End;
|
||||
|
||||
End.
|
||||
72
SRC/INTRO2.PAS
Normal file
72
SRC/INTRO2.PAS
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
Unit Intro2;
|
||||
Interface
|
||||
Procedure IntroASM;
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
CRT,DOS,GRAPHVGA,LibUses;
|
||||
Var
|
||||
pct : imageinfo;
|
||||
Spt : Word;
|
||||
|
||||
Procedure CopyBob(Y1,Y2 : word);
|
||||
Var
|
||||
X,Y : word;
|
||||
Begin
|
||||
asm
|
||||
{ Calcul des pts de depart }
|
||||
Push DS
|
||||
Mov AX,Y2
|
||||
mov BX,320
|
||||
Mul bx
|
||||
Mov DI,AX { DI = DI + 289 (320-31) }
|
||||
Mov AX,Y1
|
||||
Mul BX
|
||||
Mov SI,AX { SI = SI + 289 (320-31) }
|
||||
Mov AX,0A000h {WriteS}
|
||||
Mov ES,AX
|
||||
Mov AX,SPt
|
||||
Mov DS,AX
|
||||
Mov DX,39
|
||||
@@B1: Mov CX,160
|
||||
Rep MovsW
|
||||
dec DX
|
||||
jnz @@B1
|
||||
Pop DS
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure initFont;
|
||||
begin
|
||||
InitGraph(VGA);
|
||||
LoadImage(Title_Logo,Pct);
|
||||
PutImage(Pct,1);
|
||||
Delay(1000);
|
||||
FadeOut(0,$FF,1);
|
||||
FillChar(Screen^,64000,0);
|
||||
Freeimage(Pct);
|
||||
LoadImage(Title_txt,Pct);
|
||||
Spt := Seg(Pct.Picture^);
|
||||
end;
|
||||
|
||||
Procedure IntroAsm;
|
||||
Var
|
||||
C : Byte;
|
||||
Begin
|
||||
initFont;
|
||||
C := 0;
|
||||
PaletteOff;
|
||||
While (c<39+(4*40)) do
|
||||
Begin
|
||||
CopyBob(C,80);
|
||||
fadein(0,4,Pct.Palette,1);
|
||||
delay(1500);
|
||||
fadeWhite(1,4,1);
|
||||
Fadeout(0,4,1);
|
||||
inc(C,40);
|
||||
End;
|
||||
FreeImage(Pct);
|
||||
end;
|
||||
|
||||
End.
|
||||
|
||||
407
SRC/LENS.PAS
Normal file
407
SRC/LENS.PAS
Normal file
|
|
@ -0,0 +1,407 @@
|
|||
Unit Lens;
|
||||
Interface
|
||||
Uses CRT,DOS,GraphVGA,LibUses;
|
||||
{ IffLoad,LibUses;}
|
||||
Const
|
||||
Mx : Word = 80;
|
||||
My : Word = 80;
|
||||
defo : Word = 150;
|
||||
size = (84*84);
|
||||
O_ORG = (0*(Size*2));
|
||||
O_NORM = (1*(Size*2));
|
||||
O_TFM = (2*(Size*2));
|
||||
O_CMAP = (3*(Size*2));
|
||||
Rc : Word = 40;
|
||||
RC2 : Word = 40*40;
|
||||
Dis : Word = 0;
|
||||
Dis2 : Word = 0;
|
||||
|
||||
|
||||
Procedure InitLens;
|
||||
|
||||
Procedure CloseLens;
|
||||
|
||||
Procedure LensPath;
|
||||
|
||||
implementation
|
||||
|
||||
Var
|
||||
P : ImageInfo;
|
||||
P3 : ImageInfo;
|
||||
Pict : Pointer;
|
||||
Par : Byte;
|
||||
Mx2 : Word;
|
||||
Memory : Pointer;
|
||||
Org : Pointer; { Array[0..Size] of Word; }
|
||||
Norm : Pointer; { Array[0..Size] of word; }
|
||||
TFm : Pointer; { Array[0..Size] of word; }
|
||||
CMap : Pointer; { Array[0..Size] of word; }
|
||||
X,Y : integer;
|
||||
SX,SY : integer;
|
||||
Speed : Integer;
|
||||
|
||||
{
|
||||
Procedure GetMask;
|
||||
Var
|
||||
X,Y : Word;
|
||||
Begin
|
||||
LoadIFF('MASK.LBM',P);
|
||||
PutImage(P,3);
|
||||
FreeImage(p);
|
||||
DirectVideo(True);
|
||||
for Y:=0 to mY-1 do
|
||||
for X:=0 to mX-1 do
|
||||
CMap[(Y*Mx)+X] := GetPixel(100+X,Y+1);
|
||||
DirectVideo(False);
|
||||
end;
|
||||
|
||||
Procedure WriteMask;
|
||||
Var
|
||||
F : File;
|
||||
Begin
|
||||
Assign(F,'LENS.PRE');
|
||||
ReWrite(F,1);
|
||||
BlockWrite(F,TFM,SizeOf(TFM));
|
||||
BlockWrite(F,CMap,SizeOf(CMap));
|
||||
Close(F);
|
||||
End;
|
||||
|
||||
Procedure ReadMask;
|
||||
Var
|
||||
F : File;
|
||||
Begin
|
||||
Assign(F,'LENS.PRE');
|
||||
Reset(F,1);
|
||||
BlockRead(F,TFM,SizeOf(TFM));
|
||||
BlockRead(F,CMap,SizeOf(CMap));
|
||||
Close(F);
|
||||
End;
|
||||
}
|
||||
|
||||
Procedure Precal;
|
||||
Var
|
||||
P : Pointer;
|
||||
MemSeg : Word;
|
||||
MemOfs : Word;
|
||||
Begin
|
||||
Defo := 150;
|
||||
Dis := 0;
|
||||
mx := 84;
|
||||
my := Mx;
|
||||
Rc := Mx Div 2;
|
||||
RC2 := RC * Rc;
|
||||
Mx2 := Mx Div 2;
|
||||
|
||||
MemSeg := Seg(Memory^);
|
||||
MemOfs := Ofs(Memory^);
|
||||
|
||||
{ ReadMask;}
|
||||
OpenSub(Lens_Precal);
|
||||
{ BlockWrite(LibraryFile,Tfm,SizeOf(Tfm));
|
||||
BlockWrite(LibraryFile,Cmap,SizeOf(Cmap));
|
||||
}
|
||||
P := Ptr(MemSeg,MemOfs+O_TFM);
|
||||
LoadRaw(P^,Size*2);
|
||||
P := Ptr(MemSeg,MemOfs+O_CMAP);
|
||||
Loadraw(P^,Size*2);
|
||||
{ GetMask;
|
||||
WriteMask;}
|
||||
End;
|
||||
|
||||
Procedure InitLens;
|
||||
Var
|
||||
I,J : Byte;
|
||||
A : Word;
|
||||
f : Text;
|
||||
Begin
|
||||
GetMem(Memory,$FFFF); { Working memory (for transformations)}
|
||||
Precal;
|
||||
Par := 0;
|
||||
SX := -2;
|
||||
SY := -3;
|
||||
X := 0;
|
||||
Y := 0;
|
||||
Speed := 2;
|
||||
LoadImage(Parchemin_Non,P);
|
||||
LoadImage(Parchemin_Code,P3);
|
||||
GetMem(Pict,$FFFF);
|
||||
|
||||
{
|
||||
GetMem(Org,Size*Sizeof(Word));
|
||||
GetMem(Norm,Size*Sizeof(Word));
|
||||
GetMem(TFm,Size*Sizeof(Word));
|
||||
GetMem(CMap,Size*Sizeof(Word));
|
||||
}
|
||||
|
||||
Move(P3.Picture^,Pict^,64000);
|
||||
Move(P.Palette[0].Rouge,P.Palette[ 64].Rouge,64*3);
|
||||
Move(P.Palette[0].Rouge,P.Palette[128].Rouge,64*3);
|
||||
Move(P.Palette[0].Rouge,P.Palette[192].Rouge,64*3);
|
||||
For J:=1 to 3 do
|
||||
for I:=1 to 63 do
|
||||
With P.Palette[(J*64)+I] do
|
||||
Case Par Of
|
||||
0 : Begin
|
||||
if Rouge-(3*j) > 0 Then dec(Rouge,(3*j));
|
||||
If Vert- (3*j) > 0 then dec(vert ,(3*j));
|
||||
If Bleu+ (2*j) < 63 Then Inc(Bleu ,(2*j));
|
||||
End;
|
||||
1 : Begin
|
||||
A := (Rouge+Vert+Bleu) Div 3;
|
||||
Rouge := A;
|
||||
Vert := A;
|
||||
Bleu := A;
|
||||
End;
|
||||
2 : Begin
|
||||
if Rouge-(4*j) > 0 Then dec(Rouge,(4*j));
|
||||
If Vert- (4*j) > 0 then dec(vert ,(4*j));
|
||||
If Bleu+ (8*j) < 63 Then Inc(Bleu ,(8*j));
|
||||
End;
|
||||
3 : Begin
|
||||
Rouge := 0;
|
||||
Vert := 0;
|
||||
Bleu := 0;
|
||||
End;
|
||||
End;
|
||||
PutImage(P,0);
|
||||
Move(ptr($A000,0)^,PageW^,64000);
|
||||
End;
|
||||
|
||||
Procedure LensASM;
|
||||
Var
|
||||
Segmts: Word; { Source Segment }
|
||||
SegMem: Word; { Memory Segment }
|
||||
SegDat: Word; { Data Segment }
|
||||
SegWrt: Word; { Write Segment }
|
||||
I : Byte;
|
||||
L_X2,
|
||||
L_Y2 : Word;
|
||||
C : Word;
|
||||
L_Dss : Word;
|
||||
Ofst : Word;
|
||||
L_Mxx : Word;
|
||||
L_MX : Word;
|
||||
L_MX2 : Word;
|
||||
L_MY : Word;
|
||||
L_SPE : Integer;
|
||||
|
||||
Begin
|
||||
Move(P.Picture^,PageW^,64000);
|
||||
Segmts := Seg(Pict^);
|
||||
SegMem := Seg(Memory^);
|
||||
SegWrt := WriteS;
|
||||
L_Mxx := 320-Mx;
|
||||
L_MX := MX;
|
||||
L_MX2 := MX2;
|
||||
L_MY := MY;
|
||||
L_X2 := X;
|
||||
L_Y2 := Y;
|
||||
L_SPE := Speed;
|
||||
|
||||
Asm
|
||||
cli
|
||||
Push DS
|
||||
Pop AX
|
||||
Mov SegDat,AX {; Preserve DATA Segment }
|
||||
|
||||
Mov BX,320
|
||||
Mov AX,L_Y2
|
||||
Mul BX
|
||||
Add AX,L_X2 {; AX = (Y2*320)+X2 }
|
||||
Mov DX,L_MX {; DX = MX }
|
||||
Mov BX,L_MX2 {; BX = MX2 }
|
||||
Mov L_DSS,AX {; DSS = (Y2*320)+X2 }
|
||||
Mov SI,AX
|
||||
{
|
||||
For Y1:=1 to My do
|
||||
For X1:=1 to Mx do
|
||||
Begin
|
||||
Org[C] := getPixel(X+X1,Y+Y1);
|
||||
inc(C);
|
||||
end;
|
||||
}
|
||||
Mov AX,SegMem {; ES = Memory Segment }
|
||||
Mov ES,AX
|
||||
|
||||
MOV DI,O_ORG {; ES:DI = MemSeg:ORG }
|
||||
|
||||
Mov AX,Segmts {; Get source background image }
|
||||
MOV DS,AX {; DS:SI }
|
||||
|
||||
@@Bcl1: Mov CX,BX {; copy BX (MX2) Words }
|
||||
rep MovsW
|
||||
add SI,L_MXX {; Align to 320-MX bytes }
|
||||
Dec DX {; Next Line }
|
||||
Jnz @@BCL1
|
||||
{ end }
|
||||
|
||||
Mov AX,SegDat {; restore DATA Segment }
|
||||
Mov DS,AX
|
||||
|
||||
Mov DX,L_MY
|
||||
Mov DI,O_NORM
|
||||
Mov SI,L_DSS
|
||||
|
||||
Mov AX,SegWrt {; Get writing buffer }
|
||||
Mov DS,AX
|
||||
|
||||
@@Bcl5: Mov CX,BX {; copy BX (MX2) Words }
|
||||
rep MovsW
|
||||
add SI,L_MXX {; Align to 320-MX bytes }
|
||||
Dec DX {; Next Line }
|
||||
Jnz @@BCL5
|
||||
Mov AX,SegMem
|
||||
MOV DS,AX {; Recover DATA SEGMENT }
|
||||
|
||||
Mov AX,SegWrt {; Put New }
|
||||
Mov ES,AX {; ES:DI = WriteSegment target }
|
||||
Xor AX,AX
|
||||
Mov CX,L_MY
|
||||
Xor SI,SI
|
||||
Mov DI,L_DSS {; DI = DSS (Y2*320) }
|
||||
@@Bcl3: Mov DX,L_MY
|
||||
@@Bcl2: Mov BX,O_TFM {; get Transistion Offset }
|
||||
Mov AX,Word Ptr[BX+SI]
|
||||
Mov Ofst,AX
|
||||
Mov BX,O_Org {; Get Pixel Value At Ofs }
|
||||
Add BX,AX
|
||||
Mov AL,Byte Ptr[BX]
|
||||
Mov BX,O_CMAP
|
||||
cmp Word Ptr[BX+SI],0
|
||||
je @@TR1
|
||||
CMP Word Ptr[BX+SI],63 {; Bit Map normal }
|
||||
Jb @@TR3
|
||||
@@TR4: Add AX,WORD Ptr[BX+SI] {; Add Color Masking }
|
||||
Jmp @@TR2
|
||||
|
||||
@@TR1: Mov BX,O_NORM
|
||||
Add BX,OFST
|
||||
mov AL,Byte Ptr[BX]
|
||||
jmp @@TR2
|
||||
@@TR3: mov AL,Byte Ptr[BX+SI]
|
||||
@@TR2: inc SI
|
||||
Inc SI
|
||||
StosB
|
||||
dec DX
|
||||
Jnz @@Bcl2
|
||||
Add DI,L_MXX
|
||||
Loop @@Bcl3
|
||||
|
||||
mov AX,SegWrt {; Transfert SegWrt to Screen }
|
||||
Mov DS,AX
|
||||
Mov CX,32000
|
||||
Xor DI,DI
|
||||
Mov SI,DI
|
||||
Mov AX,0A000h
|
||||
mov ES,AX
|
||||
rep MovsW
|
||||
|
||||
MOV AX,SegDat {; Restore DS }
|
||||
Mov DS,AX
|
||||
|
||||
{ WAIT VBL }
|
||||
MOV CX,Speed
|
||||
MOV DX,$3DA
|
||||
@@W1: IN AL,DX
|
||||
TEST AL,$08
|
||||
JNE @@W1
|
||||
|
||||
@@W2: IN AL,DX
|
||||
TEST AL,$08
|
||||
JE @@W2
|
||||
DEC CX
|
||||
JNZ @@W1
|
||||
|
||||
sti
|
||||
end;
|
||||
End;
|
||||
{
|
||||
Procedure DrawMask;
|
||||
Var
|
||||
X,Y : Word;
|
||||
Begin
|
||||
DirectVideo(True);
|
||||
FillChar(ptr($A000,0)^,64000,0);
|
||||
for Y:=0 to mY-1 do
|
||||
for X:=0 to mX-1 do
|
||||
Begin
|
||||
PutPixel(X+1,Y+1,Tfm[(Y*Mx)+X]);
|
||||
If CMap[(Y*Mx)+X] <> 0 Then
|
||||
PutPixel(100+X,Y+1,64)
|
||||
Else PutPixel(100+X,Y+1,15);
|
||||
end;
|
||||
DirectVideo(False);
|
||||
end;
|
||||
}
|
||||
Procedure LensPath;
|
||||
var
|
||||
Z : Word;
|
||||
Begin
|
||||
Y := 1;
|
||||
setRGB(P.Palette);
|
||||
Speed := 1;
|
||||
While (Y<=90) do
|
||||
Begin
|
||||
X := 10;
|
||||
While (X <=320-90) do
|
||||
Begin
|
||||
LensAsm;
|
||||
inc(x,2);
|
||||
End;
|
||||
Z := 0;
|
||||
While (X>10) do
|
||||
Begin
|
||||
LensAsm;
|
||||
dec(X,5);
|
||||
inc(Z);
|
||||
If Z Mod 3 = 0 Then inc(Y,2);
|
||||
End;
|
||||
End;
|
||||
X := 10;
|
||||
While (X <=320-100) do
|
||||
Begin
|
||||
LensAsm;
|
||||
inc(x,2);
|
||||
End;
|
||||
Z := 0;
|
||||
X := 230;
|
||||
Speed := 1;
|
||||
Y := 101;
|
||||
While (Z<10) do
|
||||
begin
|
||||
Inc(X,SX);
|
||||
Inc(Y,SY);
|
||||
if (X+SX<1) Or (X+SX > 320-90) then Begin Sx := -SX; inc(Z); end;
|
||||
if (Y+SY<1) Or (Y+Sy > 200-90) then Begin SY := -SY; inc(Z); end;
|
||||
LensAsm;
|
||||
End;
|
||||
Z:=0;
|
||||
SX := -1;
|
||||
Speed := 2;
|
||||
Sy := 1;
|
||||
While (Z<4) do
|
||||
begin
|
||||
Inc(X,SX);
|
||||
Inc(Y,SY);
|
||||
if (X+SX<1) Or (X+SX > 320-90) then Begin Sx := -SX; inc(Z); end;
|
||||
if (Y+SY<1) Or (Y+Sy > 200-90) then Begin SY := -SY; inc(Z); end;
|
||||
LensAsm;
|
||||
End;
|
||||
FadeOut(0,$FF,1);
|
||||
End;
|
||||
|
||||
|
||||
Procedure CloseLens;
|
||||
Begin
|
||||
FreeImage(P);
|
||||
FreeImage(P3);
|
||||
FreeMem(Pict,$FFFF);
|
||||
FreeMem(Memory,$FFFF);
|
||||
|
||||
{ FreeMem(Org,Size*Sizeof(Word));
|
||||
FreeMem(Norm,Size*Sizeof(Word));
|
||||
FreeMem(TFm,Size*Sizeof(Word));
|
||||
FreeMem(CMap,Size*Sizeof(Word));}
|
||||
End;
|
||||
|
||||
End.
|
||||
148
SRC/LIBUSES.PAS
Normal file
148
SRC/LIBUSES.PAS
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
Unit LibUses;
|
||||
Interface
|
||||
Uses
|
||||
GRAPHVGA;
|
||||
CONST
|
||||
Title_Logo = 0;
|
||||
Parchemin_Code = 64778;
|
||||
Parchemin_Non = 129556;
|
||||
Lens_Precal = 194334;
|
||||
Voxel_High = 222562;
|
||||
Thunder_Logo = 287340;
|
||||
Thunder_Ligh = 352118;
|
||||
Thunder_Dark = 416896;
|
||||
Moon_walk = 481674;
|
||||
Title_txt = 529966;
|
||||
Thunder_Ldrk = 659522;
|
||||
Vox_Info = 594744;
|
||||
Greetings1 = 724300;
|
||||
Greetings2 = 789078;
|
||||
|
||||
{
|
||||
Adding LOGO3.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
POSITION NULLE
|
||||
Adding PARCOD.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 64778
|
||||
Adding PARDECOD.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 129556
|
||||
Adding LENS.PRE to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 194334
|
||||
Adding MAPHI.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 222562
|
||||
Adding VIEW3.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 287340
|
||||
Adding VIEW1.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 352118
|
||||
Adding VIEW2.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 416896
|
||||
Adding MOON.BUF to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 481674
|
||||
Adding TITRE11.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 529966
|
||||
Adding INFO3.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 594744
|
||||
Adding VIEW4.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 659522
|
||||
Adding Z-FIN3.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 724300
|
||||
Adding Z-FIN4.SCI to RUNES.OTL
|
||||
Is Position IS (Size Of Runes Before )
|
||||
Size Is : 789078
|
||||
|
||||
}
|
||||
|
||||
Procedure OpenLib( N : String);
|
||||
|
||||
Procedure CloseLib;
|
||||
|
||||
Procedure OpenSub (Witch : Longint);
|
||||
|
||||
Procedure LoadImage( Witch : LongInt;
|
||||
Var Ima : ImageInfo);
|
||||
|
||||
Procedure LoadData ( Witch : Longint;
|
||||
Var D : Pointer;
|
||||
Size : Word);
|
||||
|
||||
Procedure LoadRaw ( Var D ;
|
||||
Size : Word );
|
||||
|
||||
Var
|
||||
LibraryFile : File;
|
||||
|
||||
Implementation
|
||||
|
||||
Procedure OpenLib( N : String);
|
||||
Begin
|
||||
Assign(LibraryFile,N);
|
||||
{$I-}
|
||||
Reset(LibraryFile,1);
|
||||
If IOResult <> 0 Then
|
||||
begin
|
||||
Writeln('Oops, seem to be some problems with the data-file');
|
||||
Halt;
|
||||
End;
|
||||
{$I+}
|
||||
End;
|
||||
|
||||
Procedure CloseLib;
|
||||
Begin
|
||||
Close(LibraryFile);
|
||||
end;
|
||||
|
||||
Procedure OpenSub (Witch : Longint);
|
||||
begin
|
||||
Seek(LibraryFile,Witch);
|
||||
end;
|
||||
|
||||
Procedure Loadimage( Witch : LongInt;
|
||||
Var Ima : ImageInfo);
|
||||
Var
|
||||
Header : LongInt;
|
||||
F : file;
|
||||
X,Y : Word;
|
||||
CC : Byte;
|
||||
Xs,YS : Word;
|
||||
Info : Word;
|
||||
Begin
|
||||
Seek(LibraryFile,Witch);
|
||||
BlockRead(LibraryFile,Header,4);
|
||||
BlockRead(LibraryFile,Xs,2);
|
||||
BlockRead(LibraryFile,YS,2);
|
||||
BlockRead(LibraryFile,Info,2);
|
||||
AllocImage(Xs,Ys,Ima);
|
||||
For Xs:=0 to $FF do
|
||||
With Ima do
|
||||
BlockRead(LibraryFile,Palette[Xs],3);
|
||||
BlockRead(LibraryFile,Ima.Picture^,ima.Size);
|
||||
End;
|
||||
|
||||
Procedure LoadData ( Witch : Longint;
|
||||
Var D : Pointer;
|
||||
Size : Word );
|
||||
Begin
|
||||
Seek(LibraryFile,Witch);
|
||||
BlockRead(LibraryFile,D^,size);
|
||||
End;
|
||||
|
||||
|
||||
Procedure LoadRaw ( Var D;
|
||||
Size : Word );
|
||||
Begin
|
||||
BlockRead(LibraryFile,D,size);
|
||||
End;
|
||||
|
||||
End.
|
||||
163
SRC/MOON.PAS
Normal file
163
SRC/MOON.PAS
Normal file
|
|
@ -0,0 +1,163 @@
|
|||
Unit Moon;
|
||||
Interface
|
||||
Uses
|
||||
CRT,DOS,GRAPHVGA,LIBUSES;
|
||||
const
|
||||
MoonX = 111;
|
||||
MoonY = 89;
|
||||
MaskX = 151;
|
||||
MaskY = 89;
|
||||
|
||||
Procedure InitMoon;
|
||||
Procedure CloseMoon;
|
||||
|
||||
Procedure BouffeLaLune;
|
||||
|
||||
Procedure GerbeLaLune;
|
||||
|
||||
Implementation
|
||||
Var
|
||||
P : RGB;
|
||||
Moon1 : Pointer; { Array of Byte; {10080 }
|
||||
Moon2 : Pointer;
|
||||
Mask1 : Pointer; {13680 }
|
||||
Mask2 : Pointer;
|
||||
|
||||
Procedure PutBob(X1,Y1,X2,Y2 : word; P : Pointer);
|
||||
Begin
|
||||
asm
|
||||
{ Calcul des pts de depart }
|
||||
cli
|
||||
Push DS
|
||||
Mov AX,WriteS
|
||||
Mov ES,AX
|
||||
|
||||
Lds SI,P
|
||||
INC SI
|
||||
INC SI
|
||||
Mov AX,Y1
|
||||
mov BX,320
|
||||
Mul bx
|
||||
add ax,X1 { DI = Y2*320+X2 }
|
||||
Mov Di,AX { DI = DI + 289 (320-31) }
|
||||
Sub BX,X2
|
||||
|
||||
mov DX,Y2
|
||||
@@Bcl:Mov CX,X2
|
||||
rep movsb
|
||||
Add DI,BX
|
||||
dec dx
|
||||
jnz @@Bcl
|
||||
|
||||
pop DS
|
||||
sti
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure InitMoon;
|
||||
var
|
||||
X,Y,C : Word;
|
||||
Begin
|
||||
FillChar(Screen^,64000,0);
|
||||
PaletteOff;
|
||||
opensub(Moon_walk);
|
||||
|
||||
GetMem(Moon1,10080);
|
||||
GetMem(Moon2,10080);
|
||||
GetMem(Mask1,13680);
|
||||
GetMem(Mask2,13680);
|
||||
|
||||
LoadRaw(P,SizeOf(P));
|
||||
LoadRaw(Moon1^,10080); {SizeOf(Moon1));}
|
||||
LoadRaw(Moon2^,10080); {SizeOf(Moon2));}
|
||||
LoadRaw(Mask1^,13680); {SizeOf(Mask1));}
|
||||
LoadRaw(Mask2^,13680); {SizeOf(Mask2));}
|
||||
SetRgb(P);
|
||||
end;
|
||||
|
||||
Procedure CloseMoon;
|
||||
Begin
|
||||
FreeMem(Moon1,10080);
|
||||
FreeMem(Moon2,10080);
|
||||
FreeMem(Mask1,13680);
|
||||
FreeMem(Mask2,13680);
|
||||
end;
|
||||
|
||||
Procedure AddBob(X1,Y1,X2,Y2 : word; P : Pointer);
|
||||
Begin
|
||||
asm
|
||||
{ Calcul des pts de depart }
|
||||
cli
|
||||
Push DS
|
||||
Mov AX,WriteS
|
||||
Mov ES,AX
|
||||
Lds SI,P
|
||||
inc SI
|
||||
inc SI
|
||||
Mov AX,Y1
|
||||
mov BX,320
|
||||
Mul bx
|
||||
add ax,X1 { DI = Y2*320+X2 }
|
||||
Mov Di,AX { DI = DI + 289 (320-31) }
|
||||
|
||||
Sub BX,X2
|
||||
|
||||
mov DX,Y2
|
||||
@@Bcl:Mov CX,X2
|
||||
@@Bc2:Mov AH,Byte Ptr ES:[DI]
|
||||
xor AL,AL
|
||||
mov AL,Byte Ptr DS:[SI]
|
||||
cmp AL,0
|
||||
je @@go
|
||||
inc AL
|
||||
@@go: inc SI
|
||||
cmp AL,16
|
||||
jbe @@ok
|
||||
xor AL,AL
|
||||
@@ok: Sub AH,AL
|
||||
Mov AL,AH
|
||||
cmp AL,0
|
||||
jnle @@sor
|
||||
Xor AL,AL
|
||||
@@Sor:Stosb
|
||||
Loop @@Bc2
|
||||
Add DI,BX
|
||||
dec dx
|
||||
jnz @@Bcl
|
||||
|
||||
pop DS
|
||||
sti
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure BouffeLaLune;
|
||||
Var
|
||||
C : Word;
|
||||
Begin
|
||||
For C:=0 to 138 do
|
||||
begin
|
||||
PutBob(160-55,100-44,MoonX,MoonY,Moon1);
|
||||
AddBob(214-C,100-44,MaskX,MaskY,Mask1);
|
||||
Move(Ptr(WriteS,0)^,Ptr($A000,0)^,64000);
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
end;
|
||||
End;
|
||||
|
||||
Procedure GerbeLaLune;
|
||||
Var
|
||||
C : Word;
|
||||
Begin
|
||||
For C:=138 to 138*2 do
|
||||
begin
|
||||
PutBob(160-55,100-44,MoonX,MoonY,Moon2);
|
||||
AddBob(210-C,100-44,MaskX,MaskY,Mask2);
|
||||
Move(Ptr(WriteS,0)^,Ptr($A000,0)^,64000);
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
WaitVbl;
|
||||
end;
|
||||
End;
|
||||
|
||||
End.
|
||||
404
SRC/PASDVT.PAS
Normal file
404
SRC/PASDVT.PAS
Normal file
|
|
@ -0,0 +1,404 @@
|
|||
{
|
||||
PASDVT.TPU - TP(6.0) unit for interfacing to DEMOVT.EXE // ARM 12/93,4/94
|
||||
|
||||
(based on original VTASM.INC by JCAB)
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Note: VTASM.INC nomenclature sounded a bit clumsy to me, so I decided
|
||||
not to follow it too closely O:-)
|
||||
|
||||
The equivalence between VTASM.INC procedures and VTDEMO.TPU ones is
|
||||
as follows:
|
||||
|
||||
VTDEMO.TPU VTASM.INC
|
||||
========== =========
|
||||
VT_Init InitMusic
|
||||
VT_Poll CallMusic
|
||||
VT_AutoOff VTDisconnectTimer
|
||||
VT_AutoOn VTConnectTimer
|
||||
VT_Timer VTGetTickCounter
|
||||
VT_Start VTBeginSync
|
||||
VT_SyncStart VTBeginSync + VTWaitForStart
|
||||
VT_GoTo VTJumpPos
|
||||
VT_GetSem VTCheckSemaphore (*)
|
||||
VT_SetSem VTSetSemaphore
|
||||
VT_Resync VTMiddleSync
|
||||
VT_SetVolume VTSetSoundVolume
|
||||
VT_GetVolume VTGetSoundVolume
|
||||
|
||||
VT_Delay (no equivalent)
|
||||
|
||||
|
||||
(*) vtasm.inc's VTCheckSemaphore compares semaphore bx with value al,
|
||||
while vtdemo.tpu's VT_GetSem simply returns the value of the semaphore
|
||||
and leaves any comparison up to you.
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
4/94 -- New functions:
|
||||
|
||||
VT_QueryCh -- returns TRUE if note played since last query.
|
||||
VT_ChStatus -- returns channel's tone, instrument, and volume.
|
||||
|
||||
VT_ChannelCount -- returns number of channels
|
||||
VT_CurrentPos -- returns current pattern/note
|
||||
VT_Abort -- tells DVT to quit on exit
|
||||
|
||||
}
|
||||
|
||||
UNIT PASDVT;
|
||||
|
||||
Interface
|
||||
|
||||
{ ==============================================================
|
||||
|
||||
T H E P R O C ' S }
|
||||
|
||||
function VT_Init : boolean; { detect and initialize DEMOVT }
|
||||
procedure VT_Poll; { ò 50Hz DEMOVT manual polling }
|
||||
procedure VT_AutoOff; { switch to manual polling }
|
||||
procedure VT_AutoOn; { switch to auto (IRQ0) polling }
|
||||
function VT_Timer : longint; { get music timer count (50Hz) }
|
||||
procedure VT_Start; { setup to start playing }
|
||||
procedure VT_SyncStart; { Like start, but then waits 1/2 sec till music sounds }
|
||||
procedure VT_GoTo( pattern, note : byte ); { jump to given pattern/note within score }
|
||||
function VT_GetSem( sem : byte ) : byte; { get semaphore "sem" value }
|
||||
procedure VT_SetSem( sem, va : byte ); { set semaphore "sem" to "va" }
|
||||
procedure VT_Resync( sem, pattern, note : byte ); { wait for sync point }
|
||||
procedure VT_SetVolume( level : byte ); { set volume level }
|
||||
function VT_GetVolume : byte; { get volume level }
|
||||
|
||||
procedure VT_Delay( h : word ); { delay h hundredths of a second }
|
||||
{ while still updating music }
|
||||
|
||||
function VT_QueryCh( ChanNo : byte ) : boolean; { TRUE if new note }
|
||||
procedure VT_ChStatus( ChanNo : byte; var per : word; var inst, volu : byte);
|
||||
function VT_ChannelCount : byte; { get # of channels }
|
||||
procedure VT_CurrentPos( var pat, note : byte ); { current pattern/note }
|
||||
procedure VT_Abort;
|
||||
|
||||
{ ==============================================================
|
||||
|
||||
...AND THINGS FOR ALL YOU SHOW-OFF DO-IT-YOURSELF TYPES ;->
|
||||
}
|
||||
Type
|
||||
TChanData =
|
||||
RECORD
|
||||
Period : WORD;
|
||||
Ins : BYTE;
|
||||
Vol : BYTE;
|
||||
END;
|
||||
TChansData = ARRAY[1..32] OF TChanData;
|
||||
TChansTrig = ARRAY[1..32] OF BOOLEAN;
|
||||
|
||||
TYPE
|
||||
TVTRunInfo =
|
||||
RECORD
|
||||
|
||||
{ Out }
|
||||
|
||||
Semaphores : ARRAY[0..255] OF BYTE;
|
||||
ChansTrig : TChansTrig;
|
||||
|
||||
NumChannels : BYTE;
|
||||
|
||||
CtrlEntryPoint : POINTER;
|
||||
|
||||
TickCounter : LONGINT;
|
||||
|
||||
RegEntryPoint : POINTER;
|
||||
|
||||
ChansData : TChansData;
|
||||
|
||||
Pos : BYTE;
|
||||
Seq : BYTE;
|
||||
|
||||
fill2 : ARRAY[1..81] OF BYTE;
|
||||
|
||||
{ In }
|
||||
|
||||
fill3 : ARRAY[1..3] OF BYTE;
|
||||
|
||||
JumpNewPos : BOOLEAN;
|
||||
JumpPosSeq : BYTE;
|
||||
JumpPosNote : BYTE;
|
||||
|
||||
Volume : BYTE;
|
||||
|
||||
Abort : BOOLEAN;
|
||||
|
||||
fill4 : ARRAY[1..248] OF BYTE;
|
||||
|
||||
END;
|
||||
|
||||
VT_PInfo = ^TVTRunInfo;
|
||||
VT_RInfo = TVTRunInfo;
|
||||
|
||||
VTIdString = ARRAY [0..255] OF BYTE;
|
||||
|
||||
var
|
||||
VT_Info : VT_PInfo; { points to VT_RInfo record within DEMOVT }
|
||||
AppIDFound : ^VTIdString; { dunno, ask JCAB... ;-) }
|
||||
|
||||
|
||||
|
||||
Implementation
|
||||
|
||||
const
|
||||
VTOK : boolean = False; { = True if DEMOVT installed and initialized }
|
||||
|
||||
var
|
||||
VTControl : procedure ( command : word );
|
||||
|
||||
{ VTInfo^.VTCtrlEntry for quick access }
|
||||
{ (hope DEMOVT never changes it!) }
|
||||
|
||||
|
||||
procedure CLI; inline( $fa );
|
||||
procedure STI; inline( $fb );
|
||||
|
||||
{ // VT_init }
|
||||
|
||||
function VT_Init : boolean; assembler;
|
||||
Const
|
||||
MagicAX = $5654; {'VT'}
|
||||
MagicBX = $5472; {'Tr'}
|
||||
MagicCX = $6163; {'ac'}
|
||||
MagicXorBX = $6B65; {'ke'}
|
||||
MagicXorCX = $7220; {'r '}
|
||||
asm
|
||||
mov ax, MagicAX
|
||||
mov bx, MagicBX
|
||||
mov cx, MagicCX
|
||||
xor di,di
|
||||
mov es, di
|
||||
int 2fh
|
||||
xor dl,dl
|
||||
and ax,ax
|
||||
jnz @no
|
||||
cmp bx, MagicBX xor MagicXorBX
|
||||
jne @no
|
||||
cmp cx, MagicCX xor MagicXorCX
|
||||
jne @no
|
||||
|
||||
inc dl { DEMOVT detected! }
|
||||
mov [word ptr AppIdFound+2], es
|
||||
mov [word ptr AppIdFound ], di { save this... but for what ? }
|
||||
|
||||
les di, [es:di-4]
|
||||
mov [word ptr VT_Info+2], es
|
||||
mov [word ptr VT_Info], di
|
||||
|
||||
les di, [es:di+256+33] { read VTCtrlEntry vector }
|
||||
mov [word ptr VTControl+2], es
|
||||
mov [word ptr VTControl], di { ...and copy it to VTControl }
|
||||
|
||||
@no:
|
||||
xor ah, ah
|
||||
mov al, dl
|
||||
mov [VTOK], al
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Poll }
|
||||
|
||||
procedure VT_Poll;
|
||||
begin
|
||||
if VTOK then VTControl( 2 );
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_AutoOff }
|
||||
|
||||
procedure VT_AutoOff;
|
||||
begin
|
||||
if VTOK then VTControl( 1 );
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_AutoOn }
|
||||
|
||||
procedure VT_AutoOn;
|
||||
begin
|
||||
if VTOK then VTControl( 0 );
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Timer }
|
||||
|
||||
function VT_Timer : longint;
|
||||
begin
|
||||
if VTOK then begin
|
||||
CLI;
|
||||
VT_Timer := VT_Info^.TickCounter;
|
||||
STI;
|
||||
end else
|
||||
VT_Timer := 0;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Start }
|
||||
|
||||
procedure VT_Start;
|
||||
begin
|
||||
if VTOK then VTControl( 3 );
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_SyncStart }
|
||||
|
||||
procedure VT_SyncStart;
|
||||
begin
|
||||
if VTOK then begin
|
||||
VTControl( 3 );
|
||||
CLI;
|
||||
VT_Info^.TickCounter := 0;
|
||||
STI;
|
||||
repeat VT_Poll until VT_Timer >= 25; { 25/50ths = 1/2 second }
|
||||
VT_Info^.TickCounter := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_GoTo }
|
||||
|
||||
procedure VT_GoTo( pattern, note : byte );
|
||||
begin
|
||||
if VTOK then with VT_Info^ do begin
|
||||
JumpNewPos := TRUE;
|
||||
JumpPosSeq := pattern;
|
||||
JumpPosNote := note;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_GetSem }
|
||||
|
||||
function VT_GetSem( sem : byte ) : byte;
|
||||
begin
|
||||
if VTOK then
|
||||
VT_GetSem := VT_Info^.Semaphores[ sem ]
|
||||
else
|
||||
VT_GetSem := 0;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_SetSem }
|
||||
|
||||
procedure VT_SetSem( sem, va : byte );
|
||||
begin
|
||||
if VTOK then VT_Info^.Semaphores[ sem ] := va;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Sync }
|
||||
|
||||
procedure VT_Resync( sem, pattern, note : byte );
|
||||
begin
|
||||
if VTOK then begin
|
||||
if VT_GetSem( sem ) = 0 then VT_Goto( pattern, note );
|
||||
inc( sem );
|
||||
repeat VT_Poll until VT_GetSem( sem ) <> 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_SetVolume }
|
||||
|
||||
procedure VT_SetVolume( level : byte );
|
||||
begin
|
||||
if VTOK then VT_Info^.Volume := level;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_GetVolume }
|
||||
|
||||
function VT_GetVolume : byte;
|
||||
begin
|
||||
if VTOK then
|
||||
VT_GetVolume := VT_Info^.Volume
|
||||
else
|
||||
VT_GetVolume := 0;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Delay }
|
||||
|
||||
procedure VT_Delay( h : word );
|
||||
var l : longint;
|
||||
begin
|
||||
if VTOK then begin
|
||||
l := VT_Timer + h shr 1;
|
||||
repeat VT_Poll until VT_Timer >= l;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_QueryCh }
|
||||
|
||||
function VT_QueryCh( ChanNo : byte ) : boolean;
|
||||
begin
|
||||
VT_QueryCh := false;
|
||||
if VTOK then
|
||||
if VT_Info^.ChansTrig[ ChanNo ] then begin
|
||||
VT_QueryCh := true;
|
||||
VT_Info^.ChansTrig[ ChanNo ] := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_ChStatus }
|
||||
|
||||
procedure VT_ChStatus( ChanNo : byte; var per : word; var inst, volu : byte);
|
||||
begin
|
||||
if VTOK then
|
||||
with VT_Info^.ChansData[ ChanNo ] do begin
|
||||
per := period;
|
||||
inst := ins;
|
||||
volu := vol;
|
||||
end
|
||||
else begin
|
||||
per := 0;
|
||||
inst := 0;
|
||||
volu := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Channels }
|
||||
|
||||
function VT_ChannelCount : byte;
|
||||
begin
|
||||
if VTOK then
|
||||
VT_ChannelCount := VT_Info^.NumChannels
|
||||
else
|
||||
VT_ChannelCount := 0;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_CurrentPos }
|
||||
|
||||
procedure VT_CurrentPos( var pat, note : byte );
|
||||
begin
|
||||
if VTOK then
|
||||
with VT_Info^ do begin
|
||||
pat := seq;
|
||||
note := pos;
|
||||
end
|
||||
else begin
|
||||
pat := 0;
|
||||
note := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ // VT_Abort }
|
||||
|
||||
procedure VT_Abort;
|
||||
begin
|
||||
if VTOK then VT_Info^.Abort := true;
|
||||
end;
|
||||
|
||||
|
||||
END.
|
||||
|
||||
63
SRC/PRESENT.PAS
Normal file
63
SRC/PRESENT.PAS
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
Unit Present;
|
||||
Interface
|
||||
Procedure Thunder;
|
||||
implementation
|
||||
|
||||
Uses
|
||||
CRT,DOS,LIBUses,GraphVGA;
|
||||
Var
|
||||
P1,P2 : Imageinfo;
|
||||
|
||||
Procedure Strike(J,I : Byte);
|
||||
Var
|
||||
C : Byte;
|
||||
begin
|
||||
Move(P1.Picture^,Ptr($A000,0)^,64000);
|
||||
SetRGB(P1.Palette);
|
||||
for C:=0 to J do
|
||||
WaitVbl;
|
||||
Move(P2.Picture^,Ptr($A000,0)^,64000);
|
||||
SetRGB(P1.Palette);
|
||||
For C:=0 to I do
|
||||
WaitVbl;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Thunder;
|
||||
Var
|
||||
P,C : Word;
|
||||
Begin
|
||||
P := 0;
|
||||
loadImage(Thunder_Ligh,P1);
|
||||
LoadImage(Thunder_Dark,P2);
|
||||
P := 0;
|
||||
While (P <= 15) do
|
||||
Begin
|
||||
putImage(P2,2);
|
||||
For c:=0 to 5 do
|
||||
waitvbl;
|
||||
Strike(Random(5),Random(50));
|
||||
inc(p);
|
||||
End;
|
||||
FreeImage(p1);
|
||||
FreeImage(P2);
|
||||
LoadImage(Thunder_Logo,P1);
|
||||
LoadImage(Thunder_Ldrk,P2);
|
||||
P := 0;
|
||||
While (P <= 9) do
|
||||
Begin
|
||||
putImage(P2,2);
|
||||
For c:=0 to 5 do
|
||||
waitvbl;
|
||||
Strike(Random(5),Random(50));
|
||||
inc(p);
|
||||
End;
|
||||
FreeImage(P1);
|
||||
FreeImage(P2);
|
||||
End;
|
||||
|
||||
|
||||
End.
|
||||
|
||||
|
||||
|
||||
BIN
SRC/TOTAL.OTL
Normal file
BIN
SRC/TOTAL.OTL
Normal file
Binary file not shown.
56
SRC/TOTAL1.PAS
Normal file
56
SRC/TOTAL1.PAS
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
Program DEMO;
|
||||
Uses
|
||||
{ PASDVT }
|
||||
CRT,DOS,GRAPHVGA,LibUses,Intro2,Present,Moon,lens,voxel,Fire;
|
||||
{Var
|
||||
P : imageInfo; }
|
||||
Begin
|
||||
|
||||
{ IF NOT VT_Init THEN BEGIN { Init DEMOVT }
|
||||
{ WriteLn('Missing Player !'); { check if DEMOVT a-ok }
|
||||
{ HALT(1);
|
||||
END;
|
||||
VT_AutoOn;
|
||||
Vt_SyncStart;}
|
||||
CheckBreak := False;
|
||||
InitGraph(VGA);
|
||||
DirectVideo(False);
|
||||
{ DirectVideo(True);}
|
||||
OpenLib('TOTAL.OTL');
|
||||
|
||||
{ SEGMENT : INTRO }
|
||||
introAsm;
|
||||
|
||||
{ SEGMENT : TITLE }
|
||||
Thunder;
|
||||
|
||||
{ SEGMENT : MOON }
|
||||
InitMoon;
|
||||
BouffeLaLune;
|
||||
CloseMoon;
|
||||
|
||||
{ SEGMENT : LENS }
|
||||
InitLens;
|
||||
LensPath;
|
||||
CloseLens;
|
||||
|
||||
{ SEGMENT : VOXEL }
|
||||
InitVoxel;
|
||||
FolowPath;
|
||||
CloseVoxel;
|
||||
|
||||
{ SEGMENT : MOON 2 }
|
||||
InitMoon;
|
||||
ClearDevice(0);
|
||||
GerbeLaLune;
|
||||
CloseMoon;
|
||||
delay(100);
|
||||
FadeOut(0,$FF,1);
|
||||
|
||||
{ SEGMENT : Close & Grettings }
|
||||
Greetings;
|
||||
|
||||
{ END }
|
||||
CloseGraph;
|
||||
CloseLib;
|
||||
End.
|
||||
395
SRC/VOXEL.PAS
Normal file
395
SRC/VOXEL.PAS
Normal file
|
|
@ -0,0 +1,395 @@
|
|||
Unit Voxel;
|
||||
Interface
|
||||
Uses
|
||||
CRT,DOS,GRAPHVGA,Libuses;
|
||||
const
|
||||
Mult = 512;
|
||||
Divs = Mult;
|
||||
Sword= 9;
|
||||
Modul = 5;
|
||||
Ang : Word = 0;
|
||||
Dist = 1;
|
||||
AddX = 1000;
|
||||
Multip = 2;
|
||||
MX : Integer = 200; { -400 }
|
||||
MY : Integer = 1;
|
||||
MZ : Integer = 1;
|
||||
|
||||
{ Mx = Mult*100;
|
||||
MY = Mult; { 5 }
|
||||
{ Mz = Mult; { 8 }
|
||||
{ Mx = 20;
|
||||
MY = 70; 5
|
||||
Mz = 20; 8 }
|
||||
{
|
||||
YLen : Array[-60..-20] Of Byte =
|
||||
( 4, 4, 4, 4, 4, 4, 4, 4, 4 ,4, 4, 4, 4, 4,
|
||||
6, 6, 6, 6, 6, 6, 6, 6, 6 ,6, 6, 6, 6,
|
||||
8, 8, 8, 8, 8, 8, 8, 8, 8 ,8, 8, 8, 8, 8);
|
||||
}
|
||||
LX : Array[-60..-20] of Byte =
|
||||
( 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
||||
3, 3, 3, 3, 3);
|
||||
{
|
||||
Db : Array[-60..-19,0..15] of byte = (
|
||||
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
|
||||
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
|
||||
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
|
||||
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
|
||||
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
|
||||
( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7),
|
||||
( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7),
|
||||
( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7),
|
||||
( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7),
|
||||
( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5),
|
||||
( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5),
|
||||
( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5),
|
||||
( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5),
|
||||
( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
|
||||
( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
|
||||
( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
|
||||
( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
|
||||
( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3),
|
||||
( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3),
|
||||
( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3),
|
||||
( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3),
|
||||
( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1),
|
||||
( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1));
|
||||
}
|
||||
Procedure InitVoxel;
|
||||
Procedure FolowPath;
|
||||
Procedure CloseVoxel;
|
||||
|
||||
Implementation
|
||||
Var
|
||||
P : ImageInfo;
|
||||
H : ImageInfo;
|
||||
Sinus,
|
||||
Cosin : Array[ 0..359] of Integer;
|
||||
{ Delta : Array[-49..49] of Shortint;}
|
||||
OldY : integer;
|
||||
SegP : Word;
|
||||
segH : WOrd;
|
||||
PX,Py : integer;
|
||||
Writ : Byte;
|
||||
|
||||
|
||||
Procedure InitVoxel;
|
||||
Var
|
||||
I : Word;
|
||||
X,Y : Word;
|
||||
Begin
|
||||
LoadImage(Voxel_High,H);
|
||||
{ LoadImage(Voxel_Color,P);
|
||||
Loadrix('MapHi.sci',H); }
|
||||
LoadImage(Vox_info,P);
|
||||
Move(P.Picture^,PageW^,64000);
|
||||
PutImage(P,3);
|
||||
FreeImage(P);
|
||||
SetRGb(H.Palette);
|
||||
SegP := Seg(H.Picture^);
|
||||
SegH := segP; {Seg(H.Picture^);}
|
||||
PX := 160;
|
||||
Py := 100;
|
||||
For I:=0 to 359 do
|
||||
Begin
|
||||
Cosin[i] := Round(cos(Rad(I))*Mult);
|
||||
Sinus[i] := Round(sin(Rad(I))*Mult);
|
||||
end;
|
||||
Fillchar(Ptr($A000,0)^,32000,0);
|
||||
Fillchar(Ptr(WriteS,0)^,32000,0);
|
||||
Ang := 0;
|
||||
End;
|
||||
|
||||
Procedure HLine(X,Y : integer; Co : Byte; L,H : Word); Assembler;
|
||||
Asm
|
||||
Mov AX,WriteS
|
||||
Mov ES,AX
|
||||
mov CX,L
|
||||
mov AX,Y
|
||||
mov BX,X
|
||||
dec BX
|
||||
dec AX
|
||||
cmp AX,0
|
||||
jl @@Out
|
||||
cmp AX,199
|
||||
ja @@Out
|
||||
cmp BX,0
|
||||
jl @@inv
|
||||
cmp bx,320
|
||||
jae @@out
|
||||
mov DX,BX
|
||||
add DX,CX
|
||||
cmp dx,310
|
||||
jg @@too
|
||||
jmp @@ok
|
||||
@@inv:
|
||||
Add Cx,bx
|
||||
mov Bx,0
|
||||
jmp @@ok
|
||||
@@too:
|
||||
sub Dx,320
|
||||
Sub CX,DX
|
||||
shr cx,1
|
||||
dec CX
|
||||
@@ok:
|
||||
cmp Cx,0
|
||||
jle @@out
|
||||
{ shr CX,1}
|
||||
mov DX,320
|
||||
Mul DX
|
||||
Add BX,AX
|
||||
Mov SI,H
|
||||
shl si,1
|
||||
@@Dn:
|
||||
mov AL,Co
|
||||
Mov AH,AL
|
||||
Mov DX,CX
|
||||
@@Ec:
|
||||
Mov CX,DX
|
||||
|
||||
Mov DI,BX
|
||||
Rep StosW
|
||||
Add BX,320
|
||||
cmp BX,64000
|
||||
ja @@out
|
||||
Dec SI
|
||||
Jnz @@ec
|
||||
Jmp @@Out
|
||||
@@out:
|
||||
end;
|
||||
|
||||
Procedure DrawVoxel;
|
||||
Label
|
||||
Out;
|
||||
var
|
||||
X,Y,Z : Integer;
|
||||
Zcal : Integer;
|
||||
ZLen : Byte;
|
||||
YC : Word;
|
||||
Nx,Ny : Word;
|
||||
X1,Y1 : integer;
|
||||
C : Byte;
|
||||
R : Shortint;
|
||||
Q : Integer;
|
||||
regX,RegY : Integer;
|
||||
Higher : Integer;
|
||||
Hig : Integer;
|
||||
Delta : Array[-50..50] of Byte;
|
||||
Begin
|
||||
Asm
|
||||
mov AX,WRITES
|
||||
Mov ES,AX
|
||||
xor DI,DI
|
||||
Mov DX,33*160
|
||||
Mov AX,0303h
|
||||
Mov BX,3
|
||||
@@B: Mov CX,DX
|
||||
Rep STOSW
|
||||
dec AH
|
||||
dec AL
|
||||
dec BL
|
||||
jnz @@b
|
||||
{ Mov Cx,16000
|
||||
xor AX,AX
|
||||
rep StosW}
|
||||
End;
|
||||
RegX := Cosin[ang];
|
||||
regY := Sinus[ang];
|
||||
inc(px, -(OldY*RegY) Div Divs);
|
||||
inc(Py, (OldY*RegX) Div Divs);
|
||||
{ If Py >= 200 Then PY := 0;
|
||||
if Px >= 320 Then PX := 0;
|
||||
if Py < 0 Then Py := 199;
|
||||
if Px < 0 then Px := 319;}
|
||||
YC := 0;
|
||||
NX := PX+((-(18)*RegY) Div divs);
|
||||
NY := PY+(((18)*RegX) Div Divs);
|
||||
{ Higher := Mem[SegH:(NY*320)+NX];}
|
||||
{ Asm
|
||||
Mov DX,$3C8
|
||||
Mov AL,0
|
||||
Out DX,AL
|
||||
Inc DX
|
||||
Mov AL,60
|
||||
Out DX,AL
|
||||
Out DX,AL
|
||||
Out DX,AL
|
||||
End;}
|
||||
For Z:=-60 to -20 do
|
||||
Begin
|
||||
Asm
|
||||
Mov AX,Z
|
||||
Mov BX,AX
|
||||
Imul Mz
|
||||
Mov Zcal,AX
|
||||
End;
|
||||
For X:=-49 to 48 do { 49 48 }
|
||||
begin
|
||||
Asm
|
||||
{ ; Calcul de NX }
|
||||
Mov CL,9
|
||||
Mov AX,X
|
||||
IMul RegX
|
||||
Sar AX,CL
|
||||
Cmp DX,0
|
||||
js @@N1
|
||||
AND AX,07FFFh
|
||||
@@N1: Mov BX,AX
|
||||
Mov AX,Yc
|
||||
Sub AX,60
|
||||
Imul RegY
|
||||
Sar AX,Cl
|
||||
Cmp DX,0
|
||||
js @@N2
|
||||
AND AX,07FFFh
|
||||
@@N2: Add BX,AX
|
||||
Add BX,PX
|
||||
Mov NX,BX
|
||||
{ ; Calcul de NY }
|
||||
Mov AX,X
|
||||
IMul RegY
|
||||
Sar AX,CL
|
||||
Cmp DX,0
|
||||
js @@N3
|
||||
AND AX,07FFFh
|
||||
@@N3: Mov BX,AX
|
||||
Mov AX,Yc
|
||||
Sub AX,60
|
||||
Imul RegX
|
||||
Sar AX,Cl
|
||||
Cmp DX,0
|
||||
js @@N4
|
||||
AND AX,07FFFh
|
||||
@@N4: Sub BX,AX
|
||||
Add BX,PY
|
||||
Mov NY,BX
|
||||
{ ; Calcul de l'offset NY * 320 + Nx :) }
|
||||
Mov AX,NY
|
||||
Mov BX,320
|
||||
Mul BX
|
||||
Add AX,NX
|
||||
Mov DI,AX
|
||||
{ ; Prise de C et Hig }
|
||||
Mov AX,SegP
|
||||
Mov ES,AX
|
||||
Mov Al,Byte Ptr ES:[DI]
|
||||
Mov C,AL
|
||||
Mov AX,Segh
|
||||
Mov ES,AX
|
||||
xor AH,AH
|
||||
Mov Al,Byte Ptr ES:[DI]
|
||||
{ ; Calcul du Y }
|
||||
Xor AH,AH
|
||||
neg AX
|
||||
{ Sub AX,Higher}
|
||||
Mov CL,Multip { 5 }
|
||||
sal AX,Cl
|
||||
Add AX,AddX {-2000 -2500 }
|
||||
Mov Y,AX
|
||||
|
||||
IMul My
|
||||
Idiv ZCal
|
||||
add AX,30 { 160 }
|
||||
Mov Y1,AX
|
||||
|
||||
Cmp AX,0
|
||||
Jl Out
|
||||
Cmp AX,199
|
||||
Ja Out
|
||||
Mov BX,AX
|
||||
{ ; Calcul de X1 }
|
||||
Xor DX,DX
|
||||
Mov AX,X
|
||||
IMul Mx
|
||||
IDiv Zcal
|
||||
Add AX,160
|
||||
Mov X1,AX
|
||||
|
||||
Cmp AX,319
|
||||
Ja Out
|
||||
end;
|
||||
{ Putpixel(160+X,120+Z,C);
|
||||
{ PutPixel(X1,Y1,C-db[Z,C mod 16]);}
|
||||
Hline(X1,Y1,C,lx[z] shl 1,y shr 7);
|
||||
{ Hline(X1,Y1,C,Lx[Z],C-Delta[X]);}
|
||||
Delta[X] := C*2;
|
||||
OUT:
|
||||
End;
|
||||
inc(Yc);
|
||||
|
||||
end;
|
||||
Asm
|
||||
Mov BX,DS
|
||||
Mov AX,$A000
|
||||
Mov ES,AX
|
||||
Mov AX,WriteS
|
||||
Mov DS,AX
|
||||
Mov CX,32000
|
||||
Xor DI,DI
|
||||
Mov SI,DI
|
||||
Rep MovsW
|
||||
Mov DS,BX
|
||||
End;
|
||||
for x := 0 to 1 do
|
||||
WaitVBL;
|
||||
end;
|
||||
|
||||
Procedure FolowPath;
|
||||
Var
|
||||
Count : Word;
|
||||
Begin
|
||||
Ang := 90;
|
||||
OldY := 2;
|
||||
For Count := 0 to 200 do
|
||||
Begin
|
||||
DrawVoxel;
|
||||
asm
|
||||
Mov DX,Ang
|
||||
add DX,1
|
||||
cmp DX,360
|
||||
jb @@cont
|
||||
mov DX,0
|
||||
@@Cont: Mov Ang,DX
|
||||
Cmp Count,100
|
||||
jb @@out
|
||||
Mov OldY,5
|
||||
@@out:
|
||||
End;
|
||||
end;
|
||||
FadeOut(0,$FF,1);
|
||||
FillChar(screen^,64000,0);
|
||||
End;
|
||||
|
||||
Procedure CloseVoxel;
|
||||
begin
|
||||
Freeimage(P);
|
||||
FreeImage(H);
|
||||
end;
|
||||
|
||||
End.
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in a new issue