Помощь - Поиск - Пользователи - Календарь
Полная версия: Модель Солнца
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
2nick
ниже представлен код программы иммитирующей модель солнца с протуберанцами

Проблема: мигание картинки
Вопрос:
- как можно избавиться от него при помощи построения изображения в памяти
с последующим пребрасыванием его на экран. желательно используя подпрограммы
построения и вывода на ассемблере
- как изменить программу чтобы получить сферу сплошную с освещением или текстурированную

{--------------------------------------------------------------------------}
{ Солнце с протуберанцами_31                                               }
{--------------------------------------------------------------------------}
{   Как это pаботает?
    Фоpмула окpужности вокpуг начала кооpдинат r1^2=x1^2+y1^2=r0^2. Достаточно
наpисовать одну дугу от напpавления "на 12 часов" до напpавления "на 1 час 30
минут" :-) , а остальные 7 дуг получить отpажениями. Рисуем точку "на 12
часов".
    Расстояние от нее до начала кооpдинат (вpеменный pадиус) pавно pадиусу
окpужности. Пpодвигаем точку на пискель пpавее. Вpеменный pадиус может стать
больше pадиуса окpужности (точка вышла из окpужности), в таком случае опускаем
точку на пискель вниз. Для pассматpиваемой дуги это гаpантиpует, что вpеменный
pадиус обязательно опять станет меньше pадиуса окpужности (точка веpнется в
окpужность). Можно pисовать следующую точку. Так мы их pисуем, пока напpавление
из центpа окpужности на последнюю точку не станет больше, чем "на 1 час 30
мин", т.е. y1<x1.
    От умножений избавляемся следующим обpазом. В цикле для пpовеpки выхода
точки из окpужности сpавниваем не r1 с r0 и не r1^2 с r0^2, а r0^2-r1^2 с 0.
Выpажение r0^2-r1^0 уменьшается на 2*x1+1 пpи пеpемешении точки на пиксель
впpаво и увеличивается на 2*y1+1 пpи пеpемещении точки на пиксель вниз. В
случае эллипса уpавнение будет r1^2=(x1/Rx)^2+(y1/Ry)^2=1. Пеpеходим к целым числам:
x1^2*Ry^2+y1^2*Rx^2=Rx^2*Ry^2. Пpи пеpедвижении точки впpаво выpажение
Rx^2*Ry^2-x1^2*Ry^2+y1^2*Rx^2, котоpое нам надо сpавнивать с нулем для пpовеpки
необходимости опустить точку на пиксель вниз, уменьшается на величину
(2*x1+1)*Ry^2=2*x1*Ry^2+Ry^2, где пеpвое слагаемое в свою очеpедь с каждым
пеpемещением впpаво уменьшается на константу 2*Ry^2, а втоpое - константа. }
{--------------------------------------------------------------------------}
{ Алгоритм прорисовки сферы по точками 
  уравнение сферы, зная x,y и r - радиус сферы
                                                x^2+y^2+z^2=r^2
---------------------------------------------------------------------------
  Сфера полученная вращением.
            R- радиус
            n- число точек на сколько поделить
---------------------------------------------------------------------------
var	x,y,z,a,b,r:Integer;

begin
	for a:=0 to n do
		for b:=0 to n do
		begin
			x:=round(r*cos(a/n*2*Pi)*cos(b/n*Pi));
			y:=round(r*cos(a/n*2*Pi)*sin(b/n*Pi));
			z:=round(r*sin(a/n*2*Pi));
		end;
end;
---------------------------------------------------------------------------}
program sol_31;
const	radSun=25;	{ радиус Солнца }
var	sunX,sunY,x,y,XRad,i:integer;
	Projection,PolUgol:Real;

Var	screen:array[0..199,0..319] of byte absolute $a000:$0000;
var	virscr:pointer;
	virseg:word;
{ --- очистка экрана ------------------------------------------------------}
procedure cls(lvseg:word); assembler;
asm
  mov es,[lvseg]
  xor di,di
  xor ax,ax
  mov cx,320*200/2
  rep stosw
end
{--------------------------------------------------------------------------}
procedure putpixel(x,y:integer;c:byte);
begin
	byte(ptr($a000,y*320+x)^):=c;
end;
{--------------------------------------------------------------------------}
Procedure circle(x0,y0,r0,c0:integer);
Var	x1,y1,r02_r2:integer;
begin
	x1:=0;
	y1:=r0;
	r02_r2:=r0+r0+1;	{ Hа любителя: здесь можно написать "r02_r2:=0"}
	repeat
		screen[y0+y1,x0+x1]:=c0;
		screen[y0+y1,x0-x1]:=c0;
		screen[y0-y1,x0+x1]:=c0;
		screen[y0-y1,x0-x1]:=c0;
		screen[y0+x1,x0+y1]:=c0;
		screen[y0+x1,x0-y1]:=c0;
		screen[y0-x1,x0+y1]:=c0;
		screen[y0-x1,x0-y1]:=c0;
		dec(r02_r2,x1+x1+1);
		inc(x1);
		if r02_r2<=0 then	{...тогда здесь нужно написать "r02_r2<0"}
		begin
			dec(y1);
			inc(r02_r2,y1+y1+1);
		end;
	until x1>y1;
end;
{--------------------------------------------------------------------------}
Procedure fillcircle(x0,y0,r0,c0:integer);
Var	x1,y1,r02_r2,x,y:integer;
begin
	x1:=0;
	y1:=r0;
	r02_r2:=0;
	repeat
		for x:=x0-x1 to x0+x1 do
		begin
			screen[y0+y1,x]:=c0;
			screen[y0-y1,x]:=c0;
		end;
		for x:=x0-y1 to x0+y1 do
		begin
			screen[y0+x1,x]:=c0;
			screen[y0-x1,x]:=c0;
		end;
		dec(r02_r2,x1+x1+1);
		inc(x1);
		if r02_r2<0 then
		begin
			dec(y1);
			inc(r02_r2,y1+y1+1);
		end;
	until x1>y1;
end;
{--------------------------------------------------------------------------}
begin
	asm	{ установка графического режима 320x200x256 }
		mov ax,19	{Set Mode 19}
		int 10h
	end

	getmem(virscr,64000);
	virseg:=seg(virscr^);
	cls(virseg);	{ очистка графического экрана }

	Randomize;	{ инициализация датчика случайных чисел }

	sunX:=160;
	sunY:=80;	{ координаты Cолнцa }

	Repeat
		fillcircle(sunX,sunY,radSun,14);	{ Построение Солнца }

		{ Построение протуберанцев }
		for i:=1 to radSun*16 do
		begin
			{ PolUgol,XRad - полярные координаты протуберанца }
			PolUgol:=2*Pi*Random;
			Projection:=(1-sqr(Random))*Pi/2;
			XRad:=radSun+Round(exp(1.25*Random*cos(Projection)))-1;	{1..sunRad*2/16}

			x:=sunX+Round(XRad*cos(PolUgol));
			y:=sunY+Round(XRad*sin(PolUgol));
			{putpixel(x,y,12);	{ прорисовка протуберанцев }
			{screen[y,x]:=12;	{ прорисовка протуберанцев }
			byte(ptr($a000,y*320+x)^):=12;	{ прорисовка протуберанцев }
		end;
		fillchar(ptr($a000,0)^,$fa00,0);	{ очистка графического экрана }
	until port[$60]=1;	{ выход из цикла/программы при нажатии клавиши "ESC" }

	{ возвpащаемся в текстовый pежим }
	asm	{ выключение графического режима }
		mov ax,03h	{Set mode 3}
		int 10h
	end
end.

Yevgeny
Цитата
как изменить программу чтобы получить сферу сплошную с освещением или текстурированную

А ты не мог бы это пояснить как-нить, я не совсем понял, что значит текстурированная сфера? у тебя вроде бы про это нигде не написано...
Rian
Задай поиск на форуме на буферизацию, тема поднималась не раз, есть много полезных сообщений
Цитата

как изменить программу чтобы получить сферу сплошную с освещением или текстурированную

Ты имеешь в виду получить полную 3D-сферу? Со всеми наворотами и эффектами?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.