Original source code back to 1994
This commit is contained in:
commit
6bc455f9af
37 changed files with 3240 additions and 0 deletions
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.
|
||||
Loading…
Reference in a new issue