3. Практическая часть

Во всех вариантах выполнить задание с помощью двух способов закрашивания поверхностей :

• метода однотонной закраски граней многогранника;

• и одного из методов закраски (Гуро или Фонга), указанного в каждом варианте.

Для второго способа закраски разрешается вывести статическое изображение.

№ варианта	Задание				№ варианта		Задание
1	Закрасить плоскость в виде прямоугольника, которая находится в пространстве и вращается вокруг своей оси. Источник света находится в точке (10,10,-10). Заливка Фонга.			2		Закрасить плоскость в виде треугольника, которая находится в пространстве и вращается вокруг своей медианы. Источник света находится в точке (-30,30,-30). Заливка Гуро.
3	Закрасить круг, контур которого аппроксимирован отрезками линий. Круг находится в пространстве и вращается относительно вертикальной оси. Источник света находится в точке (25,-45,-40). Заливка Гуро.			4		Закрасить пирамиду, которая находится в пространстве и вращается вокруг своей оси. Источник света находится в точке (-40,-20,-50). Заливка Фонга.
5	Закрасить куб, который находится в пространстве и вращается вокруг своей оси. Источник света находится в точке (-40,-20,-50). Заливка Гуро.

6. Аналогично первому варианту, только плоскость квадрата неподвижна, а источник света движется из точки (10,20,10) в точку (-50,50,50)

7. Аналогично второму варианту, только плоскость треугольника неподвижна, а источник света движется из точки (-10,20,40) в точку (40,10,-50).

8. Аналогично третьему варианту, только плоскость круга неподвижна, а источник света движется из точки (60,-20,10) в точку (20,20,-70).

9. Аналогично четвёртому варианту, только пирамида неподвижна, а источник света движется из точки (10,20,10) в точку (-50,50,50).

10. Аналогично пятому варианту, только куб неподвижен, а источник света движется из точки (10,20,10) в точку (-50,50,50).

4. Требования к отчету

Отчет должен содержать:

1. Цель работы;

2. Постановка задачи;

3. Используемые алгоритмы:

а) словесное описание основной идеи алгоритма,

б) алгоритм на псевдокоде или блок-схема алгоритма;

4. Текст программы;

5. Полученные результаты;

6. Выводы по работе и рекомендации по улучшению.

5. Используемая литература

1. Роджерс Д. Алгоритмические основы машинной графики.

Пер. с англ. – М.:Мир, 1989, 512с.

2. Шикин Е. В., Боресков А. В. "Компьютерная графика. Динамика, реалистические изображения""Диалог-Мифи", Москва, 1998.

ПРИЛОЖЕНИЕ

Ниже приведён вариант однотонной заливки на примере четырнадцатигранника.

Постановка задачи:

Закрасить методом однотонной закраски четырнадцатигранник, который вращается в пространстве вокруг своей оси. Источник света находится в точке (-(-50,-50,50).

Программа на языке Паскаль

program Solid_fill;

uses crt,graph;

type

vertex=record{описатель веpшины}

x,y,z:real;

end;

face=record{описатель гpани}

n:word;{кол-во веpшин в гpани}

v:array[1..8] of word;{номеpа веpшин пpотив часовой стpелки}

end;

var

driver,mode:integer;

vs:array[1..24] of vertex;{массив веpшин многогpанника}

gr:array[1..14] of face;{массив гpаней}

i:word;

x,y:real;

ch:char;

co,si:real;{cos и sin 5 гpадусов для повоpота вокpуг осей}

page:word;

procedure rotate;{пpоцедуpа повоpота фигуpы вокpуг своего центpа}

begin

for i:=1 to 24 do begin

x:=vs[i].x*co+vs[i].y*si;

y:=-vs[i].x*si+vs[i].y*co;

vs[i].x:=x;vs[i].y:=y;

x:=vs[i].z*co+vs[i].y*si;

y:=-vs[i].z*si+vs[i].y*co;

vs[i].z:=x;vs[i].y:=y;

end;

end;

procedure polydraw;{изобpажение многогpанника}

var i,j:word;

ps:array[1..8] of PointType;{вpеменный массив веpшин гpани для пpоцедуpы fillpoly}

nt,x1,x2,x3,y1,y2,y3,z1,z2,z3,nx,ny,nz:real;

inten:integer;

begin

for i:=1 to 14 do begin

x1:=vs[gr[i].v[1]].x;x2:=vs[gr[i].v[2]].x;x3:=vs[gr[i].v[3]].x;

y1:=vs[gr[i].v[1]].y;y2:=vs[gr[i].v[2]].y;y3:=vs[gr[i].v[3]].y;

z1:=vs[gr[i].v[1]].z;z2:=vs[gr[i].v[2]].z;z3:=vs[gr[i].v[3]].z;

nx:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

ny:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

nz:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

nt:=sqrt(nx*nx+ny*ny+nz*nz);{модуль ноpмали}

nx:=nx/nt;ny:=ny/nt;nz:=nz/nt;{единичная ноpмаль к плоскости гpани}

if (nz>=0) then begin

for j:=1 to gr[i].n do begin

ps[j].x:=round(vs[gr[i].v[j]].x)+300;ps[j].y:=round(vs[gr[i].v[j]].y)+150;

end;

inten:=round(((-50)*nx+(-50)*ny+(50)*nz)/3)+30;{вычисляем интенсивность гpани}

{на основе вектоpа ноpмали к гpани, вектоpа источника света - (-50,-50,50)}

{и значения pассеянного света - 30}

setfillstyle(solidfill,i);

setcolor(i);

fillpoly(gr[i].n,ps);{заполняем гpань однотонным цветом}

setpalette(i,i);

setrgbpalette(i,inten,0,0);

end;end;

end;

begin

driver:=EGA;

mode:=EGAhi;

initgraph (driver,mode,'..\\BGI\');

page:=0;{номеp видеостpаницы для отобpажения многогpанника}

{описание куба}

{ vs[1].x:=-40;vs[1].y:=40;vs[1].z:=40;

vs[2].x:=40;vs[2].y:=40;vs[2].z:=40;

vs[3].x:=40;vs[3].y:=40;vs[3].z:=-40;

vs[4].x:=-40;vs[4].y:=40;vs[4].z:=-40;

vs[5].x:=-40;vs[5].y:=-40;vs[5].z:=40;

vs[6].x:=-40;vs[6].y:=-40;vs[6].z:=-40;

vs[7].x:=40;vs[7].y:=-40;vs[7].z:=-40;

vs[8].x:=40;vs[8].y:=-40;vs[8].z:=40;

gr[1].n:=4;gr[1].v[1]:=1;gr[1].v[2]:=5;gr[1].v[3]:=8;gr[1].v[4]:=2;

gr[2].n:=4;gr[2].v[1]:=4;gr[2].v[2]:=6;gr[2].v[3]:=5;gr[2].v[4]:=1;

gr[3].n:=4;gr[3].v[1]:=3;gr[3].v[2]:=7;gr[3].v[3]:=6;gr[3].v[4]:=4;

gr[4].n:=4;gr[4].v[1]:=2;gr[4].v[2]:=8;gr[4].v[3]:=7;gr[4].v[4]:=3;

gr[5].n:=4;gr[5].v[1]:=1;gr[5].v[2]:=2;gr[5].v[3]:=3;gr[5].v[4]:=4;

gr[6].n:=4;gr[6].v[1]:=5;gr[6].v[2]:=6;gr[6].v[3]:=7;gr[6].v[4]:=8;

{описание четыpнадцатигpанника}

vs[1].x:=-20; vs[1].y:=60;vs[1].z:=60;

vs[2].x:=-60;vs[2].y:=60;vs[2].z:=20;

vs[3].x:=-60;vs[3].y:=60;vs[3].z:=-20;

vs[4].x:=-20; vs[4].y:=60;vs[4].z:=-60;

vs[5].x:=20; vs[5].y:=60;vs[5].z:=-60;

vs[6].x:=60;vs[6].y:=60;vs[6].z:=-20;

vs[7].x:=60; vs[7].y:=60;vs[7].z:=20;

vs[8].x:=20; vs[8].y:=60;vs[8].z:=60;

vs[9].x:=60; vs[9].y:=20; vs[9].z:=60;

vs[10].x:=60; vs[10].y:=20;vs[10].z:=-60;

vs[11].x:=-60;vs[11].y:=20;vs[11].z:=-60;

vs[12].x:=-60;vs[12].y:=20;vs[12].z:=60;

vs[13].x:=60;vs[13].y:=-20;vs[13].z:=60;

vs[14].x:=60;vs[14].y:=-20;vs[14].z:=-60;

vs[15].x:=-60;vs[15].y:=-20;vs[15].z:=-60;

vs[16].x:=-60;vs[16].y:=-20;vs[16].z:=60;

vs[17].x:=-20;vs[17].y:=-60;vs[17].z:=60;

vs[18].x:=-60;vs[18].y:=-60;vs[18].z:=20;

vs[19].x:=-60;vs[19].y:=-60;vs[19].z:=-20;

vs[20].x:=-20;vs[20].y:=-60;vs[20].z:=-60;

vs[21].x:=20;vs[21].y:=-60;vs[21].z:=-60;

vs[22].x:=60;vs[22].y:=-60;vs[22].z:=-20;

vs[23].x:=60;vs[23].y:=-60;vs[23].z:=20;

vs[24].x:=20;vs[24].y:=-60;vs[24].z:=60;

gr[1].n:=8;gr[1].v[1]:=1;gr[1].v[2]:=8;gr[1].v[3]:=7;gr[1].v[4]:=6;

gr[1].v[5]:=5;gr[1].v[6]:=4;gr[1].v[7]:=3;gr[1].v[8]:=2;

gr[2].n:=8;gr[2].v[1]:=18;gr[2].v[2]:=19;gr[2].v[3]:=20;gr[2].v[4]:=21;

gr[2].v[5]:=22;gr[2].v[6]:=23;gr[2].v[7]:=24;gr[2].v[8]:=17;

gr[3].n:=8;gr[3].v[1]:=18;gr[3].v[2]:=16;gr[3].v[3]:=12;gr[3].v[4]:=2;

gr[3].v[5]:=3;gr[3].v[6]:=11;gr[3].v[7]:=15;gr[3].v[8]:=19;

gr[4].n:=8;gr[4].v[1]:=23;gr[4].v[2]:=22;gr[4].v[3]:=14;gr[4].v[4]:=10;

gr[4].v[5]:=6;gr[4].v[6]:=7;gr[4].v[7]:=9;gr[4].v[8]:=13;

gr[13].n:=8;gr[13].v[1]:=1;gr[13].v[2]:=12;gr[13].v[3]:=16;gr[13].v[4]:=17;

gr[13].v[5]:=24;gr[13].v[6]:=13;gr[13].v[7]:=9;gr[13].v[8]:=8;

gr[14].n:=8;gr[14].v[1]:=14;gr[14].v[2]:=21;gr[14].v[3]:=20;gr[14].v[4]:=15;

gr[14].v[5]:=11;gr[14].v[6]:=4;gr[14].v[7]:=5;gr[14].v[8]:=10;

gr[5].n:=3;gr[5].v[1]:=9;gr[5].v[2]:=7;gr[5].v[3]:=8;

gr[6].n:=3;gr[6].v[1]:=5;gr[6].v[2]:=6;gr[6].v[3]:=10;

gr[7].n:=3;gr[7].v[1]:=3;gr[7].v[2]:=4;gr[7].v[3]:=11;

gr[8].n:=3;gr[8].v[1]:=2;gr[8].v[2]:=12;gr[8].v[3]:=1;

gr[9].n:=3;gr[9].v[1]:=24;gr[9].v[2]:=23;gr[9].v[3]:=13;

gr[10].n:=3;gr[10].v[1]:=22;gr[10].v[2]:=21;gr[10].v[3]:=14;

gr[11].n:=3;gr[11].v[1]:=19;gr[11].v[2]:=15;gr[11].v[3]:=20;

gr[12].n:=3;gr[12].v[1]:=16;gr[12].v[2]:=18;gr[12].v[3]:=17;

{}

{описание пиpамиды}

{ vs[1].x:=80;vs[1].y:=-40;vs[1].z:=80;

vs[2].x:=-80;vs[2].y:=-40;vs[2].z:=-80;

vs[3].x:=180;vs[3].y:=-40;vs[3].z:=-80;

vs[4].x:=0;vs[4].y:=40;vs[4].z:=0;

gr[1].n:=3;gr[1].v[1]:=1;gr[1].v[2]:=3;gr[1].v[3]:=4;

gr[2].n:=3;gr[2].v[1]:=2;gr[2].v[2]:=1;gr[2].v[3]:=4;

gr[3].n:=3;gr[3].v[1]:=2;gr[3].v[2]:=4;gr[3].v[3]:=3;

gr[4].n:=3;gr[4].v[1]:=1;gr[4].v[2]:=2;gr[4].v[3]:=3;

}

co:=0.996194698;si:=0.087155742;

repeat

repeat

setvisualpage(page);

setactivepage(1-page);

cleardevice;{очистка экpана}

polydraw;

delay(60);{задеpжка для синхpонизации с ходом луча pазвеpтки на экpане}

rotate;

page:=1-page;

until keypressed;

ch:=readkey;

ch:=readkey;

until (ch=#27);

closegraph;

end.

Вариант заливки методом Гуро на примере куба.

Постановка задачи:

Закрасить методом Гуро куб. Источник света находится в точке (-50,-50,50).

Программа на языке Pascal

program GURO_Example;

uses crt,graph;

Type

NewPoint = record

X ,Y ,Z : integer;

end;

Type

Norm = record

i ,j ,k : real;

end;

Type

Gran = record

n:array[1..4] of byte; {номера точек составляющих грань}

f:boolean; {Флаг переднего плана}

end;

var

driver,mode:integer;

i:word;

point:array[1..8] of NewPoint; {Массив координат вершин X,Y,Z}

Allp:array[1..8] of PointType; {Массив координат вершин X,Y}

N:array[1..8] of Norm; {Массив нормалей к вершинам}

eN:array[1..8] of Norm; {Массив еденичных нормалей к вершинам}

moda:real; {Абсолютная величена нормали}

inten:array[1..8] of integer; {Массив освещённости в вершинах}

co,si:real;

page:byte;

ch:char;

Gr:array[1..6] of Gran; {Массив граней}

x1,y1,z1,x2,y2,z2,x3,y3,z3:integer;

procedure Fill(i:byte);

var

a,c,d:byte;

b,x2,x1,xx,yy,e:integer;

b1,b2,a1,a2:real;

IQ,IR,IP,kor:real;

begin

{Упорядочем номера вершин выбраной грани по Y}

b:=400;

for a:=1 to 4 do begin

if Allp[Gr[i].n[a]].y<b then begin

b:=Allp[Gr[i].n[a]].y;

c:=Gr[i].n[a];

for d:=a downto 2 do

Gr[i].n[d]:=Gr[i].n[d-1];

Gr[i].n[1]:=c;

end;

end;

b:=400;

for a:=2 to 4 do begin

if Allp[Gr[i].n[a]].y<b then begin

b:=Allp[Gr[i].n[a]].y;

c:=Gr[i].n[a];

for d:=a downto 3 do

Gr[i].n[d]:=Gr[i].n[d-1];

Gr[i].n[2]:=c;

end;

end;

b:=400;

for a:=3 to 4 do begin

if Allp[Gr[i].n[a]].y<b then begin

b:=Allp[Gr[i].n[a]].y;

c:=Gr[i].n[a];

for d:=a downto 4 do

Gr[i].n[d]:=Gr[i].n[d-1];

Gr[i].n[3]:=c;

end;

end;

{Разбиваем четырёхугольник на три части и закрашиваем его}

{ FROM 1 TO 2 }

for yy:=Allp[Gr[i].n[1]].y to Allp[Gr[i].n[2]].y do begin

if (Allp[Gr[i].n[2]].x<>Allp[Gr[i].n[1]].x)and(Allp[Gr[i].n[2]].y<>Allp[Gr[i].n[1]].y) then begin

b1:=Allp[Gr[i].n[1]].y*Allp[Gr[i].n[2]].x-Allp[Gr[i].n[2]].y*Allp[Gr[i].n[1]].x;

b1:=b1/(Allp[Gr[i].n[2]].x-Allp[Gr[i].n[1]].x);;

a1:=Allp[Gr[i].n[2]].y-Allp[Gr[i].n[1]].y;

a1:=a1/(Allp[Gr[i].n[2]].x-Allp[Gr[i].n[1]].x);

x1:=round((yy-b1)/a1);

end else

x1:=Allp[Gr[i].n[1]].x;

if (Allp[Gr[i].n[3]].x<>Allp[Gr[i].n[1]].x)and(Allp[Gr[i].n[3]].y<>Allp[Gr[i].n[1]].y) then begin

b2:=Allp[Gr[i].n[1]].y*Allp[Gr[i].n[3]].x-Allp[Gr[i].n[3]].y*Allp[Gr[i].n[1]].x;

b2:=b2/(Allp[Gr[i].n[3]].x-Allp[Gr[i].n[1]].x);

a2:=Allp[Gr[i].n[3]].y-Allp[Gr[i].n[1]].y;

a2:=a2/(Allp[Gr[i].n[3]].x-Allp[Gr[i].n[1]].x);

x2:=round((yy-b2)/a2);

end else

x2:=Allp[Gr[i].n[3]].x;

kor:=sqrt(sqr(Allp[Gr[i].n[1]].x-x1)+sqr(Allp[Gr[i].n[1]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[1]].x-Allp[Gr[i].n[2]].x)+sqr(Allp[Gr[i].n[1]].y-Allp[Gr[i].n[2]].y));

IQ:=(kor)*inten[Gr[i].n[2]]+(1-kor)*inten[Gr[i].n[1]];

kor:=sqrt(sqr(Allp[Gr[i].n[1]].x-x2)+sqr(Allp[Gr[i].n[1]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[1]].x-Allp[Gr[i].n[3]].x)+sqr(Allp[Gr[i].n[1]].y-Allp[Gr[i].n[3]].y));

IR:=(kor)*inten[Gr[i].n[3]]+(1-kor)*inten[Gr[i].n[1]];

if x1<>x2 then begin

for xx:=x2 to x1 do begin

IP:=(abs(x1-xx)/abs(x1-x2))*IR+(1-abs(x1-xx)/abs(x1-x2))*IQ;

putpixel(xx,yy,round((round(IP)+10)*15/35));

end;

end;

end;

{ FROM 2 TO 3 }

for yy:=Allp[Gr[i].n[2]].y to Allp[Gr[i].n[3]].y do begin

if (Allp[Gr[i].n[4]].x<>Allp[Gr[i].n[2]].x)and(Allp[Gr[i].n[4]].y<>Allp[Gr[i].n[2]].y) then begin

b1:=Allp[Gr[i].n[2]].y*Allp[Gr[i].n[4]].x-Allp[Gr[i].n[4]].y*Allp[Gr[i].n[2]].x;

b1:=b1/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[2]].x);;

a1:=Allp[Gr[i].n[4]].y-Allp[Gr[i].n[2]].y;

a1:=a1/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[2]].x);

x1:=round((yy-b1)/a1);

end else

x1:=Allp[Gr[i].n[4]].x;

if (Allp[Gr[i].n[3]].x<>Allp[Gr[i].n[1]].x)and(Allp[Gr[i].n[3]].y<>Allp[Gr[i].n[1]].y) then begin

b2:=Allp[Gr[i].n[1]].y*Allp[Gr[i].n[3]].x-Allp[Gr[i].n[3]].y*Allp[Gr[i].n[1]].x;

b2:=b2/(Allp[Gr[i].n[3]].x-Allp[Gr[i].n[1]].x);

a2:=Allp[Gr[i].n[3]].y-Allp[Gr[i].n[1]].y;

a2:=a2/(Allp[Gr[i].n[3]].x-Allp[Gr[i].n[1]].x);

x2:=round((yy-b2)/a2);

end else

x2:=Allp[Gr[i].n[3]].x;

kor:=sqrt(sqr(Allp[Gr[i].n[2]].x-x1)+sqr(Allp[Gr[i].n[2]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[2]].x-Allp[Gr[i].n[4]].x)+sqr(Allp[Gr[i].n[2]].y-Allp[Gr[i].n[4]].y));

IQ:=(kor)*inten[Gr[i].n[4]]+(1-kor)*inten[Gr[i].n[2]];

kor:=sqrt(sqr(Allp[Gr[i].n[1]].x-x2)+sqr(Allp[Gr[i].n[1]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[1]].x-Allp[Gr[i].n[3]].x)+sqr(Allp[Gr[i].n[1]].y-Allp[Gr[i].n[3]].y));

IR:=(kor)*inten[Gr[i].n[3]]+(1-kor)*inten[Gr[i].n[1]];

if x1<>x2 then begin

for xx:=x2 to x1 do begin

IP:=(abs(x1-xx)/abs(x1-x2))*IR+(1-(abs(x1-xx)/abs(x1-x2)))*IQ;

putpixel(xx,yy,round((round(IP)+10)*15/35));

end;

end;

end;

{ FROM 3 TO 4 }

for yy:=Allp[Gr[i].n[3]].y to Allp[Gr[i].n[4]].y do begin

if (Allp[Gr[i].n[4]].x<>Allp[Gr[i].n[2]].x)and(Allp[Gr[i].n[4]].y<>Allp[Gr[i].n[2]].y) then begin

b1:=Allp[Gr[i].n[2]].y*Allp[Gr[i].n[4]].x-Allp[Gr[i].n[4]].y*Allp[Gr[i].n[2]].x;

b1:=b1/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[2]].x);;

a1:=Allp[Gr[i].n[4]].y-Allp[Gr[i].n[2]].y;

a1:=a1/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[2]].x);

x1:=round((yy-b1)/a1);

end else

x1:=Allp[Gr[i].n[4]].x;

if (Allp[Gr[i].n[3]].x<>Allp[Gr[i].n[4]].x)and(Allp[Gr[i].n[3]].y<>Allp[Gr[i].n[4]].y) then begin

b2:=Allp[Gr[i].n[3]].y*Allp[Gr[i].n[4]].x-Allp[Gr[i].n[4]].y*Allp[Gr[i].n[3]].x;

b2:=b2/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[3]].x);

a2:=Allp[Gr[i].n[4]].y-Allp[Gr[i].n[3]].y;

a2:=a2/(Allp[Gr[i].n[4]].x-Allp[Gr[i].n[3]].x);

x2:=round((yy-b2)/a2);

end else

x2:=Allp[Gr[i].n[4]].x;

kor:=sqrt(sqr(Allp[Gr[i].n[2]].x-x1)+sqr(Allp[Gr[i].n[2]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[2]].x-Allp[Gr[i].n[4]].x)+sqr(Allp[Gr[i].n[2]].y-Allp[Gr[i].n[4]].y));

IQ:=(kor)*inten[Gr[i].n[4]]+(1-kor)*inten[Gr[i].n[2]];

kor:=sqrt(sqr(Allp[Gr[i].n[3]].x-x2)+sqr(Allp[Gr[i].n[3]].y-yy));

kor:=kor/sqrt(sqr(Allp[Gr[i].n[3]].x-Allp[Gr[i].n[4]].x)+sqr(Allp[Gr[i].n[3]].y-Allp[Gr[i].n[4]].y));

IR:=(kor)*inten[Gr[i].n[4]]+(1-kor)*inten[Gr[i].n[3]];

if x1<>x2 then begin

for xx:=x2 to x1 do begin

IP:=(abs(x1-xx)/abs(x1-x2))*IR+(1-abs(x1-xx)/abs(x1-x2))*IQ;

putpixel(xx,yy,round((round(IP)+10)*15/35));

end;

end;

end;

end;

procedure DrowKarkas;{Процедура рисования куба}

var

i:byte;

begin

Allp[1].x:=point[1].x; Allp[1].y:=point[1].y;

Allp[2].x:=point[2].x; Allp[2].y:=point[2].y;

Allp[3].x:=point[3].x; Allp[3].y:=point[3].y;

Allp[4].x:=point[4].x; Allp[4].y:=point[4].y;

Allp[5].x:=round(point[5].x-(point[5].z*sqrt(2))/sqrt(3)); Allp[5].y:=round(point[5].y-(point[5].z)/sqrt(3));

Allp[6].x:=round(point[6].x-(point[6].z*sqrt(2))/sqrt(3)); Allp[6].y:=round(point[6].y-(point[6].z)/sqrt(3));

Allp[7].x:=round(point[7].x-(point[7].z*sqrt(2))/sqrt(3)); Allp[7].y:=round(point[7].y-(point[7].z)/sqrt(3));

Allp[8].x:=round(point[8].x-(point[8].z*sqrt(2))/sqrt(3)); Allp[8].y:=round(point[8].y-(point[8].z)/sqrt(3));

for i:=1 to 6 do

if Gr[i].f then Fill(i);

end;

begin

driver:=VGA;

mode:=VGAlo;

initgraph (driver,mode,'');

point[1].x:=200; point[1].y:=100; point[1].z:=0;

point[2].x:=300; point[2].y:=100; point[2].z:=0;

point[3].x:=200; point[3].y:=150; point[3].z:=0;

point[4].x:=300; point[4].y:=150; point[4].z:=0;

point[5].x:=200; point[5].y:=100; point[5].z:=50;

point[6].x:=300; point[6].y:=100; point[6].z:=50;

point[7].x:=200; point[7].y:=150; point[7].z:=50;

point[8].x:=300; point[8].y:=150; point[8].z:=50;

x1:=point[5].x;x2:=point[2].x;x3:=point[3].x;

y1:=point[5].y;y2:=point[2].y;y3:=point[3].y;

z1:=point[5].z;z2:=point[2].z;z3:=point[3].z;

N[1].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[1].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[1].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[1].x;x2:=point[6].x;x3:=point[4].x;

y1:=point[1].y;y2:=point[6].y;y3:=point[4].y;

z1:=point[1].z;z2:=point[6].z;z3:=point[4].z;

N[2].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[2].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[2].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[1].x;x2:=point[7].x;x3:=point[4].x;

y1:=point[1].y;y2:=point[7].y;y3:=point[4].y;

z1:=point[1].z;z2:=point[7].z;z3:=point[4].z;

N[3].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[3].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[3].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[3].x;x2:=point[8].x;x3:=point[2].x;

y1:=point[3].y;y2:=point[8].y;y3:=point[2].y;

z1:=point[3].z;z2:=point[8].z;z3:=point[2].z;

N[4].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[4].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[4].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[7].x;x2:=point[1].x;x3:=point[6].x;

y1:=point[7].y;y2:=point[1].y;y3:=point[6].y;

z1:=point[7].z;z2:=point[1].z;z3:=point[6].z;

N[5].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[5].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[5].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[5].x;x2:=point[2].x;x3:=point[8].x;

y1:=point[5].y;y2:=point[2].y;y3:=point[8].y;

z1:=point[5].z;z2:=point[2].z;z3:=point[8].z;

N[6].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[6].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[6].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[5].x;x2:=point[3].x;x3:=point[8].x;

y1:=point[5].y;y2:=point[3].y;y3:=point[8].y;

z1:=point[5].z;z2:=point[3].z;z3:=point[8].z;

N[7].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[7].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[7].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

x1:=point[7].x;x2:=point[6].x;x3:=point[4].x;

y1:=point[7].y;y2:=point[6].y;y3:=point[4].y;

z1:=point[7].z;z2:=point[6].z;z3:=point[4].z;

N[8].i:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

N[8].j:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

N[8].k:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

moda:=sqrt(sqr(N[1].i)+sqr(N[1].j)+sqr(N[1].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[1].i:=N[1].i/moda;eN[1].j:=N[1].j/moda;eN[1].k:=N[1].k/moda;end;

moda:=sqrt(sqr(N[2].i)+sqr(N[2].j)+sqr(N[2].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[2].i:=N[2].i/moda;eN[2].j:=N[2].j/moda;eN[2].k:=N[2].k/moda;end;

moda:=sqrt(sqr(N[3].i)+sqr(N[3].j)+sqr(N[3].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[3].i:=N[3].i/moda;eN[3].j:=N[3].j/moda;eN[3].k:=N[3].k/moda;end;

moda:=sqrt(sqr(N[4].i)+sqr(N[4].j)+sqr(N[4].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[4].i:=N[4].i/moda;eN[4].j:=N[4].j/moda;eN[4].k:=N[4].k/moda;end;

moda:=sqrt(sqr(N[5].i)+sqr(N[5].j)+sqr(N[5].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[5].i:=N[5].i/moda;eN[5].j:=N[5].j/moda;eN[5].k:=N[5].k/moda;end;

moda:=sqrt(sqr(N[6].i)+sqr(N[6].j)+sqr(N[6].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[6].i:=N[6].i/moda;eN[6].j:=N[6].j/moda;eN[6].k:=N[6].k/moda;end;

moda:=sqrt(sqr(N[7].i)+sqr(N[7].j)+sqr(N[7].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[7].i:=N[7].i/moda;eN[7].j:=N[7].j/moda;eN[7].k:=N[7].k/moda;end;

moda:=sqrt(sqr(N[8].i)+sqr(N[8].j)+sqr(N[8].k));

if moda=0 then begin eN[1].i:=0;eN[1].j:=0;eN[1].k:=0; end else

begin eN[8].i:=N[8].i/moda;eN[8].j:=N[8].j/moda;eN[8].k:=N[8].k/moda;end;

{вычисляем интенсивность света в вершинах, источник освещения

находится в точке (-50,-50,70) ,коэфициент рассеяного света равен 30}

inten[1]:=round(((-50)*eN[1].i+(-50)*eN[1].j+(70)*eN[1].k)/3)+30;

inten[2]:=round(((-50)*eN[2].i+(-50)*eN[2].j+(70)*eN[1].k)/3)+30;

inten[3]:=round(((-50)*eN[3].i+(-50)*eN[3].j+(70)*eN[1].k)/3)+30;

inten[4]:=round(((-50)*eN[4].i+(-50)*eN[4].j+(70)*eN[1].k)/3)+30;

inten[5]:=round(((-50)*eN[5].i+(-50)*eN[5].j+(70)*eN[1].k)/3)+30;

inten[6]:=round(((-50)*eN[6].i+(-50)*eN[6].j+(70)*eN[1].k)/3)+30;

inten[7]:=round(((-50)*eN[7].i+(-50)*eN[7].j+(70)*eN[1].k)/3)+30;

inten[8]:=round(((-50)*eN[8].i+(-50)*eN[8].j+(70)*eN[1].k)/3)+30;

Gr[1].f:=TRUE;Gr[1].n[1]:=5;Gr[1].n[2]:=6;Gr[1].n[3]:=7;Gr[1].n[4]:=8;

Gr[2].f:=TRUE;Gr[2].n[1]:=3;Gr[2].n[2]:=4;Gr[2].n[3]:=7;Gr[2].n[4]:=8;

Gr[3].f:=TRUE;Gr[3].n[1]:=2;Gr[3].n[2]:=4;Gr[3].n[3]:=6;Gr[3].n[4]:=8;

Gr[4].f:=FALSE;Gr[4].n[1]:=1;Gr[4].n[2]:=3;Gr[4].n[3]:=5;Gr[4].n[4]:=7;

Gr[5].f:=FALSE;Gr[5].n[1]:=1;Gr[5].n[2]:=2;Gr[5].n[3]:=3;Gr[5].n[4]:=4;

Gr[6].f:=FALSE;Gr[6].n[1]:=1;Gr[6].n[2]:=2;Gr[6].n[3]:=5;Gr[6].n[4]:=6;

for i:= 1 to 15 do

begin

setpalette(i, i);

setrgbpalette(i,0,0,30+2*i);

end;

DrowKarkas;

readkey;

closegraph;

end.

Вариант заливки методом Фонга на примере вращающегося куба.

Постановка задачи:

Закрасить методом Фонга куб.

Программа на языке Pascal

program Fong_fill;

uses crt{,graph},XVGA;

type

vertex=record

x,y,z:real;

end;

face=record

n:word;{кол-во веpшин в гpани}

v:array[1..4] of word;{номеpа веpшин пpотив часовой стpелки}

end;

rebra=record

v1,v2,v3: byte;

end;

pGran=^tGran;

tGran=array[0..80,0..80] of byte;

tVCub=record

v:byte;

g:array[1..3]of ^tGran;

end;

const

YY=40;

alpha = Pi*2/YY;

_co=0.996194698; _si=0.087155742;

LIGHT: vertex = ( x:100; y:100; z:100 ); { точечный источник света }

{ падает вдоль оси Z }

SEE: vertex = ( x:320; y:175; z:400 ); { точка наблюдения }

Ia = 3; { интенсивность рассеянного света }

Il = 20; { интенсивность точечного источника }

Ka = 0.5; { коэфф. диффузного света }

Kd = 0.1; { коэфф. диффузного отражения }

Ks = 0.1; { коэфф. зеркального отражения }

d = 1; { положение объекта к точке наблюдения }

k = 3; { произвольная постоянная }

{ n=1: степень апроксимации распред.зеркально отраженного света }

var

vs:array[1..8] of vertex;{массив веpшин многогpанника}

rb:array[1..8] of rebra; {ребра в вершинах}

gr:array[1..6] of face;{массив гpаней}

i:word;

a,b:real;

x,y:real;

ch:char;

co,si:real;

apage:word;

pr,pg,pb,pn:integer;

Function CalcGran(aV1,aV2,aV3,aV4:vertex):pGran;

Var

buf:pGran;

Begin

New(buf);

CalcGran:=buf;

End;

Procedure Normal(v0,v1,v2,v3:vertex; Var N:vertex);

Begin

N.x := (v1.y-v0.y)*(v2.z-v0.z)-(v1.x-v0.x)*(v2.y-v0.y)+

(v3.y-v0.y)*(v1.z-v0.z)-(v3.x-v0.x)*(v1.y-v0.y)+

(v2.y-v0.y)*(v3.z-v0.z)-(v2.x-v0.x)*(v3.y-v0.y);

N.y := (v1.z-v0.z)*(v2.x-v0.x)-(v1.x-v0.x)*(v2.z-v0.z)+

(v3.z-v0.z)*(v1.x-v0.x)-(v3.x-v0.x)*(v1.z-v0.z)+

(v2.z-v0.z)*(v3.x-v0.x)-(v2.x-v0.x)*(v3.z-v0.z);

N.z := (v1.x-v0.x)*(v2.y-v0.y)-(v1.y-v0.y)*(v2.x-v0.x)+

(v3.x-v0.x)*(v1.y-v0.y)-(v3.y-v0.y)*(v1.x-v0.x)+

(v2.x-v0.x)*(v3.y-v0.y)-(v2.y-v0.y)*(v3.x-v0.x);

End;

Procedure Vector(a,b:vertex; Var V:vertex);

Begin

V.x := b.x-a.x; V.y:= b.y-a.y; V.z := b.z-a.z;

End;

Procedure VectOtraj(norm:vertex; Var Otr:vertex);

Begin

Otr.x := 2*norm.z*norm.z-1;

Otr.y := 2*norm.z*norm.y;

Otr.z := 2*norm.z*norm.x;

End;

Function Intens(aN,aL,aR,aS:vertex):real;

Var

NL,RS:real;

Begin

NL := aN.x*aL.x + aN.y*aL.y + aN.z*aL.z;

RS := aR.x*aS.x + aR.y*aS.y + aR.z*aS.z;

Intens := Ia*Ka + (Il/(k+d))*(Kd*NL+Ks*RS);

End;

Function OtrLen(a,b:vertex):real;

Begin

OtrLen:=sqrt( (b.x-a.x)*(b.x-a.x)+(b.y-a.y)*(b.y-a.y)+(b.z-a.z)*(b.z-a.z) );

End;

Procedure rotate;

Begin

for i:=1 to 8 do

begin

x:=vs[i].x*co+vs[i].y*si;

y:=-vs[i].x*si+vs[i].y*co;

vs[i].x:=x; vs[i].y:=y;

x:=vs[i].z*co+vs[i].y*si;

y:=-vs[i].z*si+vs[i].y*co;

vs[i].z:=x; vs[i].y:=y;

end;

end;

Procedure polydraw;{изобpажение многогpанника}

Var

i:word;

j,k:real;

nt,x1,x2,x3,y1,y2,y3,z1,z2,z3,nx,ny,nz:real;

inten:word;

ir:real;

n:word;

LL,NN,RR,SS: vertex;

Nv1,Nv2,Nv3,Nv4,Nu,Nv,Nw : vertex;

V1,V2,V3,V4,U,V,ww,W : vertex;

uuu,vvv,ttt,wl,ggg : real;

r1,r2,r3,r4:vertex;

px,py:word;

Begin

n:=0;

for i:=1 to 6 do

begin

x1:=vs[gr[i].v[1]].x; x2:=vs[gr[i].v[2]].x; x3:=vs[gr[i].v[3]].x;

y1:=vs[gr[i].v[1]].y; y2:=vs[gr[i].v[2]].y; y3:=vs[gr[i].v[3]].y;

z1:=vs[gr[i].v[1]].z; z2:=vs[gr[i].v[2]].z; z3:=vs[gr[i].v[3]].z;

nx:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);

ny:=-((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1));

nz:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);

nt:=sqrt(nx*nx+ny*ny+nz*nz);

nx:=nx/nt; ny:=ny/nt; nz:=nz/nt;

if (nz>0) then

begin

{ грань куба }

V1:=vs[gr[i].v[1]];

V2:=vs[gr[i].v[2]];

V3:=vs[gr[i].v[3]];

V4:=vs[gr[i].v[4]];

{ нормали к вершинам }

r1.x:=vs[rb[gr[i].v[1]].v1].x-V1.x;

r1.y:=vs[rb[gr[i].v[1]].v1].y-V1.y;

r1.z:=vs[rb[gr[i].v[1]].v1].z-V1.z;

r2.x:=vs[rb[gr[i].v[1]].v2].x-V1.x;

r2.y:=vs[rb[gr[i].v[1]].v2].y-V1.y;

r2.z:=vs[rb[gr[i].v[1]].v2].z-V1.z;

r3.x:=vs[rb[gr[i].v[1]].v3].x-V1.x;

r3.y:=vs[rb[gr[i].v[1]].v3].y-V1.y;

r3.z:=vs[rb[gr[i].v[1]].v3].z-V1.z;

Normal(V1,r1,r2,r3,Nv1);

ggg:=sqrt(Nv1.x*Nv1.x+Nv1.y*Nv1.y+Nv1.z*Nv1.z);

Nv1.x:=Nv1.x/ggg; Nv1.y:=Nv1.y/ggg; Nv1.z:=Nv1.z/ggg;

r1.x:=vs[rb[gr[i].v[2]].v1].x-V1.x;

r1.y:=vs[rb[gr[i].v[2]].v1].y-V1.y;

r1.y:=vs[rb[gr[i].v[2]].v1].z-V1.z;

r2.x:=vs[rb[gr[i].v[2]].v2].x-V1.x;

r2.y:=vs[rb[gr[i].v[2]].v2].y-V1.y;

r2.y:=vs[rb[gr[i].v[2]].v2].z-V1.z;

r3.x:=vs[rb[gr[i].v[2]].v3].x-V1.x;

r3.y:=vs[rb[gr[i].v[2]].v3].y-V1.y;

r3.y:=vs[rb[gr[i].v[2]].v3].z-V1.z;

Normal(V2,r1,r2,r3,Nv2);

ggg:=sqrt(Nv2.x*Nv2.x+Nv2.y*Nv2.y+Nv2.z*Nv2.z);

Nv2.x:=Nv2.x/ggg; Nv2.y:=Nv2.y/ggg; Nv2.z:=Nv2.z/ggg;

r1.x:=vs[rb[gr[i].v[3]].v1].x-V1.x;

r1.y:=vs[rb[gr[i].v[3]].v1].y-V1.y;

r1.y:=vs[rb[gr[i].v[3]].v1].z-V1.z;

r2.x:=vs[rb[gr[i].v[3]].v2].x-V1.x;

r2.y:=vs[rb[gr[i].v[3]].v2].y-V1.y;

r2.y:=vs[rb[gr[i].v[3]].v2].z-V1.z;

r3.x:=vs[rb[gr[i].v[3]].v3].x-V1.x;

r3.y:=vs[rb[gr[i].v[3]].v3].y-V1.y;

r3.y:=vs[rb[gr[i].v[3]].v3].z-V1.z;

Normal(V3,r1,r2,r3,Nv3);

ggg:=sqrt(Nv3.x*Nv3.x+Nv3.y*Nv3.y+Nv3.z*Nv3.z);

Nv3.x:=Nv3.x/ggg; Nv3.y:=Nv3.y/ggg; Nv3.z:=Nv3.z/ggg;

r1.x:=vs[rb[gr[i].v[4]].v1].x-V1.x;

r1.y:=vs[rb[gr[i].v[4]].v1].y-V1.y;

r1.y:=vs[rb[gr[i].v[4]].v1].z-V1.z;

r2.x:=vs[rb[gr[i].v[4]].v2].x-V1.x;

r2.y:=vs[rb[gr[i].v[4]].v2].y-V1.y;

r2.y:=vs[rb[gr[i].v[4]].v2].z-V1.z;

r3.x:=vs[rb[gr[i].v[4]].v3].x-V1.x;

r3.y:=vs[rb[gr[i].v[4]].v3].y-V1.y;

r3.y:=vs[rb[gr[i].v[4]].v3].z-V1.z;

Normal(V4,r1,r2,r3,Nv4);

ggg:=sqrt(Nv4.x*Nv4.x+Nv4.y*Nv4.y+Nv4.z*Nv4.z);

Nv4.x:=Nv4.x/ggg; Nv4.y:=Nv4.y/ggg; Nv4.z:=Nv4.z/ggg;

uuu:=0;

vvv:=0;

j:=0;

while j<=1 do

begin

{ Точки U,V }

U.x:=round((1-j)*V4.x+j*V1.x);

U.y:=round((1-j)*V4.y+j*V1.y);

U.z:=round((1-j)*V4.z+j*V1.z);

V.x:=round((1-j)*V3.x+j*V2.x);

V.y:=round((1-j)*V3.y+j*V2.y);

V.z:=round((1-j)*V3.z+j*V2.z);

{ Векторы Nu,Nv }

uuu:=j;

vvv:=j;

Nu.x:=(1-uuu)*Nv4.x+uuu*Nv1.x;

Nu.y:=(1-uuu)*Nv4.y+uuu*Nv1.y;

Nu.z:=(1-uuu)*Nv4.z+uuu*Nv1.z;

Nv.x:=(1-vvv)*Nv3.x+vvv*Nv2.x;

Nv.y:=(1-vvv)*Nv3.y+vvv*Nv2.y;

Nv.z:=(1-vvv)*Nv3.z+vvv*Nv2.z;

{ Mw }

k:=0;

while k<=1 do

begin

ttt:=k;

W.x:=(1-ttt)*U.x+k*V.x; W.y:=(1-ttt)*U.y+k*V.y; W.z:=(1-ttt)*U.z+k*V.z;

ww.x:=(1-ttt)*Nu.x+ttt*Nv.x;

ww.y:=(1-ttt)*Nu.y+ttt*Nv.y;

ww.z:=(1-ttt)*Nu.z+ttt*Nv.z;

wl:=sqrt(ww.x*ww.x+ww.y*ww.y+ww.z*ww.z);{}

Nw.x:=ww.x{}/wl{}; Nw.y:=ww.y{}/wl{}; Nw.z:=ww.z{}/wl{};

LL.x:=W.x-LIGHT.x; LL.y:=W.y-LIGHT.y; LL.z:=W.z-LIGHT.z;

ggg:=sqrt(LL.x*LL.x+LL.y*LL.y+LL.z*LL.z);

LL.x:=LL.x/ggg; LL.y:=LL.y/ggg; LL.z:=LL.z/ggg;

VectOtraj(LL,RR);

ggg:=sqrt(RR.x*RR.x+RR.y*RR.y+RR.z*RR.z);

RR.x:=RR.x/ggg; RR.y:=RR.y/ggg; RR.z:=RR.z/ggg;

SS.x:=W.x-SEE.x; SS.y:=W.y-SEE.y; SS.z:=W.z-SEE.z;

ggg:=sqrt(SS.x*SS.x+SS.y*SS.y+SS.z*SS.z);

SS.x:=SS.x/ggg; SS.y:=SS.y/ggg; SS.z:=SS.z/ggg;

ir:=Intens(Nw,LL,RR,SS);

inten:=round( (ir*100-1400)/24 );

px:=round(int(W.x+160));

py:=round(int(W.y+100));

putpixel(px,py,inten,apage);

putpixel(px+1,py,inten,apage);

putpixel(px,py+1,inten,apage);

k:=k+0.0125;

end;

j:=j+0.0125;

putpixel(round(V1.x)+160,round(V1.y)+100,100,apage);

putpixel(round(V2.x)+160,round(V2.y)+100,100,apage);

putpixel(round(V3.x)+160,round(V3.y)+100,100,apage);

putpixel(round(V4.x)+160,round(V4.y)+100,100,apage);

end;

end;

end;

End;

begin

setxvga;

palcorrect;

{описание куба}

vs[1].x := -40; vs[1].y := 40; vs[1].z:= 40;

vs[2].x := 40; vs[2].y := 40; vs[2].z:= 40;

vs[3].x := 40; vs[3].y := 40; vs[3].z:= -40;

vs[4].x := -40; vs[4].y := 40; vs[4].z:= -40;

vs[5].x := -40; vs[5].y := -40; vs[5].z:= 40;

vs[6].x := -40; vs[6].y := -40; vs[6].z:= -40;

vs[7].x := 40; vs[7].y := -40; vs[7].z:= -40;

vs[8].x := 40; vs[8].y := -40; vs[8].z:= 40;

gr[1].n:=4; gr[1].v[1]:=1; gr[1].v[2]:=5; gr[1].v[3]:=8; gr[1].v[4]:=2;

gr[2].n:=4; gr[2].v[1]:=4; gr[2].v[2]:=6; gr[2].v[3]:=5; gr[2].v[4]:=1;

gr[3].n:=4; gr[3].v[1]:=3; gr[3].v[2]:=7; gr[3].v[3]:=6; gr[3].v[4]:=4;

gr[4].n:=4; gr[4].v[1]:=2; gr[4].v[2]:=8; gr[4].v[3]:=7; gr[4].v[4]:=3;

gr[5].n:=4; gr[5].v[1]:=1; gr[5].v[2]:=2; gr[5].v[3]:=3; gr[5].v[4]:=4;

gr[6].n:=4; gr[6].v[1]:=5; gr[6].v[2]:=6; gr[6].v[3]:=7; gr[6].v[4]:=8;

rb[1].v1:=2; rb[1].v2:=4; rb[1].v3:=5;

rb[2].v1:=1; rb[2].v2:=3; rb[2].v3:=8;

rb[3].v1:=2; rb[3].v2:=4; rb[3].v3:=7;

rb[4].v1:=1; rb[4].v2:=3; rb[4].v3:=6;

rb[5].v1:=1; rb[5].v2:=6; rb[5].v3:=8;

rb[6].v1:=4; rb[6].v2:=5; rb[6].v3:=7;

rb[7].v1:=3; rb[7].v2:=6; rb[7].v3:=8;

rb[8].v1:=2; rb[8].v2:=5; rb[8].v3:=7;

co:=cos(alpha); si:=sin(alpha);

apage:=$4000;

repeat

repeat

clearpage(apage);

polydraw;

rotate;

setvideopage(apage);

apage:=$4000-apage;

until keypressed;

ch:=readkey;

ch:=readkey;

until (ch=#27);

asm { // возврат в текстовый режим }

mov AX,3h

int 10h

end;

end.

Файл XVGA.TPU для последней программы, позволяющий использовать нестандартный режим VGA. Для использования функций этого модуля наберите его в файле XVGA.PAS и откомпилируйте в XVGA.TPU.

UNIT XVGA;

INTERFACE

procedure SetXVGA;

procedure ClearPage(PageAddr:word);

procedure SetVideoPage(PageAddr:word);

procedure PutPixel(aX,aY,Value,PageAddr:word);

procedure PalCorrect;

procedure DrawLine(x1,y1,x2,y2,col,pag:word);

IMPLEMENTATION

{

// --------------------------------------------------------------------

// SetXVGA: Установить режим XVGA (320x200x256цв,4страницы)

// --------------------------------------------------------------------

}

procedure SetXVGA;

begin

asm

mov AX,13h { стандартный режим 13h }

int 10h

mov DX,3C4h { выбор регистра MemoryMode в Sequenser }

mov AL,04h

out DX,AL

inc DX { 3C5h: порт для доступа к регистру }

in AL,DX { прочитать текущее значение }

or AL,00000100b { включить второй бит }

and AL,11110111b { выключить третий бит }

out DX,AL { установить новое значение регистра }

mov DX,3D4h { Выбор регистра UnderlineLocation в CRTC }

mov AL,14h

out DX,AL

inc DX { 3D5h: порт для доступа к регистру }

in AL,DX { прочитать текущее значение }

and AL,10111111b { выключить шестой бит регистра }

out DX,AL { установить новое значение регистра }

dec DX { Выбор регистра ModeControl в CRTC }

mov AL,17h

out DX,AL

inc DX { 3D5h: порт для доступа к регистру }

in AL,DX { прочитать текущее значение }

or AL,40h { включить шестой бит регистра }

out DX,AL { установить новое значение регистра }

mov AX,0A000h { очистка видеопамяти }

mov ES,AX

xor DI,DI

xor AX,AX

mov CX,8000h

cld

rep stosw

end;

end;

{

// --------------------------------------------------------------------

// ClearPage: Очистить страницу с началом PageAddr

// --------------------------------------------------------------------

}

procedure ClearPage(PageAddr:word);

var

zp:word;

begin

zp:=PageAddr;

asm

mov AH,01111b

mov DX,3C4h

mov AL,2

out DX,AL

inc DX

mov AL,0Fh

out DX,AL

mov AX,0A000h

mov ES,AX

mov DI,zp

xor AX,AX

mov CX,8000{//4000h//64000}

cld

rep stosw

end;

end;

{

// --------------------------------------------------------------------

// SetVideoPage: Установить видимую страницу с началом PageAddr

// --------------------------------------------------------------------

}

procedure SetVideoPage(PageAddr:word);

var

vp:word;

begin

vp:=PageAddr;

asm

@@Wait:

mov DX,3DAh { дождаться окончания обратного хода луча }

in AL,DX

and AL,01000b { 3-й бит }

cmp AL,0

je @@Wait

mov BX,vp

mov DX,3D4h { работаем с CRTC }

mov AL,0Ch { старший байт начального адреса }

mov AH,BH

out DX,AX

mov AL,0Dh { младший байт начального адреса }

mov AH,BL

out DX,AX

end;

end;

{

// --------------------------------------------------------------------

// PutPixel: Высветить пиксел

// --------------------------------------------------------------------

}

procedure PutPixel(aX,aY,Value,PageAddr:word);

var

zx,zy,zv,zp:word;

{ z_ введены из-за некорректной передачи параметров }

begin

zx:=aX; zy:=aY; zv:=Value; zp:=PageAddr;

asm

{ битовая плоскость }

mov CX,zx

and CX,011b { 2 младших бита }

mov AH,01h

shl AH,CL { маска для выбора битовой плоскости }

mov DX,3C4h

mov AL,02h

out DX,AX { указать битовую плоскость }

{ адрес в видеопамяти }

mov AX,0A000h

mov ES,AX

mov CX,zy

mov AL,50h { 50h=320/4=80 }

mul CL { AX=80*Y }

mov BX,zx

mov CL,BL

shr BX,1

shr BX,1 { BX=X/4 }

add BX,AX { BX=80*Y+X/4 }

add BX,zp

mov AX,zv { запись в видеопамять }

mov [ES:BX],AL

end;

end;

{

// --------------------------------------------------------------------

// PalCorrect: Изменить палитру: убрать зеленые оттенки.

// --------------------------------------------------------------------

}

procedure PalCorrect;

var

rr:word;

begin

for rr:=0 to $003F do

asm

mov AH,10h

mov AL,15h { прочитать регистр DAC }

mov BX,rr

int 10h

mov CL,BL { убрать синий }

mov CH,0

mov DH,0

mov AL,10h { записать регистр DAC }

int 10h

end;

end;

procedure DrawLine(x1,y1,x2,y2,col,pag:word);

var

x,y,t,e,denom,dx,dy,xinc,yinc,vl,aux:integer;

begin

xinc:=1;

yinc:=1;

vl:=0;

dx:=x2-x1; dy:=y2-y1;

if(dx<0)and(dy<0)then

begin

aux:=x1; x2:=x1; x1:=aux;

aux:=y1; y2:=y1; y1:=aux;

dx:=x2-x1; dy:=y2-y1;

end;

if(dx<0) then

begin

xinc:=-1; dx:=-dx;

end;

if(dy>dx) then

begin

vl:=1; aux:=dx; dx:=dy; dy:=aux;

end;

denom:=dx shl 1 {<<}; {// =dy*2}

t:=dy shl 1;

e:=-dx;

x:=x1; y:=y1;

while(dx>=0) do

begin

dec(dx);

putpixel(x,y,col,pag);

e:=e+t;

if( e>0 ) then

begin

if(vl<>0) then

x:=x+xinc

else

y:=y+yinc;

e:=e-denom;

end;

if(vl<>0) then

y:=y+yinc

else

x:=x+xinc;

end;

end;

BEGIN

END.

29