Форум «Всё о Паскале» _ Задачи _ Преломление и полное внутренне отражение
Автор: Гersh 9.05.2006 18:02
Текст задачи: "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, я сделал тебе процедуру примерно как ты хотел, но работает все неправильно все равно (ниже скажу, почему). Вот процедура:
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}
Неверен сам принцип "преломления" - его надо переделать. Дело в том, что эта процедура у тебя вызывается по проверке цвета точки на экране. Но ты не учел, что реальная толщина плюс наклон луча могут приводить к тому, что эта процедура при прохождении границы вызовется не один, а два или больше раз. Это приведет к двойному преломлению...
И вообще, идея такой эмуляции мне не очень нравится.. Было бы интереснее попробовать продемонстрировать принцип Гюйгенса..
Автор: Гersh 10.05.2006 11:49
Ого! Какие тут все умные! Я не думал о таком Жаль... И что же мне сделать чтобы ЭТА задача работала номрально??
А может просто после преломления насильно сдвинуть луч на один пиксел вверх или вниз? Авось незаметно будет... Да... Тупой я, однако... Жаль... ( Не могу все детали просчитать наперед.
Автор: lapp 10.05.2006 16:39
Цитата(Гersh @ 10.05.2006 7:49)
И что же мне сделать чтобы ЭТА задача работала номрально??
Что делать? Не подменять естественные вещи искусственными. Тебе надо вызвать процедуру при пересечении границы? Так и делай это. Отследи момент, когда координата y становится перескает значение. Иначе говоря, так:
1. Запоминаешь старое значение y0. 2. Вычисляешь новое, y. 3. Если (y>=yb) and (y0<yb) or (y<=yb) and (y0>yb) , то вызываешь процедуру.
Здесь yb - это координата границы между средами. Этот алгоритм годится для пересечения в обе стороны.
Автор: Гersh 10.05.2006 20:11
Ура! Теперь более или менее что-то работает. Один глюк только! Почему-то иногда, когда луч идет снизу вверх (из воды в воздух), иногда вылетает Ошибка 207: Invalid floating point operation. Видимо тут где-то получается минус под корнем (в процедуре Border) Откуда он там берется? Или тут не в том дело?? При этом так получается не всегда! Иногда все, нормально иногда через какое-то время такая ошибка вылетает, а иногда при первом же пломлении. Странно ( Вот, например, при начальных параметрах x0=100; y0=300; a=10; или a=30; при первом же сталкивании с границей ошибка вылетает. А при a=190 (при тех же x и y) - при четвертом. Вот последняя версия программы:
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 11.05.2006 1:07
Добавляем в твою программу ведение лог-файла, и получаем:
Моя ошибка, да. Конечно, сравнение (двумя строчками выше) нужно делать по модулю..
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. Видишь - все просто до безобразия..
Автор: Гersh 11.05.2006 15:02
Ура! Ура!!! УРА!!!!! ВСЕ работает!! Спасибо огромное lapp!!
Автор: Гersh 12.05.2006 15:37
Я нашел еще один косяк! Почему-то, через некоторое время луч начинает тормазить и клавиши + / - не работают... Очень странно. Это уже не физика, это просто глюк какой-то... Впрочем мне уже завтра (СБ) сдавать все задачи... Если кто успеет - помогите до вечера. А если нет, то будем надеятся, что информатик этого момента не дождется... (а еще лучше, что это у моего компа глюк) Последняя версия программы:
Почему-то, через некоторое время луч начинает тормазить и клавиши + / - не работают... Очень странно. Это уже не физика, это просто глюк какой-то...
Я такого не замечал.. Но + и - у тебя реализованы нехорошо. Ты лучше не прибавляй и вычитай сотню, а умножай и дели на 2. Это будет гораздо эффективнее.
Автор: Гersh 12.05.2006 20:13
А в чем раздница? + / - сотня или 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 зависит от быстродействия компьютера, Верно? Кроме того так гораздно удобнее. (Ой, что-то я уже флужу. Сорри. Завязываю...) Ура! Спасибо большое за помощь, консультацию и за все!