From: Phillip Helbig---undress to reply on 20 Jul 2010 06:27 In article <8bb49fdc-7788-477f-94c5-c1af4d21e809(a)z10g2000yqb.googlegroups.com>, The Star King <jfb(a)npl.co.uk> writes: > > > !GCC$ ATTRIBUTES STDCALL > > > which i wasn't aware of but which is reminiscent of the Intel Fortran > > > !DEC$ command. Aahhh yes---Directive-Enhanced Compilation. I'm sure Steve Lionel can give us some of the history of this preprocessor command. :-)
From: dpb on 20 Jul 2010 08:20 The Star King wrote: .... > This means that the Fortran program will not have a main "program" > declaration. How can gfortran cope with this? Same way as for any other Win32 API declaration -- build what you need. Sotoo (CVF-compatible; do whatever it is in your compiler to get similar results) integer function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow ) !DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain .... integer :: hInstance, hPrevInstance, nCmdShow integer :: lpCmdLine .... integer hInstance, hPrevInstance, nCmdShow, lpCmdLine type (T_MSG) :: mesg .... if (hPrevInstance .eq. 0) then if (InitApplication(hInstance)== 0) then WinMain = FALSE return end if end if hInst = hInstance .... do while (GetMessage(mesg, NULL, 0, 0)) i = TranslateMessage(mesg) i = DispatchMessage(mesg) end do WinMain = mesg%wParam end etc., ... If there hasn't been a module built for WinMain and friends specific for the particular compiler, your mission, should you choose to accept it, .... :) It's tedious but basically a straightforward process, much of which can be automated. What's actually available as starting points in the open source genre I'm not aware but I'd think somebody would have a pretty good handle on it that could be modified to any particular compiler's extensions. This does assume there is a way to do the name-mangling required... --
From: Steve Lionel on 20 Jul 2010 15:50 On 7/20/2010 6:27 AM, Phillip Helbig---undress to reply wrote: > In article > <8bb49fdc-7788-477f-94c5-c1af4d21e809(a)z10g2000yqb.googlegroups.com>, The > Star King<jfb(a)npl.co.uk> writes: > >>>> !GCC$ ATTRIBUTES STDCALL >>>> which i wasn't aware of but which is reminiscent of the Intel Fortran >>>> !DEC$ command. > > Aahhh yes---Directive-Enhanced Compilation. I'm sure Steve Lionel can > give us some of the history of this preprocessor command. :-) > Certainly I could, but I think you know it already. I will comment that pretty much all Fortran compilers with comment-like directives follow the general format of ! (or C) followed by three letters and then $. (An exception is OpenMP which uses !$OMP.) !DIR$ is another popular "introducer" and Intel Fortran also recognizes it. -- Steve Lionel Developer Products Division Intel Corporation Nashua, NH For email address, replace "invalid" with "com" User communities for Intel Software Development Products http://software.intel.com/en-us/forums/ Intel Software Development Products Support http://software.intel.com/sites/support/ My Fortran blog http://www.intel.com/software/drfortran
From: FX on 20 Jul 2010 15:58 > You need to prepare a WinMain function and at least one callback > function for Windows to call. If you have a main PROGRAM in your Fortran code (as opposed to only subroutines and functions), your compiler has the task of getting the OS to run it appropriately (creating whatever machine code entry point is expected by the application loader). -- FX
From: James Van Buskirk on 20 Jul 2010 18:27 "The Star King" <jfb(a)npl.co.uk> wrote in message news:8bb49fdc-7788-477f-94c5-c1af4d21e809(a)z10g2000yqb.googlegroups.com... > James, thanks very much for your reply. Sorry, I didn't realise the > functions you mentioned were win32 functions. However, to get a > program running in a window a little more "magic" is needed. You need > to prepare a WinMain function and at least one callback function for > Windows to call. These are generally written in C as > int WINAPI WinMain (HINSTANCE hinstance, HINSTANCED hPrevInstance, > PSTR szCmdLine, int iCmdShow); > LRESULT CALLBACK WndProc (HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM > lParam); > This means that the Fortran program will not have a main "program" > declaration. How can gfortran cope with this? It just can these days. I updated my Fortran adaptation of Petzold's Hello, world program. Comcast seems to have made it more difficult to update my web page just now, however, so here it comes: C:\gfortran\clf\HelloWin>type HelloWin2.f90 ! HelloWin2.f90 ! Public domain 2007-2010 James Van Buskirk ! Compiled with: ! gfortran -Wall -mwindows HelloWin2.f90 -oHelloWin2 -lgdi32 module win32_types use ISO_C_BINDING implicit none private public WNDCLASSEX_T type, bind(C) :: WNDCLASSEX_T integer(C_INT) cbSize integer(C_INT) style type(C_FUNPTR) lpfnWndProc integer(C_INT) cbClsExtra integer(C_INT) cbWndExtra integer(C_INTPTR_T) hInstance integer(C_INTPTR_T) hIcon integer(C_INTPTR_T) hCursor integer(C_INTPTR_T) hbrBackground type(C_PTR) lpszMenuName type(C_PTR) lpszClassName integer(C_INTPTR_T) hIconSm end type WNDCLASSEX_T public POINT_T type, bind(C) :: POINT_T integer(C_LONG) x integer(C_LONG) y end type POINT_T public MSG_T type, bind(C) :: MSG_T integer(C_INTPTR_T) hwnd integer(C_INT) message integer(C_INTPTR_T) wParam integer(C_INTPTR_T) lParam integer(C_LONG) time type(POINT_T) pt end type MSG_T public RECT_T type, bind(C) :: RECT_T integer(C_LONG) left integer(C_LONG) top integer(C_LONG) right integer(C_LONG) bottom end type RECT_T public PAINTSTRUCT_T type, bind(C) :: PAINTSTRUCT_T integer(C_INTPTR_T) hdc integer(C_INT) fErase type(RECT_T) rcPaint integer(C_INT) fRestore integer(C_INT) fIncUpdate integer(C_INT8_T) rgbReserved(32) end type PAINTSTRUCT_T end module win32_types module win32 use ISO_C_BINDING implicit none private public GetModuleHandle interface function GetModuleHandle(lpModuleName) & bind(C,name='GetModuleHandleA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: GetModuleHandle integer(C_INTPTR_T) GetModuleHandle character(kind=C_CHAR) lpModuleName(*) end function GetModuleHandle end interface public GetCommandLine interface function GetCommandLine() & bind(C,name='GetCommandLineA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: GetCommandLine type(C_PTR) GetCommandLine end function GetCommandLine end interface public DefWindowProc interface function DefWindowProc(hwnd, Msg, wParam, lParam) & bind(C,name='DefWindowProcA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: DefWindowProc integer(C_LONG) DefWindowProc integer(C_INTPTR_T), value :: hwnd integer(C_INT), value :: Msg integer(C_INTPTR_T), value :: wParam integer(C_INTPTR_T), value :: lParam end function DefWindowProc end interface public LoadIcon interface function LoadIcon(hInstance, lpIconName) & bind(C,name='LoadIconA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: LoadIcon integer(C_INTPTR_T) LoadIcon integer(C_INTPTR_T), value :: hInstance character(kind=C_CHAR) lpIconName(*) end function LoadIcon end interface public LoadCursor interface function LoadCursor(hInstance, lpCursorName) & bind(C,name='LoadCursorA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: LoadCursor integer(C_INTPTR_T) LoadCursor integer(C_INTPTR_T), value :: hInstance character(kind=C_CHAR) lpCursorName(*) end function LoadCursor end interface public GetStockObject interface function GetStockObject(fnObject) & bind(C,name='GetStockObject') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: GetStockObject integer(C_INTPTR_T) GetStockObject integer(C_INT), value :: fnObject end function GetStockObject end interface integer(C_INT), parameter, public :: WHITE_BRUSH = 0 ! Stock object public RegisterClassEx interface function RegisterClassEx(WndClass) & bind(C,name='RegisterClassExA') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: RegisterClassEx integer(C_SHORT) RegisterClassEx type(WNDCLASSEX_T) WndClass end function RegisterClassEx end interface ! Work around bug in libuser32.a ! public CreateWindow ! interface ! function CreateWindow(lpClassName, lpWindowName, dwStyle, & ! x, y, nWidth, nHeight, hwndParent, hMenu, hInstance, & ! lpParam) bind(C,name='CreateWindow') ! ! use ISO_C_BINDING ! implicit none !!GCC$ ATTRIBUTES STDCALL :: CreateWindow ! integer(C_INTPTR_T) CreateWindow ! character(kind=C_CHAR) lpClassName(*) ! character(kind=C_CHAR) lpWindowName(*) ! integer(C_LONG), value :: dwStyle ! integer(C_INT), value :: x ! integer(C_INT), value :: y ! integer(C_INT), value :: nWidth ! integer(C_INT), value :: nHeight ! integer(C_INTPTR_T), value :: hWndParent ! integer(C_INTPTR_T), value :: hMenu ! integer(C_INTPTR_T), value :: hInstance ! type(C_PTR), value :: lpParam ! end function CreateWindow ! end interface public CreateWindowEx interface function CreateWindowEx(dwExStyle, lpClassName, & lpWindowName, dwStyle, x, y, nWidth, nHeight, & hwndParent, hMenu, hInstance, lpParam) & bind(C,name='CreateWindowExA') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: CreateWindowEx integer(C_INTPTR_T) CreateWindowEx integer(C_LONG), value :: dwExStyle character(kind=C_CHAR) lpClassName(*) character(kind=C_CHAR) lpWindowName(*) integer(C_LONG), value :: dwStyle integer(C_INT), value :: x integer(C_INT), value :: y integer(C_INT), value :: nWidth integer(C_INT), value :: nHeight integer(C_INTPTR_T), value :: hWndParent integer(C_INTPTR_T), value :: hMenu integer(C_INTPTR_T), value :: hInstance type(C_PTR), value :: lpParam end function CreateWindowEx end interface public ShowWindow interface function ShowWindow(hWnd,nCmdShow) bind(C,name='ShowWindow') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: ShowWindow integer(C_INT) ShowWindow integer(C_INTPTR_T), value :: hWnd integer(C_INT), value :: nCmdShow end function ShowWindow end interface public UpdateWindow interface function UpdateWindow(hWnd) bind(C,name='UpdateWindow') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: UpdateWindow integer(C_INT) UpdateWindow integer(C_INTPTR_T), value :: hWnd end function UpdateWindow end interface public GetMessage interface function GetMessage(lpMsg,hWnd,wMsgFilterMin,wMsgFilterMax) & bind(C,name='GetMessageA') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: GetMessage integer(C_INT) GetMessage type(MSG_T) lpMsg integer(C_INTPTR_T), value :: hWnd integer(C_INT), value :: wMsgFilterMin integer(C_INT), value :: wMsgFilterMax end function GetMessage end interface public TranslateMessage interface function TranslateMessage(lpMsg) bind(C,name='TranslateMessage') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: TranslateMessage integer(C_INT) TranslateMessage type(MSG_T) lpMsg end function TranslateMessage end interface public DispatchMessage interface function DispatchMessage(lpMsg) bind(C,name='DispatchMessageA') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: DispatchMessage integer(C_LONG) DispatchMessage type(MSG_T) lpMsg end function DispatchMessage end interface public ExitProcess interface subroutine ExitProcess(uExitCode) bind(C,name='ExitProcess') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: ExitProcess integer(C_INT), value :: uExitCode end subroutine ExitProcess end interface public BeginPaint interface function BeginPaint(hwnd,lpPaint) bind(C,name='BeginPaint') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: BeginPaint integer(C_INTPTR_T) BeginPaint integer(C_INTPTR_T), value :: hwnd type(PAINTSTRUCT_T) lpPaint end function BeginPaint end interface public GetClientRect interface function GetClientRect(hwnd,lpRect) bind(C,name='GetClientRect') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: GetClientRect integer(C_INT) GetClientRect integer(C_INTPTR_T), value :: hwnd type(RECT_T) lpRect end function GetClientRect end interface public DrawText interface function DrawText(hdc, lpString, nCount, lpRect, & uFormat) bind(C,name='DrawTextA') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: DrawText integer(C_INT) DrawText integer(C_INTPTR_T), value :: hdc character(kind=C_CHAR) lpString(*) integer(C_INT), value :: nCount type(RECT_T) lpRect integer(C_INT), value :: uFormat end function DrawText end interface public EndPaint interface function EndPaint(hwnd,lpPaint) bind(C,name='EndPaint') use ISO_C_BINDING use win32_types implicit none !GCC$ ATTRIBUTES STDCALL :: EndPaint integer(C_INT) EndPaint integer(C_INTPTR_T), value :: hwnd type(PAINTSTRUCT_T) lpPaint end function EndPaint end interface public PostQuitMessage interface subroutine PostQuitMessage(nExitCode) bind(C,name='PostQuitMessage') use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: PostQuitMessage integer(C_INT), value :: nExitCode end subroutine PostQuitMessage end interface end module win32 module procs use win32 use win32_types use ISO_C_BINDING implicit none private public WndProc contains function WndProc(hwnd, iMsg, wParam, lParam) bind(C) !GCC$ ATTRIBUTES STDCALL :: WndProc integer(C_LONG) WndProc integer(C_INTPTR_T), value :: hwnd integer(C_INT), value :: iMsg integer(C_INTPTR_T), value :: wParam integer(C_INTPTR_T), value :: lParam integer(C_INTPTR_T) hdc type(PAINTSTRUCT_T) ps type(RECT_T) rect integer(C_INT) result4 character(kind=C_CHAR) message*(80) select case(iMsg) case(1) ! WM_CREATE WndProc = 0 return case(15) ! WM_PAINT hdc = BeginPaint(hwnd, ps) result4 = GetClientRect(hwnd, rect) message = 'Hello, gfortran!'//achar(0) result4 = DrawText(hdc, message, -1, rect, 37) result4 = EndPaint(hwnd, ps) WndProc = 0 return case(2) ! WM_DESTROY call PostQuitMessage(0) WndProc = 0 return end select WndProc = DefWindowProc(hwnd, iMsg, wParam, lParam) end function WndProc end module procs function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow) bind(C, name='Wi nMain') !program WinMain use win32 use win32_types use procs use ISO_C_BINDING implicit none !GCC$ ATTRIBUTES STDCALL :: WinMain integer(C_INT) WinMain integer(C_INTPTR_T), value :: hInstance integer(C_INTPTR_T), value :: hPrevInstance type(C_PTR), value :: lpCmdLine integer(C_INT), value :: nCmdShow character(kind=C_CHAR), pointer :: pcNull(:) ! integer(C_INTPTR_T) hInstance ! type(C_PTR) szCommandLine type(WNDCLASSEX_T) WndClass character(kind=C_CHAR), pointer :: cDefault(:) character(kind=C_CHAR), target :: szAppName*(80) integer(C_SHORT) result2 integer(C_INTPTR_T) hwnd character(kind=C_CHAR), target :: szWindowCaption*(80) integer(C_INT) result4 type(MSG_T) msg integer(C_INT) argh4 nullify(pcNull) ! hInstance = GetModuleHandle(pcNull) ! szCommandLine = GetCommandLine() call C_F_POINTER(lpCmdLine,cDefault,[0]) ! call C_F_POINTER(szCommandLine,cDefault,[0]) szAppName = 'HelloWin'//achar(0) WndClass%cbSize = size(transfer(Wndclass,[0_C_INT8_T])) WndClass%style = 3 ! ior(CS_HREDRAW, CS_VREDRAW) WndClass%lpfnWndProc = C_FUNLOC(WndProc) WndClass%cbClsExtra = 0 WndClass%cbWndExtra = 0 WndClass%hInstance = hInstance WndClass%hIcon = LoadIcon(0_C_INTPTR_T, cDefault) ! IDI_APPLICATION WndClass%hCursor = LoadCursor(0_C_INTPTR_T, cDefault) ! IDC_ARROW WndClass%hbrBackground = GetStockObject(WHITE_BRUSH) WndClass%lpszMenuName = C_NULL_PTR WndClass%lpszClassName = C_LOC(szAppName(1:1)) WndClass%hIconSm = LoadIcon(0_C_INTPTR_T, cDefault) ! IDI_APPLICATION result2 = RegisterClassEx(WndClass) szWindowCaption = 'The Hello Program'//achar(0) ! Workaround for bug ! hwnd = CreateWindow(szAppName, szWindowCaption, & ! 13565952, -2147483648, -2147483648, -2147483648, & ! -2147483648, 0_C_INTPTR_T, 0_C_INTPTR_T, hInstance, & ! C_NULL_PTR) argh4 = -2147483647-1 ! Workaround for libuser32.a bug ! hwnd = CreateWindow(szAppName, szWindowCaption, & ! 13565952, argh4, argh4, argh4, argh4, 0_C_INTPTR_T, & ! 0_C_INTPTR_T, hInstance, C_NULL_PTR) hwnd = CreateWindowEx(0, szAppName, szWindowCaption, & 13565952, argh4, argh4, argh4, argh4, 0_C_INTPTR_T, & 0_C_INTPTR_T, hInstance, C_NULL_PTR) result4 = ShowWindow(hwnd, 10) ! SW_SHOWDEFAULT result4 = UpdateWindow(hwnd) do while(GetMessage(msg, 0_C_INTPTR_T, 0, 0) /= 0) result4 = TranslateMessage(msg) result4 = DispatchMessage(msg) end do call ExitProcess(int(msg%wParam, C_INT)) WinMain = 0 end function WinMain !end program WinMain C:\gfortran\clf\HelloWin>gfortran -Wall -mwindows HelloWin2.f90 -oHelloWin2 -lgd i32 HelloWin2.f90:403.41: function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow) bind(C, name='W 1 Warning: Unused dummy argument 'hprevinstance' at (1) HelloWin2.f90:403.62: function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow) bind(C, name='W 1 Warning: Unused dummy argument 'ncmdshow' at (1) C:\gfortran\clf\HelloWin>HelloWin2 C:\gfortran\clf\HelloWin>gfortran -v Built by Equation Solution < http://www.Equation.com>. Using built-in specs. COLLECT_GCC=gfortran COLLECT_LTO_WRAPPER=c:/gcc_equation/bin/../libexec/gcc/x86_64-pc-mingw32/4.5.0/l to-wrapper.exe Target: x86_64-pc-mingw32 Configured with: .../gcc-4.5-20091217-mingw/configure --host=x86_64-pc-mingw32 -- build=x86_64-unknown-linux-gnu --target=x86_64-pc-mingw32 --prefix=/home/gfortra n/gcc-home/binary/mingw32/native/x86_64/gcc/4.5-20091217 --with-gmp=/home/gfortr an/gcc-home/binary/mingw32/native/x86_64/gmp --with-mpfr=/home/gfortran/gcc-home /binary/mingw32/native/x86_64/mpfr --with-mpc=/home/gfortran/gcc-home/binary/min gw32/native/x86_64/mpc --with-sysroot=/home/gfortran/gcc-home/binary/mingw32/cro ss/x86_64/gcc/4.5-20091217 --with-gcc --with-gnu-ld --with-gnu-as --disable-shar ed --disable-nls --disable-tls --enable-libgomp --enable-languages=c,fortran,c++ --enable-threads=win32 --disable-win32-registry Thread model: win32 gcc version 4.5.0 20091217 (experimental) (GCC) Well, you can't see what it did because it popped up a command window and that was the 64-bit compiler. Results for the 32-bit compiler: C:\gfortran\clf\HelloWin>gfortran -Wall -mwindows HelloWin2.f90 -oHelloWin2 -lgd i32 HelloWin2.f90:403.41: function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow) bind(C, name='W 1 Warning: Unused dummy argument 'hprevinstance' at (1) HelloWin2.f90:403.62: function WinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow) bind(C, name='W 1 Warning: Unused dummy argument 'ncmdshow' at (1) C:\gfortran\clf\HelloWin>HelloWin2 C:\gfortran\clf\HelloWin>gfortran -v Built by Equation Solution <http://www.Equation.com>. Using built-in specs. Target: i386-pc-mingw32 Configured with: .../gcc-4.5-20090813-mingw/configure --host=i386-pc-mingw32 --bu ild=x86_64-unknown-linux-gnu --target=i386-pc-mingw32 --prefix=/home/gfortran/gc c-home/binary/mingw32/native/x86_32/gcc/4.5-20090813 --with-gcc --with-gnu-ld -- with-gnu-as --disable-shared --disable-nls --disable-tls --with-gmp=/home/gfortr an/gcc-home/binary/mingw32/native/x86_32/gmp --with-mpfr=/home/gfortran/gcc-home /binary/mingw32/native/x86_32/mpfr --enable-languages=c,fortran,c++ --with-sysro ot=/home/gfortran/gcc-home/binary/mingw32/cross/x86_32/gcc/4.5-20090813 --enable -libgomp --enable-threads=win32 --disable-win32-registry Thread model: win32 gcc version 4.5.0 20090813 (experimental) (GCC) You will have to try it out for yourself as again the program popped up a window. Also I checked with Task Manager that this program was indeed 32-bit (and the other was 64-bit.) If all you need is OpenGL, I am not sure that you really need a Windows program; maybe OpenGL can pop up a graphics window from a console program. -- write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, & 6.0134700243160014d-154/),(/'x'/)); end
First
|
Prev
|
Next
|
Last
Pages: 1 2 3 4 5 Prev: Excell calling dll with 100% CPU usage Next: Simple Hack TO Get $1500 To Your PayPal Account. |