OpenGLによる3次元CGプログラミング
作者: 林武文, 加藤清敬
出版社/メーカー: コロナ社
MODULE m_callback USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE INTEGER(GLCINT), PARAMETER :: KEY_ESC = 27 INTEGER(glcint) :: ixBegin, iyBegin, mButton REAL(glfloat) :: distance, twist, elevation, azimuth CONTAINS !--------------------------------------------------------- SUBROUTINE display() IMPLICIT NONE CALL glClear( IOR(GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT) ) CALL glPushMatrix() CALL polarview(distance, twist, elevation, azimuth) CALL glEnable( GL_DEPTH_TEST ) CALL glEnable( GL_LIGHTING ) CALL glBegin( GL_POLYGON ) CALL glNormal3f( 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glVertex3f( 1.0_glfloat, 0.0_glfloat, 1.0_glfloat ) CALL glVertex3f( 1.0_glfloat, 0.0_glfloat, -1.0_glfloat ) CALL glVertex3f( -1.0_glfloat, 0.0_glfloat, -1.0_glfloat ) CALL glVertex3f( -1.0_glfloat, 0.0_glfloat, 1.0_glfloat ) CALL glEnd() CALL glDisable( GL_LIGHTING ) CALL drawNormal( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat, & 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glPopMatrix() CALL glDisable( GL_DEPTH_TEST ) CALL glutSwapBuffers() RETURN END SUBROUTINE display !--------------------------------------------------------- SUBROUTINE drawNormal(x0, y0, z0, x1, y1, z1) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: x0, y0, z0, x1, y1, z1 CALL glColor3f( 1.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glLineWidth( 2.0_glfloat ) CALL glPushMatrix() CALL glTranslatef( x0, y0, z0 ) CALL glBegin( GL_LINES ) CALL glVertex3f( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glVertex3f( x1, y1, z1 ) CALL glEnd() CALL glPopMatrix() RETURN END SUBROUTINE drawNormal !--------------------------------------------------------- SUBROUTINE myKbd(key, ix, iy) IMPLICIT NONE INTEGER(GLCINT), INTENT(IN OUT) :: key, ix, iy SELECT CASE(key) CASE (ICHAR('R')) CALL resetview() CALL glutPostRedisplay() CASE (KEY_ESC) STOP CASE DEFAULT CONTINUE END SELECT CALL glutPostRedisplay() RETURN END SUBROUTINE myKbd !--------------------------------------------------------- SUBROUTINE myMouse(ibutton, istate, ix, iy) IMPLICIT NONE INTEGER(glcint), INTENT(IN OUT):: ibutton, istate, ix, iy IF ( istate == GLUT_DOWN ) THEN ixBegin = ix iyBegin = iy mButton = ibutton END IF RETURN END SUBROUTINE myMouse !--------------------------------------------------------- SUBROUTINE myMotion(ix, iy) IMPLICIT NONE INTEGER(glcint), INTENT(IN OUT) :: ix, iy INTEGER(glcint) :: ixDisp, iyDisp ixDisp = ix - ixBegin iyDisp = iy - iyBegin SELECT CASE (mbutton) CASE (GLUT_LEFT_BUTTON) azimuth = azimuth + REAL(ixDisp, glfloat) / 5.0_glfloat elevation = elevation - REAL(iyDisp, glfloat) / 5.0_glfloat CASE (GLUT_MIDDLE_BUTTON) twist = AMOD(twist + REAL(ixDisp, glfloat) / 3.0_glfloat, 360.0_glfloat) CASE (GLUT_RIGHT_BUTTON) distance = distance - REAL(ixDisp + iyDisp, glfloat) / 60.0_glfloat END SELECT ixBegin = ix iyBegin = iy CALL glutPostRedisplay() RETURN END SUBROUTINE myMotion !--------------------------------------------------------- SUBROUTINE polarview(distance, twist, elevation, azimuth) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: distance, twist, elevation, azimuth CALL glTranslatef( 0.0_glfloat, 0.0_glfloat, -distance ) CALL glRotatef(-twist , 0.0_glfloat, 0.0_glfloat, 1.0_glfloat ) CALL glRotatef(-elevation, 1.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glRotatef(-azimuth , 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) RETURN END SUBROUTINE polarview !--------------------------------------------------------- SUBROUTINE resetview() IMPLICIT NONE distance = 6.0_glfloat twist = 0.0_glfloat elevation = -45.0_glfloat azimuth = 30.0_glfloat RETURN END SUBROUTINE resetview !--------------------------------------------------------- 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 = 600, iheight = 600 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(IOR(GLUT_RGBA, GLUT_DOUBLE), GLUT_DEPTH) ) iwin = glutCreateWindow( progname ) CALL glClearColor( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat, 1.0_glfloat ) CALL glutKeyboardFunc( myKbd ) CALL glutMouseFunc( myMouse ) CALL glutMotionFunc( myMotion ) CALL resetView() CALL glShadeModel( GL_FLAT ) CALL glEnable( GL_LIGHT0 ) RETURN END SUBROUTINE myInit !--------------------------------------------------------- SUBROUTINE myReshape(iwidth, iheight) IMPLICIT NONE INTEGER(GLCINT), INTENT(IN) :: iwidth, iheight REAL(GLDOUBLE) :: aspect aspect = REAL(iwidth, glfloat) / REAL(iheight, glfloat) CALL glViewport(0, 0, iwidth, iheight) CALL glMatrixMode( GL_PROJECTION ) CALL glLoadIdentity() CALL gluPerspective( 40.0_gldouble, aspect, 1.0_gldouble, 10.0_gldouble ) CALL glMatrixMode( GL_MODELVIEW ) RETURN END SUBROUTINE myReshape !--------------------------------------------------------- END MODULE m_subs !========================================================= PROGRAM GLUT6 USE m_subs IMPLICIT NONE CALL glutInit() CALL myInit( 'GLUT6' ) CALL glutReshapeFunc( myReshape ) CALL glutDisplayFunc( display ) CALL glutMainLoop() STOP END PROGRAM GLUT6