コンウェイのライフゲームというものがあります。昔、マイコン上でよく遊ばれていたものです。あれは２次元でのものでしたが、OpenGL があるのでせっかくだから三次元でやってみることにしました。
結論から言うと、生命発生・維持・死亡のバランスが難しく、ちょっとパラメータをいじった範囲ではあまり面白いものになりませんでした。コロニー状の定常状態は発生しても、形を保って動いてゆく図形が現れないところがつまらないです。
ふと思いついて作り始めて、どうでもいい OpenGL での描画のデバッグに時間を食ってしまい、肝心のメインの部分を全然チェックしていません。
（むしろ、独立な二次元面を重ねて三次元にしたほうが面白いかもしれないと思いました。）
■実行結果
40*40*40 の立方体状の単純格子上で実行しています。
光源を無限遠の平行光にしているので、赤い点は光源ではなく、マーカーの中心から見た光源の方向になっています。
■Fortran ソース
- 境界の扱いですが周期境界条件ではなく、壁に囲まれたようになっています。
- 最初の分布は乱数で決めています。
- 生命誕生・存続・死亡の条件は最隣接サイトの占有数で決定しています。
- 占有数 1〜9 ：淋しくて死亡。
- 占有数 10〜19 ：生命誕生または生きながらえる。
- 占有数 20〜26 ：人口過密で死亡。
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(C_INT) 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(C_INT) 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(C_DOUBLE) FUNCTION arUtilTimer() BIND(C, NAME = 'arUtilTimer') USE, INTRINSIC :: ISO_C_BINDING 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, 1.0_glfloat, 0.0_glfloat, 1.0_glfloat ] REAL(glfloat ) :: mat_flash(4) = [ 0.0_glfloat, 1.0_glfloat, 0.0_glfloat, 1.0_glfloat ] REAL(glfloat ) :: mat_flash_shiny(1) = [ 50.0 ] REAL(glfloat ) :: ambi(4) = [ 0.1_glfloat, 0.1_glfloat, 0.1_glfloat, 0.1_glfloat ] REAL(glfloat ) :: lightZeroColor(4) = [ 0.0_glfloat, 1.0_glfloat, 1.0_glfloat, 0.1_glfloat ] ! shadow REAL(gldouble) :: shadowMatrix(4, 4), plane(4) REAL(glfloat ), SAVE :: xl = 50.0_glfloat, yl = 50.0_glfloat, zl = 200.0_glfloat, wl = 0.0_glfloat, theta = 0.0 ! INTEGER, PARAMETER :: nz = 40 INTEGER, SAVE :: icount, mat(nz, nz, nz) = 0 INTEGER :: ix, iy, iz, m(nz, nz, nz) LOGICAL, SAVE :: qfirst = .TRUE. REAL, ALLOCATABLE :: tmp(:, :, :) ! ! move light position ! xl = 100.0 * COS(theta) yl = 100.0 * SIN(theta) theta = theta + 0.05 ! 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) CALL argConvGlpara(patt_trans, gl_para) ! /* load the camera transformation matrix */ CALL glMatrixMode(GL_MODELVIEW) CALL glLoadMatrixd( gl_para ) CALL glLightfv(GL_LIGHT0, GL_POSITION, [xl, yl, zl, wl]) ! light_position + light kind 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) ! IF (qfirst) THEN qfirst = .FALSE. CALL RANDOM_SEED() ALLOCATE(tmp(nz, nz, nz)) CALL RANDOM_NUMBER(tmp) WHERE (tmp > 0.74) mat = 1 DEALLOCATE(tmp) icount = 0 END IF icount = icount + 1 ! ! Life cycle ! IF (MOD(icount, 10) == 0) THEN ! delay DO ix = 1, nz DO iy = 1, nz DO iz = 1, nz SELECT CASE( icount_nextn(mat, ix, iy, iz) ) CASE (0:9,20:26) m(ix, iy, iz) = 0 CASE (10:19) m(ix, iy, iz) = 1 CASE DEFAULT STOP 'error impossible!' END SELECT END DO END DO END DO mat = m END IF ! ! light position = [xl, yl, zl, wl] ! CALL glPushMatrix() CALL glPushAttrib(GL_LIGHTING_BIT) CALL glColor3f(1.0_glfloat, 0.0_glfloat, 0.1_glfloat) CALL glTranslatef( xl, yl, zl ) CALL glutSolidSphere(5.0_gldouble, 10, 10) CALL glPopAttrib() CALL glPopMatrix() ! ! Shadow ! plane = [ 0.0_gldouble, 0.0_gldouble, 1.0_gldouble, 0.0_gldouble] ! plane normal; 4th element = intercept CALL glPushMatrix() CALL projectShadowMatrix(shadowMatrix, plane, [xl, yl, zl, wl]) ! light vector; 4th element = scaling factor CALL glMultMatrixd(shadowMatrix) ! CALL glScalef(5.0_glfloat, 5.0_glfloat, 5.0_glfloat) CALL glPointSize(7.0_glfloat) CALL glTranslatef( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glColor3f(0.0_glfloat, 0.0_glfloat, 0.0_glfloat) ! CALL glBegin(GL_POINTS) DO ix = 1, nz DO iy = 1, nz DO iz = 1, nz IF (mat(ix, iy, iz) == 1) CALL glVertex3f(REAL(ix - nz / 2, glfloat), REAL(iy - nz / 2, glfloat), REAL(iz, glfloat)) END DO END DO END DO CALL glEnd() CALL glPopMatrix() ! ! object ! CALL glPushMatrix() CALL glEnable(GL_LIGHTING) CALL glEnable(GL_LIGHT0) ! CALL glScalef(5.0_glfloat, 5.0_glfloat, 5.0_glfloat) CALL glPointSize(7.0_glfloat) CALL glTranslatef( 0.0_glfloat, 0.0_glfloat, 0.0_glfloat ) CALL glColor3f(1.0_glfloat, 1.0_glfloat, 1.0_glfloat) CALL glBegin(GL_POINTS) DO ix = 1, nz DO iy = 1, nz DO iz = 1, nz IF (mat(ix, iy, iz) == 1) CALL glVertex3f(REAL(ix - nz / 2, glfloat), REAL(iy - nz / 2, glfloat), REAL(iz, glfloat)) END DO END DO END DO CALL glEnd() CALL glPopMatrix() ! IF ( SUM(mat) == 0 ) qfirst = .TRUE. ! restart when all dead ! CALL glDisable( GL_LIGHTING ) CALL glDisable( GL_DEPTH_TEST ) RETURN END SUBROUTINE draw !---------------------------------------------------- INTEGER FUNCTION icount_nextn(mat, ix0, iy0, iz0) ! count next neighbour INTEGER, INTENT(IN) :: mat(:, :, :), ix0, iy0, iz0 INTEGER :: kx, ky, kz icount_nextn = 0 DO kx = ix0 - 1, ix0 + 1 IF ( kx < 1 .OR. kx > SIZE(mat, 1) ) CYCLE DO ky = iy0 - 1, iy0 + 1 IF ( ky < 1 .OR. ky > SIZE(mat, 2) ) CYCLE DO kz = iz0 - 1, iz0 + 1 IF ( kz < 1 .OR. kz > SIZE(mat, 3) ) CYCLE IF ( kx == ix0 .AND. ky == iy0 .AND. kz == iz0 ) CYCLE ! skip center IF ( mat(kx, ky, kz) == 1 ) icount_nextn = icount_nextn + 1 END DO END DO END DO RETURN END FUNCTION icount_nextn !------------------------------------------------------------- SUBROUTINE projectShadowMatrix(sm, plane, light) REAL(gldouble), INTENT(OUT) :: sm(:, :) REAL(gldouble), INTENT(IN ) :: plane(:) REAL(glfloat ), INTENT(IN ) :: light(:) REAL(gldouble) :: dot INTEGER :: i sm = 0.0 dot = DOT_PRODUCT(plane, REAL(light, gldouble)) ! <plane|light> I dot_product * diagonal Matrix DO i = 1, 4 sm(:, i) = -REAL(light(:), gldouble) * plane(i) ! |light><plane| 4x4 Matrix END DO DO i = 1, 4 sm(i, i) = dot + sm(i, i) END DO RETURN END SUBROUTINE projectShadowMatrix 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
