GLUT (Gyudon Love Uho TKTT)
F03GL 利用の環境設定メモ帳
以前と比べて使いやすくなった気がします。
- F03GL f03gl.zip dowmload F03GL: Fortran interface to OpenGL
- FreeGlut freeglut 2.8.1 MSVC download http://www.transmissionzero.co.uk/software/freeglut-devel/、The freeglut Project :: About
- F03GL から opengl_gl.f90、 opengl_glu.f90、 opengl_glut.f90 (但し opengl_freeglut.f90 を改名したもの）を抜き出す。
- 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 へコピー。
- Configuration は x64 のみ。
- Linker -> Input は、Opengl32.lib Glu32.lib freeglut.lib の三つを追加。
以前のプログラムの再現
少しだけ書き直しました。
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
