Silverfrost Forums

Welcome to our forums

Dynamic backgrounds, font colors and warning signs

22 Jul 2020 11:53 #26075

Thanks for that Paul. I was preparing a simple example of where I thought this might be useful, in interactive vector/phasor diagrams before I saw your response.

winapp
module test_step
use clrwin
implicit none
integer,       parameter :: dp = kind(1.d0), cirnpts =361
real(kind=dp), parameter :: pi = 4.d0*atan(1.d0)
real(kind=dp), parameter :: deg2rad = pi/180.d0
real(kind=dp), parameter :: eps = epsilon(1.d0)
integer :: pl_npts(4) = [cirnpts,2,1,2]
real(kind=dp) :: mag=0.5d0, mag_max=1.5d0, mag_min=-1.5d0, mag_step=0.1d0
real(kind=dp) :: a =0.d0, a_max=360.d0, a_min=-360.d0, a_step=0.2d0
real(kind=dp) :: pl_x1(2) = [0.d0, 0.5d0], pl_y1(2) = [0.d0,eps]
real(kind=dp) :: pl_x0(1:cirnpts), pl_y0(1:cirnpts)
real(kind=dp) :: pl_xe(2) = [-1.d0,1.d0], pl_ye(2) = [-1.d0,1.d0]
contains
   integer function gui_cb()
   integer i
   integer, save :: iw
   real(kind=dp) theta
     do i = 1, cirnpts, 1
       theta = deg2rad*dble(i) ; pl_x0(i) = cos(theta) ; pl_y0(i) = sin(theta)
     end do
     iw = winio@('%mn[Exit]&', 'exit')
     iw = winio@('%fn[Consolas]&')
     iw = winio@('%ts&',1.2d0)
     iw = winio@('%2.1ob[scored]&')
     iw = winio@('Magnitude [pu]%~fl%df%ta%6^rf&', mag_min, mag_max, mag_step, mag, update_cb)
     iw = winio@('%nlAngle [deg]%~fl%df%2ta%6^rf%cb&', a_min, a_max, a_step, a, update_cb)
     call winop@('%pl[native,independent,x_array,n_graphs=4]')
     call winop@('%pl[smoothing=4,margin=60,width=3,x-axis=@,y-axis=@]')
     call winop@('%pl[colour=grey, link=lines,symbol=0,symbol_size=4,pen_style=1]')
     call winop@('%pl[colour=black,link=lines,symbol=0,symbol_size=4,pen_style=0]')
     call winop@('%pl[colour=black,link=lines,symbol=6,symbol_size=4,pen_style=0]')
     call winop@('%pl[colour=white,link=none, symbol=10,symbol_size=1,pen_style=0]')
     iw = winio@('%ts&',2.d0)
     iw = winio@('%pl&',600,600,pl_npts,pl_x0,pl_y0, &
                                        pl_x1,pl_y1, &
                                        pl_x1(2),pl_y1(2), &
                                        pl_xe, pl_ye)
     iw = winio@('%cb')
     gui_cb = 2
   end function gui_cb

   integer function update_cb()
   real(kind=dp) theta, xmax, xmin, ymax, ymin
     theta    = deg2rad*a
     pl_x1(2) = mag*cos(theta) ; pl_y1(2) = mag*sin(theta)
     if (abs(pl_x1(2)).lt. eps) pl_x1(2) = eps
     if (abs(pl_y1(2)).lt. eps) pl_y1(2) = eps
     xmax = max(1.d0,maxval(pl_x1))
     xmin = min(-1.d0,minval(pl_x1))
     ymax = max(1.d0,maxval(pl_y1))
     ymin = min(-1.d0,minval(pl_y1))
     pl_xe(1) = max(abs(xmax),abs(xmin),abs(ymax),abs(ymin)) ; pl_xe(2) = - pl_xe(1)
     pl_ye(1) = pl_xe(1) ; pl_ye(2) = - pl_ye(1)
     call simpleplot_redraw@()
     update_cb = 2
   end function update_cb
end module test_step

program main
use test_step, only : gui_cb
implicit none
integer i
  i = gui_cb()
end program main
22 Jul 2020 8:16 #26079

Quoted from PaulLaidler By the way, in response to your earlier comment, %pl now has the option [file=fileName] as an alternative to [params]. For example:

CALL winop@('%pl[file=plot.dat]')

Waiting to test this great addition to native %PL which will make it so easy and pleasant to use!

21 Nov 2020 3:30 #26627

DanRRight

In response to your request concerning changing %rf data under program control. a new routine CONTROL_UPDATE@ has been added for a future release of the DLLs (after v8.70).

Here is an outline description and example...

CONTROL_UPDATE@ behaves exactly like WINDOW_UPDATE@ but if the variable relates to %rd or %rf then any limits (%il or %fl) are not applied and any out-of-range alert icon (%~il or %~fl) is removed.

winapp
program main
integer iw,winio@
double precision x
common x
integer,external::cb
x = 442.0d0
iw = winio@('%~fl&',1d0,256d0)
iw = winio@('Input:  %12rf&',x)
iw = winio@('  Result: %`12rf&',x)
iw = winio@('%ff&')
iw = winio@('%ff%nl%cn%^bt[Change]', cb)
end program

integer function cb()
include <clearwin.ins>
double precision x
common x
x = 400.0d0
call control_update@(x)
cb = 2
end function
22 Nov 2020 4:43 #26628

Thanks, Paul.

Please login to reply.