395 lines
9.9 KiB
ObjectPascal
395 lines
9.9 KiB
ObjectPascal
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.
|
|
|
|
|
|
|
|
|