%pl show coodinates at mouse

I have tried various ways of displaying coordinates interactively as the mouse moves across a %pl graph. After much experimenting, I have concluded that the method outlined in the code below is the most flexible and I shall be using this as the basis for new code.

I am sharing this demonstration code, in the hope that other %pl users may find this useful.

module p
use clrwin
implicit none
real*8 :: plx(5) = [0,1,2,3,4]
real*8 :: ply(5) = [0,1,4,9,16]
integer :: pl_handle = 1, gr_handle = 2, follow_mouse = 1
contains
integer function g()
integer :: iw, i
  i = create_graphics_region@(gr_handle,900,620)
  call winop@('%pl[y_min=0,y_max=16,x_min=0,x_max=4]')
  iw = winio@('%fn[Consolas]%ts%mn[Exit]%`rb[Follow mouse]%ff&',1.5d0,'exit',follow_mouse)
  iw = winio@('%`^pl[native,frame,etched,gridlines,x_array,full_mouse_input]&',900,620,5,plx,ply,pl_handle,pl_cb)
  iw = winio@('')
  g = 1
end function g
integer function pl_cb()
character(len=256) CLEARWIN_STRING@, callback_reason
logical, save :: active = .false., first = .true.
integer :: i, xpixel, ypixel
integer, save :: black, light_yellow
real*8 :: xx, yy, x(1), y(1)
character(len=12) xstr, ystr
character(len=36) str 
  if (active) then 
    pl_cb = 2
    return
  end if
  if (first) then ; black = rgb@(0,0,0) ; light_yellow = rgb@(255,255,204)
    first = .false.
  end if
  active = .true.
  callback_reason = clearwin_string@('CALLBACK_REASON')
  
  if ( CALLBACK_REASON .eq. 'PLOT_ADJUST' ) then
    call SET_PLOT_MODE@(1)
    call DRAW_SYMBOLSD@(plx,ply,5,6,5,rgb@(255,0,0))  ! Use this to draw the symbols at the data points
    call SET_PLOT_MODE@(0)
    i = copy_graphics_region@(gr_handle,0,0,900,620,pl_handle,0,0,900,620, 13369376)
     
  else if (callback_reason .eq. 'MOUSE_MOVE') then
     if (follow_mouse .eq. 1) then
       i = copy_graphics_region@(pl_handle,0,0,900,620,gr_handle,0,0,900,620, 13369376)
       xpixel = CLEARWIN_INFO@('GRAPHICS_MOUSE_X') ; ypixel = CLEARWIN_INFO@('GRAPHICS_MOUSE_Y')
       i = GET_PLOT_DATA@(xpixel, ypixel, xx, yy)
       if (xx .ge. minval(plx)) then    ! better to evalute this limits prior to the plot being generated
         if (xx .le. maxval(plx)) then
           if (yy .ge. minval(ply)) then
             if (yy .le. maxval(ply)) then
               write(xstr,'(EN12.3)') xx   ; write(ystr,'(EN12.3)') yy
               xstr = adjustl(xstr)        ; ystr = adjustl(ystr)
               write(str,'(a)') trim(xstr)//achar(13)//char(10)//trim(ystr)
               call size_in_pixels@(18,9)
               call draw_filled_rectangle@(xpixel+5,ypixel+5,xpixel+10+100,ypixel+45,light_yellow)
               call draw_characters@(str,xpixel+10,ypixel+30,black)
             end if
           end if
         end if
       end if
     end if
  end if
  active = .false.
  pl_cb = 1
end function pl_cb
end module p

program main
use p
implicit none
integer :: i
i = g()
end program main

Ken

Thank you for the helpful sample code. The required first line is 'module p'.

An alternative (and IMO less pleasing approach) that uses the status bar is illustrated here...

      WINAPP
      USE clrwin
      INTEGER,PARAMETER:: N=11
      INTEGER,PARAMETER:: M=2
      INTEGER,EXTERNAL::cb
      REAL*8 x(N),y(N)
      INTEGER(7) hwnd
      INTEGER i,sbparts(M)
      DATA sbparts /26,-1/
      COMMON hwnd
      DO i=1,N
        x(i)=0.1d0*(i-1)
        y(i)=x(i)*x(i) 
      ENDDO
      i=winio@('%ww%ca[ClearWin+]&')
      i=winio@('%bg[BTNFACE]&')
      CALL winop@('%pl[title=Quadratic]') 
      CALL winop@('%pl[width=2]')     
      CALL winop@('%pl[x_array]')     
      CALL winop@('%pl[link=curves]') 
      CALL winop@('%pl[symbol=9]')    
      CALL winop@('%pl[colour=red]')  
      CALL winop@('%pl[pen_style=2]') 
      CALL winop@('%pl[frame,gridlines]')
      CALL winop@('%pl[y_sigfigs=2]')
      CALL winop@('%pl[y_axis=y-data]')
      CALL winop@('%pl[x_max=1.00]')
      CALL winop@('%pl[dx=0.20]')
      CALL winop@('%pl[dy=0.20]')
      CALL winop@('%pl[y_max=1.0]')
      CALL winop@('%pl[full_mouse_input]')
      i=winio@('%`bg[white]&')
      i=winio@('%`*sb%lc&', M, sbparts, hwnd)
      i=winio@('%`bg&',RGB@(252,252,252))
      i=winio@('%pv%^pl',400,250,N,x,y,cb)
      END

      INTEGER FUNCTION cb()
      USE clrwin
      CHARACTER(80) status, reason
      INTEGER(7) hwnd
      COMMON hwnd
      REAL*8 x,y
      reason = clearwin_string@('CALLBACK_REASON')
      IF(reason == 'MOUSE_MOVE')THEN
        ix = clearwin_info@('GRAPHICS_MOUSE_X')
        iy = clearwin_info@('GRAPHICS_MOUSE_Y')
        i = get_plot_data@(ix,iy,x,y)
        status = ' '
        IF(x >= 0d0 .AND. y >= 0d0 .AND. x <= 1d0 .AND. y <= 1d0)THEN
          write(status,'(a,i3,a,i3,a)') ' Point(',ix,',',iy,')'
          CALL set_status_text@(hwnd,0,status)
          write(status,'(a,f6.2,a,f6.2,a)') ' Value(',x,',',y,')'
        ELSE
          CALL set_status_text@(hwnd,0,status)
        ENDIF          
        CALL set_status_text@(hwnd,1,status)
      ENDIF  
      cb = 2
      END

Paul's example reminded me that in general a %pv could be applied to %pl. Here is an updated version of the code in my first post that shows the modifications required for this more general case.

module p
use clrwin
implicit none
real*8 :: plx(5) = [0,1,2,3,4], ply(5) = [0,1,4,9,16]
integer :: screen_width, screen_depth, pl_handle = 1, gr_handle = 2, follow_mouse = 1, gw = 900, gh = 620  
contains
integer function g()
integer :: iw, i
  screen_width = CLEARWIN_INFO@('SCREEN_WIDTH') ; screen_depth = CLEARWIN_INFO@('SCREEN_DEPTH')
  i = create_graphics_region@(gr_handle,screen_width,screen_depth)   ! Sufficiently large graphics region
  call winop@('%pl[y_min=0,y_max=16,x_min=0,x_max=4]')
  iw = winio@('%ww%fn[Consolas]%ts%mn[Exit]%`rb[Follow mouse]%ff&',1.5d0,'exit',follow_mouse)
  iw = winio@('%pv%`^pl[native,frame,etched,gridlines,x_array,full_mouse_input]&',gw,gh,5,plx,ply,pl_handle,pl_cb)
  iw = winio@('')
  i = delete_graphics_region@(gr_handle)
  g = 1
end function g
integer function pl_cb()
character(len=256) CLEARWIN_STRING@, callback_reason
logical, save :: active = .false., first = .true.
integer :: i, xpixel, ypixel
integer, save :: black, light_yellow
real*8 :: xx, yy
character(len=12) xstr, ystr
character(len=36) str 
  if (active) then
    pl_cb = 2
    return
  end if
  if (first) then ; black = rgb@(0,0,0) ; light_yellow = rgb@(255,255,204)
    first = .false.
  end if
  active = .true.
  callback_reason = clearwin_string@('CALLBACK_REASON')
  
  if ( CALLBACK_REASON .eq. 'RESIZE') then
      gw = CLEARWIN_INFO@('GRAPHICS_WIDTH') ; gh = CLEARWIN_INFO@('GRAPHICS_DEPTH') ! Get updated size of %pl graphics window
      
  else if ( CALLBACK_REASON .eq. 'PLOT_ADJUST' ) then
    call SET_PLOT_MODE@(1)
    call DRAW_SYMBOLSD@(plx,ply,5,6,5,rgb@(255,0,0))  ! Use this to draw the symbols at the data points
    call SET_PLOT_MODE@(0)
    i = copy_graphics_region@(gr_handle,0,0,gw,gh,pl_handle,0,0,gw,gh, 13369376)
    
  else if (callback_reason .eq. 'MOUSE_MOVE') then
     if (follow_mouse .eq. 1) then
       i = copy_graphics_region@(pl_handle,0,0,gw,gh,gr_handle,0,0,gw,gh, 13369376)
       xpixel = CLEARWIN_INFO@('GRAPHICS_MOUSE_X') ; ypixel = CLEARWIN_INFO@('GRAPHICS_MOUSE_Y')
       i = GET_PLOT_DATA@(xpixel, ypixel, xx, yy)
       if (xx .ge. minval(plx)) then    ! better to evalute these limits prior to the plot being generated
         if (xx .le. maxval(plx)) then
           if (yy .ge. minval(ply)) then
             if (yy .le. maxval(ply)) then
               write(xstr,'(EN12.3)') xx   ; write(ystr,'(EN12.3)') yy
               xstr = adjustl(xstr)        ; ystr = adjustl(ystr)
               write(str,'(a)') trim(xstr)//achar(13)//char(10)//trim(ystr)
               call size_in_pixels@(18,9)
               call draw_filled_rectangle@(xpixel+5,ypixel+5,xpixel+10+100,ypixel+45,light_yellow)
               call draw_characters@(str,xpixel+10,ypixel+30,black)
             end if
           end if
         end if
       end if
     end if
  end if
  active = .false.
  pl_cb = 1
end function pl_cb
end module p

program main
use p
implicit none
integer :: i
i = g()
end program main