! Программа МАЯТНИК с диалогом! (Графики выводятся c продолжением) ФОН БЕЛЫЙ ! Колебания маятника с углом, изменяемым по закону FIotTAU(tau) ! с предварительным вычислением коэффициентов этой функции. Module PenDiaL ! Мой модуль с параметрами диалога Use IFLogM ! Intel-модуль диалога !Use DFLogM Include 'resource.fd' ! Подключить FD-ресурс-файл Type(Dialog) MyDLG ! Dialog определён в IFLogM Integer(4) MaxFi, Ld, MAXt, msec !------------------------------------------------------------------ Logical(4):: flag, If_OK(5) ! массив If_OK фактически не задействован Integer(4)::status, IOS Character(50)::String End Module PenDiaL Module GraPARAM ! Параметры для построения двух графиков Real(8) H_R8, W_R8 Integer(2) H_i2, W_i2 ! высота и ширина области графика Integer(2) iXprev1, iYprev1, iZprev1, iXprev0, iYprev0, iZprev0 End Module GraPARAM Module FiParam ! Параметры для расчёта угла от приведённого времени !Real(8)::p1=1.282D0, AA=-0.05208, BB=-0.06805, CC=0.008868 Real(8)::p1, AA, BB, CC Real(8)::Period, tauMax, HalfPeriod ! приведённые Period, Period*1/4, Period*1/2 Real(8),Parameter::wOTfiMax(35)= & ! 5 10 15 20 25 30 35 40 45 [1.000476D0, 1.001907D0, 1.004301D0, 1.007669D0, 1.012031D0, 1.01741D0, 1.023833D0, 1.031341D0, 1.039973D0, & ! 50 55 60 65 70 75 80 85 90 1.049783D0, 1.060829D0, 1.073182D0, 1.086923D0, 1.102145D0, 1.118959D0, 1.137493D0, 1.157895D0, 1.180341D0, & ! 95 100 105 110 115 120 125 130 135 1.205037D0, 1.23223D0, 1.262212D0, 1.295340D0, 1.332050D0, 1.37288D0, 1.418513D0, 1.469819D0, 1.527948D0, & ! 140 145 150 155 160 165 170 175 1.594446D0, 1.671479D0, 1.762204D0, 1.871499D0, 2.00751D0, 2.185444D0, 2.439363D0, 2.877664D0] End Module FiParam Program M1_Pendulum ! Колебания маятника Use PenDiaL Use FiParam Use GraPARAM Use IFQWin !Use DFLib Implicit None Type(QWinfo) Winfo Type (xyCoord) iPOld, LftDnSW ! для хранения предыдущ. нач. координат Type(WindowConfig) WC Type(WxyCoord) WP, P(4),P0(4), P_fi0(4) ! P, P0 - массивы под полигон Real(8),Parameter::pi=3.141592653589793D0, g = 9.807D0 ! , ro = 7820D0 ! = плотность кг/м^3 Real(8) D_s, DL_s, R_d, b_d , zC, zD ! Физичекие размеры маятника и коефф. в ф-ле z(x)=(zC+x^2)/(zD+x) !External FIotTAU Real(8) FIotTAU ! = функция, вычисляющая угол от приведённого времени Logical(4) Log Integer(2) i2 Integer(4) i4res, NUnit Real(8) x,y,x0,y0,fi,fi0,co,si, wrk !Real(8)::Ax,Ay=-16D0, Bx, By=14D0, HtoW, dfi=0.025D0, R, ELd, DLs, del, ELd0 Real(8)::Ax,Ay=-17D0, Bx, By=18D0, HtoW, dfi=0.025D0, R, ELd, DLs, del, ELd0 Integer :: num=0 , K Real(8)::Xprev,XCprev Real(8) fiMax, Tperiod, t, dt, tMax, PhPeriod Real(8) dTau, DLMatPend, tKoeff Character(6) ChTime, ChTimeLev0, ChTimeLev1 ! СЛЕДУЕТ использовать ВРЕМЯ t !----------------------------------НАЧАЛЬНАЯ КАРТИНА--------------------------------------------------------------------- Log = GetWindowConfig(WC) HtoW = Dble(WC.numYpixels)/Dble(WC.numXpixels) !Bx=(By-Ay)/HtoW/2; Ax=-Bx ! симметричный вариант Bx=(By-Ay)/HtoW; Ax=-Bx*0.675 ! Bx = Bx*0.325 !Call GetViewCoord_W(Ax, Ay, LftDnSW) ! получить координаты !Call MoveTo_W(Ax+10., Ay+0.675,WP) !Call GetCurrentPosition(LftDnSW) !Call GetViewCoord_W(Ax+10., Ay+0.675, wLftDnSW) ! получить координаты секундомера LftDnStopWatch <--- LftDnSW !LftDnSW = int2(wLftDnSW) Xprev=Ax; XCprev=Ax DLMatPend = 0.779D0 ! - длина соотв. мат. маятника tKoeff = sqrt(2*g/DLMatPend) ! = коэфф. для пересчёта: tau = t * tKoeff. ( 5.018D0 = sqrt(2*g/L), где L=0.779m длина ) MaxFi = 5 ! Максимальный угол Call GetParam( MaxFi ) ! Опр.коэфф. ф-ии FIotTAU и приведённые tauMax; HalfPeriod=2*tauMax; Period = 4*tauMax fiMax = MaxFi*pi/180 !!! TPeriod = Period/1.47 - для макс. угла 130 град. !TPeriod = Period/wOTfiMax(MaxFi /5) ! Теоретический ("линейный" - без учёта fiMax) приведённый период tMax = 5D0 ! в сек., 0.0275 сек - шаг по физическому времени. dt = 0.0275D0 ! - шаг (сек) по физическому времени. dTau = 0.0275D0*tKoeff ! - приведённый шаг по времени. 5.018D0 = sqrt(2*g/L), где L=0.779m длина ! соотв. мат. маятн. Использовать в ссылках на FIotTAU ! Физичекие размеры маятника D_s = 0.03D0 ! диаметр стержня в метрах. DL_s = 1D0 ! длина стержня в метрах. R_d = 0.08D0 ! радиус диска в метрах. b_d = 0.1D0 ! ширина (толщина) диска в метрах. zD = ((0.5*D_s)**2*DL_s) /(R_d**2*b_d) zC = zD/3 +0.5*(R_d/DL_s)**2; zD = 0.5*zD ! коефф. в ф-ле z(x)=(zC+x^2)/(zD+x) ! Условные размеры маятника: R=1.0D0 ! радиус диска(ов) на рисунке del=R/8 ! полуширина (радиус) стержня на рисунке DLs=13.5D0 ! длина стержня на рисунке ELd=12.15D0 ! расстояние от подвеса до центра диска на рисунке ELd/DLs=0.9 Call GraINI(0D0, Angle(0D0), FIotTAU(0D0)) ! инициализация графиков Winfo%type=QWIN$MAX ! type для максимизации обрамляющего окна i4res = SetWSizeQQ (QWin$FrameWindow, Winfo) !i2 = SetBKColor(15) !Call ClearScreen($GClearScreen) ! i2=InitializeFonts() ! i2=SetFont("t'Arial Cyr'hh64w14')") ! h20w12 ! Call MoveTo(100,100,iPOld) !Call OutGText("Alt + Enter") ! Call SleepQQ(2000) P_fi0=[WxyCoord(del, 0D0), WxyCoord(del, -DLs), WxyCoord(-del, -DLs), WxyCoord(-del, 0D0)] Open(Unit=10, File='User', Title='1') ! Окно №10 ! Окно №10 активно и имеет фокус ! status = INQFOCUSQQ(focusunit) ! i4res= GetActiveQQ() ! i4res= SetActiveQQ(10) ! Для рисования в ДО NUnit=10. Call SetChildWin(10) ! Рисовать фон в ДО NUnit=10. Open(Unit=11, File='User', Title='2') ! Окно №11 ! Окно №11 активно и имеет фокус Call SetChildWin(11) ! Рисовать фон в ДО NUnit=11. ! ДО №11 с нарисованным фоном активно и находится в фокусе. !Call SleepQQ(1000) t = 0D0 Write(ChTime,"(F6.2)") t ChTimeLev0 = ChTime; ChTimeLev1 = ChTime !fi = FIotTAU(t*tKoeff) ! = fiMax ! fi= 0 !co=cos(fi); si=sin(fi) !P(:).wx=[del*co, DLs*si+del*co, DLs*si-del*co, -del*co] ! Стержень !P(:).wy=[del*si, -DLs*co+del*si, -DLs*co-del*si, -del*si] P_fi0=[WxyCoord(del, 0D0), WxyCoord(del, -DLs), WxyCoord(-del, -DLs), WxyCoord(-del, 0D0)] !P_fi0 = fP_fi0(DLs) P0 = P_fi0 ! в двух положениях. P = P_fi0 fi= 0; co=cos(fi); si=sin(fi) x=ELd*sin(fi); y=-ELd*cos(fi) ! Координаты центра диска. Call DrawPendulum(P_fi0, x, y, 0) ! Рисовать маятник чёрным. !Call DrawPendulum(P, 0D0, -ELd, 0) ! Рисовать маятник чёрным. ! Call SleepQQ(2000) ! НАДО успеть нажать Alt+Enter ELd0 = ELd !------------------------------------------------------------------------------------------------------- Call RunDiaL() ! Инициализация диалога DIA: If(flag) Then ! ДИАЛОГ: Проверка результата инициализации !Call DrawPendulum(P, x, y, 0) ! Рисовать маятник чёрным в актиное окно (при 1-ом входе в №11). !!i4res=FocusQQ(10) DoDIA: Do ! Начало цикла диалога. Выбраны i4-параметра: x=0D0; y=-ELd ! Координаты центра диска. x0=x; y0=y ! MAXt - макс. число периодов, Ld - расст. от подвеса до центра диска, MaxFi - макс. угол (град.) fiMax = MaxFi*pi/180 ELd = DLs*(Dble(Ld)/100)/DL_s ! расстояние от подвеса до центра диска на рисунке (Ld см/100 см) wrk = (Dble(Ld)/100)/DL_s DLMatPend = (zC + wrk**2) / (zD + wrk) * DL_s ! ! - длина соотв. мат. маятника tKoeff = sqrt(2*g/DLMatPend) ! = коэфф. для пересчёта: tau = t * tKoeff. ( 5.018D0 = sqrt(2*g/L), где L=0.779m длина ) Call GetParam( MaxFi ) ! Опр.коэфф.ф-ии FIotTAU и приведённ. tauMax; HalfPeriod=2*tauMax; Period = 4*tauMax TPeriod = Period/wOTfiMax(MaxFi/5) ! Теоретический ("линейный" - без учёта fiMax) приведённый период. PhPeriod = Period / tKoeff ! Реальный физический период (в сек) маятника. ??? м.б. он не потребуется? tMax = MAXt*PhPeriod If(ELd /= ELd0) Then Call DrawPendulum(P_fi0, x, y, 15) ! стереть круг в ДО №=NUnit Call DrawPendulum(P_fi0, 0D0, -ELd, 0)! нарисовать круг в новом положении i4res=FocusQQ(NUnit) NUnit = 21 - NUnit ! смена номеров i4res= SetActiveQQ(NUnit) Call DrawPendulum(P_fi0, x, y, 15) ! стереть круг в ДО №=NUnit x=0D0; y=-ELd ! Координаты центра диска. Call DrawPendulum(P_fi0, x, y, 0)! нарисовать круг в новом положении ! стереть круг в ДО №=NUnit ! нарисовать круг в новом положении x0=x; y0=y ELd0 = ELd EndIf !---------------------------------------------------- !Call DrawPendulum(P, x, y, 15) ! Стереть маятник - рисовать белым цветом ! Call SleepQQ(800) ! Call DrawPendulum(P, 0D0, -ELd, 15) ! Рисовать маятник чёрным. t = 0D0 Write(ChTime,"(F6.2)") t ChTimeLev0 = ChTime; ChTimeLev1 = ChTime NUnit = 10 ! номер окна i4res=FocusQQ(21 - NUnit) ! отображение ДО NUnit=11 fi = 0D0 fi0 = fi Do i4res= SetActiveQQ(NUnit) ! Для рисования в ДО NUnit=10. i2=SetColor(15) ! Для стирания старого изображения. x0=ELd*sin(fi0); y0=-ELd*cos(fi0) ! -61 для №10, -60 для №11, -59 для №10, Call DrawPendulum(P0, x0, y0, 15) ! Стереть маятник - рисовать белым цветом Call Stativ(#505050) !!! 27.02.14 i2=SetColor(15) !i2=Polygon_W($GFillInterior,P0,4) ! стержень !i2=Ellipse_W($GFillInterior,x0-R,y0-R, x0+R, y0+R) ! диск if( t > tMax) Exit !Write(ChTime,"(F5.2)") (K-2)/60.0 ! ЧАСЫ ! СЛЕДУЕТ использовать ВРЕМЯ t !i2 = Rectangle_W($GFillInterior,Bx - 5.5D0, By-0.575D0,Bx , By-1.45D0) ! Стереть показания часов !!i2 = Rectangle_W($GFillInterior, Ax +10.5D0, Ay+4.5D0, Ax +17.4D0, Ay+2.8D0) !i4res=SetColorRGB(#0F0F0F) i2=SetColor(0) i2 = Rectangle($GFillInterior, LftDnSW%xCoord+40_2, LftDnSW%yCoord-100_2, LftDnSW%xCoord+230_2, LftDnSW%yCoord-50_2) !i2=SetColor(0) !i2 = Rectangle_W($GBorder, Ax +10.5D0, Ay+4.5D0, Ax +17.4D0, Ay+2.8D0) !Call MoveTo_W(Bx - 17.75D0, By-0.55D0, WP) !Call OutGText(ChTimeLev1//" сек") i2=SetColor(0) ! Для рисования нового изображения. msec = 15; If(t ==0) Then t = t + dt msec =500 Write(ChTime,"(F6.2)") 0D0 Else t = t + dt Write(ChTime,"(F6.2)") min(t, tMax) EndIf ! t = dt*k - Period/4 fi0=fi; P0=P fi = FIotTAU(t*tKoeff) !fi=fi+dfi !P(:).wx=[del*cos(fi), DLs*sin(fi)+del*cos(fi), DLs*sin(fi)-del*cos(fi), -del*cos(fi)] !P(:).wy=[del*sin(fi), -DLs*cos(fi)+del*sin(fi), -DLs*cos(fi)-del*sin(fi), -del*sin(fi)] co=cos(fi); si=sin(fi) P(:).wx=[del*co, DLs*si+del*co, DLs*si-del*co, -del*co] P(:).wy=[del*si, -DLs*co+del*si, -DLs*co-del*si, -del*si] !Call MoveTo_W(x, y, WP) ! i2=LineTo_W(0D0, 0D0) Call Stativ(#505050) x=ELd*sin(fi); y=-ELd*cos(fi) ! ! -59 для №10, -58 для №11, Call DrawPendulum(P, x, y, 0) !i2=SetColor(0) ! Отрисовка в ДО NUnit=10: ============ ! i2=Polygon_W($GFillInterior,P,4) ! стержень !i2=Ellipse_W($GFillInterior, x-R,y-R ,x+R,y+R ) ! диск ! i2=SetColor(15) !i2=Ellipse_W($GFillInterior,-del*0.65, -del*0.65, del*0.65, del*0.65) ! ось подвеса !i2=SetColor(7) !i2=Ellipse_W($GFillInterior,x-R/10,y-R/10 ,x+R/10,y+R/10 ) ! центр диска ============ !Write(ChTime,"(F5.2)") K/60.0 Write(ChTime,"(F6.2)") min(t, tMax) ChTimeLev1 = ChTimeLev0; ChTimeLev0 = ChTime; !!!Call MoveTo_W(Bx - 5.5D0, By-0.55D0, WP) ! Call MoveTo_W(Ax + 13.5D0, Ay+4.5D0, WP) !Call MoveTo_W(Ax +10.5D0, Ay+5.D0, WP) ! вывод в часы Call MoveTo(LftDnSW%xCoord+50, LftDnSW%yCoord-110, iPOld) ! вывод в часы i4res=SetColorRGB(#0060FF); Call OutGText(ChTime) ! i4res=SetColorRGB(#0060FF); i2=SetColor(15) Call MoveTo(LftDnSW%xCoord+250, LftDnSW%yCoord-110, iPOld) ! вывод в часы Call OutGText("сек") i2=SetColor(10) i2=Ellipse_W($GFillInterior,-del/4,-del/4, del/4, del/4) !Call GRA_CS(t*tKoeff) !Call GRA_CC(t*tKoeff) Call GraDraw(t, Angle(t*tKoeff), FIotTAU(t*tKoeff)) Call SleepQQ(msec) ! задержка i4res=FocusQQ(NUnit) ! перключение на ДО NUnit=10 NUnit = 21 - NUnit ! смена окон EndDo ! Выход со стёртым ДОа №=NUnit, а в фокусе ДОб №=(21 - NUnit) i2 = Rectangle_W($GFillInterior,Bx - 5.5D0, By-0.575D0,Bx , By-1.45D0) ! очистка правого верхнего угла !i2 = SetColor(12); ! Call MoveTo_W(Bx - 5.5D0, By-0.55D0, WP); Call OutGText(" 0.00 сек") ! обнуление угла !!! i2 = Rectangle_W($GFillInterior, 0d0,0d0, 1d0,1d0) ! Call MoveTo_W(Ax +10.5D0, Ay+5.D0, WP) ! вывод в часы i2=SetColor(0) i2 = Rectangle($GFillInterior, LftDnSW%xCoord+50_2, LftDnSW%yCoord-100_2, LftDnSW%xCoord+230_2, LftDnSW%yCoord-50_2) Call MoveTo(LftDnSW%xCoord+50, LftDnSW%yCoord-110, iPOld) ! вывод в часы !i2=SetColor(12); i4res=SetColorRGB(#0060FF); Call OutGText(ChTime) ! Write(ChTime,"(F6.2)") tMax ! Call OutGText(ChTime//" сек") Call SleepQQ(500) ! зафиксировать финишное положение Call Stativ(#505050) Call DrawPendulum(P_fi0, 0D0, -ELd, 0) ! рисую исходный маятник в ДОа №=NUnit P0 = P_fi0 !i2 = SetColor(13); i2 = Rectangle_W($GFillInterior, 0d0,0d0, 1d0,1d0) ; i4res=FocusQQ(NUnit) NUnit = 21 - NUnit ! смена номеров ! i2 = SetColor(15); i2 = Rectangle_W($GFillInterior, 0d0,0d0, 1d0,1d0) i4res= SetActiveQQ(NUnit) ! активизирую ДОб Call DrawPendulum(P, x, y, 15) ! стереть тек. маятник в ДОб Call Stativ(#505050) Call DrawPendulum(P_fi0, 0D0, -ELd, 0) ! рисую исходный маятник в ДОб №=NUnit P = P_fi0; fi = 0D0 i2 =SetColor(15) !<< ИЗМЕНИТЬ !<