実行結果
ソース・プログラム
module m_test use ISO_C_BINDING use opengl_types use gl use freeglut implicit none contains recursive subroutine display() bind(c) call glClear(GL_COLOR_BUFFER_BIT) call glBegin(GL_LINE_LOOP) call glVertex2d(-0.9_GLdouble, -0.9_GLdouble) call glVertex2d( 0.9_GLdouble, -0.9_GLdouble) call glVertex2d( 0.9_GLdouble, 0.9_GLdouble) call glVertex2d(-0.9_GLdouble, 0.9_GLdouble) call glEnd() call glFlush() return end subroutine display recursive subroutine init() bind(c) call glClearColor(0.0_GLclampf, 0.0_GLclampf, 1.0_GLclampf, 1.0_GLclampf) return end subroutine init end module m_test integer(4) function WinMain(hInstance, hPrevInst, lpszCmdLine, nCmdLine) bind(c, name = 'WinMain') use m_test implicit none integer(4), intent(in) :: hInstance, hPrevInst, lpszCmdLine, nCmdLine integer(C_INT) :: res integer(C_INT) :: argc type (C_PTR) :: argv character(kind = C_CHAR), target :: text*(80) argc = 1 argv = C_NULL_PTR text = 'Prog'//achar(0) argv = C_LOC(text) call glutInit(argc, argv) call glutInitDisplayMode(GLUT_RGBA) res = glutCreateWindow('OpenGL Window created using GLUT Library'//achar(0)) call glutDisplayFunc(display) call init() call glutMainLoop() winmain = 0 stop end function WinMain
もしくは bind を削って !DEC$ のコンパイラ指示行を入れる方が正しいのかもしれない。
integer(4) function WinMain(hInstance, hPrevInst, lpszCmdLine, nCmdLine) !DEC$ ATTRIBUTES STDCALL, ALIAS:'WinMain' :: WinMain
オプション