OpenGLによる3次元CGプログラミング
作者: 林武文, 加藤清敬
出版社/メーカー: コロナ社
ロケット形状の定義ファイル。
MyShape.f90
MODULE m_myShape USE opengl_gl USE opengl_glu IMPLICIT NONE REAL(gldouble) :: pi2 = 2.0_gldouble * 3.14159265358979_gldouble ! 4.0d0 * ATAN(1.0d0) CONTAINS !---------------------------- SUBROUTINE myCircle(r, n) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: r INTEGER, INTENT(IN) :: n REAL(glfloat) :: x, y, z, dq INTEGER :: i dq = pi2 / REAL(n, glfloat) CALL glPushMatrix() y = 0.0_glfloat CALL glBegin( GL_LINE_LOOP ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f(x, y, z ) END DO CALL glEnd() CALL glPopMatrix() RETURN END SUBROUTINE myCircle !---------------------------- SUBROUTINE myDisc( r, n ) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: r INTEGER, INTENT(IN) :: n REAL(glfloat) :: x, y, z, dq INTEGER :: i CALL glEnable( GL_NORMALIZE ) dq = pi2 / REAL(n, glfloat) CALL glPushMatrix() y = 0.0_glfloat CALL glBegin( GL_POLYGON ) CALL glNormal3f( 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f(x, y, z ) END DO CALL glEnd() CALL glPopMatrix() CALL glDisable( GL_NORMALIZE ) RETURN END SUBROUTINE myDisc !---------------------------- SUBROUTINE mySolidCylinder( r, h, n ) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: r, h INTEGER, INTENT(IN) :: n REAL(glfloat) :: x, y, z, dq INTEGER :: i CALL glEnable( GL_NORMALIZE ) dq = pi2 / REAL(n, glfloat) y = 0.5_glfloat * h CALL glPushMatrix() CALL glRotatef( -dq * 180.0_glfloat / REAL(pi2, glfloat), 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glBegin( GL_QUAD_STRIP ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glNormal3f( x, 0.0_glfloat, z) CALL glVertex3f( x, y, z ) CALL glVertex3f( x, -y, z ) END DO CALL glEnd() CALL glBegin( GL_POLYGON ) CALL glNormal3f( 0.0_glfloat, -1.0_glfloat, 0.0_glfloat ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f( x, -y, z ) END DO CALL glEnd() CALL glBegin( GL_POLYGON ) CALL glNormal3f( 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f( x, y, z ) END DO CALL glEnd() CALL glPopMatrix() CALL glDisable( GL_NORMALIZE ) RETURN END SUBROUTINE mySolidCylinder !---------------------------- SUBROUTINE myWireCylinder( r, h, n ) IMPLICIT NONE REAL(glfloat), INTENT(IN) :: r, h INTEGER, INTENT(IN) :: n REAL(glfloat) :: x, y, z, dq INTEGER :: i CALL glEnable( GL_NORMALIZE ) dq = pi2 / REAL(n, glfloat) y = 0.5_glfloat * h CALL glPushMatrix() CALL glRotatef( -dq * 180.0_glfloat / REAL(pi2, glfloat), 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glBegin( GL_LINES ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f( x, y, z ) CALL glVertex3f( x, -y, z ) END DO CALL glEnd() CALL glBegin( GL_LINE_LOOP ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f( x, y, z ) END DO CALL glEnd() CALL glBegin( GL_LINE_LOOP ) DO i = 0, n - 1 x = r * COS( dq * i ) z = r * SIN( dq * i ) CALL glVertex3f( x, -y, z ) END DO CALL glEnd() CALL glPopMatrix() RETURN END SUBROUTINE myWireCylinder !---------------------------- END MODULE m_myShape
MODULE m_callback USE opengl_glut USE m_myShape IMPLICIT NONE INTEGER(GLCINT), PARAMETER :: KEY_ESC = 27 CONTAINS !--------------------------- SUBROUTINE display() IMPLICIT NONE CALL glClear( IOR(GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT) ) CALL glPushMatrix() CALL glTranslatef( 0.0_glfloat, 0.0_glfloat, -20.0_glfloat ) CALL glPushMatrix() CALL glTranslatef( 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL myWireCylinder( 1.0_glfloat, 2.0_glfloat, 12 ) CALL glTranslatef( 0.0_glfloat, 1.0_glfloat, 0.0_glfloat ) CALL glRotatef( -90.0_glfloat, 1.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glutWireCone( 1.0_gldouble, 2.0_gldouble, 12, 3 ) CALL glPopMatrix() CALL glTranslatef( 0.0_glfloat, -1.0_glfloat, 0.0_glfloat ) CALL myWireCylinder( 1.0_glfloat, 2.0_glfloat, 12 ) CALL glPopMatrix() 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 = 300, 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( 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( 30.0_gldouble, aspect, 1.0_gldouble, 50.0_gldouble ) CALL glMatrixMode( GL_MODELVIEW ) RETURN END SUBROUTINE myInit !--------------------------- END MODULE m_subs !========================================================= PROGRAM GLUT3 USE m_subs IMPLICIT NONE CALL glutInit() CALL myInit("GLUT3") CALL glutDisplayFunc( display ) CALL glutMainLoop() STOP END PROGRAM GLUT3
