Texture Mapping
ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸
³ W E L C O M E ³
³ To the VGA Trainer Program ³ ³
³ By ³ ³
³ DENTHOR of ASPHYXIA ³ ³ ³
ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ; ³ ³
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
--==[ PART 21 ]==--
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
þ Introduction
Hi there! It's been quite a long time (again) since the last tutorial ...
I'll bet some of you had given up one me ;-)
Today is my 21st birthday, so I decided it would be the perfect time to
finish up this trainer which I have been meaning to send out for weeks.
It's on texure mapping. I know, I know, I said light sourcing, then gourad,
then texture mapping, but I got enough mail (a deluge in fact ;) telling me
to do texure mapping...
I'll be using the code from Tut 20 quite extensively, so make sure you know
whats going on in there... well, on with the show!
BTW, I've improved my web page quite a bit... give it a visit, I want to
really ramp up that hit count :)
If you would like to contact me, or the team, there are many ways you
can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
on the ASPHYXIA BBS.
2) Write to : Grant Smith
P.O.Box 270 Kloof
3640
Natal
South Africa
3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
call during work hours). Call +27-31-73-2129 if you call
from outside South Africa. (It's YOUR phone bill ;-))
4) Write to denthor@goth.vironix.co.za in E-Mail.
5) Write to asphyxia@beastie.cs.und.ac.za to get to all of
us at once.
http://www.vironix.co.za/~grants (WWW)
ftp.eng.ufl.edu pub/msdos/demos/code/graph/tutor (FTP)
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
þ Free Direction Texture Mapping
There are two things you should know before we begin.
Firstly, I am cheating. The texture mapping I am going to show you is not
perspective-correct, with clever divides for z-placement etc. This method
looks almost as good and is quite a bit faster too.
Secondly, you will find it all rather easy. The reason for this is that it's
all rather simple. I first made the routine by sitting down with some paper
and a pencil and had it on the machine in a few hours. A while later when
people on the net started discussing their methods, they were remarkably
similar.
Let me show you what I mean.
Let us assume you have a texture of 128x128 (a straight array of bytes
[0..127, 0..127]) which you want to map onto the side of a polygon. The
problem of course being that the polygon can be all over the place, with
one side longer then the other etc.
Our first step is to make sure we know which end is up... let me
demonstrate...
1
+
/ \
/ \
4 + + 2
\ /
\ /
+
3
Let us say that the above is the chosen polygon. We have decided that point
1 is the top left, point 3 is bottom right. This means that
1 - 2 is the top of the texture
2 - 3 is the right of the texture
3 - 4 is the bottom of the texture
4 - 1 is the left of the texture
The same polygon, but rotated :
3
+
/ \
/ \
2 + + 4
\ /
\ /
+
1
Although the positions of the points are different, point 1 is still the
top left of our texture.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
þ How to put it to screen
Okay, so now you have four points and know which one of them is also the top
left of our texture. What next?
If you think back to our tutorial on polygons, you will remember we draw it
scanline by scanline. We do texture mapping the same way.
Lets look at that picture again :
1
+
a / \ b
/ \
4 + + 2
\ /
\ /
+
3
We know that point 1 is at [0,0] in our texture. Point 2 is at [127,0],
Point 3 is at [127,127], and Point 4 is at [0,127].
The clever bit, and the entire key to texture mapping, is making the
logical leap that precisely half way between Point 1 and Point 2 (b), we are at
[64,0] in our texture. (a) is in the same manner at [0,64].
That's it. All we need to know per y scanline is :
The starting position on the x axis of the polgon line
The position on the x in the texture map referenced by that point
The position on the y in the texture map referenced by that point
The ending position on the x axis of the polgon line
The position on the x in the texture map referenced by that point
The position on the y in the texture map referenced by that point
Let me give you an example. Let's sat that (a) and (b) from the above
picture are on the same y scanline. We know that the x of that scanline is
(say) 100 pixels at the start and 200 pixels at the end, making it's width
100 pixels.
We know that on the left hand side, the texture is at [0,64], and at the
right hand side, the texture is at [64,0]. In 100 pixels we have to
traverse our texture from [0,64] to [64,0].
Assume at the start we have figured out the starting and ending points in
the texture
textureX = 0;
textureY = 64;
textureEndX = 64;
textureEndY = 0;
dx := (TextureEndX-TextureX)/(maxx-minx);
dy := (TextureEndY-TextureY)/(maxx-minx);
for loop1 := minx to maxx do BEGIN
PutPixel (loop1, ypos, texture [textureX, textureY], VGA);
textureX = textureX + dx;
textureY = textureY + dy;
END;
Do the above for all the scanlines, and you have a texture mapped polygon!
It's that simple.
We find our beginning and ending positions in the usual fasion. We know
that Point 1 is [0,0]. We know that Point 2 is [127,0]. We know the number
of scanlines on the y axis between Point 1 and Point 2.
textureDX = 127/abs (point2.y - point1.y)
We run though all the y scanlines, starting from [0,0] and adding the above
formula to the X every time. When we hit the last scanline, we will be at
point [127,0] in the texure.
Repeat for all four sides, and you have the six needed variables per
scanline.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
þ In closing
As you can see, texture mapping (this type at least) is quite easy, and
produces quite a good result. You will however notice a bit of distortion
if you bring the polygon too close. This can be fixed by a) Subdividing the
polygon, so the one is made up of four or more smaller polygons. Much
bigger, but works; b) Using more accurate fixed point; or c) Figuring out
perspective correct texture mapping, mapping along constant-z lines etc.
When people write me, they often refer to my "tutes". This stems back to
Mark Feldman calling them such in the PCGPE. I always though a "tute" was
something you did with your car to gain someones attention. I dunno, maybe
its an Australian thing ;-)
I have been coding almost exclusively in C/C++ for the past year or so.
Sorry guys, thats all they will pay me for ;) Anyway, the trainers will
continue to be in Pascal for ease of understanding by beginners, but if
someone (*ahem* Snowman) doesn't start converting them to C soon, I will do
it myself. He also corrected any mistakes I made while he was converting,
so I'd prefer he did it (sort of a proofreader after release...)
Send me presents! It's my birthday!
Byeeeee.....
- Denthor
16-04-96
Unit GFX3;
INTERFACE
USES crt;
CONST VGA = $A000;
TYPE Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
VAR Virscr : VirtPtr; { Our first Virtual screen }
Vaddr : word; { The segment of our virtual screen}
Scr_Ofs : Array[0..199] of Word;
Procedure SetMCGA;
{ This procedure gets you into 320x200x256 mode. }
Procedure SetText;
{ This procedure returns you to text mode. }
Procedure Cls (Where:word;Col : Byte);
{ This clears the screen to the specified color }
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
procedure flip(source,dest:Word);
{ This copies the entire screen at "source" to destination }
Procedure Pal(Col,R,G,B : Byte);
{ This sets the Red, Green and Blue values of a certain color }
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
procedure WaitRetrace;
{ This waits for a vertical retrace to reduce snow on the screen }
Procedure Hline (x1,x2,y:word;col:byte;where:word);
{ This draws a horizontal line from x1 to x2 on line y in color col }
Procedure Line(a,b,c,d:integer;col:byte;where:word);
{ This draws a solid line from a,b to c,d in colour col }
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
{ This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
in color col }
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
{ This puts a pixel on the screen by writing directly to memory. }
Function Getpixel (X,Y : Integer; where:word) :Byte;
{ This gets the pixel on the screen by reading directly to memory. }
Procedure LoadCEL (FileName : string; ScrPtr : pointer);
{ This loads the cel 'filename' into the pointer scrptr }
Procedure LoadPal (FileName : string);
{ This loads in an Autodesk Animator V1 pallette file }
IMPLEMENTATION
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. }
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetText; { This procedure returns you to text mode. }
BEGIN
asm
mov ax,0003h
int 10h
end;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cls (Where:word;Col : Byte); assembler;
{ This clears the screen to the specified color }
asm
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
BEGIN
FreeMem (VirScr,64000);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure flip(source,dest:Word); assembler;
{ This copies the entire screen at "source" to destination }
asm
push ds
mov ax, [Dest]
mov es, ax
mov ax, [Source]
mov ds, ax
xor si, si
xor di, di
mov cx, 32000
rep movsw
pop ds
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Pal(Col,R,G,B : Byte); assembler;
{ This sets the Red, Green and Blue values of a certain color }
asm
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
Var
rr,gg,bb : Byte;
Begin
asm
mov dx,3c7h
mov al,col
out dx,al
add dx,2
in al,dx
mov [rr],al
in al,dx
mov [gg],al
in al,dx
mov [bb],al
end;
r := rr;
g := gg;
b := bb;
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure WaitRetrace; assembler;
{ This waits for a vertical retrace to reduce snow on the screen }
label
l1, l2;
asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
{ This draws a horizontal line from x1 to x2 on line y in color col }
asm
mov ax,where
mov es,ax
mov ax,y
mov di,ax
shl ax,8
shl di,6
add di,ax
add di,x1
mov al,col
mov ah,al
mov cx,x2
sub cx,x1
shr cx,1
jnc @start
stosb
@Start :
rep stosw
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Line(a,b,c,d:integer;col:byte;where:word);
{ This draws a solid line from a,b to c,d in colour col }
function sgn(a:real):integer;
begin
if a>0 then sgn:=+1;
if a<0 then sgn:=-1;
if a=0 then sgn:=0;
end;
var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
begin
u:= c - a;
v:= d - b;
d1x:= SGN(u);
d1y:= SGN(v);
d2x:= SGN(u);
d2y:= 0;
m:= ABS(u);
n := ABS(v);
IF NOT (M>N) then
BEGIN
d2x := 0 ;
d2y := SGN(v);
m := ABS(v);
n := ABS(u);
END;
s := m shr 1;
FOR i := 0 TO m DO
BEGIN
putpixel(a,b,col,where);
s := s + n;
IF not (smxy then mxy:=y2;
if y3mxy then mxy:=y3; { Choose the min y mny and max y mxy }
if y4mxy then mxy:=y4;
if mny<0 then mny:=0;
if mxy>199 then mxy:=199;
if mny>199 then exit;
if mxy<0 then exit; { Verticle range checking }
mul1:=x1-x4; div1:=y1-y4;
mul2:=x2-x1; div2:=y2-y1;
mul3:=x3-x2; div3:=y3-y2;
mul4:=x4-x3; div4:=y4-y3; { Constansts needed for intersection calc }
for yc:=mny to mxy do
begin
mnx:=320;
mxx:=-1;
if (y4>=yc) or (y1>=yc) then
if (y4<=yc) or (y1<=yc) then { Check that yc is between y1 and y4 }
if not(y4=y1) then
begin
x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
if xmxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y1>=yc) or (y2>=yc) then
if (y1<=yc) or (y2<=yc) then { Check that yc is between y1 and y2 }
if not(y1=y2) then
begin
x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
if xmxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y2>=yc) or (y3>=yc) then
if (y2<=yc) or (y3<=yc) then { Check that yc is between y2 and y3 }
if not(y2=y3) then
begin
x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
if xmxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y3>=yc) or (y4>=yc) then
if (y3<=yc) or (y4<=yc) then { Check that yc is between y3 and y4 }
if not(y3=y4) then
begin
x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
if xmxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if mnx<0 then
mnx:=0;
if mxx>319 then
mxx:=319; { Range checking on horizontal line }
if mnx<=mxx then
hline (mnx,mxx,yc,color,where); { Draw the horizontal line }
end;
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
BEGIN
rad := theta * pi / 180
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
{ This puts a pixel on the screen by writing directly to memory. }
asm
mov ax,where
mov es,ax
mov bx,[y]
shl bx,1
mov di,word ptr [Scr_Ofs + bx]
add di,[x]
mov al,[col]
mov es:[di],al
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function Getpixel (X,Y : Integer; where:word):byte; assembler;
{ This puts a pixel on the screen by writing directly to memory. }
asm
mov ax,where
mov es,ax
mov bx,[y]
shl bx,1
mov di,word ptr [Scr_Ofs + bx]
add di,[x]
mov al,es:[di]
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure LoadCEL (FileName : string; ScrPtr : pointer);
{ This loads the cel 'filename' into the pointer scrptr }
var
Fil : file;
Buf : array [1..1024] of byte;
BlocksRead, Count : word;
begin
assign (Fil, FileName);
reset (Fil, 1);
BlockRead (Fil, Buf, 800); { Read and ignore the 800 byte header }
Count := 0;
BlocksRead := $FFFF;
while (not eof (Fil)) and (BlocksRead <> 0) do begin
BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
Count := Count + 1024;
end;
close (Fil);
end;
procedure LoadPal (FileName : string);
var
F:file;
loop1:integer;
pall:array[0..255,1..3] of byte;
begin
assign (F, FileName);
reset (F,1);
blockread (F, pall,768);
close (F);
for loop1 := 0 to 255 do
Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
end;
VAR Loop1:integer;
BEGIN
For Loop1 := 0 to 199 do
Scr_Ofs[Loop1] := Loop1 * 320;
END.{$X+}
USES Crt,GFX3;
CONST VGA = $A000;
maxpolys = 18;
A : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10, -10, 10 ),
(10 , -10, 10 ),
(10 , 10 , 10 ),
(-10, 10 , 10 )),
((-10, 10 , -10),
(10 , 10 , -10),
(10 , -10, -10),
(-10, -10, -10)),
((-10, 10 , 10 ),
(-10, 10 , -10),
(-10, -10, -10),
(-10, -10, 10 )),
((10 , -10, 10 ),
(10 , -10, -10),
(10 , 10 , -10),
(10 , 10 , 10 )),
((10 , 10 , 10 ),
(10 , 10 , -10),
(-10, 10 , -10),
(-10, 10 , 10 )),
((-10, -10, 10 ),
(-10, -10, -10),
(10 , -10, -10),
(10 , -10, 10 )),
(*********)
((-10, -10,-20 ),
(10 , -10,-20 ),
(10 , 10 ,-20 ),
(-10, 10 ,-20 )),
((-10, 10 , -30),
(10 , 10 , -30),
(10 , -10, -30),
(-10, -10, -30)),
((-10, 10 ,-20 ),
(-10, 10 , -30),
(-10, -10, -30),
(-10, -10,-20 )),
((10 , -10,-20 ),
(10 , -10, -30),
(10 , 10 , -30),
(10 , 10 ,-20 )),
((10 , 10 ,-20 ),
(10 , 10 , -30),
(-10, 10 , -30),
(-10, 10 ,-20 )),
((-10, -10,-20 ),
(-10, -10, -30),
(10 , -10, -30),
(10 , -10,-20 )),
(*********)
((-30, -10, 10 ),
(-20, -10, 10 ),
(-20, 10 , 10 ),
(-30, 10 , 10 )),
((-30, 10 , -10),
(-20, 10 , -10),
(-20, -10, -10),
(-30, -10, -10)),
((-30, 10 , 10 ),
(-30, 10 , -10),
(-30, -10, -10),
(-30, -10, 10 )),
((-20, -10, 10 ),
(-20, -10, -10),
(-20, 10 , -10),
(-20, 10 , 10 )),
((-20, 10 , 10 ),
(-20, 10 , -10),
(-30, 10 , -10),
(-30, 10 , 10 )),
((-30, -10, 10 ),
(-30, -10, -10),
(-20, -10, -10),
(-20, -10, 10 ))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
XOfs = 100;
YOfs = 160;
Type Point = Record
x,y,z:integer; { The data on every point we rotate}
END;
Pictype = array [0..127,0..127] of byte;
VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated }
Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
centre, tcentre : Array [1..maxpolys] of Point;
Order : Array[1..maxpolys] of integer;
lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table }
poly : array [0..199,1..2] of integer;
ytopclip,ybotclip:integer; {where to clip our polys to}
xoff,yoff,zoff:integer;
pic : ^pictype;
lefttable : array [-200..400,0..2] of integer;
righttable : array [-200..400,0..2] of integer;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. }
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Hline (x1,x2,y:integer;col:byte;where:word); assembler;
{ This draws a horizontal line from x1 to x2 on line y in color col }
asm
mov ax,x1
cmp ax,0
jge @X1Okay
mov x1,0
@X1Okay :
mov ax,x2
cmp ax,319
jle @X2Okay
mov x2,319
@X2Okay :
mov ax,x1
cmp ax,x2
jg @Exit
mov ax,where
mov es,ax
mov ax,y
mov di,ax
shl ax,8
shl di,6
add di,ax
add di,x1
mov al,col
mov ah,al
mov cx,x2
sub cx,x1
shr cx,1
jnc @start
stosb
@Start :
rep stosw
@Exit :
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
{ This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
in color col }
var miny,maxy:integer;
loop1:integer;
Procedure doside (x1,y1,x2,y2:integer);
{ This scans the side of a polygon and updates the poly variable }
VAR temp:integer;
x,xinc:integer;
loop1:integer;
BEGIN
if y1=y2 then exit;
if y2(ytopclip)) and (loop1<(ybotclip)) then BEGIN
if (x shr 7poly[loop1,2]) then poly[loop1,2]:=x shr 7;
END;
x:=x+xinc;
END;
END;
begin
asm
mov si,offset poly
mov cx,200
@Loop1:
mov ax,32766
mov ds:[si],ax
inc si
inc si
mov ax,-32767
mov ds:[si],ax
inc si
inc si
loop @loop1
end; { Setting the minx and maxx values to extremes }
miny:=y1;
maxy:=y1;
if y2maxy then maxy:=y2;
if y3>maxy then maxy:=y3;
if y4>maxy then maxy:=y4;
if minyybotclip then maxy:=ybotclip;
if (miny>199) or (maxy<0) then exit;
Doside (x1,y1,x2,y2);
Doside (x2,y2,x3,y3);
Doside (x3,y3,x4,y4);
Doside (x4,y4,x1,y1);
for loop1:= miny to maxy do
hline (poly[loop1,1],poly[loop1,2],loop1,color,where);
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetUpPoints;
{ This creates the lookup table }
VAR loop1,loop2:integer;
BEGIN
For loop1:=0 to 360 do BEGIN
lookup [loop1,1]:=round(sin (rad (loop1))*16384);
lookup [loop1,2]:=round(cos (rad (loop1))*16384);
END;
For loop1:=1 to maxpolys do BEGIN
centre[loop1].x := (lines[loop1,1].x + lines[loop1,2].x +
lines[loop1,3].x + lines[loop1,4].x) div 4;
centre[loop1].y := (lines[loop1,1].y + lines[loop1,2].y +
lines[loop1,3].y + lines[loop1,4].y) div 4;
centre[loop1].z := (lines[loop1,1].z + lines[loop1,2].z +
lines[loop1,3].z + lines[loop1,4].z) div 4;
END;
END;
Procedure LoadGFX;
{ This loads up our texture }
VAR f1 : File;
bob : array [0..255, 1..3] of byte;
loop1 : Integer;
BEGIN
getmem (pic,sizeof(pic^));
loadcel ('side1.cel',pic);
assign (f1, 'side1.cel');
reset (f1, 1);
seek (f1, 32);
blockread (f1, bob, 768);
close (f1);
for loop1:=0 to 255 do
Pal (loop1, bob[loop1,1], bob[loop1,2], bob[loop1,3]);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure RotatePoints (x,Y,z:Integer);
{ This rotates the objecct in lines to translated }
VAR loop1,loop2:integer;
a,b,c:integer;
BEGIN
For loop1:=1 to maxpolys do BEGIN
for loop2:=1 to 4 do BEGIN
b:=lookup[y,2];
c:=lines[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,1];
c:=lines[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].x:=a;
translated[loop1,loop2].y:=lines[loop1,loop2].y;
b:=-lookup[y,1];
c:=lines[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,2];
c:=lines[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].z:=a;
if x<>0 then BEGIN
b:=lookup[x,2];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,1];
c:=translated[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[x,1];
c:=translated[loop1,loop2].y;
translated[loop1,loop2].y:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,2];
c:=translated[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].z:=a;
END;
if z<>0 then BEGIN
b:=lookup[z,2];
c:=translated[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,1];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[z,1];
c:=translated[loop1,loop2].x;
translated[loop1,loop2].x:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,2];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].y:=a;
END;
END;
END;
{******************}
For loop1:=1 to maxpolys do BEGIN
b:=lookup[y,2];
c:=centre[loop1].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,1];
c:=centre[loop1].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
tcentre[loop1].x:=a;
tcentre[loop1].y:=centre[loop1].y;
b:=-lookup[y,1];
c:=centre[loop1].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,2];
c:=centre[loop1].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
tcentre[loop1].z:=a;
if x<>0 then BEGIN
b:=lookup[x,2];
c:=tcentre[loop1].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,1];
c:=tcentre[loop1].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[x,1];
c:=tcentre[loop1].y;
tcentre[loop1].y:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,2];
c:=tcentre[loop1].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
tcentre[loop1].z:=a;
END;
if z<>0 then BEGIN
b:=lookup[z,2];
c:=tcentre[loop1].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,1];
c:=tcentre[loop1].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[z,1];
c:=tcentre[loop1].x;
tcentre[loop1].x:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,2];
c:=tcentre[loop1].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
tcentre[loop1].y:=a;
END;
END;
END;
Procedure TextureMapPoly (x1,y1,x2,y2,x3,y3,x4,y4:integer;where:word);
{ The main procedure, contains various nested procedures }
VAR miny, maxy, loop1 : integer;
Procedure scanleftside (x1,x2,ytop,lineheight:integer;side:byte);
{ Scan in our needed variables ... X on the left, texturmap X, texturemap Y}
VAR x,px,py,xadd,pxadd,pyadd:integer;
y:integer;
BEGIN
lineheight:=lineheight+1;
xadd:=(x2-x1) shl 7 div lineheight;
if side = 1 then BEGIN
px:=(127-1) shl 7;
py:=0;
pxadd:=(-127 shl 7) div lineheight;
pyadd:=0;
END;
if side = 2 then BEGIN
px:=127 shl 7;
py:=127 shl 7;
pxadd:=0;
pyadd:=(-127 shl 7) div lineheight;
END;
if side = 3 then BEGIN
px:=0;
py:=127 shl 7;
pxadd:=127 shl 7 div lineheight;
pyadd:=0;
END;
if side = 4 then BEGIN
px:=0;
py:=0;
pxadd:=0;
pyadd:=127 shl 7 div lineheight;
END;
x:=x1 shl 7;
for y:=0 to lineheight do BEGIN
lefttable[ytop+y,0]:=x shr 7;
lefttable[ytop+y,1]:=px shr 7;
lefttable[ytop+y,2]:=py shr 7;
x:=x+xadd;
px:=px+pxadd;
py:=py+pyadd;
END;
END;
Procedure scanrightside (x1,x2,ytop,lineheight:integer;side:byte);
{ Scan in our needed variables ... X on the right, texturmap X, texturemap Y}
VAR x,px,py,xadd,pxadd,pyadd:integer;
y:integer;
BEGIN
lineheight:=lineheight+1;
xadd:=(x2-x1) shl 7 div lineheight;
if side = 1 then BEGIN
px:=0;
py:=0;
pxadd:=127 shl 7 div lineheight;
pyadd:=0;
END;
if side = 2 then BEGIN
px:=127 shl 7;
py:=0;
pxadd:=0;
pyadd:=127 shl 7 div lineheight;
END;
if side = 3 then BEGIN
px:=127 shl 7;
py:=127 shl 7;
pxadd:=(-127) shl 7 div lineheight;
pyadd:=0;
END;
if side = 4 then BEGIN
px:=0;
py:=127 shl 7;
pxadd:=0;
pyadd:=(-127) shl 7 div lineheight;
END;
x:=x1 shl 7;
for y:=0 to lineheight do BEGIN
righttable[ytop+y,0]:=x shr 7;
righttable[ytop+y,1]:=px shr 7;
righttable[ytop+y,2]:=py shr 7;
x:=x+xadd;
px:=px+pxadd;
py:=py+pyadd;
END;
END;
Procedure Texturemap;
{ This uses the tables we have created to actually draw the texture }
VAR px1,py1:integer;
px2,py2:integer;
polyx1,polyx2,y,linewidth:integer;
pxadd,pyadd:integer;
bob, twhere :word;
BEGIN
bob:=seg (pic^);
tWhere := Where; { ds is used elsewhere ... variables are not accessable }
if miny<0 then miny:=0;
if maxy>199 then maxy:=199;
if minyybotclip then maxy:=ybotclip;
if maxy-miny<2 then exit;
if miny>199 then exit;
if maxy<0 then exit;
for y:=miny to maxy do BEGIN
polyx1:=lefttable[y,0]; { X Starting position }
px1:=lefttable[y,1] shl 7; { Texture X at start }
py1:=lefttable[y,2] shl 7; { Texture Y at stary }
polyx2:=righttable[y,0]; { X Ending position }
px2:=righttable[y,1] shl 7; { Texture X at end }
py2:=righttable[y,2] shl 7; { Texture Y at end }
linewidth:=polyx2-polyx1; { Width of line }
if linewidth<=0 then linewidth:=1;
pxadd:=(px2-px1) div linewidth;
pyadd:=(py2-py1) div linewidth;
asm
push ds
mov bx,polyx1
mov di,bx
mov dx,[Y]
mov bx, dx
shl dx, 8
shl bx, 6
add dx, bx
add di, dx
mov ax,twhere { es:di points to start of line }
mov es,ax
mov bx, px1
mov cx,lineWidth
mov dx, bob
mov ds, dx
mov dx,py1
@Loop1 :
xor si,si
mov ax,bx
and ax,1111111110000000b; { Get rid of fixed point }
add si,ax
mov ax,dx
shr ax,7
add si,ax { get the pixel in our texture }
movsb { draw the pixel to the screen }
mov ax,pxadd
add bx,ax
mov ax,pyadd
add dx,ax { increment our position in the texture }
loop @loop1
pop ds
end;
END;
END;
BEGIN
miny:=32767;
maxy:=0;
if y1maxy then maxy:=y1;
if y2maxy then maxy:=y2;
if y3maxy then maxy:=y3;
if y4maxy then maxy:=y4;
if miny>maxy-5 then exit; { Why paint slivers? }
if (y2 tcentre[curpos+1].z then BEGIN
temp := tcentre[curpos+1].x;
tcentre[curpos+1].x := tcentre[curpos].x;
tcentre[curpos].x := temp;
temp := tcentre[curpos+1].y;
tcentre[curpos+1].y := tcentre[curpos].y;
tcentre[curpos].y := temp;
temp := tcentre[curpos+1].z;
tcentre[curpos+1].z := tcentre[curpos].z;
tcentre[curpos].z := temp;
temp := order[curpos+1];
order[curpos+1] := order[curpos];
order[curpos] := temp;
curpos:=0;
END;
curpos:=curpos+1;
END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure MoveAround;
{ This is the main display procedure. }
VAR deg,deg2,loop1,loop2:integer;
ch:char;
BEGIN
pal (1, 0, 0,63);
pal (2, 0,32,63);
pal (3, 32, 0,63);
pal (4, 32,32,63);
pal (5, 0,63,63);
pal (6, 32,63,63);
pal ( 7, 0,63, 0);
pal ( 8, 0,63,32);
pal ( 9, 32,63, 0);
pal (10, 32,63,32);
pal (11, 0,63,63);
pal (12, 32,63,63);
pal (13, 63, 0, 0);
pal (14, 63,32, 0);
pal (15, 63, 0,32);
pal (16, 63,32,32);
pal (17, 63,63, 0);
pal (18, 63,63,32);
{ for loop1:=1 to 15 do
pal (loop1,0,loop1*4+3,63-(loop1*4+3));}
pal (100,50,50,50);
deg:=0;
deg2:=0;
ch:=#0;
Cls (vaddr,0);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=a [loop1,loop2,1]*8;
Lines [loop1,loop2].y:=a [loop1,loop2,2]*8;
Lines [loop1,loop2].z:=a [loop1,loop2,3]*8;
END;
SetUpPoints;
LoadGFX;
cls (vaddr,0);
cls (vga,0);
Xoff := 160;
Yoff:=100;
zoff:=-600;
ytopclip:=101;
ybotclip:=100;
line (0,100,319,100,100,vga);
delay (2000);
for loop1:=1 to 25 do BEGIN
RotatePoints (deg2,deg,deg2);
SortPoints;
DrawPoints;
line (0,ytopclip,319,ytopclip,100,vaddr);
line (0,ybotclip,319,ybotclip,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
deg2:=(deg2+1) mod 360;
ytopclip:=ytopclip-4;
ybotclip:=ybotclip+4;
END;
Repeat
if keypressed then ch:=upcase (Readkey);
RotatePoints (deg2,deg,deg2);
SortPoints;
DrawPoints;
line (0,0,319,0,100,vaddr);
line (0,199,319,199,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
deg2:=(deg2+3) mod 360;
Until ch=#27;
for loop1:=1 to 25 do BEGIN
ytopclip:=ytopclip+4;
ybotclip:=ybotclip-4;
RotatePoints (deg2,deg,deg2);
SortPoints;
DrawPoints;
line (0,ytopclip,319,ytopclip,100,vaddr);
line (0,ybotclip,319,ybotclip,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
deg2:=(deg2+1) mod 360;
END;
END;
BEGIN
clrscr;
writeln ('Welcome to the twenty first trainer! This one is on texure mapping.');
writeln;
writeln ('Just sit bak and watch, it''s non interactive. Total reuse of Tut 20''s');
writeln ('code, aside from the texure mapping procedure. Have fun!');
writeln;
writeln;
write ('Hit any key to continue ...');
readkey;
SetUpVirtual;
SetMCGA;
MoveAround;
SetText;
ShutDown;
Writeln ('All done. This concludes the twenty first sample program in the ASPHYXIA');
Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally');
Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
Writeln (' denthor@goth.vironix.co.za');
Writeln ('The numbers are available in the main text. You may also write to me at:');
Writeln (' Grant Smith');
Writeln (' P.O. Box 270');
Writeln (' Kloof');
Writeln (' 3640');
Writeln (' Natal');
Writeln (' South Africa');
Writeln ('I hope to hear from you soon!');
Writeln; Writeln;
Write ('Hit any key to exit ...');
readkey;
END.
[BACK] Back
Discuss this article in the forums
See Also: © 1999-2011 Gamedev.net. All rights reserved. Terms of Use Privacy Policy
|