4 Jun 2020 8:54
#25558
I often use %pl or %gr to develop simple animations. These generally run for a fixed period at a fixed speed after the user invokes the start callback. I have been thinking that it would be useful for the user to adjust the speed, or stop and then restart at some point during the animation. Discovering the %dl format code the other day, I came up with the following – which provides the required functionality. I’m just wondering if others have a better way of achieving the same end result? Ken
module t
use clrwin
implicit none
private ; public build_gui
integer, parameter :: dp = kind(1.d0), gw = 800, gh = 800, npts(1:2) = (/2,2/)
real(kind=dp) :: x(1:2)=0.d0, y(1:2)=0.d0, limits_x(1:2) = (/-2.d0,2.d0/), limits_y(1:2) = (/-2.d0,2.d0/)
logical :: run = .false., forward = .true.
integer(kind=7) :: win_handle
real(kind=dp) :: speed = 0.08d0, speed_not_running = 5.d0
contains
integer function build_gui()
integer, save :: iw
iw = winio@('%mn[Exit]&','exit')
iw = winio@('%hw&',win_handle)
iw = winio@('%fn[Tahoma]&')
call winop@('%pl[native, independent, x_array, n_graphs=2, width=3, smoothing=5]')
call winop@('%pl[colour=red, link=lines, pen_style=0, symbol=6, symbol_size=6]')
call winop@('%pl[colour=red, link=none, pen_style=1, symbol=0, symbol_size=6]') !To force display to show 4 quad.
call winop@('%pl[x_axis=@,y_axis=@,dx=1.0,dy=1.0,margin=100]')
iw = winio@('%bf%pl%`bf&',gw,gh,npts,x,y,limits_x,limits_y)
iw = winio@('%ts%ob[invisible]%^tt[Start]%2nl%^tt[Stop]%2nl%^tt[Slower]%2nl%^tt[Normal]%2nl%^tt[Faster]%2nl%^tt[Reverse]%cb&', &
0.8d0,start_cb,stop_cb,slow_cb,normal_cb,fast_cb,reverse_cb)
iw = winio@('%dl',speed_not_running,calc_cb)
build_gui = 2
end function build_gui
integer function start_cb()
integer i
run = .true. ; i = normal_cb() ; start_cb = 2
end function start_cb
integer function stop_cb()
integer i
run = .false. ; i = speed_not_running_cb() ; stop_cb = 2
end function stop_cb
integer function speed_not_running_cb()
call CHANGE_TIMER_INTERVAL@( win_handle, speed_not_running ) ; speed_not_running_cb = 2
end function speed_not_running_cb
integer function fast_cb()
speed = speed/2.d0 ; call CHANGE_TIMER_INTERVAL@( win_handle, speed ) ; fast_cb = 2
end function fast_cb
integer function normal_cb()
speed = 0.05d0 ; call CHANGE_TIMER_INTERVAL@( win_handle, speed ) ; normal_cb = 2
end function normal_cb
integer function slow_cb()
speed = speed*2.d0 ; call CHANGE_TIMER_INTERVAL@( win_handle, speed ) ; slow_cb = 2
end function slow_cb
integer function reverse_cb()
if (forward) then ; forward = .false. ; else if (.not. forward) then ; forward = .true. ; end if ; reverse_cb = 2
end function reverse_cb
integer function calc_cb()
real(kind=dp), save :: theta, d_theta
logical, save :: first = .true.
if (first) then ; d_theta = 4.d0*atan(1.0)/180.d0 ; theta = 0.d0 ; first = .false. ; end if
if (run) then
x(2) = cos(theta) ; y(2) = sin(theta) ; call simpleplot_redraw@()
if (forward) then ; theta = theta + d_theta
else ; theta = theta - d_theta ; end if
end if
calc_cb = 2
end function calc_cb
end module t
program main
use t, only : build_gui
i = build_gui()
end program main