|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Andry Chyiko 2:5064/39 11 Mar 2003 11:06:32
To : Eugene Pyvovarov
Subject : [FWD] 3д
--------------------------------------------------------------------------------
_Eugene Pyvovarov_ -> _All_, 10 Мар 03 23:11
EP> как в паскале на мутить 3д графику(без асм)
без асм - медленно. хотя можно функцию рисования линии заменить на код на
паскале (примеров много), блюр - не что иное, как среднее арифметическое цветов
покселей вокруг данной точки, тоже можно заменить... вывод на экран - на асме
действительно быстрее.
пользоваться формулами:
sx = xSize/2+x*dist/(z+dist),
sy = ySize/2-y*dist/(z+dist).
sx, sy - кoopдинaты пpoeкции тoчки нa экpaнe,
x, y, z - 3D кoopдинaты тoчки,
dist - paccтoяниe oт кaмepы (oнa нaxoдитcя в тoчкe (0,0,-dist)) дo нaчaлa
кoopдинaт.
вот пример:
=== Цитирую файл CDG.PAS ===
{$G+}
Uses Crt;
Const Vect: Array[1..8, 1..3] of Byte =
(
(0, 0, 0),
(0, 0, 1),
(1, 0, 1),
(1, 0, 0),
(0, 1, 0),
(0, 1, 1),
(1, 1, 1),
(1, 1, 0));
L = 50; {Размер ребра куба}
dist = 180; {Положение наблюдателя}
pi1 = Pi/180;
Type
TGraphScreen=array[1..200,1..320]of byte; {Графический экран}
TPoint = Record {Структура КУБ}
x, y, z: Real;
sx, sy: Integer;
end;
Var
Scrn: TGraphScreen absolute $A000:0; {Указатель на адрес начала видеопамяти}
VScrn: ^Tgraphscreen; {Буфер экрана}
VScrnAddr: Word; {Адрес буфера в памяти}
i, j, a, b, c: Integer;
Cub, Cube: Array[1..8] of TPoint; {Куб}
Centr: Array[1..3] of TPoint;
Cs, Sn: Array[0..360] of Real; {Таблицы синусов и косинусов}
S1, S2: Byte;
{-------------------------------------------------------------------
Рисование линии
-------------------------------------------------------------------}
Procedure Line(x1,y1,x2,y2 : Integer; Color : Byte);
var
x,y,s1,s2,dlx,dly,e: integer;
change: boolean;
begin
asm
mov ax,[x1]
mov [x],ax
mov ax,[y1]
mov [y],ax
mov ax,[x2]
sub ax,[x1]
mov si,ax
jns @1
neg ax
@1:
mov [dlx],ax
mov ax,[y2]
sub ax,[y1]
mov di,ax
jns @2
neg ax
@2:
mov [dly],ax
cmp si,0
jl @3
cmp si,0
jg @4
mov ax,0
jmp @5
@3:
mov ax,-1
jmp @5
@4:
mov ax,1
@5:
mov [s1],ax
cmp di,0
jl @6
cmp di,0
jg @7
mov ax,0
jmp @8
@6:
mov ax,-1
jmp @8
@7:
mov ax,1
@8:
mov [s2],ax
mov ax,[dly]
cmp ax,[dlx]
jle @9
mov ax,[dlx]
mov bx,[dly]
xchg ax,bx
mov [dlx],ax
mov [dly],bx
mov [change],1 {<<<}
jmp @10
@9:
mov [change],0
@10:
mov ax,[dlx]
mov bx,[dly]
shl bx,1
sub bx,ax
mov [e],bx
mov ax,[dlx]
mov dx,ax
shl ax,1
mov bx,[dly]
shl bx,1
mov cx,1
@11:
cmp cx,dx
jg @12
push ax
push bx
push dx
push di
mov ax,VScrnAddr
mov es,ax
mov bx,[X]
mov dx,[Y]
mov di,bx
mov bx, dx
shl dx, 8
shl bx, 6
add dx, bx
add di, dx
mov al, [Color]
stosb
pop di
pop dx
pop bx
pop ax
@13:
cmp [e],0
jl @14
push ax
cmp [change],0
je @15
mov ax,[x]
add ax,[s1]
mov [x],ax
jmp @16
@15:
mov ax,[y]
add ax,[s2]
mov [y],ax
@16:
pop ax
sub [e],ax
jmp @13
@14:
push ax
cmp [change],0
je @17
mov ax,[y]
add ax,[s2]
mov [y],ax
jmp @18
@17:
mov ax,[x]
add ax,[s1]
mov [x],ax
@18:
add [e],bx
inc cx
pop ax
jmp @11
@12:
push ax
push bx
push dx
push di
mov ax,VScrnAddr
mov es,ax
mov bx,[X]
mov dx,[Y]
mov di,bx
mov bx, dx
shl dx, 8
shl bx, 6
add dx, bx
add di, dx
mov al, [Color]
stosb
pop di
pop dx
pop bx
pop ax
end;
end;
{-------------------------------------------------------------------
Установка новой палитры
-------------------------------------------------------------------}
Procedure SetPallete(c, r, g, b :Byte);
Begin
Port[$3C8] := C;
Port[$3C9] := R;
Port[$3C9] := G;
Port[$3C9] := B;
End;
{-------------------------------------------------------------------
Генерация новой палитры
-------------------------------------------------------------------}
Procedure SetSkyPalette;
var
x:Byte;
begin
for x := 0 to 255 do
begin
SetPallete(x, x div 4, x div 4, x div 4);
end;
end;
{-------------------------------------------------------------------
Эффект БЛЮР - размытие
-------------------------------------------------------------------}
Procedure Blur(s:Word);Assembler;
Asm
mov bx,321
push ds
mov ds,s
xor ch,ch
xor ax,ax
@l:
mov cl,[bx + 1]
add ax,cx
mov cl,[bx+320]
add ax,cx
mov cl,[bx-320]
add ax,cx
shr ax,2
mov [bx],al
inc bx
cmp bx,63679
jnz @l
pop ds{}
end;
{-------------------------------------------------------------------
Визуализация изображения, т.е. вывод из буфера на экран
-------------------------------------------------------------------}
Procedure Vis(Source:Word);Assembler;
Asm
push ds
mov ax,source
mov es,ax
mov ax,0a000h
mov ds,ax
mov bx,80
@fl:
shl bx,2
db $66;mov ax,es:[bx]
db $66;mov [bx],ax
shr bx,2
inc bx
cmp bx,15920
jne @fl
pop ds
end;
{-------------------------------------------------------------------
Поворот координат
-------------------------------------------------------------------}
Procedure RotateCords(A, B, T : Word; Var P: TPoint);
Var I : Integer;
Xt, Yt, Zt, X1, Y1, Z1 : Real;
Begin
With P do
Begin
Xt := X;
Yt := Y;
Zt := Z;
{ вокpуг оси X }
Y1 := Yt* Cs[A] - Zt* Sn[A];
Z1 := Yt* Sn[A] + Zt* Cs[A];
Yt := Y1; Zt := Z1;
{ вокpуг оси Y }
X1 := Xt* Cs[B] + Zt* Sn[B];
Z1 := - X* Sn[B] + Zt* Cs[B];
Xt := X1; Zt := Z1;
{ вокpуг оси Z }
X1 := Xt* Cs[T] - Yt* Sn[T];
Y1 := Xt* Sn[T] + Yt* Cs[T];
Xt := X1; Yt := Y1;
X := Xt;
Y := Yt;
Z := Zt;
End;
End;
Procedure CubeDraw(Col: Byte);
begin
Line(Cube[1].Sx, Cube[1].Sy, Cube[2].Sx, Cube[2].Sy, Col);
Line(Cube[2].Sx, Cube[2].Sy, Cube[3].Sx, Cube[3].Sy, Col);
Line(Cube[3].Sx, Cube[3].Sy, Cube[4].Sx, Cube[4].Sy, Col);
Line(Cube[4].Sx, Cube[4].Sy, Cube[1].Sx, Cube[1].Sy, Col);
Line(Cube[5].Sx, Cube[5].Sy, Cube[6].Sx, Cube[6].Sy, Col);
Line(Cube[6].Sx, Cube[6].Sy, Cube[7].Sx, Cube[7].Sy, Col);
Line(Cube[7].Sx, Cube[7].Sy, Cube[8].Sx, Cube[8].Sy, Col);
Line(Cube[8].Sx, Cube[8].Sy, Cube[5].Sx, Cube[5].Sy, Col);
Line(Cube[5].Sx, Cube[5].Sy, Cube[1].Sx, Cube[1].Sy, Col);
Line(Cube[6].Sx, Cube[6].Sy, Cube[2].Sx, Cube[2].Sy, Col);
Line(Cube[7].Sx, Cube[7].Sy, Cube[3].Sx, Cube[3].Sy, Col);
Line(Cube[8].Sx, Cube[8].Sy, Cube[4].Sx, Cube[4].Sy, Col);
end;
Begin
New(Vscrn); {Создаем новый указатель на буфер}
FillChar(Vscrn^, 64000, 0); {Очистка экрана}
Vscrnaddr := Seg(Vscrn^);
Asm {Переходим в графический режим}
Mov AX, 13H
Int 10H
End;
SetSkyPalette; {Установим палитру}
For I := 0 To 360 Do {Создаем таблицу синусов и косинусов}
Begin
Cs[I] := Cos(I * Pi1);
Sn[I] := Sin(I * Pi1);
End;
For I := 1 To 8 Do {Вычисляем координаты исходного куба}
With Cub[I] Do
Begin
X := (Vect[I, 1] * L - L Div 2);
Y := (Vect[I, 2] * L - L Div 2);
Z := (Vect[I, 3] * L - L Div 2);
End;
Centr[1].x := -50;
Centr[1].y := 0;
Centr[1].z := 30;
Centr[2].x := 50;
Centr[2].y := 0;
Centr[2].z := 30;
Centr[3].x := 0;
Centr[3].y := 0;
Centr[3].z := -59;
Repeat
For j := 1 to 3 do RotateCords(S1, S2, 0, Centr[j]);
Cube := Cub;
For J := 1 To 8 Do {Расчитаем координаты вершин в двухмерном пространстве}
With Cube[J] Do
Begin
RotateCords(A, B, C, Cube[J]); {Поворот куба}
Sx := Round(160 + (X + Centr[1].x) * Dist / (Z + Dist + Centr[1].z));
Sy := Round(100 - (Y + Centr[1].y) * Dist / (Z + Dist + Centr[1].z));
End;
{Hарисуем куб}
CubeDraw(140);
Cube := Cub;
For J := 1 To 8 Do {Расчитаем координаты вершин в двухмерном пространстве}
With Cube[J] Do
Begin
RotateCords(B, C, A, Cube[J]); {Поворот куба}
Sx := Round(160 + (X + Centr[2].x) * Dist / (Z + Dist + Centr[2].z));
Sy := Round(100 - (Y + Centr[2].y) * Dist / (Z + Dist + Centr[2].z));
End;
{Hарисуем куб}
CubeDraw(140);{}
Cube := Cub;
For J := 1 To 8 Do {Расчитаем координаты вершин в двухмерном пространстве}
With Cube[J] Do
Begin
RotateCords(C, A, B, Cube[J]); {Поворот куба}
Sx := Round(160 + (X + Centr[3].x) * Dist / (Z + Dist + Centr[3].z));
Sy := Round(100 - (Y + Centr[3].y) * Dist / (Z + Dist + Centr[3].z));
End;
{Hарисуем куб}
CubeDraw(140);
Line(0, 0, 320, 0, 0);
Line(0, 199, 320, 199, 0);
Blur(VScrnAddr); {Сгладим линии}
Vis(VScrnAddr); {Hа экран!}
Inc(A, 1);
A := A mod 360;
if a = 100 then Inc(B, 1);
B := B mod 360;
if a = 200 then Inc(C, 1);
C := C mod 360;
if A mod 10 = 0 then S1 := 1 else S1 := 0;
if A mod 5 = 0 then S2 := 1 else S2 := 0;
Until KeyPressed;
{Обратно в текстовый режим}
Asm
Mov AX, 3H
Int 10H
End;
WriteLn('(c) Dozer, 2003');
End.
=== Конец цитаты ===
EP> ....обьясните на пальцах плз :)
думаю комментариев достаточно.
Tакие дела, Eugene
---
* Origin: (2:5064/39)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
| Тема: |
Автор: |
Дата: |
|
[FWD] 3д |
Eugene Pyvovarov |
11 Mar 2003 00:11:52 |
 [FWD] 3д |
Andry Chyiko |
11 Mar 2003 11:06:32 |
  [FWD] 3д |
Andrey Dashkovsky |
13 Mar 2003 00:28:02 |
 [FWD] 3д |
Dmitriy Konovalov |
14 Mar 2003 14:57:10 |
|
[FWD] 3д |
Alex Astafiev |
11 Mar 2003 17:53:26 |
|
|
