■

OpenGLによる3次元CGプログラミング
作者: 林武文, 加藤清敬
出版社/メーカー: コロナ社

• 1.5 課題

メインプログラムを WinMain にすることで、DOS 窓抜きで Window を開く。Linker の SYSTEM オプションの SUBSYSTEM を Windows にする必要あり。

MODULE m_callback
USE opengl_gl
USE opengl_glut
IMPLICIT NONE
INTEGER(GLCINT), PARAMETER :: KEY_ESC = 27
CONTAINS
!---------------------------
SUBROUTINE display()
IMPLICIT NONE
INTEGER :: i, n = 100
REAL(GLFLOAT) :: x, y, r = 0.5_glfloat, theta, pai
pai = 4.0_glfloat * ATAN(1.0)
CALL glClear( GL_COLOR_BUFFER_BIT )
CALL glLineWidth( 2.0_glfloat )
CALL glBegin( GL_LINE_LOOP )
 DO i = 0, n - 1
 x = r * COS( 2.0 * PAI * REAL(i, glfloat) / REAL(n, glfloat) )
 y = r * SIN( 2.0 * PAI * REAL(i, glfloat) / REAL(n, glfloat) )
 CALL glVertex3f( x, y, 0.0_glfloat )
 END DO
CALL glEnd()
CALL glFlush()
RETURN
END SUBROUTINE display
!---------------------------
SUBROUTINE myKbd(key, ix, iy)
IMPLICIT NONE
INTEGER(GLCINT), INTENT(IN OUT) :: key, ix, iy
IF (key == KEY_ESC) STOP
RETURN
END SUBROUTINE myKbd
!---------------------------
END MODULE m_callback
!=========================================================
MODULE m_subs
USE m_callback
IMPLICIT NONE
CONTAINS
!---------------------------
SUBROUTINE myInit(progname)
IMPLICIT NONE
CHARACTER(LEN = *), INTENT(IN) :: progname
INTEGER(GLCINT) :: iwidth = 500, iheight = 500
INTEGER(GLCINT) :: iwin
CALL glutInitWindowPosition( 0_glfloat, 0_glfloat )
CALL glutInitWindowSize( iwidth, iheight )
CALL glutInitDisplayMode( GLUT_RGBA )
iwin = glutCreateWindow( progname )
CALL glClearColor( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat, 1.0_glfloat )
CALL glutKeyboardFunc( myKbd )
!
CALL glMatrixMode( GL_PROJECTION )
CALL glLoadIdentity()
CALL glOrtho( -1.0_gldouble, 1.0_gldouble, -1.0_gldouble, &
               1.0_gldouble, -1.0_gldouble, 1.0_gldouble )
RETURN
END SUBROUTINE myInit
!---------------------------
END MODULE m_subs
!=========================================================
INTEGER (KIND = 4) FUNCTION WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!DEC$ ATTRIBUTES STDCALL, DECORATE, ALIAS : 'WinMain' :: WinMain
USE m_subs
IMPLICIT NONE
INTEGER, INTENT(IN) :: hInstance, hPrevInstance, lpszCmdLine, nCmdShow
CALL glutInit()
CALL myInit("GLUT1")
CALL glutDisplayFunc( display )
CALL glutMainLoop()
STOP
END FUNCTION WinMain