Topic: Mouse event

Hi Jeff
A procedure to move a cross on screen (to draw a cross on the screen) causes a problem.
It's a short procedure as follows:
Starting with registering the mouse  next is call loop the rest is done by the handle_click call back routines. There also  stop idle is called so that clearmouseclick is executed. See below

What happens:
After return to the current window menu every mouse click else where on the graphic screen results in a segmentation fault! Of course these mouse clicks without any target makes no sense but could happen.
Only after closing that current window and restarting it again this fault does not happen again.
I made a small test program with only the routine move cross and the same happened!

I understood that  clearmouseclick clears the events. But my impression is that the mouse event is still (a bit) active until the current graphic window is closed too. The Windows controlled mouse is working but also a mouse click outside the Window menu gives the wrong response resulting in a crash. 
What can I do to solve this problem? Do I have to run the mouse handling in a separate thread?
Regards, Klaus

SUBROUTINE MOVE_CROSS (x_cross, y_cross, finish)  ! exit when finished
USE AppGraphics
Use W_ords_to_pixels
Logical finish
DOUBLE PRECISION   x_cross, y_cross
   finish=.false.
!    __________________________________________________________________
    Call registermousehandler (MOUSE_LB_DOWN, handle_click)
    Call registermousehandler (MOUSE_RB_DOWN, handle_clickrb)

Call loop ! the corresponding world ordinates related to mouse x and y are defined in handleclick

call clearmouseclick(MOUSE_LB_DOWN)
call clearmouseclick(MOUSE_RB_DOWN)
contains

subroutine handle_click(x, y)
    integer::x, y 
    logical Clicked
print *,'move cross: handle click started for LB_down'
Clicked = ismouseclick (MOUSE_LB_DOWN)
If(clicked)then !          x+y > 0)then
    call line (x-20,y,x+20,y)
    Call line (x,y-20,x,y+20)
    x_cross = dble(real(x -x_offset))/scale_x ;  y_cross  = ywtot- dble(real(y+y_offset))/scale_y
    Print*,'move cross: handle click got ordinates by LB_down',x,y
    Call stopidle ( )
end if
end subroutine handle_click

subroutine handle_clickrb(x,y)
    integer::x, y 
    logical Clicked
print *,'move cross stops: handle click for RB_down',x,y
    Clicked = ismouseclick (MOUSE_RB_DOWN)
If(clicked)then
    Finish = .true.
     Call stopidle ( );return
    Print*,'handle click move cross finished'
end if
end subroutine handle_clickrb
End SUBROUTINE MOVE_CROSS

Re: Mouse event

Klaus,

I'll have to experiment with this problem a bit. Could you explain "After return to the current window menu..." a bit more?  Are you saying after the routine returns, or after a separate window is closed, returning to a main window?

Jeff Armstrong
Approximatrix, LLC

Re: Mouse event

Jeff,
Here more about this mouse matter:
“After return to the current window menu” means that a graphic window  is available to show the mouse movements by a cross  from where MOVE_CROSS is called. After the right mouse button is pressed the control returns to the existing graphic window.

See my simple test program written as a subroutine added to my dialog tests:

subroutine child_window_test
use appgraphics
logical finish
DOUBLE PRECISION   x_move, y_move
    initW = getcurrentwindow()  ! keep the main window in memory for return to it
    dlg_screen = initwindow(1000, 1000, title = "mouse test", closeflag = .false.)
    call setcolor(Black)
    Call setbkcolor(white)
    Call settextstyle(MONOSPACE_FONT, horiz_dir,16)
    Call clearviewport()


Call setcolor(black)
CALL OUTTEXTxy(1,1,'Pick midpoint and press left button - right button: return')

Do while (.not. finish)
! 1-- Click a point on a part, define the coordinates of the point
CALL MOVE_CROSS(x_move,y_move,finish)! Move the mouse to a point on the screen and press left button
if (finish)then
    Print*,'the mouse function is finished'
    Else
    Print*,'Pick next point'
end if
end do
   
call delay (1000)

end subroutine child_window_test



After "finish" (right button in Move_cross) a mouse button hit causes the crash.
By the way: I am still very happy with the use of SF and your fast reply on all the questions!
Regards Klaus

Re: Mouse event

Klaus,

This was  a tricky one!  The reason you're getting the crash, I believe, is that your mouse handlers are still attempting to be called after the right-click leaves your monitoring loop.  Normally, this behaivor isn't problematic, but your mouse handlers are "contain"ed routines rather than globally visible routines.  When idling via "loop()" in MOVE_CROSS, the  variables x_cross, y_cross, and finish are all defined and within scope.  When you exit MOVE_CROSS, though, those variables cease to be defined.  Furthermore, both handle_click and handle_clickrb are no longer valid, visible subroutines.

When you move outside of MOVE_CROSS back into child_window_test, the window will continue passing mouse events to the no-longer-visible handle_click and handle_clickrb subroutines that attempt to access nonexistent variables (since they only existed in MOVE_CROSS's scope).   This behavior causes the crash.

One problem with AppGraphics right now is that the Fortran interface doesn't provide an easy way to disconnect mouse handlers.  The process is easy in C, though.   That call should be added to the Fortran interface.

One fix, though, is to make the mouse handlers and the variables they access more "visible" rather than "contain"ed within a subroutine.   I did this using a module:

module cross_sup

DOUBLE PRECISION::x_cross, y_cross
Logical mfinish

contains

SUBROUTINE MOVE_CROSS (finish)
USE AppGraphics
implicit none
Logical finish

    finish=.false. 

    Call registermousehandler (MOUSE_LB_DOWN, handle_click)
    Call registermousehandler (MOUSE_RB_DOWN, handle_clickrb)

    Call loop()
    
    call clearmouseclick(MOUSE_LB_DOWN)
    call clearmouseclick(MOUSE_RB_DOWN)
    
    finish = mfinish

    
End SUBROUTINE MOVE_CROSS


subroutine handle_click(x, y)
use appgraphics
implicit none
    integer::x,y
    logical::Clicked
    
    integer::x_offset=10, y_offset=10
    real::scale_x=1.0, scale_y=1.0, ywtot=1.0
    
    print *,'move cross: handle click started for LB_down'
    Clicked = ismouseclick (MOUSE_LB_DOWN)
    If(clicked) then
        call line (x-20,y,x+20,y)
        Call line (x,y-20,x,y+20)
        x_cross = dble(real(x -x_offset))/scale_x
        y_cross = ywtot-dble(real(y+y_offset))/scale_y
        Print*,'move cross: handle click got ordinates by LB_down',x,y
         
        call clearmouseclick(MOUSE_LB_DOWN)
        
        
        
        Call stopidle ( )
    end if
end subroutine handle_click

subroutine handle_clickrb(x,y)
use appgraphics
implicit none
    integer::x,y
    logical::Clicked
    print *,'move cross stops: handle click for RB_down',x,y
    Clicked = ismouseclick (MOUSE_RB_DOWN)
    If(clicked)then
        mFinish = .true.
        Call stopidle ( )
        return
        Print*,'handle click move cross finished' 
        call clearmouseclick(MOUSE_RB_DOWN)
    END If
end subroutine handle_clickrb

end module cross_sup

Now if the mouse handlers are still triggered, they are still visible since they are module procedures and they access only module variables.  I may have made a few additional variable declarations just to get things building and running, but I think you'll see what I did.

I will look into adding an "unregister" call for mouse events  since you should be able to disconnect them.  That would have avoided this whole issue.

Jeff Armstrong
Approximatrix, LLC

Re: Mouse event

Thanks Jeff for your investigation and explanation.
Now I understand what happens and i try first your module solution.
Klaus

Re: Mouse event

Jeff,
The mouse_move procedure using module cross_sup are working in my application
with a small addition. I added directly after start of the handle callbacks
If (mfinish) return
to avoid doing unwanted things in the handlers
Next there are more mouse actions planned like a drag mouse which i hope to solve similar
Klaus

Re: Mouse event

Klaus,

The next version of AppGraphics will include calls to remove mouse handlers.  It's easy to do in C right now, but impossible using only the Fortran interface.  They should have been present in the library.

Jeff Armstrong
Approximatrix, LLC

Re: Mouse event

Thanks Jeff,
I forgot to mention that also  mfinish =  finish has to be after finish = .false. starting mouse_move.
A remove mouse handlers should be very helpful and I think also that too much active handlers might cause other problems
Klaus