OpenGLによる3次元CGプログラミング
作者: 林武文, 加藤清敬
出版社/メーカー: コロナ社
MODULE m_callback USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE INTEGER(GLCINT), PARAMETER :: KEY_ESC = 27 REAL(glfloat) :: theta = 0.0_glfloat REAL(gldouble) :: dist = 0.0_gldouble REAL(glfloat), PARAMETER :: pai = 3.1415926536_glfloat CONTAINS !--------------------------- SUBROUTINE display() IMPLICIT NONE INTEGER :: i CALL glClear( GL_COLOR_BUFFER_BIT ) CALL glPushMatrix() CALL gluLookAt(0.0_gldouble, 1.0_gldouble, dist, 0.0_gldouble, 1.0_gldouble, & dist + 1.0_gldouble, 0.0_gldouble, 1.0_gldouble, 0.0_gldouble ) CALL glPushMatrix() CALL glTranslatef( 1.5_glfloat, 2.0_glfloat, 10.0_glfloat ) CALL glRotatef( theta, 1.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glColor3f( 1.0_glfloat, 1.0_glfloat, 1.0_glfloat ) CALL glutWireTeapot( 1.0_gldouble ) CALL glPopMatrix() CALL glPushMatrix() CALL glTranslatef( -1.5_glfloat, 2.0_glfloat, 20.0_glfloat ) CALL glRotatef( 2.0_glfloat * theta, 1.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glColor3f( 1.0_glfloat, 0.0_glfloat, 1.0_glfloat ) CALL glutWireTorus( 0.2_gldouble, 1.0_gldouble, 15, 30 ) CALL glPopMatrix() CALL glPushMatrix() CALL glTranslatef( 0.0_glfloat, 1.0_glfloat, 30.0_glfloat ) CALL glRotatef( 3.0_glfloat * theta, 0.2_glfloat, -1.0_glfloat, 0.0_glfloat ) CALL glRotatef( -90.0_glfloat, 1.0_glfloat, 0.2_glfloat, 0.0_glfloat ) CALL glColor3f( 1.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glutWireSphere( 1.0_gldouble, 15, 15 ) CALL glPopMatrix() CALL glColor3f( 1.0_glfloat, 1.0_glfloat, 1.0_glfloat ) CALL glBegin(GL_LINES) DO i = -35, 35, 2 CALL glVertex3f( REAL(i, glfloat), 0.0_glfloat, -35.0_glfloat ) CALL glVertex3f( REAL(i, glfloat), 0.0_glfloat, 35.0_glfloat ) CALL glVertex3f( -50.0_glfloat, 0.0_glfloat, REAL(i, glfloat) ) CALL glVertex3f( 50.0_glfloat, 0.0_glfloat, REAL(i, glfloat) ) END DO CALL glEnd() CALL glPopMatrix() CALL glutSwapBuffers() RETURN END SUBROUTINE display !--------------------------- SUBROUTINE idle() IMPLICIT NONE dist = MOD(dist + 0.05_gldouble, 32.0_gldouble) theta = MOD(theta + 0.5_glfloat, 360.0_glfloat) CALL glutPostRedisplay() RETURN END SUBROUTINE idle !--------------------------- 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 = 640, iheight = 480 INTEGER(GLCINT) :: iwin REAL(GLDOUBLE) :: aspect aspect = REAL(iwidth, glfloat) / REAL(iheight, glfloat) CALL glutInitWindowPosition( 0_glfloat, 0_glfloat ) CALL glutInitWindowSize( iwidth, iheight ) CALL glutInitDisplayMode( IOR(GLUT_DOUBLE, 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 gluPerspective( 60.0_gldouble, aspect, 0.1_gldouble, 40.0_gldouble ) CALL glMatrixMode( GL_MODELVIEW ) RETURN END SUBROUTINE myInit !--------------------------- END MODULE m_subs !========================================================= PROGRAM GLUT4 USE m_subs IMPLICIT NONE CALL glutInit() CALL myInit("GLUT4-1") CALL glutDisplayFunc( display ) CALL glutIdleFunc( idle ) CALL glutMainLoop() STOP END PROGRAM GLUT4