The discussion about sorting in another thread reminded me of the short demo program below which was sitting on my desktop.
When a %pl is embedded in a window, if it is desired to continually update the plot, for example to show the progress of a simulation, this can lead to “flicker” of the display.
One way to circumvent this is demonstrated in the program below. Replace the %pl with a %gr in the window which is to display the progress of your calculation. Use %pl[external] to plot the intermediate results to an memory resident graphics region created using create_graphics_region@, then copy from that graphics region back to the %gr that is displayed in your output window.
The sample program is not optimised, as you don’t need to create and delete the memory resident graphics region each time the function plot() is called, but the additional logic obscures the simplicity of what the sample program is illustrating.
In the sample program, a cocktail sort on a small random array is animated with the display updated every time a swap of two variables occurs, without any discernible flicker of the display.
module demo
use clrwin
implicit none
real*8 :: arr(50)
integer :: uid_gr = 1000, uid_pl = 2000, gw = 900, gh = 500
contains
integer function sort()
integer :: iw, i
i = new_data() ! New data
iw = winio@('%mn[Exit]&','exit')
iw = winio@('%^tt[Sort]%^tt[New data]&',cocktail_cb,new_data)
iw = winio@('%bg%nl%`gr&', rgb@(220,220,220), gw, gh, uid_gr)
iw = winio@('%sc',plot) !Call plot after window is initially formed
sort = 2
end function sort
integer function cocktail_cb()
call set_cursor_waiting@(1) ; call cocktailsort(arr) ; cocktail_cb = 2
call set_cursor_waiting@(0)
end function cocktail_cb
integer function new_data()
logical, save :: first = .true.
integer :: i
call random_number(arr)
if ( .not. first ) i = plot()
first = .false. ; new_data = 2
end function new_data
integer function plot()
integer :: i, iw
i = create_graphics_region@(uid_pl, gw, gh )
i = select_graphics_region@(uid_pl)
iw = winio@('%pl[native,frame,gridlines,etched,width=3,link=columns,colour=blue,'//&
'dx=5,y_max=1,dy=0.5,x-axis=@,y-axis=@,external]',&
size(arr,kind=3),0.d0,1.d0,arr)
i = copy_graphics_region@( uid_gr, 1, 1, gw, gh, uid_pl, 1, 1, gw, gh, 13369376 )
i = delete_graphics_region@(uid_pl)
call sleep1@(0.01)
plot = 2
end function plot
subroutine cocktailsort(arr)
real*8, intent(inout) :: arr(:)
integer :: startp, endp, i, k, n
real*8 :: temp
logical :: swapped
n = size(arr) ; startp = 1 ; endp = n ; swapped = .true.
do while (swapped)
call temporary_yield@()
swapped = .false.
do i = startp, endp - 1, +1
if (arr(i) > arr(i + 1)) then
temp = arr(i) ; arr(i) = arr(i + 1) ; arr(i + 1) = temp ; swapped = .true.
k = plot() ! update plot after swap
end if
end do
if (.not. swapped) exit
endp = endp - 1 ; swapped = .false.
do i = endp, startp + 1, -1
if (arr(i - 1) > arr(i)) then
temp = arr(i) ; arr(i) = arr(i - 1) ; arr(i - 1) = temp ; swapped = .true.
k = plot() ! update plot after swap
end if
end do
startp = startp + 1
end do
end subroutine cocktailsort
end module demo
program p
use demo
i = sort()
end program p