407 lines
8.9 KiB
ObjectPascal
407 lines
8.9 KiB
ObjectPascal
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.
|