FreeBASIC コンウェイのライフゲーム

'========================
'コンウェイのライフゲーム
'========================

' 意味とルール : https://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0
' プログラマー :   Klaus Brock                              02/2017
' コンパイル   :   Windows-Console (FbEdit)

Dim Shared As Short i,j,ib,ih,iz,il,k,l,lb,lh,m,n,ix,jx,RegelTyp,fanz,istop,lebend,LivNbrs,breit,hoch,_
                    liox,reux,lioy,reuy,Vzmillsek,Splfd,ireg
Dim Shared As Integer igen,lincolor,circolor,totcolor,lebcolor,backcolor,fndx,MousePosX,MousePosY,MouseKeyState,_
                    scrb,scrh,scrct,xstart,ystart
Dim Shared As String steuer,Taste,Pfeil
Dim Shared As BOOLEAN cnt

'RegelTyp 3 : 生きるための隣人の数 :
Dim Shared As Short ueberleb (1 To 8) = { -1,-1,-1,-1,-1,-1,-1,-1 }
'RegelTyp 3 : 誕生時の隣人の数 :
Dim Shared As Short neugebor (1 To 8) = { -1,-1,-1,-1,-1,-1,-1,-1 }

  lincolor  = 7
  circolor  = 0
  totcolor  = 15
  lebcolor  = 4   ' 最初の割り当て、その後、循環的に
  backcolor = 14  ' 競技場の初期背景
Dim Shared As Integer farbe (1 To 13)  'fndxの色
  Farbe(1)  =  4
  Farbe(2)  =  1
  Farbe(3)  =  2
  Farbe(4)  =  3
  Farbe(5)  =  5
  Farbe(6)  =  6
  Farbe(7)  =  8
  Farbe(8)  =  9
  Farbe(9)  =  10
  Farbe(10) =  11
  Farbe(11) =  12
  Farbe(12) =  13
  Farbe(13) =  10 '14 は背景色

Declare Sub StartWerteSetzen()
Declare Sub GitterLinienZeichnen()
Declare Sub BelebteZellenInit()
Declare Sub MainLoop()

Declare Sub CountLivingNeigbors()

' ... die Conway-"Welten" :
Declare Sub KlassischConway()
Declare Sub KopierWelt()
Declare Sub FreiDefWelt()

' ---

Declare Sub ZellGeburtInit()
Declare Sub ZellGeburt()
Declare Sub ZellTod()
Declare Sub ZellPos()
Declare Sub StopKey()
Declare Sub Ausgestorben()
Declare Sub ShowArray()

'------------------- メイン・プログラム -----------------------------------------------------

Cls

Randomize

StartWerteSetzen

'内部作業配列の望ましい寸法（lh*lb）が判明した :
'numW = 現在のフィールド / numFolg = 次世代のフラグ
Dim Shared As BOOLEAN numW    (1 To lh, 1 To lb)
Dim Shared As BOOLEAN numFolg (1 To lh, 1 To lb)

Do
  GitterLinienZeichnen
  BelebteZellenInit
  igen   = 1     '  生成 = ゲートのすべての論理フィールドを1回通過する
  MainLoop
Loop


'-------------------  レベル1のサブは以下の通り  -----------------------------------------------------

Sub StartWerteSetzen

Width 100,70
  Print ""
  Print "   -------------------------   ■"
  Print "   コンウェイのライフゲーム      ■"
  Print "   ------------------------- ■■■"
  Print ""
  Print "意味とルール : https://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0"
  Print "プログラマー           : Klaus Brock                                02/2017"
  Print ""

  '物理的な画面解像度 :
  ScreenInfo scrb,scrh,scrct
  Print "画面の解像度：b * h * 色深度 : " ;scrb;" * ";scrh;" * ";scrct

  '物理的な画面の幅と高さ、セルのサイズを設定します（すべてピクセル数）。
  Print ""
  Input "描画画面の幅（デフォルトは b/1.5）ピクセル単位             : "; ib
  If ib = 0 Or ib > scrb Then
    ib  = scrb/1.5
  EndIf
  Input "描画画面の高さ（デフォルトは h/1.5 - 30）ピクセル単位      : "; ih
  If ih = 0 Or ih > scrh Then
    ih  = scrh/1.5 - 30  'タスクバーのスペースを確保
  EndIf
  Input "セルの高さ（ピクセル単位）（デフォルト 10 / 最小 2）   : "; iz
  If iz = 0 Then
    iz  = 10
  EndIf
  If iz < 2  Then
    iz  = 2
  EndIf

  '論理画面 サイズ (垂直方向と水平方向のセルの数) を決定します。
  '物理画面 サイズを可能な限り最大に調整します。セルの数は整数です。
  'そのため、物理的な画面 サイズの指定について心配する必要はありません。
  Print ""
  Print "競技場のサイズはセル数（ピクセル数）の整数に調整されます :"
  ib = ib - ib Mod (iz+1) 'math. Remainder
  Print "描画画面の幅をピクセル単位で調整 = "; ib
  ih = ih - ih Mod (iz+1) 'math. Remainder
  Print "描画画面の高さをピクセル単位で調整 = "; ih

  'これにより、論理ゲームゲートのサイズは lb x lh セルとなり、
  '競技場には常に整数個のフィールドが存在することが保証されます :
  Print "結果として得られる競技場のサイズ（セル） :"
  lb = ib \ (iz+1) 'math. Floor
  Print "  log. 競技場の幅(セル単位) = 列 = "; lb
  lh = ih \ (iz+1) 'math. Floor
  Print "  log. 技場の高さ(セル単位) = 行  = "; lh

  '描画画面から飛び出したときの競技場の特性 :
  Print ""
  Print "画面端を越える場合の競技場の特性 : "
  Print "-------------------------------------------------- "
  Print "- 円環面上/下 + 左/右 (デフォルト)"
  Print "  - 左側から出たセルは右側から戻ってくる"
  Print "  - 上に出たセルは下から戻ってくる"
  Print "                            ...逆も同様 (デフォルト)  --> 1"
  Print "- 円環面なし、競技場外"
  Print "                 すべてのセルは死んだとみなされる     --> 2"
  Print "- 円環面は上/下のみ（左/右＝セル死）                  --> 3"
  Print "- 円環面は左/右のみ（上/下＝セル死）                  --> 4"
  Input "競技場の特性を選択してください  : "; Splfd
  If Splfd = 0 Then
     Splfd = 1
  ElseIf Splfd > 4 Then
     Splfd = 1
  Else
  EndIf

  ' クエリルールの種類 / 生存/誕生のルール番号
  Print ""
  Print "ルールの種類 : "
  Print "------------ "
  Print "  23/3   コンウェイ・クラシック（デフォルト）--> RegelTyp 1"
  Print "  1357/1357  コピーワールド                  --> RegelTyp 2"
  Print "  l../b...   自由に定義します                --> RegelTyp 3"
  Input "ルールの種類を選択してください。  : "; RegelTyp
  If RegelTyp= 0 Then
     RegelTyp = 1
  ElseIf RegelTyp= 3 Then
  	  Print
  	  Print "  ライフゲームのルールの略語: (Wikipedia) "
  	  Print "  まず、セルが生き残る場合の近傍の数の数字を（昇順で）指定して、"
  	  Print "  次に、セルが誕生する場合の数字をスラッシュで区切って並べます。"
     Input "  生存条件の数を、最大8桁の 0 〜8（ カンマ区切り）を入力してください : "_
        ,ueberleb(1),ueberleb(2),ueberleb(3),ueberleb(4),ueberleb(5),ueberleb(6)_
        ,ueberleb(7),ueberleb(8)
     Input "  誕生条件の数を、最大 8桁の 0 〜8（ カンマ区切り）を入力してください : "_
        ,neugebor(1),neugebor(2),neugebor(3),neugebor(4),neugebor(5),neugebor(6)_
        ,neugebor(7),neugebor(8)
     For ireg = 2 To 8
     	 If ueberleb(ireg) = 0 Then
     	 	 ueberleb(ireg) = -1
     	 EndIf
     	 If neugebor(ireg) = 0 Then
     	 	 neugebor(ireg) = -1
     	 EndIf
     Next
     Print "  選択されたコンウェイルールの世界 : ";
       For ireg = 1 To 8
       	If ueberleb(ireg) > -1 Then
       		Print ueberleb(ireg);
       	EndIf
       Next ireg
       Print " /";
       For ireg = 1 To 8
       	If neugebor(ireg) > -1 Then
       		Print neugebor(ireg);
       	EndIf
       Next ireg
       Print ""
  ElseIf RegelTyp> 3 Then
     RegelTyp = 1
  Else
  EndIf

    '何世代ごとの停止す条件。0の場合は無限に実行
  Print ""
  Print "途中停止: コピーワールド(ルール タイプ 2)では 4 の倍数を推奨します "
  Print "--------------"
  Input "  何世代ごとに途中停止しますか? ( なしの場合は ENTER ): "; istop
  'If istop = "" Then
  '  istop  = 0
  'EndIf

  ' 各世代終了後の遅延 :
  Print ""
  Print "各生成後の遅延（視認性向上のため）:"
  Print "----------------------------------"
  Print "  遅延なし             デフォルト   :  0"
  Print "  標準遅延（セル数に応じて） 推奨   :  1"
  Print "  遅延表示（ミリ秒単位）.           : nnn"
  Input "遅延を選択してください  : "; Vzmillsek
  If Vzmillsek = 1 Then
     Vzmillsek = ((1921-lb) * (1001-lh)) / 30000
     Print "ミリ秒単位の標準遅延: ";Vzmillsek
  EndIf

  ' 色番号 :
  Print ""
  Input "色数を入力してください 1 - 13 ( Default 1 ) : "; fanz
  If fanz= 0 Then
     fanz= 1
  ElseIf fanz>13 Then
    fanz=13
  Else
  EndIf

  ' ... to do :
  Print ""
  Print "これで絵が描けます :"
  Print "--------------------------"
  Print "- 描画画面で、初期状態で生きているセルを、マウスで左クリックしてマークします。"
  Print "- 誤って入力しセルは、マウスの右クリックで修正できます。"
  Print "- 線の描画 :  M キーを押してキー操作に切り替えます。マウス左クリックで線の起点をマークします。"
  Print "  矢印キーを使って線を描画できます。マウスで描画するモードに戻すには ESCape キーを押します。"
  Print "- 起動・中断・終了 - 空白キーを押すと、描画画面を表示します。"
  Print "                   - S キー(Stop)で描画表示を停止します。何かキー入力すると表示再開します。"
  Print "                   - Stop 状態で A キーを押すと、現在のゲームをキャンセルし、描画をリセットします"
  Print "                   - Stop 状態で C キーを押すと、プログラムは終了します。"
  Print "                   - つまり、描画プログラムの終了は、S キーを押した後 C キーを押します。"
  Print ""
  Print "  ===> 何かキーを押すと描画画面を開始します !"
  Sleep

End Sub


Sub GitterLinienZeichnen

  'ゲームゲート／ライトグレーの線をlhとlb に応じて描画します。グリッド線自体には1ピクセル追加します。
  ScreenRes ib, ih, 8    ' 画面モード 巾 x 高さ 8bpp
  ScreenControl 100,0,0  ' 画面位置 SET_WINDOW_POS 左上
  Color lincolor,backcolor
  Cls
  WindowTitle "コンウェイのライフゲーム /RegTyp=" & RegelTyp & " 世代=" & igen & " (開始：Space、 停止：S、終了：C)"
  ' erst die waagerechten :
  For i=0 To ih Step iz+1
    Line(1,i)-(ib,i),lincolor
  Next i
  ' jetzt die senkrechten :
  For i=0 To ib Step iz+1
    Line(i,1)-(i,ih),lincolor
  Next i
  'Mittelpunktsmarkierung :
  Circle(ib/2,ih/2),iz,circolor

End Sub


Sub BelebteZellenInit

  '内部数字配列をホームポジションへ、これが現在の作業フィールドです :
  For i=1 To lh            'log. Hoehe   (Zeilen)
    For j=1 To lb          'log. Breite  (Spalten)V
      numW(i,j) = FALSE
    Next j
  Next i
  'マウスで最初に生存させるセルを設定する :
  Do
    '描画画面内のマウス座標を決定する :
    GetMouse (MousePosX, MousePosY, , MouseKeyState)    'Mausstatus abfragen
    breit=MousePosX
    hoch =MousePosY
    '線画（m）または終了（スペース）が要求されましたか？
    Taste=InKey
    If Taste = "m" Or Taste = Chr(27) Then 'これらの 2 つの値で矢印操作
       Pfeil = Taste
    EndIf
    'マウス座標から内部数値配列の対応するインデックス i,j を計算する:
    i = hoch  \ (iz+1) +1
    j = breit \ (iz+1) +1
    '内部配列とゲート内のセルを誕生させる、マウスの左ボタン :
    If MouseKeyState And 1 Then
    	numW(i,j) = TRUE
      ZellGeburtInit()
      'カーソルキー（矢印キー）を使って、
      '今入力したセルから始まる線の描画を要求しましたか ? :
      If Pfeil = "m" Then ' m キーは、カーソルキーでは絵を描き始める
        Do
        	 Pfeil = InKey
      	 If Pfeil = Chr(255,72) Then 'nach oben
             i = i - 1
          EndIf
          If Pfeil = Chr(255,75) Then 'nach links
             j = j - 1
          EndIf
          If Pfeil = Chr(255,77) Then 'nach rechts
             j = j + 1
          EndIf
          If Pfeil = Chr(255,80) Then 'nach unten
             i = i + 1
          EndIf
          If Pfeil <> " " Then 'カーソルキーが使われたので、この方向に線を引く
         	numW(i,j) = TRUE
            ZellGeburtInit()
          EndIf
        Loop Until Pfeil = Chr(27) 'ESCape  絵を残すために :
      EndIf
    EndIf
    '誤って生存化されたセルを修正するには、マウスの右ボタン :
    If MouseKeyState And 2 Then
    	numW(i,j) = FALSE
    	ZellTod()
    EndIf
  'スペースキーを押すとマークを終了:
  Loop Until Taste = " "

End Sub


Sub MainLoop

  ' ... そしてここからが本当の始まりです !!!
  '      ------------------------------------
  '
  'マウスで塗りつぶされた競技場の1 回限りの転送 :
  For i=1 To lh            'log. Hoehe   (Zeilen)
   For j=1 To lb          'log. Breite  (Spalten)V
     numFolg(i,j) = numW(i,j)    '最新の状態にする（0=死亡、1誕生の順）
   Next j
  Next i
  '
  Do             '  望ましい無限ループ (s.LOOP)
    ' --- 現在の世代の始まり :  ---
    WindowTitle "コンウェイのライフゲーム /RegTyp=" & RegelTyp & " 世代=" & igen & " (開始：Space、 停止：S、終了：C)"
    lebend = 0          ' この世代以降に「すべて絶滅」したかどうかの検出
    For i=1 To lh
      For j=1 To lb
        CountLivingNeigbors()
        If RegelTyp=1 Then
          KlassischConway()
        ElseIf RegelTyp=2 Then
          KopierWelt()
        ElseIf RegelTyp=3 Then
          FreiDefWelt()
        Else
          'ルールタイプが間違っています。ここでは発生しません
        EndIf
        ' ********** ここでは他のルールの世界も可能です !!!!!!!!!!!!!
        If numW(i,j) = TRUE Then
          lebend = lebend + 1    '世代ごとに現在生きているセルを数える
        EndIf
      Next j
    Next i
    '
    ' --- 現在の世代の終わり :  ---
    '誕生／死亡の内部数字配列を処理します。
    'つまり、現在の数値配列を更新して画像を描画します :
    fndx = (igen Mod fanz) +1  'math. Remainder
    If fndx>13 Then
    	fndx=13
    EndIf
    For i=1 To lh              'log. Hoehe   (Zeilen)
      For j=1 To lb            'log. Breite  (Spalten)
        If numW(i,j) Xor numFolg(i,j) = TRUE Then   '3=以下変更なし。 (0=死亡 1誕生の連続)
          numW(i,j) = numFolg(i,j)
          If numW(i,j) = FALSE Then
            ZellTod()
          EndIf
          If numW(i,j) = TRUE Then
            ZellGeburt()    '塗りつぶされた長方形の色は世代に応じて生じる
          EndIf
        EndIf
      Next j
    Next i
    ' 遅延 :
    Sleep Vzmillsek
    ' ユーザーの停止は「s」経由で要求されたか?
    StopKey()
    ' ... それともすべて絶滅したのでしょうか? これでプログラムは終了です！
    Ausgestorben()
    '途中停止をリクエストしましたか? （4 は「コピーワールド」で役立ちます）
    If istop > 0 Then
    	If igen Mod istop = 0 Then
        Sleep
      EndIf
    EndIf
    igen = igen+1
    Steuer = InKey
    If Steuer = "c" Or Steuer = "C" Then
    	End
    EndIf
  Loop Until ( Steuer = "a" Or Steuer = "A" )  ' A = Abbruch ご破算

End Sub


'-------------------  レベル2のサブが続きます ---------------------------------------------------

Sub CountLivingNeigbors
  'ここでは、対象となるセルの生きている隣接セルがカウントされる。 ( 3 x 3 )
  ' 「トーラス」とは :
  '隣の駒が範囲外、つまりゲーム ゲートの端に直接位置している場合は、
  '反対側の端の行/列が使用されます。
  'これにより、競技場が無限であるかのような振る舞いになります...
  LivNbrs = 0
  For k=i-1 To i+1
    For l=j-1 To j+1
    	 ' 競技場の端を越えてカウントできる（Splfd 1の標準）
    	 cnt=TRUE
       ' プレイフィールドの端を超えない通常のケース（範囲外） :
       m=k
       n=l
       ' 範囲外 / 左、右、上、下を超える = 4 つのケースを扱う :
       ' ------------------------------------------------------------------------------
       'ケース 1: TORUS 左/右 と 上/下 (このような表面は現実には有りえないが)
       If Splfd = 1 Then
         If k<1 Then  'Zeile
           m=lh
         EndIf
         If k>lh Then
           m=1
         EndIf
         If l<1 Then  'Spalte
           n=lb
         EndIf
         If l>lb Then
           n=1
         EndIf
       'Fall 2 : kein TORUS, Randueberschreitung = ZellTod
       ElseIf Splfd = 2 Then
         If k<1 Then  'Zeile
           m=1
           cnt=FALSE
         EndIf
         If k>lh Then
           m=lh
           cnt=FALSE
         EndIf
         If l<1 Then  'Spalte
           n=1
           cnt=FALSE
         EndIf
         If l>lb Then
           n=lb
           cnt=FALSE
         EndIf
       'Fall 3 : TORUS NUR oben/unten  ( links/rechts=ZellTod )
       ElseIf Splfd = 3 Then
         If k<1 Then  'Zeile
           m=lh
         EndIf
         If k>lh Then
           m=1
         EndIf
         If l<1 Then  'Spalte
           n=1
           cnt=FALSE
         EndIf
         If l>lb Then
           n=lb
           cnt=FALSE
         EndIf
       'Fall 4 : TORUS NUR links/rechts ( oben/unten =ZellTod )
       ElseIf Splfd = 4 Then
         If k<1 Then  'Zeile
           m=1
           cnt=FALSE
         EndIf
         If k>lh Then
           m=lh
           cnt=FALSE
         EndIf
         If l<1 Then  'Spalte
           n=lb
         EndIf
         If l>lb Then
           n=1
         EndIf
       Else ' nicht moeglich
       EndIf
       ' 生きている隣接セルを数える :
       If cnt = TRUE  And  numW(m,n) = TRUE Then
         LivNbrs = LivNbrs + 1
       EndIf
    Next l
  Next k
  If numW(i,j) = TRUE Then
    LivNbrs=LivNbrs-1 'セル自体が生きている場合はカウントされない !
  EndIf
End Sub


Sub KlassischConway
  'コンウェイのクラシック・ルール :
  '-----------------------------------
  ' 死亡、しかし、生きた 3人の隣人がいる :
  If numW(i,j) = FALSE And LivNbrs = 3 Then
    numFolg(i,j) = TRUE    ' 誕生を順番に記録します。
  EndIf
  ' 生存、しかし、隣人は2人未満 :
  If numW(i,j) = TRUE And LivNbrs < 2 Then  '孤独による死亡
    numFolg(i,j) = FALSE   ' シーケンス内の死亡に注意。
  EndIf
  ' 生存、しかし、3人以上の隣人が生きている :
  If numW(i,j) = TRUE And LivNbrs > 3 Then  '人口過剰による死亡
    numFolg(i,j) = FALSE   ' シーケンス内の死亡に注意。
  EndIf
  ' 2人か3人の隣人と一緒に暮らす場合に限って、生き残ることができます。
End Sub


Sub KopierWelt
  ' コピーワールド（生きている隣人の数を2で割ったもの） :
  '-----------------------------------
  If LivNbrs Mod 2 = 0 Then 'math. Remainder
    numFolg(i,j) = FALSE    ' 死亡 Vormerken Absterben bei 0,2,4,6,8 leb.Nachbarn in Folgegen.
  Else
    numFolg(i,j) = TRUE     ' 誕生 Vormerken Geburt bei 1,3,5,7 leb.Nachbarn  in Folgegen.
  EndIf
End Sub


Sub FreiDefWelt
  '生存ルール l と誕生ルール b に基づいて自由に定義できる世界 llll/bbbb  :
  '-------------------------------------------------------------------------------------
  '注: 入力されていない値は入力後に -1 に設定されます (0 はなくなります) !
  '
  ' Start-Annahme :
  numFolg(i,j) = FALSE  ' シーケンス内の死亡に注意してください。
  ' ueberlebend ? :
  If numW(i,j) = TRUE Then
    For ireg = 1 To 8
      If LivNbrs = ueberleb(ireg)  Then
        numFolg(i,j) = TRUE   ' 誕生を順番に記録します。
        Continue For
      EndIf
    Next ireg
  EndIf
  ' Geburt ? :
  If numW(i,j) = FALSE Then
    For ireg = 1 To 8
      If LivNbrs = neugebor(ireg)  Then
        numFolg(i,j) = TRUE   ' 誕生を順番に記録します。
        Continue For
      EndIf
    Next ireg
  EndIf
End Sub


Sub ZellGeburtInit
  '以前は死んでいたセルが生き返る（数値配列とゲート内）
  liox = (j-1)*(iz+1) + 1   ' +1 ist die Gitternetzlinie
  lioy = (i-1)*(iz+1) + 1   ' +1 ist die Gitternetzlinie
  reux = liox + (iz-1)
  reuy = lioy + (iz-1)
  Line(liox,lioy)-(reux,reuy),lebcolor,BF  '塗りつぶされた長方形の色 生きている INIT
End Sub


Sub ZellTod
  ZellPos()
  Line(liox,lioy)-(reux,reuy),totcolor,BF  '塗りつぶされた矩形の色 デッドINIT
End Sub


Sub ZellGeburt
  '以前は死んでいたセルが生き返る（数値配列とゲート内）
  ZellPos()
  Line(liox,lioy)-(reux,reuy),Farbe(fndx),BF  '塗りつぶされた長方形の色 生きている INIT
End Sub


Sub ZellPos
  liox = (j-1)*(iz+1) + 1   ' +1 はグリッド線
  lioy = (i-1)*(iz+1) + 1   ' +1 はグリッド線
  reux = liox + (iz-1)
  reuy = lioy + (iz-1)
End Sub


Sub StopKey
  ' Stop game
  If InKey = "s" Or InKey = "S" Then
  	 WindowTitle "CONWAYs Sp... /RegTyp=" & RegelTyp & " 世代=" & igen & " Stop ! ( C = 終了 / A = 再描画 )"
  	 Sleep
  EndIf
End Sub


Sub Ausgestorben
  ' ... すべて絶滅 :
  If lebend = 0 Then
  	 WindowTitle "コンウェイのライフゲーム /RegTyp=" & RegelTyp & " 世代=" & igen & " すべて絶滅 !"
    Sleep
    i = i / 0
  EndIf
End Sub


Sub ShowArray
  ' テスト目的のみ 完全な数値配列の出力
  For ix=1 To lh
    For jx=1 To lb
      If numW(ix,jx)= TRUE Then
        Print "1"
      Else
        Print "0"
      EndIf
    Next jx
    Print ""
  Next ix
End Sub