 |
forums.silverfrost.com
Welcome to the Silverfrost forums
|
| View previous topic :: View next topic |
| Author |
Message |
Kenneth_Smith
Joined: 18 May 2012
Posts: 799
Location: Hamilton, Lanarkshire, Scotland.
|
 Posted: Wed Oct 16, 2024 11:49 am Post subject: %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.
| Code: |
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 |
Last edited by Kenneth_Smith on Wed Oct 16, 2024 1:43 pm; edited 1 time in total |
|
| Back to top |
|
 |
PaulLaidler
Site Admin
Joined: 21 Feb 2005
Posts: 8177
Location: Salford, UK
|
| Posted: Wed Oct 16, 2024 1:08 pm Post subject: |
|
|
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...
| Code: | 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
|
|
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 799
Location: Hamilton, Lanarkshire, Scotland.
|
| Posted: Wed Oct 16, 2024 3:25 pm Post subject: |
|
|
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.
| Code: |
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 |
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
