Winop@ / %pl[external]

Paul,

A second one for you to look at.

I have been developing an application, which occasionally fails at run time when updating a number of graphics regions via %pl[external].

In the program below reproduces this failure. There are two %gr regions and two buttons.

The callbacks associated with the buttons generate some random numbers and these are plotted on the %gr regions using %pl[external].

Button 1 always succeeds, button 2 *sometimes” fails, generating a runtime %pl error “too many colours” or crashing with an access violation.

The only difference between the callback functions is that for button 1 the %pl + options are passed as a single string to winio@, while with button 2 winop@ calls are used.

When the access violation occurs in update2_cb, it is always at the first call to winop@ for drawing the second graph, i.e. immediately after iw = select_graphics_object@(uid_gr2)

Ken

module test
use clrwin
implicit none
integer, parameter :: n = 10
real*8 :: x1(10), y1(10), x2(10), y2(10)
integer :: uid_gr1=1001, uid_gr2=1002, gw=600,gh=200

contains

subroutine iface
integer:: iw 
  iw = winio@('%mn[Exit]&','exit')
  iw = winio@('Press buttons sequentially in turn.%nl&')
  iw = winio@('Button 1 always succeeds. Button 2 sometimes fails.%nl&')
  iw = winio@('Button 2 failure may be a 'too many colours' or access violation.%nl&')
  iw = winio@('%2.1ob%`gr&',gw,gh,uid_gr1)
  iw = winio@('%ff%`gr%cb&',gw,gh,uid_gr2)
  iw = winio@('%^bt[Update 1]&',update1_cb)  ! Always works
  iw = winio@('%nl%^bt[Update 2]%cb', update2_cb)  ! Fails occasionally
end subroutine iface

integer function update1_cb()  
integer :: iw
  call new_data
  ! No WINOP@ calls
  iw = select_graphics_object@(uid_gr1)
  iw = winio@('%pl[n_graphs=1,x_array,symbol=6,colour=red,link=none,external]',n, x1,y1)
  
  iw = select_graphics_object@(uid_gr2)
  iw = winio@('%pl[n_graphs=1,x_array,symbol=6,colour=blue,link=none,external]',n, x2,y2)  
   
  update1_cb = 1
end function update1_cb

integer function update2_cb()  
integer :: iw
  call new_data 
  ! With WINOP@ calls
  iw = select_graphics_object@(uid_gr1)
  call winop@('%pl[n_graphs=1]')
  call winop@('%pl[x_array]')
  call winop@('%pl[symbol=6,colour=red,link=none]')
  iw = winio@('%pl[external]',n, x1,y1) 
  
  iw = select_graphics_object@(uid_gr2)
  call winop@('%pl[n_graphs=1]')        ! Access violation at this line.
  call winop@('%pl[x_array]')
  call winop@('%pl[symbol=6,colour=blue,link=none]')
  iw = winio@('%pl[external]',n, x2,y2)      
  update2_cb = 2
end function update2_cb

subroutine new_data
  call random_number(x1) ;   call random_number(y1)
  call random_number(x2) ;   call random_number(y2)
end subroutine new_data

end module test

program main
use test
call iface
end program main

Thanks Ken. I will see what I can do.

There is a fault in ClearWin+ that I have fixed but there is a second fault that is deep inside the GDI+ library. There is no apparent fault in ClearWin+.

I will see if I can find way around this.

At the moment I can find no explanation nor fix for the second failure that I mentioned. There appears to be something in the context that the GDI+ library cannot handle.

Thanks for looking at this Paul. I did wonder if I was pushing Clearwin+ beyond is intended capability.

The modified update2_cb in the code below, seems to work correctly, and I can easily incorporate this in the larger program, while retaining the pattern of the previous calls to winop@

module test
use clrwin
implicit none
integer, parameter :: n = 10
real*8 :: x1(10), y1(10), x2(10), y2(10)
integer :: uid_gr1=1001, uid_gr2=1002, gw=600,gh=200

contains
subroutine iface
integer:: iw 
  iw = winio@('%mn[Exit]&','exit')
  iw = winio@('Press buttons sequentially in turn.%nl&')
  iw = winio@('Button 2 no longer fails.%nl&')
  iw = winio@('%2.1ob%`gr&',gw,gh,uid_gr1)
  iw = winio@('%ff%`gr%cb&',gw,gh,uid_gr2)
  iw = winio@('%^bt[Update 1]&',update1_cb) 
  iw = winio@('%nl%^bt[Update 2]%cb', update2_cb)
end subroutine iface

integer function update1_cb()  
integer :: iw
  call new_data
  iw = select_graphics_object@(uid_gr1)
  iw = winio@('%pl[n_graphs=1,x_array,symbol=6,colour=red,link=none,external]',n, x1,y1) 
  iw = select_graphics_object@(uid_gr2)
  iw = winio@('%pl[n_graphs=1,x_array,symbol=6,colour=blue,link=none,external]',n, x2,y2)  
  update1_cb = 1
end function update1_cb

integer function update2_cb()  
integer :: iw
character(len=256):: pl_string
  call new_data 
  iw = select_graphics_object@(uid_gr1)
  pl_string = '' 
  call addtoplstring(pl_string,'%pl[n_graphs=1]')
  call addtoplstring(pl_string,'%pl[x_array]')
  call addtoplstring(pl_string,'%pl[symbol=6,colour=red,link=none]')
  call addtoplstring(pl_string,'%pl[external]')
  iw = winio@(pl_string,n, x1,y1) 
  
  iw = select_graphics_object@(uid_gr2)
  pl_string = '' 
  call addtoplstring(pl_string,'%pl[n_graphs=1]')
  call addtoplstring(pl_string,'%pl[x_array]')
  call addtoplstring(pl_string,'%pl[symbol=6,colour=blue,link=none]')
  call addtoplstring(pl_string,'%pl[external]')
  iw = winio@(pl_string,n, x2,y2)      
  update2_cb = 2
end function update2_cb

subroutine addtoplstring(pl_string, append_string)
implicit none
character(len=*), intent(inout) :: pl_string
character(len=*), intent(in) :: append_string
integer :: pos1, pos2, pos3
  if (len_trim(pl_string) .eq. 0) then
    pl_string = append_string ; return
  end if
  pos1 = scan(pl_string,']',back=.true.)
  pos2 = scan(append_string,'[',back=.false.)
  pos3 = scan(append_string,']',back=.true.)
  pl_string = pl_string(1:pos1-1)//','//append_string(pos2+1:pos3)
end subroutine addtoplstring

subroutine new_data
  call random_number(x1) ;   call random_number(y1)
  call random_number(x2) ;   call random_number(y2)
end subroutine new_data
end module test

program main
use test
call iface
end program main

This issue has now been completely fixed. The faults were in the ClearWin+ library relating to %pl[external]. The fixes will be in the next release of the DLLs.