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 байт ) Кол-во скачиваний: 277
Прикрепленный файл  GERSH.PAS ( 652 байт ) Кол-во скачиваний: 268
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Гersh, я сделал тебе процедуру примерно как ты хотел, но работает все неправильно все равно (ниже скажу, почему).
Вот процедура:
procedure Border;
var
dl,dl2,s1,s2:tReal;
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}

Неверен сам принцип "преломления" - его надо переделать. Дело в том, что эта процедура у тебя вызывается по проверке цвета точки на экране. Но ты не учел, что реальная толщина плюс наклон луча могут приводить к тому, что эта процедура при прохождении границы вызовется не один, а два или больше раз. Это приведет к двойному преломлению...

И вообще, идея такой эмуляции мне не очень нравится.. Было бы интереснее попробовать продемонстрировать принцип Гюйгенса..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


Ого! blink.gif
Какие тут все умные!
Я не думал о таком sad.gif Жаль...
И что же мне сделать чтобы ЭТА задача работала номрально??

А может просто после преломления насильно сдвинуть луч на один пиксел вверх или вниз? Авось незаметно будет...
Да... Тупой я, однако... Жаль... sad.gif( Не могу все детали просчитать наперед. sad.gif

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


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Гersh @ 10.05.2006 7:49) *

И что же мне сделать чтобы ЭТА задача работала номрально??

Что делать? Не подменять естественные вещи искусственными. smile.gif
Тебе надо вызвать процедуру при пересечении границы? Так и делай это. Отследи момент, когда координата y становится перескает значение. Иначе говоря, так:

1. Запоминаешь старое значение y0.
2. Вычисляешь новое, y.
3. Если (y>=yb) and (y0<yb) or (y<=yb) and (y0>yb) , то вызываешь процедуру.

Здесь yb - это координата границы между средами. Этот алгоритм годится для пересечения в обе стороны.

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Добавляем в твою программу ведение лог-файла, и получаем:

Цитата(Log)

starting...
sqrt1: ( 1.00000000)
sqrt2: ( -0.71556114)
Значит, все-таки в процедуре Border в строке
	   dy:=Sqrt(dl2-dx*dx)*dy/Abs(dy)
под корнем - отрицательное число...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(volvo @ 10.05.2006 21:07) *

Значит, все-таки в процедуре Border в строке
	   dy:=Sqrt(dl2-dx*dx)*dy/Abs(dy)
под корнем - отрицательное число...

Моя ошибка, да. Конечно, сравнение (двумя строчками выше) нужно делать по модулю..
    if Abs(s2)>=1.0 then dy:=-dy else begin  { <-- здесь добавлена функция Abs }
dx:=dl*s2;
dy:=Sqrt(dl2-dx*dx)*dy/Abs(dy)

Цитата(Гersh @ 10.05.2006 16:11) *

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

Более-менее да.. Но я бы рекомендовал тебе делать те сравнения (новую и старую позицию с координатой границы в условии вызова процедуры Border) в реальных координатах, а не в координатах экрана Вообще все нужно делать в них, а в экранные координаты переводить только при выводе точки. (См. также замечание в конце поста).
Цитата(Гersh @ 10.05.2006 16:11) *

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

Да это же все очевидно.. Когда обнаруживается пересечение границы, нужно изменить направление луча.

1. определяем текущее направление (синус угла, s1). Для этого сначала высчитываем длину вектора перемещения dl (dl2 - это ее квадрат, сохраняем ее, поскольку пригодится в будущем) и вычисляем синус как катет на гипотенузу: s1=dx/dl .

2. по знаку dy определяем, куда мы движемся: из среды с n1 в n2 или из n2 в n1. Соответственно результирующий коэффициент преломления будет либо n2/n2, либо n1/n2. Домножаем его на синус входного угла и получаем синус выходного s2 (закон преломления).

3. Если синус получается по модулю больше 1, то вместо преломления делаем полное внутреннее отражение.

4. Если модуль синуса меньше 1, то по нему рассчитываем новое dx. Модуль dy находим по т.Пифагора (используем сохраненный квадрат перемещения), а знак dy делаем такой же, как был (домножаем на dy и делим на Abs(dy) ).

Замечание: величину dl я оставляю постоянной, что не совсем верно с точки зрения физики. Если считать, что скорость рисования луча представляет собой скорость распространения света в текущей среде, то желательно при переходе из одной среды в другую делить ее на коэффициент преломления. То есть
dl:=dl/n
Тут n равно либо n2/n1, либо n1/n2, как сказано выше. Соответственно, запоминать dl2 в этом случае не имеет смысла, поскольку все равно пересчитывать.

Далее луч летит с новыми dx и dy. Видишь - все просто до безобразия..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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


Ура! Ура!!! УРА!!!!!
ВСЕ работает!!
Спасибо огромное lapp!!
applause.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

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

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


Я нашел еще один косяк!
Почему-то, через некоторое время луч начинает тормазить и клавиши + / - не работают...
Очень странно. Это уже не физика, это просто глюк какой-то...
Впрочем мне уже завтра (СБ) сдавать все задачи... Если кто успеет - помогите до вечера. А если нет, то будем надеятся, что информатик этого момента не дождется... (а еще лучше, что это у моего компа глюк)
Последняя версия программы:


Прикрепленные файлы
Прикрепленный файл  GERSH197.PAS ( 2.01 килобайт ) Кол-во скачиваний: 286
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Гersh @ 12.05.2006 12:37) *

Почему-то, через некоторое время луч начинает тормазить и клавиши + / - не работают...
Очень странно. Это уже не физика, это просто глюк какой-то...

Я такого не замечал.. Но + и - у тебя реализованы нехорошо. Ты лучше не прибавляй и вычитай сотню, а умножай и дели на 2. Это будет гораздо эффективнее.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

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

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


А в чем раздница?
+ / - сотня или div / * два??
Ну, допустим, делю на два... Тормаза-то этим не уберешь... У меня вообще-то и цикл сам криво сделан...

Впрочем, если у тебя тормазов нет... Значит у меня комп глючит - бывает. Тогда я задачу сдам нормально и спасибо за помощь!

EDIT:
Ой! Все-все-все!!!
Я все сделал.
Сделал, чтобы не +/- 100 и //* на 2. Все работает прекрасно! И глюк с тормазами пропал!!! УРА!!

Гersh (09:27 PM) :
Ура! Я сделал еще одну задачу!
Гersh (09:27 PM) :
вернее мне помогли...
Гersh (09:27 PM) :
но я ее доделал и она работает!
Гersh (09:27 PM) :
осталось 9! =)
Гersh (09:29 PM) :
Ура! +2 к Ваша самооценка! =))

И я, кажется, понял, почему имнно так делать паузу надо! Это связано с тем что задержка delay зависит от быстродействия компьютера, Верно? Кроме того так гораздно удобнее.
(Ой, что-то я уже флужу. Сорри. Завязываю...)
Ура! Спасибо большое за помощь, консультацию и за все! !thanks.gif

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

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

 





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