![forums.silverfrost.com Forum Index](templates/subSilver/images/logo_phpBB.gif) |
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
Borrmann Manfred
Joined: 29 Mar 2007 Posts: 28
|
Posted: Wed Oct 19, 2016 10:29 am Post subject: Creating a svg file |
|
|
I have written a short program to create a SVG file using the externals 'open_svg@' and 'close_svg@'. I have attached it below.
As long i do not create a SVG file i can resize the graphics area and can perform left mouse button clicks in the graphics region as expected.
But when i clicked in the graphics region after having created the SVG file ("D:\test_02.svg") using the menuitem "Save as SVG" a run time error occured with the message "No graphics window open".
It seems to me that the drawing surface is destroyed by the creation process of the SVG file. Am i right or have i made a mistake in my short program? Thanks in advance for your assistance, Paul.
[code:1:7e73483ae2]!===================================================================================================
WINAPP
!===================================================================================================
module dwdata
!===================================================================================================
integer*4, parameter :: npoints = 501
real*8, dimension(npoints) :: real_x, pixel_x
real*8, dimension(npoints) :: real_y, pixel_y
integer :: xres = 480
integer :: yres = 580
integer*4 :: mydc = 10
end module dwdata
!===================================================================================================
program svg_test
!===================================================================================================
use dwdata
implicit none
integer :: a
external plot_graph, store_graph_as_svg
a = winio@('%ww[no_border]&')
a = winio@('%ca[SVG Test]&')
a = winio@('%mn[Save as SVG]&', store_graph_as_svg)
a = winio@('%pv%^`gr[color=#E6E6D6, user_resize, rgb_colours]', xres, yres, mydc, plot_graph)
end
!===================================================================================================
integer function store_graph_as_svg()
!===================================================================================================
use dwdata, only : xres, yres
implicit none
C_EXTERNAL OPEN_SVG@ '__open_svg' (INSTRING,VAL,VAL):INTEGER*4
C_EXTERNAL CLOSE_SVG@ '__close_svg' (VAL):INTEGER*4
integer*4 :: ihandle
store_graph_as_svg = 2
ihandle = OPEN_SVG@('D:\test_02.svg', xres, yres)
call graph
ihandle = CLOSE_SVG@(0)
if (ihandle == 0) then
endif
end
!===================================================================================================
integer function plot_graph()
!===================================================================================================
use dwdata, only : xres, yres
implicit none
integer*4 :: clearwin_info@
character(len = 20) :: clearwin_string@
plot_graph = 2
if (clearwin_string@('call_back_reason') == 'RESIZE') then
xres = clearwin_info@ ('graphics_width')
yres = clearwin_info@ ('graphics_depth')
call graph
elseif (clearwin_string@('call_back_reason') == 'MOUSE_LEFT_CLICK') then
call show_mouse_coordinates
endif
end
!===================================================================================================
subroutine graph
!===================================================================================================
use dwdata
implicit none
C_EXTERNAL DRAW_POLYLINED@ '__win_polyline_d'(REF,REF,VAL,VAL)
C_EXTERNAL SET |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
Borrmann Manfred
Joined: 29 Mar 2007 Posts: 28
|
Posted: Wed Oct 19, 2016 10:39 am Post subject: |
|
|
Not all of the program is visible. I have removed the empty and unneeded lines. Here come the code again.
[code:1:226c6db4df]
WINAPP
module dwdata
integer*4, parameter :: npoints = 501
real*8, dimension(npoints) :: real_x, pixel_x
real*8, dimension(npoints) :: real_y, pixel_y
integer :: xres = 480
integer :: yres = 580
integer*4 :: mydc = 10
end module dwdata
program svg_test
use dwdata
implicit none
integer :: a
external plot_graph, store_graph_as_svg
a = winio@('%ww[no_border]&')
a = winio@('%ca[SVG Test]&')
a = winio@('%mn[Save as SVG]&', store_graph_as_svg)
a = winio@('%pv%^`gr[color=#E6E6D6, user_resize, rgb_colours]', xres, yres, mydc, plot_graph)
end
integer function store_graph_as_svg()
use dwdata, only : xres, yres
implicit none
C_EXTERNAL OPEN_SVG@ '__open_svg' (INSTRING,VAL,VAL):INTEGER*4
C_EXTERNAL CLOSE_SVG@ '__close_svg' (VAL):INTEGER*4
integer*4 :: ihandle
store_graph_as_svg = 2
ihandle = OPEN_SVG@('D:\test_02.svg', xres, yres)
call graph
ihandle = CLOSE_SVG@(0)
if (ihandle == 0) then
endif
end
integer function plot_graph()
use dwdata, only : xres, yres
implicit none
integer*4 :: clearwin_info@
character(len = 20) :: clearwin_string@
plot_graph = 2
if (clearwin_string@('call_back_reason') == 'RESIZE') then
xres = clearwin_info@ ('graphics_width')
yres = clearwin_info@ ('graphics_depth')
call graph
elseif (clearwin_string@('call_back_reason') == 'MOUSE_LEFT_CLICK') then
call show_mouse_coordinates
endif
end
subroutine graph
use dwdata
implicit none
C_EXTERNAL DRAW_POLYLINED@ '__win_polyline_d'(REF,REF,VAL,VAL)
C_EXTERNAL SET_LINE_WIDTH@ '__set_line_width' (VAL)
C_EXTERNAL SET_LINE_STYLE@ '__set_line_style' (VAL)
C_EXTERNAL SET_SMOOTHING_MODE@ '__set_smoothing_mode'(VAL):integer
C_EXTERNAL SELECT_GRAPHICS_OBJECT@ '__select_graphics_object' (VAL) :INTEGER*4
integer*4 :: ii, RGB@, navy, smooth
call calculate_pixel_coordinates
navy = RGB@(0,0,200)
ii = select_graphics_object@ (mydc)
if (ii == 0) then
endif
smooth = set_smoothing_mode@(5)
if (smooth == 0) then
endif
call set_line_style@(0)
call set_line_width@(2)
call draw_polylined@ (pixel_x, pixel_y, npoints, navy)
end subroutine graph
subroutine show_mouse_coordinates
use dwdata, only : mydc
implicit none
C_EXTERNAL SELECT_GRAPHICS_OBJECT@ '__select_graphics_object' (VAL) :INTEGER*4
C_EXTERNAL DRAW_FILLED_ELLIPSE@ '__win_fill_ellipse_l' (VAL,VAL,VAL,VAL,VAL)
integer*4 :: ii, mxw, myw, rgb@, clearwin_info@
ii = select_graphics_object@ (mydc)
if (ii == 0) then
endif
mxw = clearwin_info@ ('graphics_mouse_x')
myw = clearwin_info@ ('graphics_mouse_y')
call draw_filled_ellipse@(mxw, myw, 6, 6, rgb@(100, 149, 237))
return
end
subroutine calculate_pixel_coordinates
use dwdata
implicit none
integer*4 :: i
real*8 :: xmin, xmax, ymin, ymax, xscale, yscale, xrange, yrange, xorg, yorg
real_x(1) = 0.d0
real_x(npoints) = 7.d0
do |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
Borrmann Manfred
Joined: 29 Mar 2007 Posts: 28
|
Posted: Wed Oct 19, 2016 10:42 am Post subject: |
|
|
Subroutine "calculate_pixel_cordinates" is not complete. Here comes the complete code of this subroutine. Code: |
subroutine calculate_pixel_coordinates
use dwdata
implicit none
integer*4 :: i
real*8 :: xmin, xmax, ymin, ymax, xscale, yscale, xrange, yrange, xorg, yorg
real_x(1) = 0.d0
real_x(npoints) = 7.d0
do i = 2, npoints-1
real_x(i) = real_x(i-1) + (real_x(npoints) - real_x(1)) / (npoints - 1)
enddo
do i = 1, npoints
real_y(i) = exp(-real_x(i)) * sin(real_x(i)*10.d0)
enddo
xrange = 0.8d0 * xres
yrange = 0.8d0 * yres
xorg = 0.5d0 * (xres - xrange)
yorg = 0.5d0 * (yres - yrange)
xmin = 0.d0
xmax = real_x(npoints)
xscale = xrange / (xmax - xmin)
ymin = minval(real_y)
ymax = maxval(real_y)
if (ymin < 0.d0) then
ymax = max(dabs(ymax), dabs(ymin))
ymin =-ymax
else
ymin = 0.d0
endif
yscale = yrange / (ymax - ymin)
do i = 1, npoints
pixel_x(i) = 0.5d0 + xorg + (real_x(i) - xmin) * xscale
pixel_y(i) = yrange - 1 + yorg - (0.5d0 + (real_y(i) - ymin)*yscale)
enddo
return
end
|
|
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7928 Location: Salford, UK
|
Posted: Wed Oct 19, 2016 4:20 pm Post subject: |
|
|
Borrmann
There are two parts to fixing this.
1) It is possible that this usage was not envisaged in the design. However, it can be made to work and a link to a new set of DLLs with this fix is provided below.
2) The calls to select_graphics_object@ must be removed because they are not needed in this context and will cause the program to fail.
The following download should be used with caution after backing up your existing DLLs. The download includes a txt file giving details of a new "native" %pl that is available here for beta testing.
https://www.dropbox.com/s/2p4n4bjt8bfo7tv/newDlls10.zip?dl=0 |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
Borrmann Manfred
Joined: 29 Mar 2007 Posts: 28
|
Posted: Wed Oct 19, 2016 5:21 pm Post subject: |
|
|
Paul,
many thanks for the very fast help.
The short program is an extract from a very large code where i do use several drawing surfaces also at the same time. To address plotting output to the right drawing surface makes the use of "select graphics object@" necessary. I hope this will make no difficulties later on when writing svg files. |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7928 Location: Salford, UK
|
Posted: Wed Oct 19, 2016 5:58 pm Post subject: |
|
|
Perhaps the call to select_graphics_object@ should be made immediately before the call to open_svg@. |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
simon
Joined: 05 Jul 2006 Posts: 268
|
Posted: Fri Mar 31, 2017 8:15 pm Post subject: |
|
|
open_svg1@ is mentioned in cwplus.enh, but I have been unable to access it from clrwin. Similarly, none of the SVG functions appear to be available in clrwin$. Are these accessible, and is there any more information on what open_svg1@ does that open_svg@ does not? |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7928 Location: Salford, UK
|
Posted: Sat Apr 01, 2017 7:07 am Post subject: |
|
|
Here is the interface that is missing from clearwin.ins...
Code: | C_EXTERNAL OPEN_SVG1@ '__open_svg1'(INSTRING,VAL,VAL,VAL):INTEGER*4
|
For third party compilers the ISO_C_BINDING interfaces can be constructed by following the pattern in "\Program Files (x86)\Silverfrost\FTN95\source64\clrwin.f95".
For example record_sound_file$ passes a string together with integer*4 values and returns an integer*4. |
|
Back to top |
|
![](templates/subSilver/images/spacer.gif) |
|
|
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
|