■

• ネタ元

http://www.dolfyn.net/dolfyn/f03gl_en.html

いわゆる Green Book からのサンプルのつづき。
元プログラムからの修正点は、RESHAPE ルーチンの引数の value 属性を消したこと。C binding を消したこと。

program fgl04

  use opengl_gl
  use opengl_glu
  use opengl_glut
  
  interface 
    subroutine graph()
    end subroutine graph

    subroutine reshape(w,h)
      use opengl_gl
      integer(glcint), intent(in) :: w,h
    end subroutine reshape
  end interface 

  integer(kind=GLint) :: winWidth = 600, winHeight = 400
  integer(kind=GLint) :: iwin
  
  call glutInit
  call glutInitDisplayMode(GLUT_SINGLE + GLUT_RGB )
  call glutInitWindowPosition( 100, 100)
  call glutInitWindowSize( winWidth, winHeight )
  iwin = glutCreateWindow("fgl04 Line chart data"//char(0))

  call glClearColor(1.0,1.0,1.0,1.0)
  call glMatrixMode(GL_PROJECTION)
  call gluOrtho2D(0.0_gldouble, 600.0_gldouble, &
                  0.0_gldouble, 400.0_gldouble  )
  
  call glutDisplayFunc( graph )
  call glutReshapeFunc( reshape )

  call glutMainLoop()
  
end program
subroutine graph

  use opengl_gl
  use opengl_glu
  use opengl_glut

  character, dimension(36) :: label =  (/ &
  'J','a','n', 'F','e','b', 'M','a','r', 'A','p','r', &
  'M','a','y', 'J','u','n', 'J','u','l', 'A','u','g', &
  'S','e','p', 'O','k','t', 'N','o','v', 'D','e','c'  /)

  integer(kind=glint) :: xRaster = 25, yRaster =50
  integer(kind=glint) :: month, k, x = 30   
  
  integer(kind=glint), dimension(12) :: data = (/ &
                    420, 342, 324, 310, 262, 185, &
                    190, 196, 217, 240, 312, 438  /)
  
  call glClear(GL_COLOR_BUFFER_BIT)
  
  ! x1, y1 Specify one vertex of a rectangle. 
  ! x2, y2 Specify the opposite vertex of the rectangle
  call glColor3f(1.0,0.0,0.0)
  do i=1,12
    call glRecti(20+(i-1)*50,65,40+(i-1)*50,data(i)-100)
  end do
  
  call glColor3f(0.0,0.0,1.0)
  call glBegin(GL_LINE_STRIP)  
  do i=1,12
    call glVertex2i(x+(i-1)*50,data(i)-100)
  end do
  call GLend()

  call glColor3f(1.0,1.0,0.0)
  xRaster = 25
  do i=1,12
    call glRasterPos2i(xRaster+(i-1)*50,data(i)-4-100)
    call glutBitmapCharacter(GLUT_BITMAP_9_BY_15,iachar('*'))
  end do
  
  call glColor3f(0.0,0.0,0.0)
  xRaster = 20
  do i=1,12
    call glRasterPos2i(xraster,yraster)
    do j=3*(i-1)+1,3*(i-1)+3
      call glutBitmapCharacter(GLUT_BITMAP_HELVETICA_12,iachar(label(j)))
    end do
    xraster=xraster+50
  end do
  
  call glFlush()
  
end subroutine graph
subroutine reshape(newWidth, newHeight)

  use OpenGL_GL
  use OpenGL_GLU

  integer(kind=GLcint), intent(IN) :: newWidth, newHeight
  real(kind=GLdouble) :: Zero, Width, Height

  Zero   = 0.0
  Width  = newWidth
  Height = newHeight

  call glMatrixMode( GL_PROJECTION )
  call glLoadIdentity()
  
  call gluOrtho2D( Zero, Width, Zero, Height )
  
  call glClear( GL_COLOR_BUFFER_BIT )

end subroutine reshape

DOS窓は略

module fgl05mod

  use opengl_gl

  integer(kind=GLint)  :: winWidth = 200, winHeight = 200

end module fgl05mod
program fgl05

  use opengl_gl
  use opengl_glu
  use opengl_glut
  use fgl05mod
    
  interface 
    subroutine square()
    end subroutine square

    subroutine reshape(w,h)
      use opengl_gl
      integer(glcint), intent(in) :: w,h
    end subroutine reshape
  end interface 

  integer(kind=GLint) :: iwin

  real(kind=GLdouble) :: x0 = 100.0, y0 = 50.0, z0 = 50.0 ! viewing coor. origin
  real(kind=GLdouble) :: xr =  50.0, yr = 50.0, zr =  0.0 ! look at this point
  real(kind=GLdouble) :: Vx =   0.0, Vy =  1.0, Vz =  0.0 ! view-up vector
  real(kind=GLdouble) :: xwmin = -40.0, ywmin = -60.0, &
                         xwmax =  40.0, ywmax =  60.0, &
                         dnear =  25.0, dfar  = 125.0
    
  call glutInit
  call glutInitDisplayMode(GLUT_SINGLE + GLUT_RGB )
  call glutInitWindowPosition( 100, 100)
  call glutInitWindowSize( winWidth, winHeight )
  iwin = glutCreateWindow("fgl05 Perspective view of a square"//char(0))

  call glClearColor(1.0,1.0,1.0,0.0)
  call glMatrixMode(GL_MODELVIEW)
  call gluLookAt(x0,y0,z0, xr,yr,zr, vx,vy,vz)

  call glMatrixMode(GL_PROJECTION)
  call glFrustum(xwmin,xwmax, ywmin,ywmax, dnear,dfar)
  
  call glutDisplayFunc( square )
  call glutReshapeFunc( reshape )

  call glutMainLoop()
  
end program
subroutine square

  use OpenGL_GL

  call glClear(GL_COLOR_BUFFER_BIT)
  
  call glColor3f(0.0,1.0,0.0)
  call glPolygonMode(GL_FRONT, GL_FILL)
  call glPolygonMode(GL_BACK, GL_LINE)  ! back face wire frame
  call glBegin(GL_QUADS)
    call glVertex3f(  0.0,   0.0, 0.0)
    call glVertex3f(100.0,   0.0, 0.0)
    call glVertex3f(100.0, 100.0, 0.0)
    call glVertex3f(  0.0, 100.0, 0.0)
  call glEnd()
  
  call glFlush()

end subroutine square
subroutine reshape(newWidth, newHeight)

  use OpenGL_GL
  use fgl05mod

  integer(kind=GLcint), intent(IN) :: newWidth, newHeight

  call glviewport(0,0,newWidth,newHeight)
  
  winWidth  = newWidth
  winHeight = newHeight

end subroutine reshape