``````{
PS> I see that a lot of people around here have polygon, texture mapping and
PS> 3D routines so why don't you all post them here, even if you already
PS> have done in the past cause there are people who didn't get them
PS> and want them :)
}

{\$G+,R-}

{ Mode-x version of polygoned objects          }
{ Originally by Bas van Gaalen & Sven van Heel }
{ Optimized by Luis Mezquita Raya              }

uses Crt,x3Dunit2;
{ ^^^^^  Contained in GRAPHICS.SWG file }
{\$DEFINE Object1}                       { Try an object between 1..4 }

const

{\$IFDEF Object1}                        { Octagon }
nofpolys=9;                            { Number of poligons-1 }

nofpoints=11;                          { Number of points-1 }

polypoints=4;                          { Number of points for each poly }

sc=5;                                  { Number of visible planes }

cr=23;                                 { RGB components }
cg=8;
cb=3;

point:array[0..nofpoints,0..2] of integer=(
(-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
(-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));

planes:array[0..nofpolys,0..3] of byte=(
(0,1,7,6),(1,2,8,7),(9,8,2,3),(10,9,3,4),(10,4,5,11),
(6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
{\$ENDIF}

{\$IFDEF Object2}                        { Cube }
nofpolys=5;                            { Number of poligons-1 }

nofpoints=7;                           { Number of points-1 }

polypoints=4;                          { Number of points for each poly }

sc=3;                                  { Number of visible planes }

cr=0;                                  { RGB components }
cg=13;
cb=23;

point:array[0..nofpoints,0..2] of integer=(
(-40,-40, 40),( 40,-40, 40),( 40,-40,-40),(-40,-40,-40),
(-40, 40, 40),( 40, 40, 40),( 40, 40,-40),(-40, 40,-40));

planes:array[0..nofpolys,0..3] of byte=(
(0,1,5,4),(1,5,6,2),(6,7,3,2),
(7,3,0,4),(0,1,2,3),(6,5,4,7));
{\$ENDIF}

{\$IFDEF Object3}                        { Octahedron }
nofpolys=7;                            { Number of poligons-1 }

nofpoints=5;                           { Number of points-1 }

polypoints=3;                          { Number of points for each poly }

sc=4;                                  { Number of visible planes }

cr=0;                                  { RGB components }
cg=3;
cb=23;

point:array[0..nofpoints,0..2] of integer=(
(  0, 0,  45),(-40,-40,  0),(-40, 40,  0),( 40, 40,  0),
( 40,-40,  0),(  0,  0,-45));

planes:array[0..nofpolys,0..3] of byte=(
(0,1,2,0),(0,2,3,0),(0,3,4,0),(0,4,1,0),
(5,1,2,5),(5,2,3,5),(5,3,4,5),(5,4,1,5));

{\$ENDIF}

{\$IFDEF Object4}                        { Spiky }
nofpolys=15;                           { Number of poligons-1 }

nofpoints=19;                          { Number of points-1 }

polypoints=4;                          { Number of points for each poly }

sc=5;                                  { Number of visible planes }

cr=23;                                 { RGB components }
cg=5;
cb=5;

point:array[0..nofpoints,0..2] of integer=(
(-10,-10, 30),( 10,-10, 30),( 30,-30,  0),( 10,-10,-30),
(-10,-10,-30),(-30,-30,  0),(-10, 10, 30),( 10, 10, 30),
( 30, 30,  0),( 10, 10,-30),(-10, 10,-30),(-30, 30,  0),
( -2, -2, 60),( -2,  2, 60),(  2, -2, 60),(  2,  2, 60),
( -2, -2,-60),( -2,  2,-60),(  2, -2,-60),(  2,  2,-60));

planes:array[0..nofpolys,0..3] of byte=(
(0,1,14,12),(7,15,13,6),(1,14,15,7),(6,13,12,0),
(1,2,8,7),(9,8,2,3),
(10,9,19,17),(10,4,16,17),(3,4,16,18),(3,9,19,18),
(10,4,5,11),
(6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
{\$ENDIF}

type  polytype=array[0..nofpolys] of integer;
pointype=array[0..nofpoints] of integer;

ptnode=word;
stack=ptnode;

const soplt=SizeOf(polytype);
sopit=SizeOf(pointype);
xst:integer=1;
yst:integer=1;
zst:integer=-2;

var   polyz,pind:array[byte] of polytype;
xp,yp:array[byte] of pointype;
phix:byte;

Procedure QuickSort(lo,hi:integer); assembler; { Iterative QuickSort }
var i,j,x,y:integer;                           { NON RECURSIVE }
asm
mov ah,48h                      { Init stack }
mov bx,1
int 21h
jc @exit
mov es,ax
xor ax,ax
mov es:[4],ax

mov cx,lo                       { Push(lo,hi) }
mov dx,hi
call @Push

@QS:    mov ax,es:[4]                   { ¨Stack empty? }
and ax,ax
jz @Empty

mov cx,es:[0]                   { Top(lo,hi) }
mov dx,es:[2]
mov lo,cx
mov hi,dx

mov bx,es:[4]                   { Pop }
mov ah,49h
int 21h
jc @exit
mov es,bx

mov ax,cx                       { ax:=(i+j) div 2 }
mov bx,dx
shr ax,1

lea bx,polyz                    { ax:=polyz[ax] }
call @index
mov x,ax

@Rep:   mov ax,cx                       { repeat ... }
lea bx,polyz                    { while polyz[i]<x do ... }
call @index
cmp ax,x
jge @Rep2
inc cx                          { inc(i); }
jmp @Rep

@Rep2:  mov ax,dx                       { while x<polyz[j] do ... }
call @index
cmp x,ax
jge @EndR
dec dx                          { dec(j); }
jmp @Rep2

@EndR:  cmp cx,dx                       { if i>j ==> @NSwap}
jg @NBl

je @NSwap
push cx

mov ax,cx
call @index
mov cx,ax                       { cx:=polyz[i] }
mov si,di

mov ax,dx                       { polyz[i]:=polyz[j] }
call @index
mov [si],ax

mov [di],cx                     { polyz[j]:=cx }
pop ax

push ax
lea bx,pind
call @index
mov cx,ax                       { cx:=pind[i] }
mov si,di

mov ax,dx                       { pind[i]:=pind[j] }
call @index
mov [si],ax

mov [di],cx                     { pind[j]:=cx }

pop cx
@NSwap: inc cx
dec dx

@NBl:   cmp cx,dx                       { ... until i>j; }
jle @Rep

mov i,cx
mov j,dx

mov dx,hi                       { if i>=hi ==> @ChkLo }
cmp cx,dx
jge @ChkLo

call @Push                      { Push(i,hi) }

@ChkLo: mov cx,lo                       { if lo>=j ==> @QSend }
mov dx,j
cmp cx,dx
jge @QSend

call @Push                      { Push(lo,j) }

@QSend: jmp @QS                         { loop while stack isn't empty }

@Empty: mov ah,49h
int 21h
jmp @exit

@index: shl ax,1                        { ax:=2*ax }
mov di,ax
push bx
mov bl,soplt
mov al,phix
xor ah,ah
mul bl
pop bx
mov ax,[di]
ret

@Push:  mov ah,48h                      { Push into stack }
mov bx,1
int 21h
jc @exit
mov bx,es
mov es,ax
mov es:[0],cx
mov es:[2],dx
mov es:[4],bx
mov di,ax
ret

@exit:
end;

Procedure Calc;
var z:pointype;
spx,spy,spz,
cpx,cpy,cpz,
zd,x,y,i,j,k:integer;
n,key,phiy,phiz:byte;
begin
phix:=0;
phiy:=0;
phiz:=0;
FillChar(xp,sizeof(xp),0);
FillChar(yp,sizeof(yp),0);

repeat

spy:=sinus(phiy);
spz:=sinus(phiz);

cpx:=cosinus(phix);
cpy:=cosinus(phiy);
cpz:=cosinus(phiz);

for n:=0 to nofpoints do
begin
i:=(cpy*point[n,0]-spy*point[n,2]) div divd;
j:=(cpz*point[n,1]-spz*i) div divd;
k:=(cpy*point[n,2]+spy*point[n,0]) div divd;
x:=(cpz*i+spz*point[n,1]) div divd;
y:=(cpx*j+spx*k) div divd;
z[n]:=(cpx*k-spx*j) div divd;
zd:=z[n]-dist;
xp[phix,n]:=(160+cpx)-(x*dist) div zd;
yp[phix,n]:=(200+spz) div 2-(y*dist) div zd;
end;

for n:=0 to nofpolys do
begin
polyz[phix,n]:=(z[planes[n,0]]+z[planes[n,1]]+
z[planes[n,2]]+z[planes[n,3]]) div 4;
pind[phix,n]:=n;
end;

QuickSort(0,nofpolys);
inc(phix,xst);
inc(phiy,yst);
inc(phiz,zst);
until phix=0;
end;

Procedure ShowObject;
var n:byte; pim:integer;
begin
retrace;
cls;
for n:=sc to nofpolys do
begin
pim:=pind[phix,n];
polygon(xp[phix,planes[pim,0]],yp[phix,planes[pim,0]],
xp[phix,planes[pim,1]],yp[phix,planes[pim,1]],
xp[phix,planes[pim,2]],yp[phix,planes[pim,2]],
xp[phix,planes[pim,3]],yp[phix,planes[pim,3]],
polyz[phix,n]+30);
end;
end;

Procedure Rotate;
var i:byte;
begin
setmodex;
Triangles:=polypoints=3;
for i:=1 to 80 do setpal(i,cr+i shr 1,cg+i shr 1,cb+i shr 1);
setborder(63);
repeat
ShowObject;
inc(phix,xst);
until KeyPressed;
setborder(0);
end;

var i:byte;
s:stack;
x,y:integer;

begin
{border:=True;}
if ParamCount=1
then begin
Val(ParamStr(1),xst,yst);
if yst<>0 then Halt;
zst:=-2*xst;
yst:=xst;
end;
WriteLn('Wait a moment ...');
Calc;
Rotate;
TextMode(LastMode);
end.

But ... wait a moment ... you also need x3dUnit2.pas
which is also included in the SWAG files

``````