しばらくぶりに、ARToolKitをいじってみます。
ローレンツ・アトラクターは複雑な三次元図形なので、ARToolKit で任意方向から眺め回せれば愉快かなとふと思う。去年作ったプログラムの描画部分を数行ばかり変えることで実現できるはず。
アトラクター部分は『C言語による 最新 アルゴリズム事典』を参照しました。
新たな環境にインストール
必要条件 チラシ裏
- F90GL が動いていること。
- ARToolKit 展開。インストールはいらない。展開だけでおk。
- 実行ファイルは展開ディレクトリ下の bin に置かないと、初期ファイルが読めない。
- LIB Path に、展開ディレクトリ下の lib を指定。
- 必要ライブラリ glut32.lib f90gl.lib f90glu.lib f90glut.lib libAR.lib libARgsub.lib libARvideo.lib
- Fortran のコンソールアプリとして製作する。
- ESCで終了しないとゴミプロセスが溜まる。
インターフェースでのポインター定義などを微妙に修正。
MODULE m_ART USE, INTRINSIC :: ISO_C_BINDING USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE !---- TYPE definitions --------------------------------- TYPE, BIND(C) :: t_ARParam INTEGER(C_INT) :: ixsize, iysize REAL(C_DOUBLE) :: dmat(4, 3) REAL(C_DOUBLE) :: dist_factor(4) END TYPE ! TYPE, BIND(C) :: t_ARMarkerInfo INTEGER(C_INT) :: iarea INTEGER(C_INT) :: id INTEGER(C_INT) :: dir REAL(C_DOUBLE) :: cf REAL(C_DOUBLE) :: pos(2) REAL(C_DOUBLE) :: dline(3, 4) REAL(C_DOUBLE) :: vertex(2, 4) END TYPE !---- global variables --------------------------------- INTEGER(C_INT) :: ithresh = 100 INTEGER(C_INT) :: icount = 0 INTEGER(C_INT) :: ipatt_id REAL(C_DOUBLE) :: patt_width = 80.0_c_double REAL(C_DOUBLE) :: patt_center(2) = (/0.0_c_double, 0.0_c_double/) REAL(C_DOUBLE) :: patt_trans(3, 4) INTEGER(C_INT) :: ixsize, iysize TYPE(t_ARParam) :: cparam !---- INTERFACE BLOCK ----------------------------------- INTERFACE SUBROUTINE arVideoCapStop() BIND(C, NAME = 'arVideoCapStop') END SUBROUTINE arVideoCapStop ! SUBROUTINE arVideoClose() BIND(C, NAME = 'arVideoClose') END SUBROUTINE arVideoClose ! SUBROUTINE argCleanup() BIND(C, NAME = 'argCleanup') END SUBROUTINE argCleanup ! INTEGER(C_INT) FUNCTION arVideoGetImage() BIND(C, NAME = 'arVideoGetImage') USE, INTRINSIC :: ISO_C_BINDING END ! SUBROUTINE arUtilSleep(i) BIND(C, NAME = 'arUtilSleep') USE, INTRINSIC :: ISO_C_BINDING INTEGER(C_INT), VALUE :: i END ! SUBROUTINE arUtilTimerReset() BIND(C, NAME = 'arUtilTimerReset') USE, INTRINSIC :: ISO_C_BINDING END ! SUBROUTINE argDrawMode2D() BIND(C, NAME = 'argDrawMode2D') END ! SUBROUTINE argDispImage( iptr, i, j ) BIND(C, NAME = 'argDispImage') USE, INTRINSIC :: ISO_C_BINDING INTEGER(C_INTPTR_T), VALUE :: iptr INTEGER, VALUE :: i, j END ! INTEGER(C_INT) FUNCTION arDetectMarker( iptr, i, mark, k ) BIND(C, NAME = 'arDetectMarker') USE, INTRINSIC :: ISO_C_BINDING IMPORT :: t_ARMarkerInfo INTEGER(C_INTPTR_T), VALUE :: iptr INTEGER(C_INT) , VALUE :: i TYPE(t_ARMarkerInfo), POINTER :: mark(:) INTEGER(C_INT) :: k END ! SUBROUTINE arVideoCapNext() BIND(C, NAME = 'arVideoCapNext') END ! SUBROUTINE argSwapBuffers() BIND(C, NAME = 'argSwapBuffers') END ! SUBROUTINE arGetTransMat(ptr, d1, d, d2) BIND(C, NAME = 'arGetTransMat') USE, INTRINSIC :: ISO_C_BINDING TYPE(C_PTR), VALUE :: ptr REAL(C_DOUBLE), VALUE :: d REAL(C_DOUBLE):: d1(2), d2(3, 4) END ! SUBROUTINE argDrawMode3D() BIND(C, NAME = 'argDrawMode3D') END SUBROUTINE argDrawMode3D ! SUBROUTINE argDraw3dCamera(ix, iy) BIND(C, NAME = 'argDraw3dCamera') USE, INTRINSIC :: ISO_C_BINDING INTEGER(C_INT), VALUE :: ix, iy END ! SUBROUTINE argConvGlpara(x, y) BIND(C, NAME = 'argConvGlpara') USE, INTRINSIC :: ISO_C_BINDING REAL(C_DOUBLE) :: x(4, 3), y(4, 4) END ! SUBROUTINE arVideoCapStart() BIND(C, NAME = 'arVideoCapStart') END ! SUBROUTINE argMainLoop( i, j, k ) BIND(C, NAME = 'argMainLoop') USE, INTRINSIC :: ISO_C_BINDING INTEGER, VALUE :: i TYPE(C_FUNPTR), VALUE :: j, k END ! INTEGER(4) FUNCTION arVideoOpen(text) BIND(C, NAME = 'arVideoOpen') USE, INTRINSIC :: ISO_C_BINDING CHARACTER(C_CHAR) :: text(*) END ! INTEGER(C_INT) FUNCTION arVideoInqSize(ix, iy) BIND(C, NAME = 'arVideoInqSize') USE, INTRINSIC :: ISO_C_BINDING INTEGER(C_INT) :: ix, iy END ! INTEGER(C_INT) FUNCTION arParamLoad(text, i, xparam) BIND(C, NAME = 'arParamLoad') USE, INTRINSIC :: ISO_C_BINDING IMPORT :: t_ARParam CHARACTER(C_CHAR) :: text(*) TYPE(t_ARParam) :: xparam INTEGER(C_INT), VALUE :: i END ! SUBROUTINE arParamChangeSize(xparam, i, j, yparam) BIND(C, NAME = 'arParamChangeSize') USE, INTRINSIC :: ISO_C_BINDING IMPORT :: t_ARParam TYPE(t_ARParam) :: xparam, yparam INTEGER(C_INT), VALUE :: i, j END ! SUBROUTINE arInitCparam(xparam) BIND(C, NAME = 'arInitCparam' ) IMPORT :: t_ARParam TYPE(t_ARParam) :: xparam END ! SUBROUTINE arParamDisp(xparam) BIND(C, NAME = 'arParamDisp') IMPORT :: t_ARParam TYPE(t_ARParam) :: xparam END ! INTEGER(4) FUNCTION arLoadPatt(text) BIND(C, NAME = 'arLoadPatt') USE, INTRINSIC :: ISO_C_BINDING CHARACTER(C_CHAR) :: text(*) END ! SUBROUTINE argInit(iptr, d, i1, i2, i3, i4) BIND(C, NAME = 'argInit') USE, INTRINSIC :: ISO_C_BINDING TYPE(C_PTR), VALUE :: iptr REAL(C_DOUBLE) , VALUE :: d INTEGER(C_INT) , VALUE :: i1, i2, i3, i4 END ! REAL(8) FUNCTION arUtilTimer() BIND(C, NAME = 'arUtilTimer') END FUNCTION arUtilTimer END INTERFACE CONTAINS !------------------------------------------------- SUBROUTINE init() BIND(C) USE, INTRINSIC :: ISO_C_BINDING USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE TYPE(t_ARParam) :: wparam CHARACTER (LEN = 35) :: vconf = "Data\\WDM_camera_flipV.xml" // c_null_char CHARACTER (LEN = 35) :: cparam_name = "Data\\camera_para.dat" // c_null_char CHARACTER (LEN = 35) :: patt_name = "Data\\patt.hiro" // c_null_char ! /* open the video path */ IF( arVideoOpen( vconf ) < 0 ) STOP ! /* find the size of the window */ IF( arVideoInqSize( ixsize, iysize ) < 0 ) STOP PRINT *, "Image size (x,y) = ", ixsize, iysize ! /* set the initial camera parameters */ IF ( arParamLoad( cparam_name, 1, wparam ) < 0 ) THEN PRINT *, "Camera parameter load error !!" STOP END IF CALL arParamChangeSize( wparam, ixsize, iysize, cparam ) CALL arInitCparam( cparam ) PRINT *, "*** Camera Parameter ***" CALL arParamDisp( cparam ) ipatt_id = arLoadPatt( patt_name ) IF ( ipatt_id < 0 ) THEN PRINT *, "pattern load error !!" STOP END IF ! /* open the graphics window */ CALL argInit( C_LOC(cparam), 1.0_c_double, 0, 0, 0, 0 ) RETURN END SUBROUTINE init !------------------------------------------------- SUBROUTINE mainLoop() BIND(C, NAME = 'mainLoop') IMPLICIT NONE INTEGER(C_INTPTR_T) :: dataPtr TYPE(t_ARMarkerInfo), POINTER:: marker_info(:) INTEGER(C_INT) :: marker_num INTEGER(C_INT) :: j, k LOGICAL, SAVE :: qfirst = .TRUE. IF (qfirst) THEN ALLOCATE(marker_info(50)) ! ? qfirst = .FALSE. END IF dataPtr = arVideoGetImage() IF (dataPtr == 0) THEN CALL arUtilSleep(2) RETURN END IF IF (icount == 0) CALL arUtilTimerReset() icount = icount + 1 CALL argDrawMode2D() CALL argDispImage( dataPtr, 0, 0 ) IF ( arDetectMarker( dataPtr, ithresh, marker_info, marker_num ) < 0 ) THEN CALL cleanup() RETURN END IF CALL arVideoCapNext() k = -1 DO j = 1, marker_num IF (ipatt_id == marker_info(j)%id) THEN IF (k == -1) THEN k = j ELSE IF (marker_info(k)%cf < marker_info(j)%cf ) k = j END IF END IF END DO IF ( k == -1 ) THEN CALL argSwapBuffers() RETURN END IF ! draw-main CALL arGetTransMat( C_LOC(marker_info(k)), patt_center, patt_width, patt_trans ) CALL draw() CALL argSwapBuffers() RETURN END SUBROUTINE mainLoop !------------------------------------------------- SUBROUTINE cleanup() BIND(C) USE, INTRINSIC :: ISO_C_BINDING USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE CALL arVideoCapStop() CALL arVideoClose() CALL argCleanup() RETURN END SUBROUTINE cleanup !------------------------------------------------- SUBROUTINE keyEvent( key, ix, iy ) BIND(C, NAME = 'keyEvent') USE, INTRINSIC :: ISO_C_BINDING USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE INTEGER(C_SIGNED_CHAR), VALUE :: key INTEGER(C_INT) , VALUE :: ix, iy IF (key == 27) THEN PRINT *, "*** ", icount / arUtilTimer(), "(frame/sec)" CALL cleanup() STOP END IF RETURN END SUBROUTINE keyEvent !--------------------------------------------------------------- SUBROUTINE draw() BIND(C) USE, INTRINSIC :: ISO_C_BINDING USE opengl_gl USE opengl_glu USE opengl_glut IMPLICIT NONE REAL(gldouble) :: gl_para(4, 4) REAL(glfloat ) :: mat_ambient(4) = (/0.0_glfloat, 0.0_glfloat, 1.0_glfloat, 1.0_glfloat/) REAL(glfloat ) :: mat_flash(4) = (/0.0_glfloat, 0.0_glfloat, 1.0_glfloat, 1.0_glfloat/) REAL(glfloat ) :: mat_flash_shiny(1) = (/50.0/) REAL(glfloat ) :: light_position(4) = (/100.0_glfloat, -200.0_glfloat, 200.0_glfloat, 0.0_glfloat/) REAL(glfloat ) :: ambi(4) = (/0.1_glfloat, 0.1_glfloat, 0.1_glfloat, 0.1_glfloat/) REAL(glfloat ) :: lightZeroColor(4) = (/1.0_glfloat, 0.0_glfloat, 0.0_glfloat, 0.1_glfloat/) REAL(glfloat ), PARAMETER :: a = 10.0_glfloat, b = 28.0_glfloat, & c = 8.0_glfloat / 3.0_glfloat, d = 0.01_glfloat REAL(glfloat ) :: x, y, z REAL(glfloat ), SAVE :: dx(3000), dy(3000), dz(3000) INTEGER :: i LOGICAL, SAVE :: first = .TRUE. ! ! Lorenz attractor IF (first) THEN first = .FALSE. x = 1.0_glfloat y = 1.0_glfloat z = 1.0_glfloat DO i = 1, 3000 dx(i) = a * (y - x) dy(i) = x * (b - z) - y dz(i) = x * y - c * z x = x + d * dx(i) y = y + d * dy(i) z = z + d * dz(i) END DO END IF ! CALL argDrawMode3D() CALL argDraw3dCamera( 0, 0 ) CALL glClearDepth( 1.0_gldouble ) CALL glClear(GL_DEPTH_BUFFER_BIT) CALL glEnable(GL_DEPTH_TEST) CALL glDepthFunc(GL_LEQUAL) ! /* load the camera transformation matrix */ CALL argConvGlpara(patt_trans, gl_para) CALL glMatrixMode(GL_MODELVIEW) CALL glLoadMatrixd( gl_para ) CALL glEnable(GL_LIGHTING) CALL glEnable(GL_LIGHT0) CALL glLightfv(GL_LIGHT0, GL_POSITION, light_position) CALL glLightfv(GL_LIGHT0, GL_AMBIENT, ambi) CALL glLightfv(GL_LIGHT0, GL_DIFFUSE, lightZeroColor) CALL glMaterialfv(GL_FRONT, GL_SPECULAR, mat_flash) CALL glMaterialfv(GL_FRONT, GL_SHININESS, mat_flash_shiny) CALL glMaterialfv(GL_FRONT, GL_AMBIENT, mat_ambient) CALL glMatrixMode(GL_MODELVIEW) !--- from here ------------------- CALL glTranslatef( 0.0_glfloat, 0.0_glfloat, 30.0_glfloat ) DO i = 1, 3000 CALL glTranslatef( dx(i) / 35.0, dy(i) / 35.0, dz(i) / 35.0 ) IF (i > 100) THEN CALL glutSolidCube(2.0_gldouble ) END IF END DO !--- till here ---------------------- CALL glDisable( GL_LIGHTING ) CALL glDisable( GL_DEPTH_TEST ) RETURN END SUBROUTINE draw !------------------------------------------------------------- END MODULE m_ART !===================================================== PROGRAM main1 USE m_art IMPLICIT NONE CALL glutInit() CALL init() CALL arVideoCapStart() CALL argMainLoop( 0, C_FUNLOC(keyEvent), C_FUNLOC(mainLoop) ) STOP END PROGRAM main1