flib.gml

开放源码的编译器open watcom 1.6.0版的源代码

      PRINT *, 'Unit 5 file handle is', SYSHANDLE( 5 )
      PRINT *, 'Unit 6 file handle is', SYSHANDLE( 6 )
      END
.exam end
.autonote Notes:
.note
The FORTRAN include file :FNAME.fsublib.fi:eFNAME., located in the
:FNAME.&pathnam.&pc.src&pc.fortran:eFNAME. directory, contains typing
and calling information for this subprogram.
The :FNAME.&pathnam.&pc.src&pc.fortran:eFNAME. directory should be
included in the
.ev &incvarup
environment variable so that the compiler can locate the include file.
.note
A value of -1 is returned if the unit is not connected to a file.
:cmt. Note that an
:cmt. .kw OPEN
:cmt. statement does not actually allocate a system file handle for the
:cmt. file; the first input/output operation will do the allocation.
.note
Units 5 and 6 are preconnected to the standard input and standard output
devices respectively.
.endnote
.*
.section REAL Function URAND
.*
.np
.ix 'URAND function'
.ix 'random number generator'
.ix 'utility subprograms' 'function URAND'
The REAL function
.id URAND
returns pseudo-random numbers in the range (0,1).
.np
The function
.id URAND
requires one argument of type INTEGER, the initial seed.
The seed can contain any integer value.
.id URAND
returns a REAL value which is a pseudo-random number in the range
(0.0,1.0).
.np
In the following example, 100 random numbers are printed.
.exam begin
      REAL URAND
      INTEGER SEED

      SEED = 75347
      DO I = 1, 100
         PRINT *, URAND( SEED )
      ENDDO
      END
.exam end
.autonote Notes:
.note
Upon each invocation of
.id URAND,
the seed argument is updated by the random number generator.
Therefore, the argument must not be a constant and, once the seed
value has been set, it must
.us not
be modified by the programmer.
.endnote
.*
.section Default Windowing Functions
.*
.np
The functions described in the following sections provide the
capability to manipulate attributes of various windows created by
&company's default windowing system for Microsoft Windows 3.x,
Windows 95, Windows NT, and IBM OS/2.
A simple default windowing FORTRAN application can be built using the
following command(s):
.begnote $break $setptnt 10
.note 16-bit Windows
.monoon
C>&wclcmd16 [fn1] [fn2] ... /bw /windows /l=windows
.monooff
.note 32-bit Windows
.monoon
C>&wclcmd32 [fn1] [fn2] ... /bw /l=win386
.br
C>wbind -n [fn1]
.monooff
.note 32-bit Windows NT or Windows 95
.monoon
C>&wclcmd32 [fn1] [fn2] ... /bw /l=nt_win
.monooff
.note 32-bit OS/2 Presentation Manager
.monoon
C>&wclcmd32 [fn1] [fn2] ... /bw /l=os2v2_pm
.monooff
.endnote
.begnote
.note Note:
At present, a restriction in Windows NT prevents you from opening the
console device (CON) for both read and write access.
Therefore, it is not possible to open additional windows for both
input and output under Windows NT.
They must be either read-only or write-only windows.
.endnote
.*
.beglevel
.*
.section dwfDeleteOnClose
.*
.millust begin
integer function dwfDeleteOnClose( unit )
integer unit
.millust end
.np
.ix 'default windowing' 'dwfDeleteOnClose'
.ix 'dwfDeleteOnClose function'
The dwfDeleteOnClose function tells the console window that it should
close itself when the corresponding file is closed.
The argument
.id unit
is the unit number associated with the opened console.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfDeleteOnClose function returns 1 if it was successful and 0 if
not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                     'About Hello World'//CHAR(13)//
     2                     'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )
      END
.tinyexam end
.*
.section dwfSetAboutDlg
.*
.millust begin
integer function dwfSetAboutDlg( title, text )
character*(*) title
character*(*) text
.millust end
.np
.ix 'default windowing' 'dwfSetAboutDlg'
.ix 'dwfSetAboutDlg function'
The dwfSetAboutDlg function sets the "About" dialog box of the default
windowing system.
The argument
.id title
is a character string that will replace the current title.
If
.id title
is CHAR(0) then the title will not be replaced.
The argument
.id text
is a character string which will be placed in the "About" box.
To get multiple lines, embed a new line character (CHAR(13)) after
each logical line in the string.
If
.id text
is CHAR(0), then the current text in the "About" box will not be
replaced.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfSetAboutDlg function returns 1 if it was successful and 0 if
not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                     'About Hello World'//CHAR(13)//
     2                     'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )
      END
.tinyexam end
.*
.section dwfSetAppTitle
.*
.millust begin
integer function dwfSetAppTitle( title )
character*(*) title
.millust end
.np
.ix 'default windowing' 'dwfSetAppTitle'
.ix 'dwfSetAppTitle function'
The dwfSetAppTitle function sets the main window's title.
The argument
.id title
is a character string that will replace the current title.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfSetAppTitle function returns 1 if it was successful and 0 if
not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                     'About Hello World'//CHAR(13)//
     2                     'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )
      END
.tinyexam end
.*
.section dwfSetConTitle
.*
.millust begin
integer function dwfSetConTitle( unit, title )
integer unit
character*(*) title
.millust end
.np
.ix 'default windowing' 'dwfSetConTitle'
.ix 'dwfSetConTitle function'
The dwfSetConTitle function sets the console window's title which
corresponds to the unit number passed to it.
The argument
.id unit
is the unit number associated with the opened console.
The argument
.id title
is the character string that will replace the current title.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfSetConTitle function returns 1 if it was successful and 0 if
not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                     'About Hello World'//CHAR(13)//
     2                     'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )
      END
.tinyexam end
.*
.section dwfShutDown
.*
.millust begin
integer function dwfShutDown()
.millust end
.np
.ix 'default windowing' 'dwfShutDown'
.ix 'dwfShutDown function'
The dwfShutDown function shuts down the default windowing I/O system.
The application will continue to execute but no windows will be
available for output.
Care should be exercised when using this function since any subsequent
output may cause unpredictable results.
.np
When the application terminates, it will not be necessary to manually
close the main window.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfShutDown function returns 1 if it was successful and 0 if not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                     'About Hello World'//CHAR(13)//
     2                     'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )
      rc = dwfShutDown()

*   do more computing that does not involve console input/output
*         .
*         .
*         .

      END
.tinyexam end
.*
.section dwfYield
.*
.millust begin
integer function dwf veld()
.millust end
.np
.ix 'default windowing' 'dwfYield'
.ix 'dwfYield function'
The dwfYield function yields control back to the operating system,
thereby giving other processes a chance to run.
.np
This function is one of the support functions that can be called from
an application using &company's default windowing support.
.np
The dwfYield function returns 1 if it was successful and 0 if not.
.cp 22
.tinyexam begin
      PROGRAM main
      INCLUDE 'FSUBLIB.FI'

      INTEGER rc
      CHARACTER response
      INTEGER i

      rc = dwfSetAboutDlg( 'Hello World About Dialog',
     1                       'About Hello World'//CHAR(13)//
     2                       'Copyright 1994 by WATCOM'//CHAR(13) )
      rc = dwfSetAppTitle( 'Hello World Application Title' )
      rc = dwfSetConTitle( 5, 'Hello World Console Title' )
      PRINT *, 'Hello World'
      OPEN( unit=3, file='CON' )
      rc = dwfSetConTitle( 3, 'Hello World Second Console Title' )
      rc = dwfDeleteOnClose( 3 )
      WRITE( unit=3, fmt=* ) 'Hello to second console'
      WRITE( unit=3, fmt=* ) 'Press Enter to close this console'
      READ( unit=3, fmt='(A)', end=100, err=100 ) response
100   CLOSE( unit=3 )

      DO i = 0, 1000
          rc = dwfYield()
*         do CPU-intensive calculation
*         .
*         .
*         .
      ENDDO
      PRINT *, i

      END
.tinyexam end
.*
.endlevel