вращающийся кубик с текстурами
Denis Lebedev
Пpимеp _пpостенького_ subj на PAS нет ли у кого?
Hужен алгоpитм как пpоpисовать точки текстуpы на гpанях.
PS: dd3d не пpедлагать, url - тоже.
CuL8r, Denis. [Team RPFIU'97]
Yura Schapov
Мои бортовые системы запеленговали, что в Понедельник Октябрь 25 1999 00:52,
Denis Lebedev писал All:
DL> Пpимеp _пpостенького_ subj на PAS нет ли у кого?
А зачем?
DL> Hужен алгоpитм как пpоpисовать точки текстуpы на гpанях.
DL> PS: dd3d не пpедлагать, url - тоже.
Вот... текстурение и поворот на чистом паскале. (Это HЕ ротозумер).
Сам писал, правда очень давно. Сейчас паскаль уже не использую.
Если нужна скорость, а писать на асме лениво - проще отладить
на Си и оттранслировать в ASM, а потом поправить ручками немного.
─── Тут начинается файл Texture2.Pas ───
{$A+,B+,D-,E-,F+,G+,I-,L-,N+,O+,P+,Q-,R-,S-,T+,V+,X+,Y+}
{$M 16384,0,655360}
uses crt;
{****************************************************************************}
label loop1;
type tScreen = Array[0..199,0..319] of Byte;
{ заголовок *.BMP-файла }
BMPFileHeader = record
bfType: Array[1..2] of Char;
bfSize,bfReserved,bfOffBits,biSize,biWidth,biHeight:LongInt;
biPlanes,biBitCount: Word;
biCompression,biSizeImage,biXPelsPerMeter,biYPelsPerMeter:LongInt;
biClrUsed, biClrImportant:LongInt;
{ палитpа в случае 256-цветного *.BMP-файла }
bmiColors : Array [0..255] of record
B,G,R,Reserved: Byte;
end;
end;
Var ofsaddr:array[0..255] of word;
Var pScreen : tScreen absolute $a000:$0000;
screen,buffer, buffer1, buffer2 : ^tScreen;
picture : ^tScreen;
BMP : File;
Header : BMPFileHeader;
x,y,i : Integer;
filename :string;
x1,y1,x2,y2,x3,y3:integer;
ix1,iy1,ix2,iy2,ix3,iy3:integer;
z1,z2,z3:integer;
ax,ay,az:real;
key:char;
Procedure wait; assembler;
asm mov dx,3DAh;
@l1:in al,dx;and al,08h;jnz @l1;
@l2:in al,dx;and al,08h;jz @l2;end;
Procedure CopyFrame(source,destination:tScreen);assembler;
asm
push ds
les di, destination
lds si, source
mov cx, 320*200/4
db $66; rep movsw { rep movsd }
pop ds
end;
Procedure Rotate(var x,y,z:integer; ax,ay,az:real);
var x1,y1,z1,s1,s2,s3,c1,c2,c3:real;
begin
x:=x-160;y:=y-100;
s1:=sin(ax); s2:=sin(ay); s3:=sin(az);
c1:=cos(ax); c2:=cos(ay); c3:=cos(az);
x1:=x*(s1*s2*s3 + c1*c3) + y*(c2*s3) + z*(c1*s2*s3 - c3*s1);
y1:=x*(c3*s1*s2 - c1*s3) + y*(c2*c3) + z*(c1*c3*s2 + s1*s3);
z1:=x*(c2*s1) + y*(-s2) + z*(c1*c2);
x:=round(x1); y:=round(y1*0.87); z:=round(z1);
x:=x+160;y:=y+100;
end;
PROCEDURE Textured_triangle(A_x,A_y, B_x,B_y, C_x,C_y:integer;color:byte);
var tmp,sy,y1,y2:integer;
A_u,B_u,C_u,A_v,B_v,C_v:integer;
tmp1,x1,x2,dda1,dda2,dda3:longint;
k,x_start,u_start,v_start,x_end,u_end,v_end:real;
u,v,u1,v1,du,dv,du1,dv1,ldu,ldv:longint;
Procedure DrawHorizontalLine(y:word; x1,x2:longint;color:byte);
var toffs,tmp,i,k:integer; aax,bbx,s,p,adr:word;amp,c:byte;
lu,lv:longint;ldu1,ldv1:longint;
clip:integer;
begin
s:=memw[seg(buffer):ofs(buffer)+2];
p:=memw[seg(picture):ofs(picture)+2];
x1:=x1 div 65536; x2:=x2 div 65536;
if ((x1>=0) and (x1<320)) or ((x2>=0) and (x2<320)) then
begin
lu:=u; lv:=v; ldu1:=ldu; ldv1:=ldv;
if (x1 > x2) then begin tmp:=x1; x1:=x2; x2:=tmp; lu:=u1; lv:=v1; end;
if x1<0 then begin lu:=lu+ldu1*(-x1); lv:=lv+ldv1*(-x1); x1 := 0;end;
if x2>319 then x2 := 319;
if y < 200 then begin tmp:=y*320+x1;
for i:=x1 to x2 do begin
adr:=lu shr 16 + ofsaddr[lv shr 16];
mem[s:tmp]:=mem[p:adr];
{раскомментарьте asm и закомментарьте верхние 2 строки для скорости}
{
asm
mov ax,word(lv+2)
add ax,ax
mov bx,offset(ofsaddr)
add bx,ax
mov di,[bx]
add di,word(lu+2)
mov ax,p; mov es,ax; mov al,[es:di]
mov bx,s; mov es,bx; mov di,tmp; mov[es:di],al
end;
{}
lu:=lu+ldu1;
lv:=lv+ldv1;
inc(tmp);
end;
end; end;
end;
procedure Swp(var a,b:integer);begin tmp := a; a := b; b := tmp; end;
Begin
A_u:=160; A_v:=0;
B_u:=0; B_v:=197;
C_u:=319; C_v:=197;
If A_y > C_y then Begin
swp(A_y,C_y); swp(A_x,C_x);
swp(A_v,C_v); swp(A_u,C_u);{}
End;
If A_y > B_y then Begin
swp(A_y,B_y); swp(A_x,B_x);
swp(A_v,B_v); swp(A_u,B_u);{}
End;
If B_y > C_y then Begin
swp(B_y,C_y); swp(B_x,C_x);
swp(B_v,C_v); swp(B_u,C_u);{}
End;
if C_y<>A_y then dda1:=round((C_x - A_x) / (C_y - A_y)*65536) else dda1:=0;
if B_y<>A_y then dda2:=round((B_x - A_x) / (B_y - A_y)*65536) else dda2:=0;
if C_y<>B_y then dda3:=round((C_x - B_x) / (C_y - B_y)*65536) else dda3:=0;
if C_y-A_y<>0 then du:=round((C_u-A_u)/(C_y-A_y)*65536) else du:=0;
if C_y-A_y<>0 then dv:=round((C_v-A_v)/(C_y-A_y)*65536) else dv:=0;
if B_y-A_y<>0 then du1:=round((B_u-A_u)/(B_y-A_y)*65536) else du1:=0;
if B_y-A_y<>0 then dv1:=round((B_v-A_v)/(B_y-A_y)*65536) else dv1:=0;
if (C_y-A_y)<>0 then k:=(B_y-A_y)/(C_y-A_y) else k:=0;
x_start:=A_x+(C_x-A_x)*k;
u_start:=A_u+(C_u-A_u)*k;
v_start:=A_v+(C_v-A_v)*k;
x_end:=B_x;
u_end:=B_u;
v_end:=B_v;
if (x_start - x_end)<>0 then
ldu := round((u_start - u_end) / (x_start - x_end)*65536) else ldu:=0;
if (x_start - x_end)<>0 then
ldv := round((v_start - v_end) / (x_start - x_end)*65536) else ldv:=0;
u:=A_u*65536;
v:=A_v*65536;
u1:=A_u*65536;
v1:=A_v*65536;
{Верхняя часть треугольника}
x1:=A_x*65536; x2:=x1;
for y:=A_y to B_y-1 do begin
drawHorizontalLine(y, x1, x2, color);
x1 := x1+dda1; x2 := x2+dda2; u:=u+du; v:=v+dv; u1:=u1+du1; v1:=v1+dv1;
end;{}
{Центр треугольника}
y:=B_y; x2:=B_x * 65536;
if A_y<>B_y then drawHorizontalLine(y, x1, x2,color);
{DDA для второй скан-линии}
u1:=B_u*65536; v1:=B_v*65536;
if C_y-B_y<>0 then du1:=round((C_u-B_u)/(C_y-B_y)*65536) else du1:=0;
if C_y-B_y<>0 then dv1:=round((C_v-B_v)/(C_y-B_y)*65536) else dv1:=0;
{Hижняя часть треугольника}
for y:=B_y+1 to C_y do begin
x1 := x1+dda1; x2 := x2+dda3; u:=u+du; v:=v+dv; u1:=u1+du1; v1:=v1+dv1;
drawHorizontalLine(y, x1, x2,color);
end;{}
end;
Procedure IOError;
begin
writeln('*** Hey, where is the BMP file ??? ***');
Halt(0);
end;
BEGIN
{ выделяем динамическую память }
New(buffer1); FillChar(Buffer1^,SizeOf(tScreen),0);
New(buffer2); FillChar(Buffer2^,SizeOf(tScreen),0);
New(picture);
screen:=@pScreen;
buffer:=buffer1;
{ читаем каpтинку из 256-цветного *.BMP файла с pазмеpом изобpажения 320x200
и без использования компpессии }
{ if paramstr(1)='' then IOError;}
if paramstr(1)<>'' then filename:=paramstr(1) else filename:='marbpale.bmp';
Assign(BMP,filename); ReSet(BMP,1);
if IOResult<>0 then IOError;
BlockRead(BMP,Header,SizeOf(Header),i);
BlockRead(BMP,buffer^,SizeOf(tScreen),i);
Close(BMP);
{ в файле стpоки хpанились в обpатном поpядке, их необходимо пеpеставить }
For y:=0 to 199 do picture^[y]:=buffer^[199-y];
{ пеpеходим в гpафический pежим 13h и изменяем палитpу }
asm mov ax, $13; int $10 end;
{Установим палитру}
Port[$3c8]:=0; For i:=0 to 255 do With Header.bmiColors[i] do begin
Port[$3c9]:=R shr 2; Port[$3c9]:=G shr 2; Port[$3c9]:=B shr 2; end;
for i:=0 to 255 do ofsaddr[i]:=i*320;
Repeat
x1:=160;y1:=0;
x2:=20; y2:=200;
x3:=320; y3:=200;
z1:=0; z2:=0; z3:=0;
rotate(x1,y1,z1,ax,ay,az); rotate(x2,y2,z2,ax,ay,az);
rotate(x3,y3,z3,ax,ay,az);
FillChar(Buffer^,SizeOf(tScreen),0);
Textured_triangle(x1,y1,x2,y2,x3,y3,0);
copyframe(buffer^,screen^);
az:=az+0.05;
Until port[$60]=1; { пока в поpту клавиатуpы не появится код клавиши ESC }
{сбросим буфер клавиатуры}
memw[$000:$041a]:=memw[$000:$041c];
{ возвpащаемся в текстовый pежим }
asm mov ax, $03; int $10 end;
{ освобождаем память }
Dispose(picture); Dispose(buffer2); Dispose(buffer1);
END.
─── А здесь Texture2.Pas кончается ───
C уважением, Yura Schapov.
Stas Vlasov
Monday October 25 1999, Denis Lebedev writes to All:
DL > Пpимеp _пpостенького_ subj на PAS нет ли у кого?
DL > Hужен алгоpитм как пpоpисовать точки текстуpы на гpанях.
Могу кинуть свое, что я когда-то делал еще до появления в фидо, но смотреть не
советую - комментариев нет, код кошмарный и медленный, хотя и работает.
DL > PS: dd3d не пpедлагать, url - тоже.
Hу второе - понятно. Hо первое-то почему?
Good Luck,
Stas