IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Преломление и полное внутренне отражение
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 31
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Текст задачи:
"197. Экран разделен горизонтальной линей, изображающей границу раздела воды и воздуха. Изобразите траекторию светового луча, выходящего из произвольной точки и распространяющего по законам геометрической оптики. Считайте, что от границ луч отражается зеркально, учтите также возможность полного внутреннего отражения. (Это должна быть анимация – луч должен лететь из произвольной (заданной) точки под произвольным (заданным) углом. – Авт.)"

А Вот, собственно программа... Только в ней нехватет основной процедуры Border:
Код

program zadacha197; {Гершенович Игорь}
Uses Crt, Graph, Gersh;
const
     n1 = 1;
     n2 = 1.33;
     X0 : Integer = 100;
     Y0 : Integer = 100;
     a : Real = 45;
     pause : Integer = 1000;
var
   x, y : Integer;
   x1, y1, dx, dy : Real;

procedure Env;
var i, x, y : Integer;
begin
     SetColor (15);
     Rectangle (0,0,GetMaxX,GetMaxY);
     SetColor (11);
     Line (0,GetMaxY div 2, GetMaxX, GetMaxY div 2);
     Randomize;
     for i:=1 to 100 do PutPixel (Random(GetMaxX),Random(GetMaxY div 2),7);
     SetColor (3);
     for i:=1 to 50 do begin
         x:=Random(GetMaxX);
         y:=Random(GetMaxY div 2)+GetMaxY div 2;
         Line (x,y,x+5,y);
     end;
end; {Env}

procedure Border;
begin
     if dy=n1/n2 then if dx>0 then a:=3*Pi/2 else a:=Pi/2 else
        begin
            {????????????????????????????????
                а сдесь должон быть расчет угла после преломления
                (если я, конечно правильно сделал критический угол)
             ??????????????????????????????? }
        end;
end; {Border}

procedure adge;
begin
     if (x=GetMaxX) or (x=0) then dx:=-dx;
     if (y=GetMaxY) or (y=0) then dy:=-dy;
end; {adge}

procedure control;
var ch : char;
begin
     repeat Ch:= Readkey  until Ch<>#0;
     case Ord (Ch) of
          43 : if pause>1 then dec(pause,100);
          45 : inc(pause,100);
          27 : halt;
     end;
end; {control}

BEGIN
     GraphBegin('');
     Env;
     x1:=X0; y1:=Y0;
     a:=a*Pi/180;
     dx:=cos(a);
     dy:=sin(a);
     repeat
           PutPixel (x,y,14);
           Delay (pause);
           PutPixel (x,y,15);
           x1:=x1+dx;
           y1:=y1+dy;
           x:=Round(x1);
           y:=Round(y1);
           MoveTo (x,y);
           if GetPixel(x,y)=11 then Border;
           if GetPixel(x,y)=15 then adge;
           if KeyPressed then control;
     until KeyPressed;
END.

Помоите эту процедуру написать!
(В программе используется мой модуль - Gersh (процедура GraphBegin('')))

Сообщение отредактировано: Гersh -


Прикрепленные файлы
Прикрепленный файл  GERSH.PAS ( 652 байт ) Кол-во скачиваний: 257
Прикрепленный файл  GERSH.PAS ( 652 байт ) Кол-во скачиваний: 250
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 31
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Ура!
Теперь более или менее что-то работает. Один глюк только! Почему-то иногда, когда луч идет снизу вверх (из воды в воздух), иногда вылетает Ошибка 207: Invalid floating point operation. Видимо тут где-то получается минус под корнем (в процедуре Border) Откуда он там берется? Или тут не в том дело??
При этом так получается не всегда! Иногда все, нормально иногда через какое-то время такая ошибка вылетает, а иногда при первом же пломлении. Странно sad.gif(
Вот, например, при начальных параметрах x0=100; y0=300; a=10; или a=30; при первом же сталкивании с границей ошибка вылетает. А при a=190 (при тех же x и y) - при четвертом.
Вот последняя версия программы:
program zadacha197; {Гершенович Игорь}
Uses Crt, Graph, Gersh;
const
n1 = 1; {показатель преломления воздуха}
n2 = 1.33; {показатель преломления воды}
X0 : Integer = 100; {начальная координата X}
Y0 : Integer = 300; {начальная координата Y}
a : Real = 10; {начальный угол}
pause : Integer = 1000;
var
x, y, yb : Integer;
x1, y1, dx, dy : Real;

procedure Env;
var i, x, y : Integer;
begin
SetColor (15);
Rectangle (0,0,GetMaxX,GetMaxY);
SetColor (11);
Line (0, yb, GetMaxX, yb);
Randomize;
for i:=1 to 100 do PutPixel (Random(GetMaxX),Random(yb),7);
SetColor (3);
for i:=1 to 50 do begin
x:=Random(GetMaxX);
y:=Random(yb)+yb;
Line (x,y,x+5,y);
end;
end; {Env}

procedure Border;
var
dl, dl2, s1, s2: Real;
begin
dl2:=dx*dx+dy*dy;
dl:=Sqrt(dl2);
s1:=dx/dl;
if dy>0 then s2:=s1*n1/n2 else s2:=s1*n2/n1;
if s2>=1.0 then dy:=-dy else begin
dx:=dl*s2;
dy:=Sqrt(dl2-dx*dx)*dy/Abs(dy)
end;
end; {Border}

procedure adge;
begin
if (x=GetMaxX) or (x=0) then dx:=-dx;
if (y=GetMaxY) or (y=0) then dy:=-dy;
end; {adge}

procedure control;
var ch : char;
begin
repeat Ch:= Readkey until Ch<>#0;
case Ord (Ch) of
43 : if pause>1 then dec(pause,100);
45 : inc(pause,100);
27 : halt;
end;
end; {control}

BEGIN
GraphBegin('');
yb:=GetMaxY div 2;
Env;
x1:=X0; y1:=Y0;
a:=a*Pi/180;
dx:=cos(a);
dy:=sin(a);
repeat
PutPixel (x,y,14);
Delay (pause);
PutPixel (x,y,15);
x1:=x1+dx;
y1:=y1+dy;
x:=Round(x1);
y:=Round(y1);
MoveTo (x,y);
if (y>=yb) and (y0<yb) or (y<=yb) and (y0>yb) then Border;
if GetPixel(x,y)=15 then adge;
if KeyPressed then control;
Y0:=y;
until KeyPressed;
END.

А чисто физически теперь ведь все нормально?

2lapp:
Кстати, а ты не объяснишь как твоя процедура действует? Как оно вообще просчитывается физчески и геометрически и как именно реализуется в алгоритме.

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 20:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name