$DEFINE KERNEL
$DEFINE GDI
$DEFINE USER
$DEFINE CTLMGR
$DEFINE MSG
$DEFINE MENUS
$DEFINE RASTEROPS
$DEFINE WINMESSAGES
$DEFINE WINSTYLES
      INCLUDE 'FORTWIN.FI'
      INCLUDE 'WINDOWS.FI'
C
C-------------------------------------------------------------------------------
C
C    PROGRAM: FORTWIN.FOR
C
C    PURPOSE: Generic MS-Fortran template for Windows 3.0 applications
C
C    FUNCTIONS:
C
C	WinMain() - calls initialization function, processes message loop
C	InitApplication() - initializes window data and registers window
C	InitInstance() - saves instance handle and creates main window
C	MainWndProc() - processes messages
C	About() - processes messages for "About" dialog box
C
C    COMMENTS:
C
C        Windows can have several copies of your application running at the
C        same time when they are written in C. The variable hInst keeps track
C        of which instance this application is so that processing will be to
C        the correct window. A Microsoft Fortran application can only be invoked
C        once (you cannot run more than one copy at a time). The reason for this
C        does not appear to be given in the manual.
C
C-------------------------------------------------------------------------------
C
C    FUNCTION: WinMain(HANDLE, HANDLE, LPSTR, int)
C
C    PURPOSE: calls initialization function, processes message loop
C
C    COMMENTS:
C
C        Windows recognizes this function by name as the initial entry point 
C        for the program.  This function calls the application initialization 
C        routine, if no other instance of the program is running, and always 
C        calls the instance initialization routine.  It then executes a message 
C        retrieval and dispatch loop that is the top-level control structure 
C        for the remainder of execution.  The loop is terminated when a WM_QUIT 
C        message is received, at which time this function exits the application 
C        instance by returning the value passed by PostQuitMessage(). 
C
C        If this function must abort before entering the message loop, it 
C        returns the conventional value NULL.
C
C        The WinMain function must be declared PASCAL and FAR.
C
C-------------------------------------------------------------------------------
C

      FUNCTION WinMain[PASCAL,FAR] (hInstance,hPrevInstance,
     *                                               IpCmdLine,nCmdShow)
      IMPLICIT NONE

      INTEGER*2 WinMain
      INTEGER*2 hInstance     ! current instance
      INTEGER*2 hPrevInstance ! previous instance
      INTEGER*4 IpCmdLine     ! command line
      INTEGER*2 nCmdShow      ! show-window type (open/icon)

      INCLUDE 'WINDOWS.FD'
      INTEGER*2 InitApplication [EXTERN,FAR]
      INTEGER*2 InitInstance [EXTERN,FAR]
      INCLUDE 'FORTWIN.FD'

      INTEGER*4 STATUS

      RECORD /MSG/ Wmsg                          ! message

      IF(hPrevInstance.EQ.0)THEN                 ! Other instances of app running?
         IF(InitApplication(hInstance).EQ.0)THEN ! Initialize shared things
	    WinMain=0                            ! Exits if unable to initialize
            RETURN
         ENDIF
      ENDIF
C
C Perform initializations that apply to a specific instance
C
      HINST=HINSTANCE
      IF(InitInstance(hInstance,nCmdShow).EQ.0)THEN
          WinMain=0
          RETURN
      ENDIF

C
C Acquire and dispatch messages until a WM_QUIT message is received.
C
      DO WHILE (GetMessage(Wmsg,       ! message structure
     *	    NULL,		       ! handle of window receiving the message
     *	    NULL,		       ! lowest message to examine
     *	    NULL).ne.0)		       ! highest message to examine
         STATUS=TranslateMessage(Wmsg) ! Translates virtual key codes
	 STATUS=DispatchMessage(Wmsg)  ! Dispatches message to window
      ENDDO
      WinMain=Wmsg.wParam          ! Returns the value from PostQuitMessage
      RETURN
      END

C
C-------------------------------------------------------------------------------
C
C    FUNCTION: InitApplication(HANDLE)
C
C    PURPOSE: Initializes window data and registers window class
C
C    COMMENTS:
C
C        This function is called at initialization time only if no other 
C        instances of the application are running.  This function performs 
C        initialization tasks that can be done once for any number of running 
C        instances.  
C
C        In this case, we initialize a window class by filling out a data 
C        structure of type WNDCLASS and calling the Windows RegisterClass() 
C        function.  Since all instances of this application use the same window 
C        class, we only need to do this when the first instance is initialized.  
C
C
C-------------------------------------------------------------------------------
C
      FUNCTION InitApplication(hInstance)
      IMPLICIT NONE

      INTEGER*2 InitApplication
      INTEGER*2 hInstance             ! Current instance

      INCLUDE 'WINDOWS.FD'
      INTEGER*4 MainWndProc [EXTERN,PASCAL,FAR]
      INCLUDE 'FORTWIN.FD'

      RECORD /WNDCLASS/ wc

C
C Fill in window class structure with parameters that describe the
C main window. NOTE the difference in the LoadCursor for user named and
C internal resources.
C
      wc.style=NULL                                 ! Class style(s).
      wc.lpfnWndProc=LOCFAR(MainWndProc)            ! Function to retrieve messages for
                                                    ! windows of this class.
      wc.cbClsExtra=0                               ! No per-class extra data.
      wc.cbWndExtra=0                               ! No per-window extra data.
      wc.hInstance=hInstance                        ! Application that owns the class.
      wc.hIcon=LoadIcon(hInstance,'FortWinIcon'C)   ! Loads icon for Minmise Box
      wc.hCursor=LoadCursor_A(NULL, IDC_ARROW)
C      wc.hCursor=LoadCursor(hInstance,'FortWinCursor'C)
      wc.hbrBackground=GetStockObject(WHITE_BRUSH)
      wc.lpszMenuName=LOCFAR('GenericFortranMenu'C) ! Name of menu resource in .RC file.
      wc.lpszClassName=LOCFAR('GenericWClass'C)     ! Name used in call to CreateWindow.

C
C Register the window class and return success/failure code.
C
      InitApplication=RegisterClass(wc)
      RETURN
      END

C
C-------------------------------------------------------------------------------
C
C    FUNCTION:  InitInstance(HANDLE, int)
C
C    PURPOSE:  Saves instance handle and creates main window
C
C    COMMENTS:
C
C        This function is called at initialization time for every instance of 
C        this application.  This function performs initialization tasks that 
C        cannot be shared by multiple instances.  
C
C        In this case, we save the instance handle in a static variable and 
C        create and display the main program window.  
C        
C-------------------------------------------------------------------------------
C
      FUNCTION InitInstance(hInstance,nCmdShow)
      IMPLICIT NONE

      INTEGER*2 InitInstance
      INTEGER*2 hInstance          ! Current instance identifier.
      INTEGER*2 nCmdShow           ! Param for first ShowWindow() call.

      INTEGER*2 hWnd               ! Main window handle.
      INTEGER*2 STATUS

      INCLUDE 'WINDOWS.FD'
      INCLUDE 'FORTWIN.FD'

C
C Save the instance handle in static variable, which will be used in 
C many subsequence calls from this application to Windows.
C
      hInst=hInstance

C
C Create a main window for this application instance.
C
      hWnd=CreateWindow(
     *        'GenericWClass'C,              ! See RegisterClass() call.
     *        'Sample Fortran Application'C, ! Text for window title bar.     
     *        WS_OVERLAPPEDWINDOW,           ! Window style.                  
     *        CW_USEDEFAULT,                 ! Default horizontal position.    
     *        CW_USEDEFAULT,                 ! Default vertical position.      
     *        CW_USEDEFAULT,                 ! Default width.                  
     *        CW_USEDEFAULT,                 ! Default height.                   
     *        NULL,                          ! Overlapped windows have no parent.
     *        NULL,                          ! Use the window class menu.       
     *        hInstance,                     ! This instance owns this window.   
     *        NULLSTR)                       ! Pointer not needed.            

C
C If window could not be created, return "failure"
C
      IF(hWnd.EQ.0)THEN
         InitInstance=0
      ELSE
C
C Make the window visible; update its client area; and return "success"
C
         STATUS=ShowWindow(hWnd,nCmdShow) ! Show the window               
         CALL UpdateWindow(hWnd)          ! Sends WM_PAINT message          
         InitInstance=1                   ! Returns the value from PostQuitMessage
      ENDIF
      RETURN
      END

C
C-------------------------------------------------------------------------------
C
C    FUNCTION: MainWndProc(HWND, unsigned, WORD, LONG)
C
C    PURPOSE:  Processes messages
C
C    MESSAGES:
C
C	WM_COMMAND    - application menu (About dialog box)
C	WM_DESTROY    - destroy window
C
C    COMMENTS:
C
C	To process the IDM_ABOUT message, call MakeProcInstance() to get the
C	current instance address of the About() function.  Then call Dialog
C	box which will create the box according to the information in your
C	generic.rc file and turn control over to the About() function.	When
C	it returns, free the intance address.
C
C       Functions called by Windows must be decalared PASCAL,FAR.
C
C-------------------------------------------------------------------------------
C
      FUNCTION MainWndProc[PASCAL,FAR] (hWnd,message,wParam,lParam)
      IMPLICIT NONE

      INTEGER*4 MainWndProc
      INTEGER*2 hWnd         ! Window handle
      INTEGER*2 message      ! Type of message
      INTEGER*2 wParam       ! Additional information
      INTEGER*4 lParam       ! additional information

      INTEGER*4 lpProcAbout  ! Pointer to the "About" function

      INTEGER*2 STATUS
      INCLUDE 'WINDOWS.FD'
      EXTERNAL ABOUT [PASCAL,FAR]
      INCLUDE 'FORTWIN.FD'

      SELECT CASE (message)
         CASE (WM_COMMAND)   ! Message: command from application menu
            IF(wParam.EQ.IDM_ABOUT)THEN
               lpProcAbout=MakeProcInstance(About,hInst)
               STATUS=DialogBox(hInst,        ! Current instance
     *                        'AboutBox'C,    ! Resource to use
     *                        hWnd,           ! Parent handle
     *                        lpProcAbout)    ! About() instance address
               CALL FreeProcInstance(lpProcAbout)
               MainWndProc=NULL
            ELSE                              ! Lets Windows process it
               MainWndProc=DefWindowProc(hWnd,message,wParam,lParam)
               RETURN
            ENDIF

         CASE (WM_DESTROY)      ! message: window being destroyed
            CALL PostQuitMessage(0)
         CASE DEFAULT           ! Passes it on if unproccessed
            MainWndProc=DefWindowProc(hWnd,message,wParam,lParam)
      END SELECT
      RETURN
      END

C
C-------------------------------------------------------------------------------
C
C    FUNCTION: About(HWND, unsigned, WORD, LONG)
C
C    PURPOSE:  Processes messages for "About" dialog box
C
C    MESSAGES:
C
C	WM_INITDIALOG - initialize dialog box
C	WM_COMMAND    - Input received
C
C    COMMENTS:
C
C	No initialization is needed for this particular dialog box, but TRUE
C	must be returned to Windows.
C       
C	Wait for user to click on "Ok" button, then close the dialog box.
C
C-------------------------------------------------------------------------------
C
      FUNCTION About[PASCAL,FAR] (hDlg,message,wParam,lParam)
      IMPLICIT NONE

      INTEGER*2 About
      INTEGER*2 hDlg                      ! window handle of the dialog box
      INTEGER*2 message                   ! type of message
      INTEGER*2 wParam                    ! message-specific information
      INTEGER*4 lParam

      INCLUDE 'WINDOWS.FD'

      SELECT CASE (message)
         CASE (WM_INITDIALOG)		   ! message: initialize dialog box
	    About=1
            RETURN

         CASE (WM_COMMAND)		   ! message: received a command
	    IF(wParam.EQ.IDOK.OR.          ! "OK" box selected?
     *         wParam.EQ.IDCANCEL)THEN     ! System menu close command?
               CALL EndDialog(hDlg,1)      ! Exits the dialog box
               About=1
               RETURN
            ENDIF
      END SELECT

      About=0			           ! Didn't process a message
      RETURN
      END
