fortran66のブログ

fortran について書きます。

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