人工知能（ＡＩ、Artifical Intelligence）は、現在世界的に流行しているＩＴ技術の一つです。しかし、それは、一般の人々には手の届かない高付加価値な技術の一つとして、その成果に私たちの日常生活は支配されっ放しで、歯がゆい思いをしている人も多いと思います。確かに、今や人工知能は、私たち一人一人の将来をも左右しかねない脅威となりつつあると言えましょう。私のような個人ではどんなに努力をしても手にすることのできない、金銭と労力がこのテクノロジーの実現のために世界的に費やされている。それが、この世の現実であることを誰も否定できないと思います。
それでは、誰もがこの現実を見て見ぬふり、いじめられっ子のようにされるがままになって、生きてゆくしかないということなのでしょうか。あるいは、どんなハラスメントを受けるよりもつらい未来が待っているにもかかわらず、私たちは、何をする術（すべ）も無く、それを手をこまねいて見ているしかないのでしょうか。いずれにしても、それは、私にとっては、好ましいことではないと思われました。
つまり、私は、このことに関して、ささやかな反抗を試みてみようと考えました。私の習得している、ささやかなコンピュータ・ソフトウェア開発技術を駆使して、人工知能を中核とした巨大システムに一矢を報いたいと考えたのです。
ここでまず申し上げておきたいことは、私自身は、人工知能そのものを作ることができないということです。人工知能に対する、私の抱いているイメージは、ハードルが高くて、例えば「オッケー、グーグル。」に反応して受け答えするくらいでは満足いたしません。したがって、私自身が満足するような高い機能仕様の人工知能を自作することは不可能なのです。
その代わりにどうするのかと申しますと、「人工知能って、何だ？」という問いから始まって、それと似ているもの、すなわち、『人工知能もどき』（あるいは、人工知能の疑似プログラム）を開発しようと思いました。人工知能それ自身は手に入れられないけれども、人工知能っぽいコンピュータ・プログラムは自作できそうな気がしました。
かつて、１９８０年代から１９９０年代の私は、双方向自動翻訳プログラムとか、森田オセロのプログラムとかを、雑誌や単行本の書籍で見つけて興味をそそられていました。こうしたＢＡＳＩＣやＣ言語によるプログラムは、当時は『思考プログラミング』と呼ばれていました。これは、プログラマ（プログラムを組む人）の側に立った呼び名（ネーミング）でした。しかし、現在の私の考えでは、これこそ、人工知能もどきの中核部分になりえるプログラムに思えました。こうした『思考プログラミング』の考え方でパソコン上で今どきの簡易言語を使って、プログラムの中心部分を作り、さらに周辺部分をふくらませていけば、『人工知能みたいな感じの疑似プログラム』が組めるのではないかと、おおざっぱなシステム設計をしてみました。
かつて、２０００年代に、ＶＢスクリプトやＨＴＬＭなどの簡易言語をかじりたてだった私は、『思考ゲームプログラミング − オセロのアルゴリズムと作成法』（アスキーブック）という書籍を購入して、コンピュータオセロの仕組みを学ぼうとしていました。４隅４辺を優先して取るように評価関数の値を上げるとか、先読みのためにゲーム木検索をしてアルファベータ法やミニマックス法で検索木の枝刈りをするとか書いてありました。関数の再帰的呼び出しによって、効率的なプログラミングをするとか、中盤には必勝読み、終盤には完全読みをするとか、その本には書かれていました。
それらの事柄は、当時の私にとっては専門的すぎる内容でした。そのため、森田和郎さんのＣ言語によるソースプログラムが巻末に載っていましたが、途中で解読不能になって何度も私は投げ出してしまいました。そのＣ言語のプログラムをＶＢスクリプトに組み直して、最新のウィンドウズのプログラムにすることを、当時の私は趣味の一つとして思いついたのでした。がしかし、その移植の思いつきは、ものの見事に挫折してしまいました。プログラムの冒頭部分（ヘッダー）の定数定義と、盤面の表示部分を作っただけで、それ以降の中核になるプログラムは全く作れませんでした。
ここ最近になって、年末年始に東京の実家に戻ると、本棚に眠っているその本を手に取ってみることが何度かありました。森田和郎さんのＣ言語によるコーディングは、私にとってはやはり難解でしたし、今さらその解読に時間と労力を費やすと、本業にさしさわります。そこは一銭にもならない趣味として、時間が取れたらやってみよう、森田オセロよりも簡単な、その中味がへっぽこでもいいじゃないか、という考えに変わっていきました。私の作りたいプログラムは、人工知能もどきなのだから、『へっぽこ人工知能』でかまわない、と考えるようになりました。
というわけで、ここ半年余りで、何かの合間に作り足して、ウィンドウズＯＳのパソコン上で動作チェックをして、付録に示したような簡易言語プログラムが出来上がりました。これを作るにあたって、プログラム上のいろんなテクニックや仕組みを開発したのですが、その説明はまたの機会に譲ることといたします。ネット上の記事をほとんど参照としなかったので、見たこともないＶＢスクリプトによるコーディングがあるかもしれませんが、そのようなプログラム開発の方針のよるものだということでご了承ください。（ＨＴＭＬで作ったゲーム盤をランダムアクセスするために、ＶＢスクリプトでアドレスのベクターテーブルを作ったり、人工知能っぽく見せるために、イベント処理の反応の仕方に細工をしたりタイマー処理を連発させたりしています。）
あとになって再び書くかもしれませんが、コンピュータ側が盤面に手を指す以下の一行の命令
Q(yy, xx).InnerText = ComMove
の書かれる位置をプログラム上で少しあとにずらしただけで、盤面をチェックしていた他の関数がタイミングが合わずに正しくチェックできなくなって、プログラム全体が誤動作してしまうこともありました。結局その不具合を直して、プログラムが正しく動くようにしましたが、プログラム全体を大幅に修正することとなってしまいました。そうした悪い手本もあるので、プログラミング上での真似はあまり利益にならないのかもしれません。それでも、人工知能に似せた簡易言語プログラムがどのように動くのかを知るために、パソコン上でそれを動かしてみるのはそれなりの意義があると思います。できる人は、ぜひ今回の付録をコピペして、コンピュータ上で動作させてみてください。
さらに説明しますと、このプログラムには、先読みをするプログラムとか、機械学習をするプログラムとかが入っていません。なのに、そこそこ強いので、人間の側が油断すると、簡単に負かされてしまいます。当たり前のことですが、それぞれの局面で相手側の石をひっくり返せる盤上の一手を全て洗い出します。そして、それぞれの一手に関して、ひっくり返せる石の数と、のちのち有利になる石の位置から評価値を割り出して、それが最大値となる手を『次の一手』に選びます。手の先読みをしない代わりに、指してはいけない手の評価値を下げて、その手を『次の一手』に選びにくくしています。
私の作ったこのプログラムは、森田オセロの最初に説明されている、序盤のミニ定石データベース（あるいはデータブック）さえ持っていません。このプログラムの中核となる思考プログラミングは評価関数（EvaluateMax関数）以内に（あるいは、以下に）まとめています。その思考ルーチンは、ゲームの最初から最後まで同じものを使っています。ただし、それは、私のヒューリスティック（heuristic、発見学習）的なものを簡易言語を使ってプログラミングされています。（そのようなやり方が、プログラミングとして普通なのかもしれませんが）４隅４辺の場所を相手の石をはさみながら優先的に取るとか、４隅４辺を相手に取られてしまうきっかけとなる手はなるべく指さないとかいう条件を、コンピュータのロジック（論理）で記述しています。
ここで、私の我がままを一言だけ申しておきます。私は、現在世界的に流行している人工知能が、機械学習とか深層学習（ディープラーニング）にとどまっていることが不満です。私たち人間は、発見的学習（ヒューリスティックス）によって、それをプログラミング言語に表現し直して、コンピュータを自在に操ることができます。だから、私たち人間が知っている人工知能は、人間と同じくらい発見的学習（ヒューリスティクス）ができないと、本当に人間を超えたことにならないのではないか、とも思えるのです。
注 "Othello"や『オセロ』は、株式会社メガハウス（旧ツクダオリジナル）の登録商標なので、以下の記事では、『オセロ』等の別名としてリバーシ（Reversi）という言葉を使います。
付録
Reversi V1.55.hta
<STYLE TYPE="text/css">
BODY { font-size:16pt; background-color:rgb(30%,70%,30%); scroll:no; }
.scaleW { font-size:16pt; font-family:"MS ゴシック"; text-align:center; }
.scaleH { font-size:16pt; font-family:"MS ゴシック"; text-align:left;
line-height:18pt; position:relative; top:-220pt; }
.banmen { font-size:16pt; font-family:"MS ゴシック"; text-align:center;
border:1pt solid black; padding:5pt; margin:10pt 20pt;
cursor:default; }
.message { font-size:12pt; font-family:"MS ゴシック"; text-align:center;
padding:5pt; margin:10pt 5pt; }
#fakebtn { font-size:12pt; font-family:"MS ゴシック"; background-color:white;
border-style:outset; padding:5pt; margin:10pt 5pt;
cursor:default; display:none; }
</STYLE>
<HTA:Application Id=oHTA Border=dialog Scroll=no MaximizeButton=no Contextmenu=no />
<SCRIPT language="VBScript">
Option Explicit
Randomize
Const BLACK = "●"
Const WHITE = "○"
Const BLANK = "＋"
Const BAD = 0
Const BONUS = 8
Const GOOD = 16
Const BEST = 32
Dim WSHShell
Set WSHShell = CreateObject("WScript.Shell")
Dim Q(7,7), R(63), vx(7), vy(7)
Dim PointJustNow, ThinkingTime, RecoveringTime, gptr, wb, cp
Dim ManMove, ComMove, Selflag
Dim SaveMes
Call ResizeTo(280, 390)
Document.Title = "Reversi V1.55" 'This is a minor revision of Reversi Game v1.54
Set wb = New WatchingBoardSpace
Set cp = New CornerProcessingList
Sub Window_Onload
Dim yy, xx, idx
ManMove = BLACK
ComMove = WHITE
LargeMode = False
idx = 0
For yy = 0 to 7
For xx = 0 to 7
Set R(idx) = Document.all.tags("SPAN")(idx)
Set Q(yy, xx) = R(idx)
idx = idx + 1
Next
Next
vy(0) = -1 : vy(1) = -1 : vy(2) = -1 : vy(3) = 0 : vy(4) = 0
vy(5) = 1 : vy(6) = 1 : vy(7) = 1
vx(0) = -1 : vx(1) = 0 : vx(2) = 1 : vx(3) = -1 : vx(4) = 1
vx(5) = -1 : vx(6) = 0 : vx(7) = 1
Call InitBan()
End Sub
Sub InitBan()
Dim idx
For idx = 0 to 63
R(idx).InnerText = BLANK
Next
P33.InnerText = WHITE
P34.InnerText = BLACK
P43.InnerText = BLACK
P44.InnerText = WHITE
PointJustNow = ""
ThinkingTime = False
RecoveringTime = False
Call wb.Clear()
fakebtn.style.display = "none"
mouth.InnerText = "さあ、始めましょう！"
Call SelectStones()
End Sub
Private Sub SelectStones()
Selflag = True
TurnB.InnerHTML = "黒番？" : BStones.InnerHTML = " それとも、"
TurnW.InnerHTML = "白番？" : WStones.InnerHTML = ""
TurnB.style.cursor = "help"
TurnW.style.cursor = "help"
End Sub
Class WatchingBoardSpace
Private List(59), Lptr
Public Sub Clear()
Lptr = 0
End Sub
Public Property Let Watch(tid)
If Not Found(tid) Then
List(Lptr) = tid
Lptr = Lptr + 1
End If
End Property
Private Function Found(id)
Dim idx, rfg
rfg = False
For idx = 0 to Lptr - 1
If List(idx) = id Then
rfg = True
Exit For
End If
Next
Found = rfg
End Function
Public Function AnyMore()
Dim Empties
Empties = GetBlanks()
If (Lptr = 0) Or (Lptr < Empties) Then
AnyMore = True
Else
AnyMore = False
End If
End Function
Private Function GetBlanks()
Dim idx, cnt
cnt = 0
For idx = 0 to 63
If R(idx).InnerText = BLANK Then
cnt = cnt + 1
End If
Next
GetBlanks = cnt
End Function
End Class
'
' Event Driven Routines
'
' On mouse over, On mouse out --- for user interface
' On click -- for user interface and the trigger on computer thinking
' On key press -- for board size changed by L key
'
Sub Document_Onmouseover
Dim target
Set target = Window.event.srcElement
If Selflag Then
If target.tagname = "SPAN" Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "white"
.backgroundcolor = "rgb(10%,10%,10%)"
End With
End If
End If
Exit Sub
End If
If target.tagname = "SPAN" Then
If Left(target.id, 1) = "P" Then
If target.InnerText = BLANK Then
wb.Watch = target.id
If CountEnemy(target.id, ManMove, ComMove) > 0 Then
With target.style
.backgroundcolor = "rgb(50%,80%,50%)"
.cursor = "help"
End With
PointJustNow = target.id
Call wb.Clear()
Else
If Not wb.AnyMore() Then
mouth.InnerText = "打てませんね ．．．思考中"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
End If
End If
End If
End Sub
Sub Document_Onmouseout
Dim target
Set target = Window.event.srcElement
If Selflag Then
If target.tagname = "SPAN" Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "black"
.backgroundcolor = "rgb(30%,70%,30%)"
End With
End If
End If
Exit Sub
End If
If target.tagname = "SPAN" Then
If Left(target.id, 1) = "P" Then
If target.innerText = BLANK Then
With target.style
.backgroundcolor = ""
.cursor = "default"
End With
PointJustNow = ""
End If
End If
End If
End Sub
Sub Document_Onclick
Dim target, yy, xx
If ThinkingTime Then Exit Sub
Set target = Window.event.srcElement
If target.id = "" Then Exit Sub
If Selflag Then
If Left(target.id, 4) = "Turn" Then
With target.style
.color = "black"
.backgroundcolor = "rgb(30%,70%,30%)"
End With
TurnB.style.cursor = "default"
TurnW.style.cursor = "default"
Call FixTurn(target.InnerText)
Selflag = False
If ComMove = BLACK Then
mouth.InnerText = "思考中 ．．．"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
Exit Sub
End If
If Left(target.id, 1) <> "P" Then Exit Sub
If PointJustNow <> "" Then
yy = Mid(target.id, 2, 1)
xx = Mid(target.id, 3, 1)
Q(yy, xx).InnerText = ManMove
With target.style
.backgroundcolor = ""
.cursor = "default"
End With
PointJustNow = ""
Call ReverseEnemy(ManMove, yy, xx, ComMove)
If Not EndChecking() Then
mouth.InnerText = "思考中 ．．．"
ThinkingTime = True
Call setTimeout("NowThinking()", 2000)
End If
End If
End Sub
Private Sub FixTurn(sterm)
Dim st, dstr
If sterm = "黒番？" Then
st = BLACK
ElseIf sterm = "白番？" Then
st = WHITE
Else
msgbox"Illegally selected [" & sterm & "]"
End If
If ManMove <> st Then
ComMove = ManMove : ManMove = st
End If
TurnB.InnerText = "黒"
TurnW.InnerText = "白"
dstr = "（あなた）"
If ManMove = BLACK Then
TurnB.InnerText = TurnB.InnerText & dstr
Else
TurnW.InnerText = TurnW.InnerText & dstr
End If
BStones.innerText = " 2 個 "
WStones.innerText = " 2 個"
End Sub
Private Sub NowThinking()
If TurnToComputer() Then
Call wb.Clear()
If Not EndChecking() Then
mouth.InnerText = DisplayYourTurn()
End If
Else
If Not EndChecking() Then
mouth.InnerText = "打つ手がありません。"
End If
End If
ThinkingTime = False
End Sub
Function DisplayYourTurn()
DisplayYourTurn = "あなたの手番です。"
End Function
Dim LargeMode
Sub Document_OnKeyPress()
Dim tk, kc
If ThinkingTime Then Exit Sub
If RecoveringTime Then Exit Sub
If fakebtn.style.display = "inline" Then Exit Sub
tk = Window.event.keyCode
kc = Chr(tk)
RecoveringTime = True
If kc = "l" Or kc = "L" Then
LargeMode = Not LargeMode
Call ChangeScale(LargeMode)
Else
RecoveringTime = False
End If
End Sub
Private Sub ChangeScale(Lmode)
Dim mes
If Lmode Then
mes = "盤を拡大サイズにします。"
Else
mes = "盤を通常サイズにします。"
End If
SaveMes = mouth.InnerText
mouth.InnerText = mes
Call setTimeout("RecoverMessage2()", 2000)
End Sub
Private Sub RecoverMessage2()
If LargeMode Then
Call ChangeScale2(420, 600, 22, 28, 24, 4, 31, -358, 24)
Else
Call ChangeScale2(280, 390, 12, 16, 16, 1, 18, -220, 12)
End If
RecoveringTime = False
End Sub
Private Sub ChangeScale2(sx, sy, fontSiz1, fontSiz2, fontSiz3, bSiz, Lh, topos, btnSiz)
Dim obj, idx, cnm, styp
Call ResizeTo(sx, sy)
For idx = 0 to document.all.length - 1
Set obj = document.all(idx)
If obj.tagName = "DIV" Then
cnm = obj.className
Set styp = obj.style
If cnm = "message" Then
styp.fontSize = fontSiz1 & "pt"
ElseIf cnm = "banmen" Then
styp.fontSize = fontSiz2 & "pt"
styp.border = bSiz & "pt solid black"
Else
styp.fontSize = fontSiz3 & "pt"
If cnm = "scaleH" Then
styp.lineHeight = Lh & "pt"
styp.position = "relative"
styp.top = topos & "pt"
End If
End If
ElseIf obj.id = "fakebtn" Then
obj.style.fontSize = btnSiz & "pt"
Else
End If
Next
mouth.InnerText = SaveMes
End Sub
'
' Heuristic AI Thinking subroutines
'
'
Function TurnToComputer()
Dim tId(), tCnt1(), tCnt2(), tLast, maxidx, yy, xx
tLast = ListingHands(ComMove, ManMove, tId, tCnt1)
If tLast = -1 Then
TurnToComputer = False
Exit Function
End If
Call CopyTable(tCnt1, tCnt2, tLast)
maxidx = EvaluateMax(tId, tCnt2, tLast)
yy = Mid(tId(maxidx), 2, 1)
xx = Mid(tId(maxidx), 3, 1)
Set gptr = Q(yy, xx)
gptr.style.backgroundcolor = "rgb(80%,50%,50%)"
gptr.InnerText = ComMove
Call setTimeout("ClearMarking()", 600)
Call ReverseEnemy(ComMove, yy, xx, ManMove)
TurnToComputer = True
End Function
Private Function ListingHands(fside, eside, tI, tC)
Dim idx, cnt, tL
tL = -1
For idx = 0 to 63
If R(idx).InnerText = BLANK Then
cnt = CountEnemy(R(idx).id, fside, eside)
If cnt > 0 Then
tL = tL + 1
ReDim Preserve tI(tL), tC(tL)
tI(tL) = R(idx).id
tC(tL) = cnt
End If
End If
Next
ListingHands = tL
End Function
Private Sub CopyTable(tC1, tC2, tL)
Dim idx
ReDim tC2(tL)
For idx = 0 to tL
tC2(idx) = tC1(idx)
Next
End Sub
Private Sub ClearMarking()
gptr.style.backgroundcolor = ""
If Right(mouth.InnerText, 9) = "あなたの手番です。" Then
End If
End Sub
Function EvaluateMax(tI, tC, tL)
Dim idx, py, px, any
For idx = 0 to tL
py = Mid(tI(idx), 2, 1)
px = Mid(tI(idx), 3, 1)
If cp.RealCorner(py, px) Then
tC(idx) = tC(idx) + BEST
Else
If CornerPriority(py, px) Then
any = OtherPriority(py, px, tC(idx))
If tC(idx) <> any Then
tC(idx) = any
End If
Else
tC(idx) = BAD
End If
End If
Next
EvaluateMax = GetMaxIndex(tC, tL)
End Function
Private Function GetMaxIndex(tC, tL)
Dim idx, retidx, maxcnt, Lst(), Lsts
maxcnt = BAD - 1
For idx = 0 to tL
If tC(idx) > maxcnt Then
maxcnt = tC(idx)
retidx = idx
End If
Next
Lsts = -1
For idx = 0 to tL
If maxcnt = tC(idx) Then
Lsts = Lsts + 1
ReDim Preserve Lst(Lsts)
Lst(Lsts) = idx
End If
Next
If Lsts > 0 Then
idx = Int(Rnd * (Lsts + 1))
retidx = Lst(idx)
End If
GetMaxIndex =retidx
End Function
Private Function CornerPriority(ay, ax)
Dim pos
If cp.CornerTL(ay, ax) Then
pos = 0
ElseIf cp.CornerBL(ay, ax) Then
pos = 1
ElseIf cp.CornerTR(ay, ax) Then
pos = 2
ElseIf cp.CornerBR(ay, ax) Then
pos = 3
Else
CornerPriority = True
Exit Function
End If
CornerPriority = cp.AroundCorner(ay, ax, pos)
End Function
Private Function OtherPriority(ay, ax, NowCnt)
Dim ret
If (ay = 0) Or (ay = 7) Then
ret = OtherEvaluation(0, ay, ax, NowCnt)
ElseIf (ax = 0) Or (ax = 7) Then
ret = OtherEvaluation(1, ay, ax, NowCnt)
ElseIf ComSide(0, 0) Or ComSide(7, 7) Then
If cp.DiagonalTLBR(ay, ax) Then
ret = OtherEvaluation(2, ay, ax, NowCnt)
Else
ret = NowCnt
End If
ElseIf ComSide(7, 0) Or ComSide(0, 7) Then
If cp.DiagonalBLTR(ay, ax) Then
ret = OtherEvaluation(3, ay, ax, NowCnt)
Else
ret = NowCnt
End If
Else
ret = NowCnt
End If
OtherPriority = ret
End Function
Private Function ComSide(ay, ax)
If Q(ay, ax).InnerText = ComMove Then
ComSide = True
Else
ComSide = False
End If
End Function
Class SideStatus
Public bfg, tfg, gfg
Private py, px, swch, mSideCorner
Private Sub Class_Initialize
bfg = False
tfg = False
gfg = False
End Sub
Public Sub PositionSet(sw, ay, ax)
swch = sw
py = ay
px = ax
End Sub
Public Sub Checking(sdt, edt, vect)
Dim idx, it
If swch = 2 Then py = sdt
If swch = 3 Then py = 7 - sdt
For idx = sdt to edt step vect
If swch = 1 Then
it = Q(idx, px).InnerText
Else
it = Q(py, idx).InnerText
End If
If it = BLANK Then
bfg = True
Exit For
End If
If it = ManMove Then
tfg = True
Else
If idx = edt Then gfg = True
If tfg Then tfg = False
End If
If swch = 2 Then py = py + vect
If swch = 3 Then py = py - vect
Next
End Sub
Public Property Get AddBonus()
If gfg Then
AddBonus = BONUS
Else
AddBonus = 0
End If
End Property
End Class
Private Function OtherEvaluation(sw, ay, ax, Ncnt)
Dim o1, o2
Set o1 = New SideStatus
Set o2 = New SideStatus
Call o1.PositionSet(sw, ay, ax)
Call o2.PositionSet(sw, ay, ax)
If sw = 1 Then
Call o1.Checking(ay+1, 7, +1)
Call o2.Checking(ay-1, 0, -1)
Else
Call o1.Checking(ax+1, 7, +1)
Call o2.Checking(ax-1, 0, -1)
End If
If OtherJudgement(o1, o2) Then
OtherEvaluation = GOOD + Ncnt + o1.AddBonus + o2.AddBonus
Else
OtherEvaluation = BAD
End If
Set o1 = Nothing
Set o2 = Nothing
End Function
Private Function OtherJudgement(o1, o2)
Dim rfg
If o1.bfg And o2.bfg Then
If Not o1.tfg And Not o2.tfg Then
rfg = True
Else
rfg = False
End If
ElseIf o1.bfg Or o2.bfg Then
If (Not o2.bfg And o2.tfg) Or (Not o1.bfg And o1.tfg) Then
rfg = False
Else
rfg = True
End If
Else
rfg = True
End If
OtherJudgement = rfg
End Function
Class CornerProcessingList
Private cny, cnx
Private scy, scx
Private cny0, cnx0
Private cny1, cnx1, cny2, cnx2, cny3, cnx3
Private last
Private dgy0, dgx0, dgy1, dgx1
Private Sub Class_Initialize
Dim idx
cny = array(0, 7, 0, 7)
cnx = array(0, 0, 7, 7)
scy = array(1, 6, 1, 6)
scx = array(1, 1, 6, 6)
cny0 = array(0, 0, 1, 2)
cnx0 = array(1, 2, 0, 0)
last = UBound(cny0)
ReDim cny1(last), cny2(last), cny3(last)
ReDim cnx1(last), cnx2(last), cnx3(last)
For idx = 0 to last
cny1(idx) = 7 - cny0(idx)
cnx1(idx) = cnx0(idx)
cny2(idx) = cny0(idx)
cnx2(idx) = 7 - cnx0(idx)
cny3(idx) = 7 - cny0(idx)
cnx3(idx) = 7 - cnx0(idx)
Next
dgy0 = array(1, 2, 5, 6)
dgx0 = array(1, 2, 5, 6)
dgy1 = array(1, 2, 5, 6)
dgx1 = array(6, 5, 2, 1)
End Sub
Public Function RealCorner(dy, dx)
RealCorner = CornerCheck(dy, dx, cny, cnx)
End Function
Public Function CornerTL(dy, dx)
CornerTL = CornerCheck(dy, dx, cny0, cnx0)
End Function
Public Function CornerBL(dy, dx)
CornerBL = CornerCheck(dy, dx, cny1, cnx1)
End Function
Public Function CornerTR(dy, dx)
CornerTR = CornerCheck(dy, dx, cny2, cnx2)
End Function
Public Function CornerBR(dy, dx)
CornerBR = CornerCheck(dy, dx, cny3, cnx3)
End Function
Public Function DiagonalTLBR(dy, dx)
DiagonalTLBR = CornerCheck(dy, dx, dgy0, dgx0)
End Function
Public Function DiagonalBLTR(dy, dx)
DiagonalBLTR = CornerCheck(dy, dx, dgy1, dgx1)
End Function
Private Function CornerCheck(ay, ax, cnyy, cnxx)
Dim rfg, idx, iy, ix
rfg = False
iy = CInt(ay)
ix = CInt(ax)
For idx = 0 to last
If (cnyy(idx) = iy) And (cnxx(idx) = ix) Then
rfg = True
Exit For
End If
Next
CornerCheck = rfg
End Function
Public Function AroundCorner(ay, ax, Index)
Dim rfg, what, posy, posx, alty, altx
rfg = True
posy = cny(Index)
posx = cnx(Index)
what = Q(posy, posx).InnerText
If what = BLANK Then
posy = scy(Index)
posx = scx(Index)
what = Q(posy, posx).InnerText
If what = ManMove Then
alty = posy + posy - ay
altx = posx + posx - ax
what = Q(alty, altx).InnerText
If what = ComMove Then
rfg = False
End If
End If
End If
AroundCorner = rfg
End Function
End Class
'
' Common Subroutines
'
'
Function EndChecking()
Dim rflg, bcnt, wcnt, mes
bcnt = CalcStones(BLACK)
wcnt = CalcStones(WHITE)
BStones.innerText = " " & bcnt & " 個 "
WStones.innerText = " " & wcnt & " 個"
If bcnt + wcnt = 64 Or (Not wb.AnyMore()) Then
If (bcnt = wcnt) Then
mes = "珍しく引き分けです。"
ElseIf bcnt > wcnt Then
mes = "黒の勝ちです。"
Else
mes = "白の勝ちです。"
End If
rflg = True
Else
If bcnt = 0 Then
mes = "白の勝ちです。"
rflg = True
ElseIf wcnt = 0 Then
mes = "黒の勝ちです。"
rflg = True
Else
rflg = False
End If
End If
If rflg Then
fakebtn.style.display = "inline"
mouth.InnerText = mes
End If
EndChecking = rflg
End Function
Function CalcStones(side)
Dim idx, cnt
cnt = 0
For idx = 0 to 63
If R(idx).InnerText = side Then
cnt = cnt + 1
End If
Next
CalcStones = cnt
End Function
Function CountEnemy(tgid, mside, yside)
Dim cnt, yy, xx, idx, nyy, nxx, vc(7)
yy = Mid(tgid, 2, 1)
xx = Mid(tgid, 3, 1)
For idx = 0 to 7
vc(idx) = 0
If Not OutOfRange(yy, xx, idx) Then
nyy = yy + vy(idx)
nxx = xx + vx(idx)
If Q(nyy, nxx).InnerText = yside Then
vc(idx) = FriendsExist(mside, nyy, nxx, idx)
End If
End If
Next
cnt = 0
For idx = 0 to 7
cnt = cnt + vc(idx)
Next
CountEnemy = cnt
End Function
Function FriendsExist(mm, dy, dx, d)
Dim y, x, ret, fr, it
y = dy
x = dx
ret = 0
fr = False
Do
it = Q(y, x).InnerText
If it = mm Then
fr = True
ElseIf it = BLANK then
Exit Do
Else
ret = ret + 1
If OutOfRange(y, x, d) Then
Exit Do
Else
y = y + vy(d)
x = x + vx(d)
End If
End If
Loop Until it = mm
If Not fr Then
ret = 0
End If
FriendsExist = ret
End Function
Function OutOfRange(y, x, d)
If (y = 0 And vy(d) = -1) Or (y = 7 And vy(d) = 1) Or _
(x = 0 And vx(d) = -1) Or (x = 7 And vx(d) = 1) Then
OutOfRange = True
Else
OutOfRange = False
End If
End Function
Sub ReverseEnemy(mside, yy, xx, yside)
Dim idx, nyy, nxx
For idx = 0 to 7
If Not OutOfRange(yy, xx, idx) Then
nyy = yy + vy(idx)
nxx = xx + vx(idx)
If Q(nyy, nxx).InnerText = yside Then
Call ChangeToFriends(mside, nyy, nxx, idx)
End If
End If
Next
End Sub
Sub ChangeToFriends(mm, dy, dx, d)
Dim y, x, it, mside
y = dy
x = dx
mside = False
Do
it = Q(y, x).InnerText
If it = mm Then
mside = True
ElseIf it = BLANK then
Exit Do
Else
If OutOfRange(y, x, d) Then
Exit Do
Else
y = y + vy(d)
x = x + vx(d)
End If
End If
Loop Until it = mm
If mside Then
Call ChangeToMySide(mm, dy, dx, d)
End If
End Sub
Sub ChangeToMySide(mm, dy, dx, d)
Dim y, x, it
y = dy
x = dx
Do
it = Q(y, x).InnerText
If it <> mm Then
Q(y, x).InnerText = mm
y = y + vy(d)
x = x + vx(d)
End If
Loop Until it = mm
End Sub
</SCRIPT>
<BODY>
<DIV class=scaleW >a b c d e f g h</DIV>
<DIV class=banmen >
<SPAN id=P00 ></SPAN> <SPAN id=P01 ></SPAN>
<SPAN id=P02 ></SPAN> <SPAN id=P03 ></SPAN>
<SPAN id=P04 ></SPAN> <SPAN id=P05 ></SPAN>
<SPAN id=P06 ></SPAN> <SPAN id=P07 ></SPAN><BR>
<SPAN id=P10 ></SPAN> <SPAN id=P11 ></SPAN>
<SPAN id=P12 ></SPAN> <SPAN id=P13 ></SPAN>
<SPAN id=P14 ></SPAN> <SPAN id=P15 ></SPAN>
<SPAN id=P16 ></SPAN> <SPAN id=P17 ></SPAN><BR>
<SPAN id=P20 ></SPAN> <SPAN id=P21 ></SPAN>
<SPAN id=P22 ></SPAN> <SPAN id=P23 ></SPAN>
<SPAN id=P24 ></SPAN> <SPAN id=P25 ></SPAN>
<SPAN id=P26 ></SPAN> <SPAN id=P27 ></SPAN><BR>
<SPAN id=P30 ></SPAN> <SPAN id=P31 ></SPAN>
<SPAN id=P32 ></SPAN> <SPAN id=P33 ></SPAN>
<SPAN id=P34 ></SPAN> <SPAN id=P35 ></SPAN>
<SPAN id=P36 ></SPAN> <SPAN id=P37 ></SPAN><BR>
<SPAN id=P40 ></SPAN> <SPAN id=P41 ></SPAN>
<SPAN id=P42 ></SPAN> <SPAN id=P43 ></SPAN>
<SPAN id=P44 ></SPAN> <SPAN id=P45 ></SPAN>
<SPAN id=P46 ></SPAN> <SPAN id=P47 ></SPAN><BR>
<SPAN id=P50 ></SPAN> <SPAN id=P51 ></SPAN>
<SPAN id=P52 ></SPAN> <SPAN id=P53 ></SPAN>
<SPAN id=P54 ></SPAN> <SPAN id=P55 ></SPAN>
<SPAN id=P56 ></SPAN> <SPAN id=P57 ></SPAN><BR>
<SPAN id=P60 ></SPAN> <SPAN id=P61 ></SPAN>
<SPAN id=P62 ></SPAN> <SPAN id=P63 ></SPAN>
<SPAN id=P64 ></SPAN> <SPAN id=P65 ></SPAN>
<SPAN id=P66 ></SPAN> <SPAN id=P67 ></SPAN><BR>
<SPAN id=P70 ></SPAN> <SPAN id=P71 ></SPAN>
<SPAN id=P72 ></SPAN> <SPAN id=P73 ></SPAN>
<SPAN id=P74 ></SPAN> <SPAN id=P75 ></SPAN>
<SPAN id=P76 ></SPAN> <SPAN id=P77 ></SPAN>
</DIV>
<DIV Class=message >
<SPAN id=TurnB></SPAN><SPAN id=BStones></SPAN>
<SPAN id=TurnW></SPAN><SPAN id=WStones></SPAN><BR><BR>
<SPAN id=Mouth></SPAN>
<SPAN id=fakebtn OnClick="InitBan()" >最初から</SPAN>
</DIV>
<DIV class=scaleH >1<BR>2<BR>3<BR>4<BR>5<BR>6<BR>7<BR>8</DIV>
</BODY>
