読者です 読者をやめる 読者になる 読者になる

fortran66のブログ

fortran について書きます。

F03GL を用いて GLUT を利用して OpenGL で作画 

GLUT (Gyudon Love Uho TKTT)
f:id:fortran66:20140917011835p:plain

F03GL 利用の環境設定メモ帳

以前と比べて使いやすくなった気がします。

  1. F03GL f03gl.zip dowmload F03GL: Fortran interface to OpenGL
  2. FreeGlut freeglut 2.8.1 MSVC download http://www.transmissionzero.co.uk/software/freeglut-devel/The freeglut Project :: About
  3. F03GL から opengl_gl.f90、 opengl_glu.f90、 opengl_glut.f90 (但し opengl_freeglut.f90 を改名したもの)を抜き出す。
  4. FreeGlut freeglu\bin\x64\freeglut.dll を c:\windows\system32 へコピー、freeglut\lib\x64\freeglut.lib を C:\Program Files (x86)\Intel\Composer XE 2015\compiler\lib\intel64 へコピー。
  5. Configuration は x64 のみ。
  6. Linker -> Input は、Opengl32.lib Glu32.lib freeglut.lib の三つを追加。

f:id:fortran66:20140917014209p:plain



以前のプログラムの再現


fortran66のブログ

少しだけ書き直しました。

      module m_bitmap
        use, intrinsic :: iso_c_binding
        implicit none
        integer, parameter :: DWORD = C_LONG, LONG = C_LONG, WORD = C_INT16_T, BYTE = C_INT8_T 
        type :: t_bitmapinfoheader
          sequence
          integer(DWORD) :: biSize           
          integer(LONG ) :: biWidth          
          integer(LONG ) :: biHeight         
          integer(WORD ) :: biPlanes         
          integer(WORD ) :: biBitCount       
          integer(DWORD) :: biCompression    
          integer(DWORD) :: biSizeImage      
          integer(LONG ) :: biXPelsPerMeter  
          integer(LONG ) :: biYPelsPerMeter  
          integer(DWORD) :: biClrUsed        
          integer(DWORD) :: biClrImportant   
        end type
!
        type :: t_rgbquad
          sequence
          integer(BYTE) :: rgbBlue  
          integer(BYTE) :: rgbGreen 
          integer(BYTE) :: rgbRed  
          integer(BYTE) :: rgbReserved  
        end type
!
        type :: t_bitmapfileheader
          sequence
          character(len = 2) :: bfType
          integer(DWORD)     :: bfSize
          integer(WORD )     :: bfReserved1
          integer(WORD )     :: bfReserved2
          integer(DWORD)     :: bfOffBits
        end type 
      contains
!----------------------------------------------------
        subroutine readbitmapfile(text, bih, bcolmap, itmp)
          character(len = *), intent(in) :: text
          type(t_bitmapinfoheader)    , intent(out) :: bih
          type(t_rgbquad), allocatable, intent(out) :: bcolmap(:)
          integer(1)     , allocatable, intent(out) :: itmp(:)
          type(t_bitmapfileheader) :: bfh
          integer :: i, len
          integer :: ir = 10
          open(ir, file = text, form = 'binary', status='old')
          read(ir) bfh
          read(ir) bih
          len = bih%biwidth * bih%biheight
          if (bih%bibitcount == 8) then 
            allocate(bcolmap(256))
            read(ir) bcolmap
            allocate( itmp(len) )
            read(ir) itmp
          else if (bih%bibitcount == 4) then
            allocate(bcolmap(16))
            read(ir) bcolmap
            allocate( itmp(len) )
            itmp = 0
            read(ir) itmp
            do i = 1, len, 2
              itmp( (i + 1) / 2) = itmp(i + 1) * 16 + itmp(i)   
            end do
          end if 
          close(ir)
        end subroutine readbitmapfile
!----------------------------------------------------
        subroutine readbitmapdata(text, iwidth, iheight, ipixel)
          character(len = *)     , intent(in ) :: text
          integer                , intent(out) :: iwidth, iheight
          integer(1), allocatable, intent(out) :: ipixel(:)
          type(t_bitmapinfoheader) :: bih
          integer :: istatus, isel, icounter, icolor
          integer :: i, j, k, m
          type(t_rgbquad), allocatable :: bcolmap(:)
          integer(1)     , allocatable :: idata(:)
          !
          call readbitmapfile('tmp.bmp', bih, bcolmap, idata)
          iwidth  = bih%biwidth
          iheight = bih%biheight
          allocate( ipixel( 4 * iwidth * iheight ) )
          if (bih%bibitcount == 8) then
            do j = 0, iheight - 1
              do i = 0, iwidth - 1
                k = 4 * (j * iwidth + i) + 1
                m = idata(j * iwidth + i + 1)
                if (m < 0) m = 256 + m
                m = m + 1 
                ipixel(k    ) = bcolmap(m)%rgbred
                ipixel(k + 1) = bcolmap(m)%rgbgreen
                ipixel(k + 2) = bcolmap(m)%rgbblue
                ipixel(k + 3) = 255
              end do
            end do
          else if (bih%bibitcount == 4) then
            icounter = 0
            do j = 0, iheight - 1
              do i = 0, iwidth - 1
                icounter = icounter + 1
                icolor = idata(icounter)
            !   if (icolor < 0) icolor = icolor + 256 ! 
                ipixel(k    ) = bcolmap(icolor)%rgbred
                ipixel(k + 1) = bcolmap(icolor)%rgbgreen
                ipixel(k + 2) = bcolmap(icolor)%rgbblue
                ipixel(k + 3) = 255
              end do
            end do
          end if
          deallocate(bcolmap, idata)
        end subroutine readbitmapdata
!----------------------------------------------------
      end module m_bitmap
!====================================================
      module m_callback
        use opengl_gl
        use opengl_glu
        use opengl_glut
        use m_bitmap
        implicit none
        integer(glcint), parameter :: key_esc = 27
        integer(glcint) :: ixbegin = 0, iybegin = 0
        integer(glcint) :: mbutton
        real(glfloat )  :: distance, twist, elevation, azimuth
        real(gldouble)  :: dnear = 1.0_gldouble, far = 30.0_gldouble, fovy = 60.0_gldouble
      contains
!---------------------------------------------------------
        subroutine display() bind(c)
          real(glfloat) :: diffuse(4)  = (/ 0.0_glfloat, 0.0_glfloat, 1.0_glfloat, 1.0_glfloat /)
          real(glfloat) :: specular(4) = (/ 1.0_glfloat, 1.0_glfloat, 1.0_glfloat, 1.0_glfloat /)
          real(glfloat) :: ambient(4)  = (/ 0.1_glfloat, 0.1_glfloat, 0.1_glfloat, 1.0_glfloat /)
          !
          call glclear( ior(gl_color_buffer_bit, gl_depth_buffer_bit) )
          call glpushmatrix()
          call polarview( )
          call glenable( gl_depth_test )
          call glenable( gl_texture_2d )
          !
          call glmaterialfv( gl_front, gl_diffuse  , diffuse   ) 
          call glmaterialfv( gl_front, gl_specular , specular  )
          call glmaterialfv( gl_front, gl_ambient  , ambient   )
          call glmaterialf ( gl_front, gl_shininess, 128.0_glfloat )
          call glenable( gl_lighting )
          !
          call glbindtexture( gl_texture_2d, 1 )
           call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
          call glend()
          call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
          call glend()
          call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
          call glend()
          call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
          call glend()
          call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat, 0.5_glfloat,-0.5_glfloat )
          call glend()
          call glbegin( gl_quads )
           call gltexcoord2f( 0.0_glfloat, 0.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
           call gltexcoord2f( 0.0_glfloat, 1.0_glfloat )
           call glvertex3f  (-0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 1.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat, 0.5_glfloat )
           call gltexcoord2f( 1.0_glfloat, 0.0_glfloat )
           call glvertex3f  ( 0.5_glfloat,-0.5_glfloat,-0.5_glfloat )
          call glend()
!
          call gldisable( gl_texture_2d )
          call glpopmatrix()
          call gldisable( gl_lighting  )
          call gldisable( gl_depth_test )
          call glutswapbuffers() 
        end subroutine display
!---------------------------------------------------------
        subroutine mykbd(key, ix, iy) bind(c)
          integer(glcint), value :: key, ix, iy
          select case(key)
            case (key_esc) 
              stop
            case default
              continue
          end select
          call glutpostredisplay()
        end subroutine mykbd
!---------------------------------------------------------
        subroutine makeimage()
          integer :: iheight, iwidth
          integer(1), allocatable :: image(:)
          integer :: iret
          call readbitmapdata("tmp.bmp", iwidth, iheight, image)
          call glpixelstorei( gl_unpack_alignment, 1 )
          call glbindtexture( gl_texture_2d, 1 )
          call gltexparameteri( gl_texture_2d, gl_texture_wrap_s    , gl_repeat  )
          call gltexparameteri( gl_texture_2d, gl_texture_wrap_t    , gl_repeat  )
          call gltexparameteri( gl_texture_2d, gl_texture_mag_filter, gl_nearest )
          call gltexparameteri( gl_texture_2d, gl_texture_min_filter, gl_nearest )
          call glteximage2d( gl_texture_2d, 0, 4, iwidth, iheight,0, &
                             gl_rgba, gl_unsigned_byte, c_loc(image) )
          call gltexenvi( gl_texture_env, gl_texture_env_mode, gl_decal )
          call glenable ( gl_texture_2d )
        end subroutine makeimage
!---------------------------------------------------------
        subroutine myinit(progname)
          character(len = *), intent(in) :: progname
          integer(glcint) :: iwidth = 700, iheight = 700
          integer(glcint) :: iwin
          call glutinitwindowposition( 0_glfloat, 0_glfloat )
          call glutinitwindowsize( iwidth, iheight )
          call glutinitdisplaymode( ior(ior(glut_rgba, glut_depth), glut_double) )
          iwin = glutcreatewindow( progname )
          call glclearcolor( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat, 1.0_glfloat )
          call glutkeyboardfunc( mykbd )
          call resetview()
          call makeimage()
          call glshademodel( gl_smooth )
          call glenable( gl_light0 )
        end subroutine myinit
!---------------------------------------------------------
        subroutine myreshape(iwidth, iheight) bind(c)
          integer(glcint), value :: iwidth, iheight
          real(gldouble) :: aspect 
          aspect = real(iwidth, glfloat) / real(iheight, glfloat)
          call glviewport( 0, 0, iwidth, iheight )
          call glmatrixmode( gl_projection )
          call glloadidentity()
          call gluperspective( fovy, aspect, dnear, far )
          call glmatrixmode( gl_modelview )
        end subroutine myreshape
!---------------------------------------------------------
        subroutine polarview()
          call gltranslatef( 0.0_glfloat, 0.0_glfloat, -distance )
          call glrotatef(-twist    , 0.0_glfloat, 0.0_glfloat, 1.0_glfloat )
          call glrotatef(-elevation, 1.0_glfloat, 0.0_glfloat, 0.0_glfloat )
          call glrotatef(-azimuth  , 0.0_glfloat, 1.0_glfloat, 0.0_glfloat )
        end subroutine polarview
!---------------------------------------------------------
        subroutine resetview()
          distance  =   2.0_glfloat
          twist     =   0.0_glfloat
          elevation = -30.0_glfloat
          azimuth   =  30.0_glfloat
        end subroutine resetview
!---------------------------------------------------------
        subroutine mymouse( ibutton, istate, ix, iy ) bind(c)
          integer(glcint), value :: ibutton, istate, ix, iy 
          if (istate == glut_down) then
            ixbegin = ix
            iybegin = iy
            mbutton = ibutton
          end if
        end subroutine mymouse
!---------------------------------------------------------
        subroutine mymotion( ix, iy ) bind(c)
          integer(glcint), value :: ix, iy
          integer(glcint) :: ixdisp, iydisp
          ixdisp = ix - ixbegin
          iydisp = iy - iybegin
          select case (mbutton)
            case (glut_left_button)
              azimuth   = azimuth   + ixdisp / 2.0_glfloat
              elevation = elevation - iydisp / 2.0_glfloat
            case (glut_middle_button)
              twist = amod( twist + ixdisp, 360.0_glfloat )
            case (glut_right_button)
              distance = distance - iydisp / 40.0_glfloat
            case default
              continue
          end select 
          ixbegin = ix
          iybegin = iy
          call glutpostredisplay()
        end subroutine mymotion
!---------------------------------------------------------
    end module m_callback
!=========================================================
        program glut8
          use m_callback
          implicit none
          call glutinit()
          call myinit( 'tktt & yosigyu' )
          call glutreshapefunc( myreshape )
          call glutdisplayfunc( display   )
          call glutmousefunc  ( mymouse   )
          call glutmotionfunc ( mymotion  )
          call glutmainloop()
        end program glut8