「ライフゲーム」の編集履歴（バックアップ）一覧はこちら

「ライフゲーム」(2010/01/11 (月) 19:18:51) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

昔なつかしいライフゲーム。

ルールは簡単。
セルが生きていて周り８つのセルを数えて2か3なら生き残る、
セルが死んでいて周りが３つなら誕生。
これだけ。

 'ライフゲーム
 #N88BASIC
 Const XMAX = 30
 Const YMAX = 30
 Const XMIN = 1
 Const YMIN = 1
 
 Const INIT_CELL_PER = 20'初期ライフの割合
 Const TIMER = 250
 Const CELLSIZE = 16
 Enum MAPPING
   MAINMAP
   SUBMAP
 End Enum
  
 Dim cell[XMAX,YMAX,1] As Byte
 MAIN()
 
 Sub MAIN()
   Randomize
   INIT()
   While (1)
     DRAW()
     Sleep(TIMER)
     NEWGEN()
   Wend
 End Sub
 
 Sub INIT()
   Dim x As Long, y As Long
 
   For x=XMIN To XMAX
     For y=YMIN To YMAX
       If Int(Rnd() *  100) < INIT_CELL_PER THen
         cell[x,y,MAINMAP] = 1
       Else
          cell[x,y,MAINMAP] = 0
       End If
     Next y
   Next x
 
 End Sub
 
 Sub DRAW()
   Dim x As Long, y As Long
 
   For x=XMIN To XMAX
     For y=YMIN To YMAX
       Line(x*CELLSIZE,y*CELLSIZE)-((x+1)*CELLSIZE, (y+1)*CELLSIZE),cell[x,y,MAINMAP],BF
     Next y
   Next x
 End Sub
 
 Sub NEWGEN()
   Dim x As Long, y As Long
   Dim cellcount As Long
   For x=XMIN To XMAX
     For y=YMIN To YMAX
     cellcount = GetCell(x,y)
     If cell[x,y,MAINMAP] = 0 And cellcount = 3 Then
       cell[x,y,SUBMAP] = 1
     Else If cell[x,y,MAINMAP] > 0 And cellcount >1 And cellcount <4 Then
       cell[x,y,SUBMAP] = cell[x,y,MAINMAP]+1
       If cell[x,y,SUBMAP] > 7 Then cell[x,y,SUBMAP] = 7
     Else
       cell[x,y,SUBMAP] = 0
     End If
     Next y
   Next x
   For x=XMIN To XMAX
     For y=YMIN To YMAX
       cell[x,y,MAINMAP] = cell[x,y,SUBMAP]
     Next y
   Next x
 End Sub
 
 Function GetCell(x As Long, y As Long) As Long
   GetCell = 0
   If cell[x-1,y-1,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x-1,y  ,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x-1,y+1,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x  ,y-1,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x  ,y+1,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x+1,y-1,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x+1,y  ,MAINMAP] > 0 Then GetCell=GetCell+1
   If cell[x+1,y+1,MAINMAP] > 0 Then GetCell=GetCell+1
 End Function