forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Clearwin+ getting started tutorial

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
jjgermis



Joined: 21 Jun 2006
Posts: 404
Location: Nürnberg, Germany

PostPosted: Sun Jan 10, 2010 6:26 pm    Post subject: Clearwin+ getting started tutorial Reply with quote

I adapted the Clearwin+ tutorial given in the online documentation and thereby learned quite a lot. Remarkable how quick one can develop a good looking program with Clearwin! This hopefully will convince some colleagues to change their mind about our "old" DOS-box programs (must be because nowadays the only thing that matters is how it looks and feels). The example code (cut, past, compile and run) is given below.

As usual I have a few questions. If it is not a problem I would like to discuss the questions separate. The first question:
It is often recommended that COMMON blocks should be avoided. Therefore I defined a module mod_factoriser. Both variables are initilized in the main part. How can I be sure that the variables still have the same value in the call-back function as in the main program? Does SAVE this?

Code:
!  Modified Clearwin+ example taken from online documentation
   module mod_factoriser
   INTEGER ans,number
   CHARACTER(len=50) str
   SAVE
   end module mod_factoriser

   WINAPP
   USE mod_factoriser
   IMPLICIT NONE
   INCLUDE <windows.ins>
   EXTERNAL factoriser,about,cb_dummy
   number=1
   str=' '
   ans=winio@('%ca[Number Factoriser]&')
   ans=winio@('%ww[casts_shadow]&')
   ans=winio@('%bg[gray]&')
   ans=winio@('%mn[&File[&Open,E&xit,|,Extra]]&',&
      &cb_dummy,'EXIT',cb_dummy)
   ans=winio@('%mn[&Help[&About Number Factoriser]]&',&
      &about)
   ans=winio@('%il&',1,2147483647)                      ! integer limits
   ans=winio@('Number to be factorised: %rd&',number)
   ans=winio@('%ta&')                                   ! tab
   ans=winio@('     %`^bt[Fac&torise]&',factoriser)     ! button
   ans=winio@('%3nl&')                                  ! insert 3 lines
   ans=winio@('%`ob[named_c][Result]&')                 ! open a box
   ans=winio@('%42st%cb',str)
   END

   INTEGER FUNCTION factoriser()
   USE mod_factoriser
   INTEGER n,k
   CHARACTER*50 val
   WRITE(val,'(i11)')number
   CALL trim@(val)
   str='The factors of '//val(1:LENG(val))//' are: 1'
   n=number
   DO k=2,n
     IF((n/k)*k.EQ.n)THEN
       WRITE(val,'(i11)')k
       CALL trim@(val)
       CALL append_string@(str,', '//val)
       n=n/k
     ENDIF
   END DO
   CALL window_update@(str)
   factoriser=1
   END

   INTEGER FUNCTION about()
   IMPLICIT NONE
   INCLUDE <windows.ins>
   INTEGER ans
   ans=winio@('%ca[About Number Factoriser]&')
   ans=winio@('%bg[blue]&')
   ans=winio@('%fn[Times New Roman]%ts%bf%cnTutorial&',2.0D0)
   ans=winio@('%ts%4nl&',1.0D0)
   ans=winio@('%cnProgram written to demonstrate%2nl&')
   ans=winio@('%ts%tc%cn%bfClearWin+&',1.5D0,RGB@(255,0,0))
   ans=winio@('%tc%sf%2nl%cnby&',-1)
   ans=winio@('%2nl%cnSilverfrost Software&')
   ans=winio@('%2nl%cn%9`bt[OK]')
   about=1
   END

   INTEGER FUNCTION cb_dummy()
   IMPLICIT NONE
   cb_dummy=1
   END

!  use if an icon.ico is available otherwise comment out
   resources
   factoriser icon icon.ico
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Sun Jan 10, 2010 7:17 pm    Post subject: Reply with quote

Many users still like Fortran-77 style programming, and find nothing wrong with COMMON - some of the arguments in favour of Fortran-90 style programming look theological to me.

I'm not sure that I would start programming with ClearWin, and embark on learning a Fortran-90 style of programming at the same time, and my advice to you is to stick to the Fortran style you are comfortable with until you have mastered Clearwin.

Eddie
Back to top
View user's profile Send private message
JohnHorspool



Joined: 26 Sep 2005
Posts: 270
Location: Gloucestershire UK

PostPosted: Sun Jan 10, 2010 10:19 pm    Post subject: Reply with quote

I use COMMON all the time. I question the reasons and arguments I have seen for using modules instead of common. I fail to see their validity.

Besides one of the really great things about Silverfrost FTN95 is the Virtual Common facility, just try replicating that using modules!
Back to top
View user's profile Send private message Visit poster's website
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Mon Jan 11, 2010 8:01 am    Post subject: Reply with quote

I've become a convert of modules. Although they are very similar to common/include, they do have the advantage of only one declaration of each variable, rather than the declaration and common list.

I've adopted a style, with a module of size parameters, being used in other modules for variable declarations. I must admit I have not got to using "CONTAINS" as yet.

I would expect that using ALOCATABLE in a module would be fairly similar to VC.

I have toyed with having a module of INTERFACE definitions, but have not got that working well as yet.

Again, it all depends on the programming style you are use to.

As to the initial post, I would recommend getting my fortran programming under control before venturing into clearwin+

John
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Jan 11, 2010 10:54 am    Post subject: Reply with quote

Going back to the original post, the SAVE attribute has no effect in this context.

Another approach to make the callback function(s) internal to the module via a CONTAINS statement.
Back to top
View user's profile Send private message AIM Address
jjgermis



Joined: 21 Jun 2006
Posts: 404
Location: Nürnberg, Germany

PostPosted: Mon Jan 11, 2010 3:12 pm    Post subject: Reply with quote

Avoiding COMMON blocks are indeed almost impossible. A big part of our code was developed even before Fortran 77. One soon realise that porting it takes a huge amount of time and in the end it does the same. To avoid the duplication of the COMMON blocks is to make a single file with the variables and then make use of the INCLUDE function. In doing so the code looks much better.

From the FTN95 online documentation the virtual common souds like a logical concept. Understanding it is another thing. Without an example and without some problem which lead to the use it, it is not that easy to understand (for myself anyway). From the comment by Paul on the use of CONTAINS I have changed the module as given below.

My next question refers to the use of EXTERNAL. In the Clearwin tutorial the call-back functions should return an integer value and should be declared as EXTERNAL. From the definition I would expect something that is really external. This is however not the case. Why not only define the call-back functions as INTEGER?

While searching the web for Clearwin examples I found the following interessting and valuable links:
1.) http://www.polyhedron.com/windows-format0html and
2.) http://www.iucr.org/resources/commissions/crystallographic-computing/newsletters/1/using-the-clearwin-lilbrary.
The application I am aiming at is actually straight forward. The user has to enter some model parameter. Upon clicking the calculate button the results must be displayed in the results window. The call-back function was actually done many years ago Smile I believe that in many cases some programer has already the call-back function and "only" want to add some GUI and get rid of the DOS-box.

Code:
   module mod_factoriser
   INTEGER ans,number
   CHARACTER(len=50) str
   
   CONTAINS
   
   INTEGER FUNCTION factoriser()
   INTEGER n,k
   CHARACTER*50 val
   WRITE(val,'(i11)')number
   CALL trim@(val)
   str='The factors of '//val(1:LENG(val))//' are: 1'
   n=number
   DO k=2,n
     IF((n/k)*k.EQ.n)THEN
       WRITE(val,'(i11)')k
       CALL trim@(val)
       CALL append_string@(str,', '//val)
       n=n/k
     ENDIF
   END DO
   CALL window_update@(str)
   factoriser=1
   END FUNCTION factoriser   
   end module mod_factoriser
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Jan 11, 2010 4:42 pm    Post subject: Reply with quote

The keyword EXTERNAL means external to the current subprogram not external to the current file.

Strictly EXTERNAL is only required when passing a subprogram as an argument otherwise EXTERNAL is optional (not sure if FTN95 needs it anyway).
You must declare the return type for a function either implicitly or explicitly.
Back to top
View user's profile Send private message AIM Address
EKruck



Joined: 09 Jan 2010
Posts: 224
Location: Aalen, Germany

PostPosted: Wed Jan 13, 2010 9:46 pm    Post subject: Reply with quote

As far as I know, Common blocks cannot be used in DLLs. Therefor I am using modules intensively and very successfully.

Callback functions for WinIO should be included in an INTEGER statement and have to be included in an EXTERNAL statement - as well in FTN95.

Generally I recommend to use IMPLICIT NONE for clean programming.
Back to top
View user's profile Send private message Visit poster's website
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Wed Jan 13, 2010 11:55 pm    Post subject: Reply with quote

That's interesting about COMMON blocks and DLLs, and if correct (I don't doubt it - I simply haven't tested it for myself) is a strong argument for Fortran-90 style programming should DLLs be required.

If IMPLICIT NONE is not specified, callback functions do need to be declared EXTERNAL in the routines where they are referenced, but it doesn't appear to be necessary to declare the symbolic name INTEGER even if their names are not implicitly integer- something that surprises me - although the function declaration does need the type to be declared in such cases (i.e. where the name doesn't match an implicit integer type and/or the basic integer type is not 4-byte). Presumably, FTN95 does something pretty clever when processing WINIO@ callbacks.

Is that standard-conforming? It's probably not, but (in practice) it doesn't matter, because the minute you write WINIO@ for the first time you are locked into FTNxx, and FTN95 doesn't care.....

Eddie
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Thu Jan 14, 2010 9:02 am    Post subject: Reply with quote

My understanding is that you cannot directly share data between DLLs or between an executable and a DLL. This applies to both COMMON blocks and to data within a MODULE. You could try using inter-process shared memory (file mapping). See the knowledge base on this forum.
Back to top
View user's profile Send private message AIM Address
jjgermis



Joined: 21 Jun 2006
Posts: 404
Location: Nürnberg, Germany

PostPosted: Thu Jan 14, 2010 10:06 am    Post subject: Reply with quote

At first I did not understand what exactly it means to pass a subprogram as an argument. I then found some copy, paste and run example (given below) from which the use of external becomes clear. In Clearwin this seems to be standard practice and advised in the online tutorial as well. If this is not strictly necessary in Clearwin I would still prefer to use EXTERNAL anyway. Interessting that in this example f and f1 are both defined as real and external. Any comments on this.
Code:
program external_demo
   implicit none
   real           :: average
   external :: f, f1
   
   write(*,*) 'Average  f(x)  von   [0.0,10.0] (n=3)  = ', &
              average(f,0.0, 10.0, 3)
   write(*,*) 'Average  f1(x) von   [0.0,1.0] (n=10)  = ', &
               average(f1,0.0, 1.0, 10)
end program external_demo

real function f(x)
! User defined function f(x)
  implicit none
  real, intent(in) :: x
  f = x
  return
end function f

real function f1(x)     
! User defined function f1(x)
  implicit none
  real, parameter :: pi = 3.141593
  real, intent(in) :: x
  f1 = 2.0 * pi * x**3
  return
end function f1

real function average (func, anfangswert, endwert, n)
! Sub-program to calculate the average
  implicit none
  real,external      :: func     
  real, intent(in)    :: anfangswert, endwert
  integer, intent(in) :: n
  real                :: delta, summe
  integer             :: i
  delta = (endwert - anfangswert) / real(n-1)
  summe = 0.0
  do i = 1, n
    summe = summe + func(real(i-1)*delta)
  end do
  average = summe / real(n)
  return
end function average

Source: https://srv.rz.uni-bayreuth.de/lehre/fortran90/vorlesung/V09/V09.html#f
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+ All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
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