Skip to content

Instantly share code, notes, and snippets.

@kornaz

kornaz/gist:9a14d84d1198ea165ad1d74b26b52b34

Created January 13, 2022 14:15
Show Gist options
  • Save kornaz/9a14d84d1198ea165ad1d74b26b52b34 to your computer and use it in GitHub Desktop.
Save kornaz/9a14d84d1198ea165ad1d74b26b52b34 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
gistfile1.txt
{
Here it is! My first attempt to do some nice 3D stuff in TMT Pascal...
I think it looks pretty cool. As you can see lots of procedures are
done in assembler, 'cause 32-bit power rules! I think that's the best
feature of TMT Pascal. This program is not very fast (no Pentium
optimizations and stuff...), but it is isn't slow too. You can find
some interesting procedures in it like Rotate3D, ConvertTo2D,
GouraudPoly, FIndColors. I think they are pretty fast. You CAN use
them in your own programs, I don't mind...
(c) Giedrius,
mail to: [email protected]
}
{$R-,Q-}
program GrdTorus;
const
TorusSegments = 24;
TorusSides = 12;
TotalVertices = TorusSegments * TorusSides;
TotalFaces = TorusSegments * TorusSides;
R1 = 140; -- Torus radius
R2 = 70; -- Torus segment radius
StepX = 3;
StepY = 2;
StepZ = 1;
type
T2DVertex = record
x, y: Integer;
end;
T3DVertex = record
x, y, z: Integer;
end;
var
_2DVertices: array [0..TotalVertices - 1] of T2DVertex;
_3DVertices, _3DVertices2: array [0..TotalVertices - 1] of T3DVertex;
_3DFaces: array [0..TotalFaces - 1, 1..4] of Word;
Sines: array [0..511] of Integer;
VScreen: array [0..63999] of Byte;
Order: array [0..TotalFaces - 1] of Word;
CentZ: array [0..TotalFaces - 1] of Integer;
FaceNormals, FaceNormals2: array [0..TotalFaces - 1] of T3DVertex;
VertexNormals, VertexNormals2: array [0..TotalVertices - 1] of T3DVertex;
Colors: array [1..4] of Byte;
_2DVerticesPtr, _3DVerticesPtr, _3DVertices2Ptr,
_3DFacesPtr, FaceNormalsPtr, VertexNormalsPtr,
FaceNormals2Ptr, VertexNormals2Ptr,
SinesPtr, VScreenPtr: Pointer;
i1, AngleX, AngleY, AngleZ: Word;
{{$DEFINE ShowRaster} -- Uncomment this if you want to see how much
-- raster time entire cycle takes
---------
-- Get pressed key (like CRT's ReadKey)
---------
function ReadChar: Char; assembler;
asm
xor ah, ah
int 16h
end;
---------
-- Check if a key was pressed (like CRT's KeyPressed)
---------
function KeyPushed: Boolean; assembler;
asm
mov ah, 1
int 16h
jz @Nope
mov al, 1
jmp @Out
@Nope:
xor al, al
@Out:
end;
---------
-- Wait for a vertical retrace
---------
procedure WaitVerRetrace; assembler;
asm
mov dx, 03DAh
@Loop1:
in al, dx
and al, 8
jnz @Loop1
@Loop2:
in al, dx
and al, 8
jz @Loop2
end;
---------
-- Set color's RGB values
---------
procedure SetRGB(Color, r, g, b: Byte); assembler;
asm
mov dx, 03C8h
mov al, Color
out dx, al
inc dx
mov al, r
out dx, al
mov al, g
out dx, al
mov al, b
out dx, al
end;
---------
-- Init new video mode
---------
procedure InitVideoMode(Mode: Byte); assembler;
asm
xor ah, ah
mov al, Mode
int 10h
end;
---------
-- Clear whole screen
---------
procedure ClearScreen(ScreenPtr: Pointer; Color: Byte); assembler;
asm
mov edi, ScreenPtr
mov bl, Color
mov bh, bl
mov ax, bx
shl eax, 16
mov ax, bx
mov ecx, 16000
cld
rep stosd
end;
---------
-- Copy whole screen (eg. virtual screen to video memory or vice versa)
---------
procedure CopyScreen(SourcePtr, DestPtr: Pointer); assembler;
asm
mov edi, DestPtr
mov esi, SourcePtr
mov ecx, 16000
cld
rep movsd
end;
---------
-- Clear an area in a screen
---------
procedure ClearArea(ScreenPtr: Pointer; Color: Byte; x1_div_4, y1, x2_div_4, y2: Integer); assembler;
asm
mov edi, ScreenPtr
xor eax, eax
mov ah, byte ptr y1
mov bx, ax
shr bx, 2
add ax, bx
mov bx, x1_div_4
shl bx, 2
add ax, bx
add edi, eax
mov dl, Color
mov dh, dl
mov ax, dx
shl eax, 16
mov ax, dx
mov bx, y2
sub bx, y1
inc bx
xor edx, edx
xor ecx, ecx
mov dx, 80
mov cx, x2_div_4
sub cx, x1_div_4
inc cx
sub dx, cx
shl edx, 2
@NextLine:
push ecx
rep stosd
pop ecx
add edi, edx
dec bx
jnz @NextLine
end;
---------
-- Copy area in a screen
---------
procedure CopyArea(SourcePtr, DestPtr: Pointer; x1_div_4, y1, x2_div_4, y2: Integer); assembler;
asm
mov edi, DestPtr
mov esi, SourcePtr
xor eax, eax
mov ah, byte ptr y1
mov bx, ax
shr bx, 2
add ax, bx
mov bx, x1_div_4
shl bx, 2
add ax, bx
add edi, eax
add esi, eax
mov bx, y2
sub bx, y1
inc bx
xor edx, edx
xor ecx, ecx
mov dx, 80
mov cx, x2_div_4
sub cx, x1_div_4
inc cx
sub dx, cx
shl edx, 2
@NextLine:
push ecx
rep movsd
pop ecx
add edi, edx
add esi, edx
dec bx
jnz @NextLine
end;
---------
-- Rotate vertices array around all three axes and store results
-- into another array
---------
procedure Rotate3D(V3DVerticesPtr, V3DVertices2Ptr, SinesPtr: Pointer; TotalVertices, AngX, AngY, AngZ: Word); assembler;
var
TempX, TempY, TempZ, TempX2, TempY2, TempZ2: Integer;
SinX, CosX, SinY, CosY, SinZ, CosZ: LongInt;
asm
mov edi, SinesPtr
xor ebx, ebx
mov bx, AngX
shl bx, 1
mov ax, [edi + ebx]
cwde
mov SinX, eax
mov bx, AngX
add bx, 128
and bx, 511
shl bx, 1
mov ax, [edi + ebx]
cwde
mov CosX, eax
mov bx, AngY
shl bx, 1
mov ax, [edi + ebx]
cwde
mov SinY, eax
mov bx, AngY
add bx, 128
and bx, 511
shl bx, 1
mov ax, [edi + ebx]
cwde
mov CosY, eax
mov bx, AngZ
shl bx, 1
mov ax, [edi + ebx]
cwde
mov SinZ, eax
mov bx, AngZ
add bx, 128
and bx, 511
shl bx, 1
mov ax, [edi + ebx]
cwde
mov CosZ, eax
mov esi, V3DVerticesPtr
mov edi, V3DVertices2Ptr
mov cx, TotalVertices
@Rotate:
-- 1st X Coordinate
mov ax, [esi]
mov TempX, ax
-- 1st Y Coordinate
movsx eax, word ptr [esi + 2]
imul CosX
mov ebx, eax
movsx eax, word ptr [esi + 4]
imul SinX
sub ebx, eax
sar ebx, 14
mov TempY, bx
-- 1st Z Coordinate
movsx eax, word ptr [esi + 2]
imul SinX
mov ebx, eax
movsx eax, word ptr [esi + 4]
imul CosX
add ebx, eax
sar ebx, 14
mov TempZ, bx
-- 2nd X Coordinate
movsx eax, TempX
imul CosY
mov ebx, eax
movsx eax, TempZ
imul SinY
add ebx, eax
sar ebx, 14
mov TempX2, bx
-- 2nd Y Coordinate
mov ax, TempY
mov TempY2, ax
-- 2nd Z Coordinate
movsx eax, TempZ
imul CosY
mov ebx, eax
movsx eax, TempX
imul SinY
sub ebx, eax
sar ebx, 14
mov TempZ2, bx
-- 3rd X Coordinate
movsx eax, TempX2
imul CosZ
mov ebx, eax
movsx eax, TempY2
imul SinZ
sub ebx, eax
sar ebx, 14
mov [edi], bx
-- 3rd Y Coordinate
movsx eax, TempX2
imul SinZ
mov ebx, eax
movsx eax, TempY2
imul CosZ
add ebx, eax
sar ebx, 14
mov [edi + 2], bx
-- 3rd Z Coordinate
mov ax, TempZ2
mov [edi + 4], ax
add esi, 6
add edi, 6
dec cx
jnz @Rotate
end;
---------
-- Convert 3D vertices array to 2D and store results into another array
---------
procedure ConvertTo2D(V3DVerticesPtr, V2DVerticesPtr: Pointer; TotalCoords: Word; OX, OY, OZ: Integer); assembler;
asm
mov edi, V3DVerticesPtr
mov esi, V2DVerticesPtr
xor cx, cx
@ConvertNext:
mov ax, [edi]
add ax, OX
shl eax, 16
sar eax, 8
cdq
mov bx, [edi + 4]
add bx, 256
add bx, OZ
shl ebx, 16
sar ebx, 16
idiv ebx
add ax, 159
mov [esi], ax
mov ax, [edi + 2]
add ax, OY
neg ax
shl eax, 16
sar eax, 8
mov ebx, 5
imul ebx
mov ebx, 6
idiv ebx
cdq
mov bx, [edi + 4]
add bx, 256
add bx, OZ
shl ebx, 16
sar ebx, 16
idiv ebx
add ax, 99
mov [esi + 2], ax
add edi, 6
add esi, 4
inc cx
cmp cx, TotalCoords
jne @ConvertNext
end;
---------
-- Draw gouraud shaded polygon. NOTE: no clipping is performed, so be careful,
-- DO NOT draw outside screen, 'cause strange things will happen... ;)
---------
procedure GouraudPoly(x1, y1, Color1, x2, y2, Color2, x3, y3, Color3: Word; Screen: Pointer); assembler;
var
LineCoords: array [1..800] of Word;
Step, ColStep: DWord;
Temp: Byte;
asm
mov ax, y1
mov bx, y3
cmp ax, bx
jl @SkipChange1
mov y1, bx
mov y3, ax
mov ax, x1
mov bx, x3
mov x1, bx
mov x3, ax
mov ax, Color1
mov bx, Color3
mov Color1, bx
mov Color3, ax
@SkipChange1:
mov ax, y1
mov bx, y2
cmp ax, bx
jl @SkipChange2
mov y1, bx
mov y2, ax
mov ax, x1
mov bx, x2
mov x1, bx
mov x2, ax
mov ax, Color1
mov bx, Color2
mov Color1, bx
mov Color2, ax
@SkipChange2:
mov ax, y2
mov bx, y3
cmp ax, bx
jl @SkipChange3
mov y2, bx
mov y3, ax
mov ax, x2
mov bx, x3
mov x2, bx
mov x3, ax
mov ax, Color2
mov bx, Color3
mov Color2, bx
mov Color3, ax
@SkipChange3:
lea esi, LineCoords
xor ebx, ebx
mov bx, y3
sub bx, y1
cmp ebx, 0
jg @Skip1
mov Step, 0
mov ColStep, 0
jmp @Continue1
@Skip1:
mov ax, x3
sub ax, x1
shl eax, 16
cdq
idiv ebx
mov Step, eax
mov ax, Color3
sub ax, Color1
shl eax, 16
cdq
idiv ebx
mov ColStep, eax
@Continue1:
mov dx, x1
shl edx, 16
mov di, Color1
shl edi, 16
xor ebx, ebx
mov cx, y1
mov bx, cx
shl bx, 2
@Loop1:
mov eax, edx
sar eax, 16
mov [esi + ebx], ax
add edx, Step
mov eax, edi
sar eax, 16
mov [esi + 800 + ebx], ax
add edi, ColStep
add bx, 4
inc cx
cmp cx, y3
jle @Loop1
xor ebx, ebx
mov bx, y2
sub bx, y1
cmp ebx, 0
jg @Skip2
mov Step, 0
mov ColStep, 0
jmp @Continue2
@Skip2:
mov ax, x2
sub ax, x1
shl eax, 16
cdq
idiv ebx
mov Step, eax
mov ax, Color2
sub ax, Color1
shl eax, 16
cdq
idiv ebx
mov ColStep, eax
@Continue2:
mov dx, x1
shl edx, 16
mov di, Color1
shl edi, 16
xor ebx, ebx
mov cx, y1
mov bx, cx
shl bx, 2
add bx, 2
@Loop2:
mov eax, edx
sar eax, 16
mov [esi + ebx], ax
add edx, Step
mov eax, edi
sar eax, 16
mov [esi + 800 + ebx], ax
add edi, ColStep
add bx, 4
inc cx
cmp cx, y2
jle @Loop2
xor ebx, ebx
mov bx, y3
sub bx, y2
cmp ebx, 0
jg @Skip3
mov Step, 0
mov ColStep, 0
jmp @Continue3
@Skip3:
mov ax, x3
sub ax, x2
shl eax, 16
cdq
idiv ebx
mov Step, eax
mov ax, Color3
sub ax, Color2
shl eax, 16
cdq
idiv ebx
mov ColStep, eax
@Continue3:
mov dx, x2
shl edx, 16
mov di, Color2
shl edi, 16
xor ebx, ebx
mov cx, y2
mov bx, cx
shl bx, 2
add bx, 2
@Loop3:
mov eax, edx
sar eax, 16
mov [esi + ebx], ax
add edx, Step
mov eax, edi
sar eax, 16
mov [esi + 800 + ebx], ax
add edi, ColStep
add bx, 4
inc cx
cmp cx, y3
jle @Loop3
cld
xor ebx, ebx
mov bx, y1
shl bx, 2
add esi, ebx
mov bx, y1
@DrawNext:
mov ax, [esi]
mov di, [esi + 2]
cmp ax, di
jle @Start
mov [esi], di
mov [esi + 2], ax
mov ax, [esi + 800]
mov di, [esi + 800 + 2]
mov [esi + 800], di
mov [esi + 800 + 2], ax
@Start:
xor ecx, ecx
mov cx, [esi + 2]
sub cx, [esi]
inc cx
xor al, al
mov ah, bl
xor edi, edi
mov di, ax
shr di, 2
add di, ax
add di, [esi]
add edi, Screen
mov ax, [esi + 800 + 2]
sub ax, [esi + 800]
cwde
sal eax, 16
cdq
idiv ecx
mov ColStep, eax
mov dx, [esi + 800]
shl edx, 16
shr cx, 1
jnc @DrawPixel
mov eax, edx
sar eax, 16
add edx, ColStep
stosb
cmp cx, 0
je @Out2
@DrawPixel:
mov eax, edx
sar eax, 16
mov Temp, al
add edx, ColStep
mov eax, edx
sar eax, 8
add edx, ColStep
mov al, Temp
stosw
dec cx
jnz @DrawPixel
@Out2:
add esi, 4
inc bx
cmp bx, y3
jle @DrawNext
end;
---------
-- Determine color at each vertex of a face
---------
procedure FindColors(VVertexNormals: Pointer; Face: Word); assembler;
var
MulVectors, MulCoords: LongInt;
FPUTemp, TSegment, TSide, _TorusSegments, _TorusSides: Word;
VertexList: array [1..4] of Word;
asm
mov esi, VVertexNormals
lea edi, Colors
lea ecx, VertexList
mov ax, TorusSegments
mov _TorusSegments, ax
mov ax, TorusSides
mov _TorusSides, ax
mov ax, Face
cwd
div _TorusSides
mov TSegment, ax
mov TSide, dx
mov ax, TSegment
cwd
div _TorusSegments
imul dx, _TorusSides
mov bx, dx
mov ax, TSide
cwd
div _TorusSides
add bx, dx
mov [ecx], bx
mov ax, TSegment
inc ax
cwd
div _TorusSegments
imul dx, _TorusSides
mov bx, dx
mov ax, TSide
cwd
div _TorusSides
add bx, dx
mov [ecx + 2], bx
mov ax, TSegment
inc ax
cwd
div _TorusSegments
imul dx, _TorusSides
mov bx, dx
mov ax, TSide
inc ax
cwd
div _TorusSides
add bx, dx
mov [ecx + 4], bx
mov ax, TSegment
cwd
div _TorusSegments
imul dx, _TorusSides
mov bx, dx
mov ax, TSide
inc ax
cwd
div _TorusSides
add bx, dx
mov [ecx + 6], bx
mov edx, ecx
xor ecx, ecx
@FindVertexCol:
push edx
movzx ebx, word ptr [edx + ecx * 2]
mov edx, ebx
shl edx, 1
shl ebx, 2
add ebx, edx
xor al, al
movsx edx, word ptr [esi + ebx + 4]
imul edx, -256
cmp edx, 0
jle @Out
mov MulCoords, edx
movsx eax, word ptr [esi + ebx]
imul eax, eax
movsx edx, word ptr [esi + ebx + 2]
imul edx, edx
add eax, edx
movsx edx, word ptr [esi + ebx + 4]
imul edx, edx
add eax, edx
mov MulVectors, eax
fild MulCoords
fild MulVectors
fsqrt
mov FPUTemp, 256
fild FPUTemp
fmulp
fdivp
mov FPUTemp, 91
fild FPUTemp
fmulp
fistp FPUTemp
mov ax, FPUTemp
@Out:
mov [edi + ecx], al
pop edx
inc ecx
cmp ecx, 4
jl @FindVertexCol
end;
---------
-- Calculate all torus data, including: vertices' coordinates,
-- faces' normals, vertices' normals
---------
procedure MakeTorus;
var
DeltaZ, DeltaX, Ax, Ay, Az, Bx, By, Bz: Integer;
in1, in2, in3: Word;
Angle, AngleStep: Real;
begin
AngleStep := 360 / TorusSides;
for in1 := 0 to TorusSides - 1 do
begin
DeltaX := Round(R2 * Cos(in1 * AngleStep * Pi / 180));
DeltaZ := Round(-R2 * Sin(in1 * AngleStep * Pi / 180));
_3DVertices[in1].x := R1 + DeltaX;
_3DVertices[in1].y := 0;
_3DVertices[in1].z := DeltaZ;
end;
AngleStep := 360 / TorusSegments;
for in2 := 1 to TorusSegments - 1 do
begin
Angle := in2 * AngleStep * Pi / 180;
for in1 := 0 to TorusSides - 1 do
begin
_3DVertices[in2 * TorusSides + in1].x :=
Round(Cos(Angle) * _3DVertices[in1].x -
Sin(Angle) * _3DVertices[in1].y);
_3DVertices[in2 * TorusSides + in1].y :=
Round(Sin(Angle) * _3DVertices[in1].x +
Cos(Angle) * _3DVertices[in1].y);
_3DVertices[in2 * TorusSides + in1].z := _3DVertices[in1].z;
end;
end;
for in2 := 0 to TorusSegments - 1 do
for in1 := 0 to TorusSides - 1 do
begin
in3 := in2 * TorusSides + in1;
_3DFaces[in3, 1] := in2 * TorusSides + in1;
_3DFaces[in3, 2] := ((in2 + 1) mod TorusSegments) * TorusSides + in1;
_3DFaces[in3, 3] := ((in2 + 1) mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides;
_3DFaces[in3, 4] := in2 * TorusSides + (in1 + 1) mod TorusSides;
Ax := _3DVertices[_3DFaces[in3, 1]].x - _3DVertices[_3DFaces[in3, 2]].x;
Ay := _3DVertices[_3DFaces[in3, 1]].y - _3DVertices[_3DFaces[in3, 2]].y;
Az := _3DVertices[_3DFaces[in3, 1]].z - _3DVertices[_3DFaces[in3, 2]].z;
Bx := _3DVertices[_3DFaces[in3, 4]].x - _3DVertices[_3DFaces[in3, 2]].x;
By := _3DVertices[_3DFaces[in3, 4]].y - _3DVertices[_3DFaces[in3, 2]].y;
Bz := _3DVertices[_3DFaces[in3, 4]].z - _3DVertices[_3DFaces[in3, 2]].z;
FaceNormals[in3].x := Ay * Bz - Az * By;
FaceNormals[in3].y := Az * Bx - Ax * Bz;
FaceNormals[in3].z := Ax * By - Ay * Bx;
end;
for in2 := 0 to TorusSegments - 1 do
for in1 := 0 to TorusSides - 1 do
begin
in3 := (in2 + 1) mod TorusSegments * TorusSides + (in1 + 1) mod TorusSides;
VertexNormals[in3].x := (FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1) mod TorusSides].x +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1) mod TorusSides].x +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].x +
FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].x) div 4;
VertexNormals[in3].y := (FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1) mod TorusSides].y +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1) mod TorusSides].y +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].y +
FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].y) div 4;
VertexNormals[in3].z := (FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1) mod TorusSides].z +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1) mod TorusSides].z +
FaceNormals[((in2 + 1) mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].z +
FaceNormals[(in2 mod TorusSegments) * TorusSides + (in1 + 1) mod TorusSides].z) div 4;
end;
end;
---------
-- Sort all faces
---------
procedure QuickSort(k1, k2: Word);
var
in1, in2, Tempp1, Tempp2: Integer;
begin
in1 := k1; in2 := k2;
Tempp1 := CentZ[(k1 + k2) shr 1];
repeat
while CentZ[in1] > Tempp1 do Inc(in1);
while Tempp1 > CentZ[in2] do Dec(in2);
if in1 <= in2 then
begin
Tempp2 := CentZ[in1]; CentZ[in1] := CentZ[in2]; CentZ[in2] := Tempp2;
Tempp2 := Order[in1]; Order[in1] := Order[in2]; Order[in2] := Tempp2;
Inc(in1);
Dec(in2);
end;
until in1 > in2;
if k1 < in2 then QuickSort(k1, in2);
if in1 < k2 then QuickSort(in1, k2);
end;
begin
WriteLn('Calculating data... Please wait!');
{ Setup our pointers }
_2DVerticesPtr := Ptr(Ofs(_2DVertices));
_3DVerticesPtr := Ptr(Ofs(_3DVertices));
_3DVertices2Ptr := Ptr(Ofs(_3DVertices2));
_3DFacesPtr := Ptr(Ofs(_3DFaces));
FaceNormalsPtr := Ptr(Ofs(FaceNormals));
VertexNormalsPtr := Ptr(Ofs(VertexNormals));
FaceNormals2Ptr := Ptr(Ofs(FaceNormals2));
VertexNormals2Ptr := Ptr(Ofs(VertexNormals2));
SinesPtr := Ptr(Ofs(Sines));
VScreenPtr := Ptr(Ofs(VScreen));
ClearScreen(VScreenPtr, 0);
{ Claculate sines' table }
for i1 := 0 to 511 do
Sines[i1] := Round(16384 * Sin(i1 * Pi / 256));
MakeTorus;
Randomize;
{ Assign random values to the starting angles }
AngleX := Random(512); AngleY := Random(512); AngleZ := Random(512);
InitVideoMode($13);
{ Setup our nice ;) palette }
for i1 := 0 to 63 do
SetRGB(i1, i1, 0, 0);
for i1 := 0 to 31 do
SetRGB(i1 + 64, 63, 1 + i1 * 2, 0);
repeat
WaitVerRetrace;
{$IFDEF ShowRaster}
SetRGB(0, 31, 31, 0);
{$ENDIF}
{CopyScreen(VScreenPtr, Ptr(_zero + $A0000));
ClearScreen(VScreenPtr, 0);}
CopyArea(VScreenPtr, Ptr(_zero + $A0000), 10, 0, 69, 199);
ClearArea(VScreenPtr, 0, 10, 0, 69, 199);
{ Rotate vertices }
Rotate3D(_3DVerticesPtr, _3DVertices2Ptr, SinesPtr, TotalVertices, AngleX, AngleY, AngleZ);
{ Rotate faces' normals }
Rotate3D(FaceNormalsPtr, FaceNormals2Ptr, SinesPtr, TotalFaces, AngleX, AngleY, AngleZ);
{ Rotate vertices' normals }
Rotate3D(VertexNormalsPtr, VertexNormals2Ptr, SinesPtr, TotalFaces, AngleX, AngleY, AngleZ);
{ Convert 3D vertices to 2D }
ConvertTo2D(_3DVertices2Ptr, _2DVerticesPtr, TotalVertices, 0, 0, 256);
for i1 := 0 to TotalFaces - 1 do
begin
Order[i1] := i1;
CentZ[i1] := (_3DVertices2[_3DFaces[i1, 1]].z + _3DVertices2[_3DFaces[i1, 2]].z +
_3DVertices2[_3DFaces[i1, 3]].z + _3DVertices2[_3DFaces[i1, 4]].z) div 4;
end;
{ Sort faces }
QuickSort(0, TotalFaces - 1);
{ Determine colors and draw faces }
for i1 := 0 to TotalFaces - 1 do
begin
if FaceNormals2[Order[i1]].z <= CentZ[TotalFaces - 1 - i1] then
begin
FindColors(VertexNormals2Ptr, Order[i1]);
GouraudPoly(_2DVertices[_3DFaces[Order[i1], 1]].x, _2DVertices[_3DFaces[Order[i1], 1]].y, Colors[1],
_2DVertices[_3DFaces[Order[i1], 2]].x, _2DVertices[_3DFaces[Order[i1], 2]].y, Colors[2],
_2DVertices[_3DFaces[Order[i1], 3]].x, _2DVertices[_3DFaces[Order[i1], 3]].y, Colors[3],
VScreenPtr);
GouraudPoly(_2DVertices[_3DFaces[Order[i1], 3]].x, _2DVertices[_3DFaces[Order[i1], 3]].y, Colors[3],
_2DVertices[_3DFaces[Order[i1], 4]].x, _2DVertices[_3DFaces[Order[i1], 4]].y, Colors[4],
_2DVertices[_3DFaces[Order[i1], 1]].x, _2DVertices[_3DFaces[Order[i1], 1]].y, Colors[1],
VScreenPtr);
end;
end;
AngleX := (AngleX + StepX) and 511;
AngleY := (AngleY + StepY) and 511;
AngleZ := (AngleZ + StepZ) and 511;
{$IFDEF ShowRaster}
SetRGB(0, 0, 0, 0);
{$ENDIF}
until KeyPushed;
ReadChar;
InitVideoMode(3);
WriteLn('Coded by Giedrius, using TMT Pascal v1.20');
WriteLn('Mail to: [email protected]');
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment