■

• ネタ元

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

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

module fgl08m

  use opengl_gl

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

end module fgl08m
program fgl08

  use opengl_gl
  use opengl_glu
  use opengl_glut
    
  use fgl08m
  
  interface 
    subroutine display()
    end subroutine display

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

    subroutine mouse(b,a,x,y)
      use OpenGL_GL
      integer(GLint), intent(in) :: b,a,x,y
    end subroutine mouse
  end interface 

  integer(kind=GLint) :: iwin
    
  call glutInit
  call glutInitDisplayMode(GLUT_SINGLE + GLUT_RGB )
  call glutInitWindowPosition( 100, 100)
  call glutInitWindowSize( winWidth, winHeight )
  iwin = glutCreateWindow("fgl08 Mouse droppings"//char(0))

  call glClearColor(0.0,0.0,0.0,0.0)

  call glMatrixMode(GL_PROJECTION)

  call gluOrtho2D( 0.0_gldouble,  150.0_gldouble, &
                   0.0_gldouble,  150.0_gldouble  )
  
  call glutMouseFunc( mouse )
  call glutDisplayFunc( display )
  call glutReshapeFunc( reshape )

  call glutMainLoop()
  
end program
subroutine display

  use OpenGL_GL

  call glClear(GL_COLOR_BUFFER_BIT)

  call glColor3f(1.0,0.0,0.0)

  call glPointSize(3.0)
  call glFlush()

end subroutine display
subroutine reshape(newWidth, newHeight)

  use OpenGL_GL
  use OpenGL_GLU

  use fgl08m

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

  Zero   = 0.0
  Width  = newWidth
  Height = newHeight

  call glviewport(0,0,newWidth,newHeight)

  call glMatrixMode(GL_PROJECTION)
  call glLoadIdentity()

  call gluOrtho2D( Zero, Width, Zero, Height )
  
  call glClear(GL_COLOR_BUFFER_BIT)

  winWidth  = newWidth
  winHeight = newHeight
  
end subroutine reshape
subroutine plotpoint(ix,iy)
  
  use OpenGL_GL

  integer(GLint), intent(in) :: ix, iy  
  
  call glBegin(GL_POINTS)
  call glVertex2i(ix,iy)
  call glEnd()
  
end subroutine plotpoint
subroutine mouse( ibutton, iaction, ix, iy )

  use OpenGL_GL
  use OpenGL_GLUT
  use fgl08m

  integer(GLint), intent(in) :: ibutton, iaction, ix, iy  

  if( ibutton == GLUT_LEFT_BUTTON .and. &
      iaction == GLUT_DOWN )then
      
    call plotpoint(ix,winHeight-iy)
  
    call glFlush()
    
  endif
  
end subroutine mouse

DOS窓は略

module fgl09m

  use opengl_gl

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

  type Point
    integer(kind=GLint) x        
    integer(kind=GLint) y        
  end type

  integer                    :: ip =   0  
  integer, parameter         :: NP = 100  
  type(Point), dimension(NP) :: Pt

end module fgl09m
program fgl09

  use opengl_gl
  use opengl_glu
  use opengl_glut
    
  use fgl09m
  
  interface 
    subroutine display()
    end subroutine display

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

    subroutine mouse(b,a,x,y)
      use OpenGL_GL
      integer(GLint), intent(in) :: b,a,x,y
    end subroutine mouse
  end interface 

  integer(kind=GLint) :: iwin
    
  Pt%x = 0
  Pt%y = 0

  call glutInit
  call glutInitDisplayMode(GLUT_SINGLE + GLUT_RGB )
  call glutInitWindowPosition( 100, 100)
  call glutInitWindowSize( winWidth, winHeight )
  iwin = glutCreateWindow("fgl09 Mouse trails"//char(0))

  call glClearColor(0.0,0.0,0.0,0.0)

  call glMatrixMode(GL_PROJECTION)

  call gluOrtho2D( 0.0_gldouble,  150.0_gldouble, &
                   0.0_gldouble,  150.0_gldouble  )
  
  call glutMouseFunc( mouse )
  call glutDisplayFunc( display )
  call glutReshapeFunc( reshape )

  call glutMainLoop()
  
end program
subroutine display

  use OpenGL_GL
  use fgl09m

  call glClear(GL_COLOR_BUFFER_BIT)

  if( ip > 1 )then
    do i=2,ip
      call Drawline(Pt(i-1),Pt(i))    
    end do
  endif

  call glFlush()
  
end subroutine display
subroutine reshape(newWidth, newHeight)

  use OpenGL_GL
  use OpenGL_GLU

  use fgl09m

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

  Zero   = 0.0
  Width  = newWidth
  Height = newHeight

  call glviewport(0,0,newWidth,newHeight)

  call glMatrixMode(GL_PROJECTION)
  call glLoadIdentity()

  call gluOrtho2D( Zero, Width, Zero, Height )
  
  call glClear(GL_COLOR_BUFFER_BIT)

  winWidth  = newWidth
  winHeight = newHeight
  
end subroutine reshape
subroutine drawline( p1, p2 )
  
  use OpenGL_GL
  use fgl09m

  type(Point), intent(in)    :: p1, p2
  
  call glBegin(GL_LINES)
    call glVertex2i(p1%x,p1%y)
    call glVertex2i(p2%x,p2%y)
  call glEnd()
    
end subroutine drawline
subroutine mouse( ibutton, iaction, ix, iy )

  use OpenGL_GL
  use OpenGL_GLUT
  use fgl09m

  integer(GLint), intent(in) :: ibutton, iaction, ix, iy  

  if( ip == 0 )then
    if( ibutton == GLUT_LEFT_BUTTON .and. &
      iaction == GLUT_DOWN )then
      Pt(1)%x = ix
      Pt(1)%y = winHeight - iy
      ip = 1
    else
      if( ibutton == GLUT_RIGHT_BUTTON ) stop 'Done'
    endif
  else
    if( ibutton == GLUT_LEFT_BUTTON .and. &
      iaction == GLUT_DOWN )then
      ip = ip + 1
      Pt(ip)%x = ix
      Pt(ip)%y = winHeight - iy

      call Drawline(Pt(ip-1),Pt(ip))

    else
      if( ibutton == GLUT_RIGHT_BUTTON ) stop 'Done'
    endif
  endif

  call glFlush()
  
end subroutine mouse