! Compile & link using FTN95 in DOS box. Run:
!    FTN95 factor.f95 /link
!
! For testing, you can download the FTN95 Personal Edition (FTN95PE) version from 
! http://silverfrost.com/32/ftn95/ftn95_personal_edition.aspx
!
! -------------------------------------------------------------
! QT software GmbH     Konstanzer Strasse 10     D-10707 Berlin
! Tel. +49(0)30/9290087-0   Fax. -2  eMail: admin@qtsoftware.de
! Info http://www.qtsoftware.de  Shop http://www.qtsoftware.com
! =============================================================


WINAPP


MODULE CommonVars
   IMPLICIT NONE
   INCLUDE <windows.ins>
   INTEGER number
   CHARACTER*50 str
END MODULE CommonVars


PROGRAM Factor
   USE CommonVars
   IMPLICIT NONE
   INTEGER, EXTERNAL :: factoriser, about
   INTEGER ans   
   number=1
   str=' '
   ans=winio@('%mn[&File[E&xit]]&','EXIT')
   ans=winio@('%mn[&Help[&About Number Factoriser]]&',about)
   ans=winio@('%il&',1,2147483647)

   ans=winio@('Number to be factorised: %rd&',number)
   ans=winio@('%ta%`^bt[Fac&torise]&',factoriser)
   ans=winio@('%2nl%ob%42st%cb',str)
END PROGRAM Factor


INTEGER FUNCTION factoriser()
   USE CommonVars
   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
   1 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
       IF(n.GT.1)GOTO 1
     ENDIF
   END DO
   CALL window_update@(str)
   factoriser=1
END FUNCTION factoriser


INTEGER FUNCTION about()
  USE CommonVars
  IMPLICIT NONE
  INTEGER ans
  INTEGER, EXTERNAL:: cbWeb
  ans=winio@('%ca[About Number Factoriser]&')
  ans=winio@('%fn[Times New Roman]%ts%bf%cnTutorial&',2.0D0)
  ans=winio@('%ts%3nl&',1.0D0)
  ans=winio@('%cnProgram developed to demonstrate%2nl&')
  ans=winio@('%ts%tc%cn%bfClearWin+&',1.5D0,RGB@(255,0,0))
  ans=winio@('%tc%sf%2nl%cnby Salford Software Ltd (modified by QT software GmbH)&',-1)
  ans=winio@('%2nl%cnClearWin+ is part of FTN95 which is available from&')
  ans=winio@('%nl%cnwww.qtsoftware.com    www.polyhedron.com&')
  ans=winio@('%2nl%cn%20`bt[OK (Close this window)]&')
  ans=winio@('%2nl%100.30^wb[http://www.qtsoftware.de/oxShop/en/Compiler-Systems/Fortran/for-Windows/'  &
             // 'FTN95-for-Microsoft-NET-Windows.html]', cbWeb)
  about=1
END FUNCTION about


integer function cbWeb()
 use clrwin$
 character(len=256)::reason, url
 reason = clearwin_string$("CALLBACK_REASON")
 url = clearwin_string$("CURRENT_URL")
 !print*, reason(1:len_trim(reason)), " = ", url(1:len_trim(url))
 cbWeb = 2
end function

