OpenGLによる3次元CGプログラミング
作者: 林武文, 加藤清敬
出版社/メーカー: コロナ社
MODULE m_callback USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE INTEGER(GLCINT), PARAMETER :: KEY_ESC = 27 LOGICAL :: wireFlag = GL_TRUE REAL(glfloat) :: theta = 0.0_glfloat REAL(glfloat) :: xOrig = 0.0_glfloat, yOrig = 0.0_glfloat REAL(glfloat) :: rColor = 1.0_glfloat, gColor = 1.0_glfloat, bColor = 1.0_glfloat CONTAINS !--------------------------- SUBROUTINE display() IMPLICIT NONE CALL glClear( GL_COLOR_BUFFER_BIT ) CALL glPushMatrix() CALL glTranslatef( xOrig, yOrig, -10.0_glfloat ) CALL glRotatef( theta, 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glColor3f( rColor, gColor, bColor ) IF (wireFlag == GL_TRUE) THEN CALL glutWireTeapot( 1.0_gldouble ) ELSE CALL glutSolidTeapot( 1.0_gldouble ) END IF CALL glPopMatrix() CALL glutSwapBuffers() RETURN END SUBROUTINE display !--------------------------- SUBROUTINE changeColor() IMPLICIT NONE CALL RANDOM_NUMBER(rColor) CALL RANDOM_NUMBER(gColor) CALL RANDOM_NUMBER(bColor) RETURN END SUBROUTINE changeColor !--------------------------- SUBROUTINE myKbd(key, ix, iy) IMPLICIT NONE INTEGER(GLCINT), INTENT(IN OUT) :: key, ix, iy SELECT CASE(key) CASE (ICHAR('w')) wireFlag = .NOT. wireFlag CASE (ICHAR('c')) CALL changeColor() CASE (ICHAR('R')) wireFlag = GL_TRUE theta = 0.0_glfloat xOrig = 0.0_glfloat yOrig = 0.0_glfloat rColor = 1.0_glfloat gColor = 1.0_glfloat bColor = 1.0_glfloat CASE (KEY_ESC) STOP CASE DEFAULT CONTINUE END SELECT CALL glutPostRedisplay() RETURN END SUBROUTINE myKbd !--------------------------- SUBROUTINE mySkey(key, ix, iy) IMPLICIT NONE INTEGER, INTENT(IN OUT) :: key, ix, iy SELECT CASE(key) CASE (GLUT_KEY_LEFT ) ! left arrow xOrig = xOrig - 0.2_glfloat IF (xOrig <= -2.0_glfloat) xOrig = -2.0_glfloat CASE (GLUT_KEY_RIGHT) ! right arrow xOrig = xOrig + 0.2_glfloat IF (xOrig >= 2.0_glfloat) xOrig = 2.0_glfloat CASE (GLUT_KEY_UP) ! up arrow yOrig = yOrig + 0.2_glfloat IF (yOrig >= 2.0_glfloat) yOrig = 2.0_glfloat CASE (GLUT_KEY_DOWN) ! up down yOrig = yOrig - 0.2_glfloat IF (yOrig <= -2.0_glfloat) yOrig = -2.0_glfloat CASE (GLUT_KEY_F1) theta = AMOD(theta + 10.0_glfloat, 360.0_glfloat) CASE (GLUT_KEY_F2) theta = AMOD(theta - 10.0_glfloat, 360.0_glfloat) CASE DEFAULT END SELECT CALL glutPostRedisplay() RETURN END SUBROUTINE mySkey !--------------------------- 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(GLUT_RGBA, GLUT_DOUBLE) ) iwin = glutCreateWindow( progname ) CALL glClearColor( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat, 1.0_glfloat ) ! CALL glutKeyboardFunc( myKbd ) CALL glutSpecialFunc( mySkey ) ! CALL glMatrixMode( GL_PROJECTION ) CALL glLoadIdentity() CALL gluPerspective( 30.0_gldouble, aspect, 1.0_gldouble, 20.0_gldouble ) CALL glMatrixMode( GL_MODELVIEW ) RETURN END SUBROUTINE myInit !--------------------------- END MODULE m_subs !========================================================= PROGRAM GLUT5 USE m_subs IMPLICIT NONE CALL glutInit() CALL myInit("GLUT5") CALL glutDisplayFunc( display ) CALL glutMainLoop() STOP END PROGRAM GLUT5