Microsoft Small Basic Program Listing

' DoubutsuShogi v0.7 - Copyright (c) 2011 Nonki Takahashi
'
' History
' 2010/01/25 v0.1 Created (440 lines)
' 2010/02/03 v0.2 Created GameRecord_ class (595 lines FVD421)
' 2010/02/11 v0.3 Made animation for piece move (805 lines FVD421-0)
' 2010/02/16 v0.4 Created captured piece move (936 lines FVD421-1)
' 2010/02/23 v0.5 Bug fix for Human_ etc (1049 lines FVD421-2)
' 2010/02/24 v0.6 Created new controls (1339 lines FVD421-3)
' 2010/02/27 v0.7 Bug fix for Game_ etc (1401 lines FVD421-4)
'
' Reference
' [1] 北岡, 藤田: "どうぶつしょうぎのほん", 2010, 幻冬舎エデュケーション
' (Kitaoka, Fujita: "Doubutsu Shogi No Hon", 2010, Gentosha Education)
' [2] 北岡, 藤田: "どうぶつしょうぎあそびかたBOOK", 2009, 幻冬舎エデュケーション
' (Kitaoka, Fujita: "Doubutsu Shogi Asobikata Book", 2009, Gentosha Education)
'
' Naming convention
' class Xxx_
' label lXxx
' constant XXX
' variable type integer iXxx
' variable type real rXxx
' variable type string sXxx
' variable type url uXxx
' variable type char cXxx
' variable type boolean bXxx
' variable type object oXxx
'
' Constant
VERSION = 0.7
SPACE = 0
CHICK1 = 1
HEN1 = 2
ELEPHANT1 = 3
GIRAFFE1 = 4
LION1 = 5
CHICK2 = 6
HEN2 = 7
ELEPHANT2 = 8
GIRAFFE2 = 9
LION2 = 10
DIRMIN = 0
TOPLEFT = 0
TOP = 1
TOPRIGHT = 2
LEFT = 3
CENTER = 4
RIGHT = 5
BOTTOMLEFT = 6
BOTTOM = 7
BOTTOMRIGHT = 8
DIRMAX = 8
FOREST = 1
SKY = 2
ROCK = 1
SCISSORS = 2
PAPER = 3
DRAW = 4
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10)
REPLAY = "4" ' Webdings replay mark for replay button
'
' Main
GraphicsWindow.Height = 540
GraphicsWindow.Width = 780
Game_Init()
Board_Init()
Console_Init()
GameRecord_Init()
While "True"
Board_New()
bArrangeOrder = "True"
Board_Draw()
GameRecord_New()
GameRecord_Draw()
Console_AskFirstTurn()
Console_ShowTurn()
' yoroshiku onegai shimasu - best regards (?)
sMessage = "よろしく" + CRLF + "おねがい" + CRLF + "します"
iX = 500
iY = 250
Console_ShowBalloon()
Console_CreateReplayButton()
Console_CreateNewGameButton()
'
Game_Loop() ' play game
'
' arigatou gozaimashita - thank you
sMessage = "ありがとう" + CRLF + "ございました"
iX = 500
iY = 250
Console_ShowBalloon()
Console_ShowReplayButton()
Console_ShowNewGameButton()
Controls.ButtonClicked = Console_OnButtonClicked
While bButtonNotClicked
Program.Delay(200)
EndWhile
Controls.ButtonClicked = Console_DoNothing
Console_HideReplayButton()
Console_HideNewGameButton()
EndWhile
'
' Board | Initialization
' out: Board_iRoX, Board_iRoY - number of ro (number of file and rank)
' out: Board_iX0, Board_iY0, Board_iX1, Board_iY1 - board coordinate
' out: Board_idX, Board_idY - cell width and height
' out: isX, isY - offset between cell and piece
' out: Captured_iRoX, Captured_iRoY - number of ro for captured piece slot
' out: Captured_iX0, Captured_iY0, Captured_iX1, Captured_iY1 - captured slot coordinate
' out: uBoard - url of board image bitmap
' out: Board_sX[], Board_sY[] - cell name sign
' out: uCell[][] - url of cell image bitmap
' out: uPiece[] - url of piece image bitmap
' out: iDirX[], iDirY[] - nine direction offset
Sub Board_Init
Board_iRoX = 3
Board_iRoY = 4
Board_iX0 = 50
Board_iY0 = 100
Board_idX = 100
Board_idY = 100
Board_iX1 = Board_iX0 + Board_idX * Board_iRoX
Board_iY1 = Board_iY0 + Board_idY * Board_iRoY
isX = 10
isY = 10
Captured_iRoX = 3
Captured_iRoY = 2
Captured_idX = Board_idX / 2
Captured_idY = Board_idY / 2
Captured_iX0 = Board_iX1
Captured_iX1 = Captured_iX0 + Captured_idX * Captured_iRoX
Captured_iY0 = Board_iY0
Captured_iY1 = Captured_iY0 + Captured_idY * Captured_iRoY
Captured_iY3 = Board_iY1
Captured_iY2 = Captured_iY3 - Captured_idY * Captured_iRoY
uBoard = "http://homepage2.nifty.com/nobukit/smallbasic.files/Board300.png"
Board_sX[1] = "A"
Board_sX[2] = "B"
Board_sX[3] = "C"
Board_sY[1] = "1"
Board_sY[2] = "2"
Board_sY[3] = "3"
Board_sY[4] = "4"
uCell[1][1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/A1.png"
uCell[2][1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/B1.png"
uCell[3][1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/C1.png"
uCell[1][2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/A2.png"
uCell[2][2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/B2.png"
uCell[3][2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/C2.png"
uCell[1][3] = "http://homepage2.nifty.com/nobukit/smallbasic.files/A3.png"
uCell[2][3] = "http://homepage2.nifty.com/nobukit/smallbasic.files/B3.png"
uCell[3][3] = "http://homepage2.nifty.com/nobukit/smallbasic.files/C3.png"
uCell[1][4] = "http://homepage2.nifty.com/nobukit/smallbasic.files/A4.png"
uCell[2][4] = "http://homepage2.nifty.com/nobukit/smallbasic.files/B4.png"
uCell[3][4] = "http://homepage2.nifty.com/nobukit/smallbasic.files/C4.png"
'
uPiece[LION1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Lion1t.png"
uPiece[GIRAFFE1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Giraffe1t.png"
uPiece[ELEPHANT1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Elephant1t.png"
uPiece[CHICK1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Chick1t.png"
uPiece[HEN1] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Hen1t.png"
uPiece[LION2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Lion2t.png"
uPiece[GIRAFFE2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Giraffe2t.png"
uPiece[ELEPHANT2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Elephant2t.png"
uPiece[CHICK2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Chick2t.png"
uPiece[HEN2] = "http://homepage2.nifty.com/nobukit/smallbasic.files/Hen2t.png"
'
iDirX[TOP] = 0
iDirY[TOP] = -1
iDirX[TOPRIGHT] = 1
iDirY[TOPRIGHT] = -1
iDirX[RIGHT] = 1
iDirY[RIGHT] = 0
iDirX[BOTTOMRIGHT] = 1
iDirY[BOTTOMRIGHT] = 1
iDirX[BOTTOM] = 0
iDirY[BOTTOM] = 1
iDirX[BOTTOMLEFT] = -1
iDirY[BOTTOMLEFT] = 1
iDirX[LEFT] = -1
iDirY[LEFT] = 0
iDirX[TOPLEFT] = -1
iDirY[TOPLEFT] = -1
iDirX[CENTER] = 0
iDirY[CENTER] = 0
EndSub
'
' Board | New
' out: Board_iCell[][] - game board
' out: Board_iNumCaptured[] - 0
' out: Board_iCaptured[][] - captured piece slot
Sub Board_New
GraphicsWindow.PenColor = "DarkOrange"
GraphicsWindow.BrushColor = "DarkOrange"
GraphicsWindow.PenWidth = 2
GraphicsWindow.FontSize = 20
GraphicsWindow.DrawImage(uBoard, Board_iX0, Board_iY0)
For i = 0 To 3
Dotted_iX0 = Board_iX0 + i * Board_idX
Dotted_iY0 = Board_iY0
Dotted_iX1 = Board_iX0 + i * Board_idX
Dotted_iY1 = Board_iY1
Graphics_DrawDottedLine()
If i > 0 Then
GraphicsWindow.DrawText(Board_iX0 + i * Board_idX - Board_idX / 2 - 5, Board_iY0 - Board_idY / 3, Board_sX[i])
EndIf
EndFor
For i = 0 To 4
Dotted_iX0 = Board_iX0
Dotted_iY0 = Board_iY0 + i * Board_idY
Dotted_iX1 = Board_iX1
Dotted_iY1 = Board_iY0 + i * Board_idY
Graphics_DrawDottedLine()
If i > 0 Then
GraphicsWindow.DrawText(Board_iX0 - Board_idX / 4, Board_iY0 + i * Board_idY - Board_idY / 2 - 10, Board_sY[i])
EndIf
EndFor
Board_iCell[1][1] = GIRAFFE2
Board_iCell[2][1] = LION2
Board_iCell[3][1] = ELEPHANT2
Board_iCell[1][2] = SPACE
Board_iCell[2][2] = CHICK2
Board_iCell[3][2] = SPACE
Board_iCell[1][3] = SPACE
Board_iCell[2][3] = CHICK1
Board_iCell[3][3] = SPACE
Board_iCell[1][4] = ELEPHANT1
Board_iCell[2][4] = LION1
Board_iCell[3][4] = GIRAFFE1
' Captured by SKY, FOREST
For i = FOREST To SKY
Board_iNumCaptured[i] = 0
For j = 1 To 6
Board_iCaptured[i][j] = SPACE
EndFor
EndFor
EndSub
'
' Board | Move
' in: bFromCaptured - if from captured slot (not from board cell)
' in: iFromX, iFromY, iPiece - piece and the position
' in: bPromote - promote chick to chicken
' in: i, j - captured slot if bFromCaptured
' in: iToX, iToY - to position
Sub Board_Move
' check i, j are in captured slot
If bFromCaptured Then
If (i > FOREST And i < SKY) Or (j < 1 And j > 6) Then
Goto lOutOfBounds
Else
iPiece = Board_iCaptured[i][j]
Goto lValidPiece
EndIf
EndIf
' check iFromX, iFromY, iToX, iToX are in board
If iFromX < 1 Or iFromX > Board_iRoX Then
Goto lOutOfBounds
EndIf
If iFromY < 1 Or iFromY > Board_iRoY Then
Goto lOutOfBounds
EndIf
iPiece = Board_iCell[iFromX][iFromY]
lValidPiece:
If iToX < 1 Or iToX > Board_iRoX Then
Goto lOutOfBounds
EndIf
If iToY < 1 Or iToY > Board_iRoY Then
Goto lOutOfBounds
EndIf
If iPiece > (iTurn - 1) * 5 And iPiece < 6 + (iTurn - 1) * 5 Then
' iPiece is a member of iTurn team
If bFromCaptured And Board_iCell[iToX][iToY] = SPACE Then
' iToX, iToY is movable position for captured iPiece
Goto lMatch
EndIf
For i = DIRMIN To DIRMAX ' nine directions
If iDirX[i] = iToX - iFromX And iDirY[i] = iToY - iFromY Then
If Game_bCanMove[iPiece][i] Then
' iToX, iToY is movable position for iPiece
Goto lMatch
EndIf
EndIf
EndFor
Sound.PlayChime()
Goto lExit
EndIf
lMatch:
' check phisically possible move if necessary
If Game_bCapture Then
iCaptured = Board_iCell[iToX][iToY]
Else
iCaptured = SPACE
EndIf
If Game_bIsPossibleMove Then
If bFromCaptured Then
Board_RemoveCaptured()
Else
iX = iFromX
iY = iFromY
Board_iCell[iX][iY] = SPACE
Board_DrawCell()
If bPromote Then
If iPiece = CHICK1 Then
iPiece = HEN1
ElseIf iPiece = CHICK2 Then
iPiece = HEN2
EndIf
EndIf
EndIf
iX = iToX
iY = iToY
Board_iCell[iX][iY] = iPiece
Board_DrawCell()
EndIf
If Game_bCapture Then
iOpposite = iTurn * 10 - 15
iCaptured = iCaptured + iOpposite
If iCaptured = HEN1 Then
iCaptured = CHICK1
ElseIf iCaptured = HEN2 Then
iCaptured = CHICK2
EndIf
Board_AddCaptured()
EndIf
Goto lExit
lOutOfBounds:
Sound.PlayChime()
lExit:
EndSub
'
' Board | Draw
' in: bArrangeOrder - piece arrange order refered from lion march
Sub Board_Draw
If bArrangeOrder Then
iX = 2 ' lion in sky
iY = 1
Board_DrawCell()
iY = 4 ' lion in forest
Board_DrawCell()
iX = 3 ' elephant in sky
iY = 1
Board_DrawCell()
iX = 1 ' elephant in forest
iY = 4
Board_DrawCell()
iX = 1 ' giraffe in sky
iY = 1
Board_DrawCell()
iX = 3 ' giraffe in forest
iY = 4
Board_DrawCell()
iX = 2 ' chick in sky
iY = 2
Board_DrawCell()
iY = 3 ' chick in sky
Board_DrawCell()
Else
For iY = 1 To 4
For iX = 1 To 3
Board_DrawCell()
EndFor
EndFor
EndIf
For i = FOREST To SKY
For j = 1 To 6
Board_DrawCaptured()
EndFor
EndFor
EndSub
'
' Board | Draw cell
' in: iX, iY - cell index
Sub Board_DrawCell
If Board_iCell[iX][iY] = SPACE Then
GraphicsWindow.DrawImage(uCell[iX][iY], Board_iX0 + (iX - 1) * Board_idX + 2, Board_iY0 + (iY - 1) * Board_idY + 2)
Else
GraphicsWindow.DrawImage(uPiece[Board_iCell[iX][iY]], Board_iX0 + (iX - 1) * Board_idX + isX, Board_iY0 + (iY - 1) * Board_idY + isY)
Sound.PlayClickAndWait()
EndIf
EndSub
'
' Board | Draw captured piece
' in: i - index FOREST team or SKY team
' in: j - index 1 to 6 for each team's capture slot
Sub Board_DrawCaptured
If i = FOREST Then
iX = Captured_iX0 + (Math.Floor((j + 1) / 2) - 1) * Captured_idX
iY = Captured_iY2 + Math.Remainder(8 - j, 2) * Captured_idY
Else ' i = SKY
iX = Captured_iX0 + (Math.Floor((j + 1) / 2) - 1) * Captured_idX
iY = Captured_iY0 + Math.Remainder(j + 1, 2) * Captured_idY
EndIf
If Board_iCaptured[i][j] = SPACE Then
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(iX + 1, iY + 1, 48, 48)
Else
GraphicsWindow.DrawResizedImage(uPiece[Board_iCaptured[i][j]], iX + isX / 2, iY + isY / 2, 42, 42)
Sound.PlayClickAndWait()
EndIf
EndSub
'
' Board | Add captured piece
' in: iCaptured - captured piece
' out: i, j - captured slot index
Sub Board_AddCaptured
If iCaptured <= 5 Then
i = FOREST
Else
i = SKY
EndIf
j = Board_iNumCaptured[i]
j = j + 1
Board_iCaptured[i][j] = iCaptured
Board_iNumCaptured[i] = j
Board_DrawCaptured()
EndSub
'
' Board | Remove captured piece
' in: i, j - captured slot index
' out: iPiece - removed piece
Sub Board_RemoveCaptured
If j > Board_iNumCaptured[i] Then
TextWindow.WriteLine("Error: j out of bounds (i = " + i + ", j = " + j + ")")
Goto lRemoveError
EndIf
iPiece = Board_iCaptured[i][j]
Stack.PushValue("board", j)
For j = j To Board_iNumCaptured[i] - 1
Board_iCaptured[i][j] = Board_iCaptured[i][j + 1]
Board_DrawCaptured()
EndFor
Board_iCaptured[i][j] = SPACE
Board_DrawCaptured()
j = Stack.PopValue("board")
Board_iNumCaptured[i] = Board_iNumCaptured[i] - 1
lRemoveError:
EndSub
'
' Board | Hide captured piece
' in: i, j - captured slot index
' out: iPiece - hidden piece
Sub Board_HideCaptured
If j > Board_iNumCaptured[i] Then
TextWindow.WriteLine("Error: j out of bounds (i = " + i + ", j = " + j + ")")
Goto lHideError
EndIf
iPiece = Board_iCaptured[i][j]
Board_iCaptured[i][j] = SPACE
Board_DrawCaptured()
Board_iCaptured[i][j] = iPiece
lHideError:
EndSub
'
' Console | Initialization
' out: sTitle - game title
' out: sColor - game title color
' out: sTurnForest - string for turn forest
' out: sForestColor - forest color
' out: sTurnSky - string for turn sky
' out: sSkyColor - sky color
' out: sForestWin - string for forest win
' out: sSkyWin - string for sky win
' out: sDraw - string for draw
' out: sDrawColor - draw color
' out: oBalloon - balloon shape object
Sub Console_Init
' show title
TextWindow.Write("どうぶつしょうぎ ") ' doubutsu shogi
sTitle[1] = "ど" ' do
sTitle[2] = "う" ' u
sTitle[3] = "ぶ" ' bu
sTitle[4] = "つ" ' tsu
sTitle[5] = "し" ' sho
sTitle[6] = "ょ"
sTitle[7] = "う" ' u
sTitle[8] = "ぎ" ' gi
sColor[1] = "Red"
sColor[2] = "Gold"
sColor[3] = "Blue"
sColor[4] = "Orange"
sColor[5] = "DeepPink"
sColor[6] = "DeepSkyBlue"
sColor[7] = "Purple"
sColor[8] = "SeaGreen"
GraphicsWindow.FontSize = 30
For i = 1 To 8
GraphicsWindow.BrushColor = sColor[i]
GraphicsWindow.DrawText(Board_iX0 + (i - 1) * 38, Board_iY0 - Board_idY * 4 / 5, sTitle[i])
EndFor
' show version
TextWindow.WriteLine("バージョン " + VERSION) ' version
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = 20
GraphicsWindow.DrawText(Board_iX1 + Board_idX * 1.5, Board_iY0 -Board_idY * 4 / 5, "バージョン " + VERSION)
' for turn
sTurnForest = "森チームの番" ' turn of forest team
sForestColor = "YellowGreen"
sTurnSky = "空チームの番" ' turn of sky team
sSkyColor = "DeepSkyBlue"
' for result
sForestWin = "森チームの勝ち" ' forest team wins
sSkyWin = "空チームの勝ち" ' sky team wins
sDraw = "引き分け" ' draw
sDrawColor = "Orange"
' for balloon
uBalloon = "http://homepage2.nifty.com/nobukit/smallbasic.files/balloon.png"
oBalloon = Shapes.AddImage(uBalloon)
Shapes.HideShape(oBalloon)
Shapes.Zoom(oBalloon, 0.5, 0.5)
Record_iX0 = Board_iX1 + Board_idX * 1.8
EndSub
'
' Console | Create replay button
' out: oReplay - replay button object
Sub Console_CreateReplayButton
sFontName = GraphicsWindow.FontName
GraphicsWindow.FontName = "Webdings"
oReplay = Controls.AddButton(REPLAY, Record_iX0, Board_iY1 - 38)
GraphicsWindow.FontName = sFontName
Controls.SetSize(oReplay, 30, 36)
Controls.HideControl(oReplay)
EndSub
'
' Console | Show replay button
' in: oReplay - replay button object
Sub Console_ShowReplayButton
Controls.ShowControl(oReplay)
Console_bReplay = "False"
bButtonNotClicked = "True"
EndSub
'
' Console | Hide replay button
' in: oReplay - replay button object
Sub Console_HideReplayButton
Controls.HideControl(oReplay)
EndSub
'
' Console | Create new game button
' out: oNewGame - new game button object
Sub Console_CreateNewGameButton
' from start
oNewGame = Controls.AddButton("はじめから", Record_iX0 + 38, Board_iY1 - 38)
Controls.HideControl(oNewGame)
EndSub
'
' Console | Show new game button
' in: oNewGame - new game button object
Sub Console_ShowNewGameButton
Controls.ShowControl(oNewGame)
bButtonNotClicked = "True"
Console_bNewGame = "False"
EndSub
'
' Console | Hide new game button
' in: oNewGame - new game button object
Sub Console_HideNewGameButton
Controls.HideControl(oNewGame)
EndSub
'
' Console | On button clicked
Sub Console_OnButtonClicked
If Controls.LastClickedButton = oReplay Then
Console_bReplay = "True"
bButtonNotClicked = "False"
ElseIf Controls.LastClickedButton = oNewGame Then
Console_bNewGame = "True"
bButtonNotClicked = "False"
EndIf
EndSub
'
' Console | Show turn
' in: iTurn - turn FOREST or SKY
Sub Console_ShowTurn
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(Board_iX1 + 10, Board_iY0 + Board_idY, 150, Board_idY * 2)
bFontBold = GraphicsWindow.FontBold
GraphicsWindow.FontBold = "False"
If iTurn = FOREST Then
RoundRect_iR = 7
RoundRect_iX = Board_iX1 + 10
RoundRect_iY = Board_iY0 + Board_idY * 2
RoundRect_iWidth = 130
RoundRect_iHeight = 40
GraphicsWindow.BrushColor = sForestColor
Graphics_FillRoundRect()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.DrawText(RoundRect_iX + RoundRect_iR - 2, RoundRect_iY + RoundRect_iR, sTurnForest)
Else ' iTurn = SKY
RoundRect_iR = 7
RoundRect_iX = Board_iX1 + 10
RoundRect_iY = Board_iY0 + Board_idY
RoundRect_iWidth = 130
RoundRect_iHeight = 40
GraphicsWindow.BrushColor = sSkyColor
Graphics_FillRoundRect()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.DrawText(RoundRect_iX + RoundRect_iR - 2, RoundRect_iY + RoundRect_iR, sTurnSky)
EndIf
GraphicsWindow.FontBold = bFontBold
EndSub
'
' Console | Show game result
' in: Game_iWinner - winner FOREST or SKY
Sub Console_ShowGameResult
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(Board_iX1 + 10, Board_iY0 + Board_idY, 150, Board_idY * 2)
bFontBold = GraphicsWindow.FontBold
GraphicsWindow.FontBold = "False"
If Game_iWinner = FOREST Then
RoundRect_iR = 7
RoundRect_iX = Board_iX1 + 10
RoundRect_iY = Board_iY0 + Board_idY * 2
RoundRect_iWidth = 150
RoundRect_iHeight = 40
GraphicsWindow.BrushColor = sForestColor
Graphics_FillRoundRect()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.DrawText(RoundRect_iX + RoundRect_iR - 2, RoundRect_iY + RoundRect_iR, sForestWin)
TextWindow.WriteLine(sForestWin)
ElseIf Game_iWinner = SKY Then
RoundRect_iR = 7
RoundRect_iX = Board_iX1 + 10
RoundRect_iY = Board_iY0 + Board_idY
RoundRect_iWidth = 150
RoundRect_iHeight = 40
GraphicsWindow.BrushColor = sSkyColor
Graphics_FillRoundRect()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.DrawText(RoundRect_iX + RoundRect_iR - 2, RoundRect_iY + RoundRect_iR, sSkyWin)
TextWindow.WriteLine(sSkyWin)
Else ' draw
RoundRect_iR = 7
RoundRect_iX = Board_iX1 + 10
RoundRect_iY = Board_iY0 + Board_idY * 1.5
RoundRect_iWidth = 130
RoundRect_iHeight = 40
GraphicsWindow.BrushColor = sSkyColor
Graphics_FillRoundRect()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.DrawText(RoundRect_iX + RoundRect_iR - 2, RoundRect_iY + RoundRect_iR, sDraw)
TextWindow.WriteLine(sDraw)
EndIf
GraphicsWindow.FontBold = bFontBold
EndSub
'
' Console | Ask first turn
' out: iTurn - FOREST or SKY
Sub Console_AskFirstTurn
GraphicsWindow.MouseMove = Console_DoNothing
sMessageBoxColor = "SaddleBrown"
GraphicsWindow.BrushColor = sMessageBoxColor
GraphicsWindow.PenColor = sMessageBoxColor
oMessageBox = Shapes.AddRectangle(300, 200)
Shapes.HideShape(oMessageBox)
iX = 240
iY = 175
Shapes.Move(oMessageBox, iX + 4, iY)
Shapes.SetOpacity(oMessageBox, 75)
'
GraphicsWindow.BrushColor = "White"
oMessageTitle = Shapes.AddText("どちらから？") ' from which?
Shapes.HideShape(oMessageTitle)
Shapes.Move(oMessageTitle, iX + 96, iY + 20)
'
Forest_iX0 = iX + 60
Forest_iX1 = Forest_iX0 + 80
Forest_iY0 = iY + 60
Forest_iY1 = Forest_iY0 + 120
'
oIcon1 = Shapes.AddImage(uCell[2][4])
Shapes.HideShape(oIcon1)
Shapes.Zoom(oIcon1, 0.8, 0.8)
Shapes.Move(oIcon1, Forest_iX0, Forest_iY0)
'
oText1 = Shapes.AddText("森チーム") ' forest team
Shapes.HideShape(oText1)
Shapes.Move(oText1, Forest_iX0, Forest_iY0 + 90)
'
Sky_iX0 = iX + 170
Sky_iX1 = Sky_iX0 + 80
Sky_iY0 = Forest_iY0
Sky_iY1 = Forest_iY1
'
oIcon2 = Shapes.AddImage(uCell[2][1])
Shapes.HideShape(oIcon2)
Shapes.Zoom(oIcon2, 0.8, 0.8)
Shapes.Move(oIcon2, Sky_iX0, Sky_iY0)
'
oText2 = Shapes.AddText("空チーム") ' sky team
Shapes.HideShape(oText2)
Shapes.Move(oText2, Sky_iX0, Sky_iY0 + 90)
'
Shapes.ShowShape(oMessageBox)
Shapes.ShowShape(oMessageTitle)
Shapes.ShowShape(oIcon1)
Shapes.ShowShape(oText1)
Shapes.ShowShape(oIcon2)
Shapes.ShowShape(oText2)
bOutOfBounds = "True"
While bOutOfBounds
GraphicsWindow.MouseDown = Console_OnMouseDown
bNotClicked = "True"
While bNotClicked
Program.Delay(200)
EndWhile
GraphicsWindow.MouseDown = Console_DoNothing
Console_CheckMouseClick()
EndWhile
Shapes.Remove(oMessageTitle)
Shapes.Remove(oIcon1)
Shapes.Remove(oText1)
Shapes.Remove(oIcon2)
Shapes.Remove(oText2)
Shapes.Remove(oMessageBox)
If iTurn = FOREST Then
TextWindow.WriteLine("先攻：森チーム") ' first turn: forest team
Else
TextWindow.WriteLine("先攻：空チーム") ' first turn: sky team
EndIf
EndSub
'
' Console | On mouse down
' out: iMX, iMY - mouse position
' out: bNotClicked - clear because clicked
Sub Console_OnMouseDown
iMX = GraphicsWindow.MouseX
iMY = GraphicsWindow.MouseY
bNotClicked = "False"
EndSub
'
' Console | Do nothing
Sub Console_DoNothing
EndSub
'
' Console | Check mouse click (which icon is selected)
' out: bOutOfBounds - selection failed
' out: iTurn - selected first turn FOREST or SKY
Sub Console_CheckMouseClick
If iMX >= Forest_iX0 And iMX <= Forest_iX1 And iMY >= Forest_iY0 And iMY <= Forest_iY1 Then
bOutOfBounds = "False"
iTurn = FOREST
ElseIf iMX >= Sky_iX0 And iMX <= Sky_iX1 And iMY >= Sky_iY0 And iMY <= Sky_iY1 Then
bOutOfBounds = "False"
iTurn = SKY
Else
bOutOfBounds = "True"
EndIf
EndSub
'
' Console | Show balloon
' in: sMessage - message in the balloon
' in: iX, iY - point of balloon root
Sub Console_ShowBalloon
' show balloon
GraphicsWindow.BrushColor = "Black"
oMessage = Shapes.AddText(sMessage)
Shapes.HideShape(oMessage)
Shapes.Move(oBalloon, iX, iY - 70)
Shapes.ShowShape(oBalloon)
Console_CountCRLF()
Shapes.Move(oMessage, iX + 60, iY - (iCRLF + 1) * 12)
Shapes.ShowShape(oMessage)
' wait a moment
Sound.PlayChimeAndWait()
' remove balloon
Shapes.Remove(oMessage)
Shapes.HideShape(oBalloon)
EndSub
'
' Console | Count CR+LF (carriage return, line feed)
' in: sMessage - message in the balloon
' in: iCRLF - number of CR+LF
Sub Console_CountCRLF
iPtr = 1
iDelta = 1
iCRLF = 0
While iDelta > 0
iDelta = Text.GetIndexOf(Text.GetSubTextToEnd(sMessage, iPtr), CRLF)
If iDelta > 0 Then
iCRLF = iCRLF + 1
iPtr = iPtr + iDelta + 1
EndIf
EndWhile
EndSub
'
' Game | Initialization
' out: Game_bCanMove[][] ' piece move ability
Sub Game_Init
Game_bCanMove[LION1][TOP] = "True"
Game_bCanMove[LION1][TOPRIGHT] = "True"
Game_bCanMove[LION1][RIGHT] = "True"
Game_bCanMove[LION1][BOTTOMRIGHT] = "True"
Game_bCanMove[LION1][BOTTOM] = "True"
Game_bCanMove[LION1][BOTTOMLEFT] = "True"
Game_bCanMove[LION1][LEFT] = "True"
Game_bCanMove[LION1][TOPLEFT] = "True"
Game_bCanMove[LION1][CENTER] = "True"
'
Game_bCanMove[GIRAFFE1][TOP] = "True"
Game_bCanMove[GIRAFFE1][TOPRIGHT] = "False"
Game_bCanMove[GIRAFFE1][RIGHT] = "True"
Game_bCanMove[GIRAFFE1][BOTTOMRIGHT] = "False"
Game_bCanMove[GIRAFFE1][BOTTOM] = "True"
Game_bCanMove[GIRAFFE1][BOTTOMLEFT] = "False"
Game_bCanMove[GIRAFFE1][LEFT] = "True"
Game_bCanMove[GIRAFFE1][TOPLEFT] = "False"
Game_bCanMove[GIRAFFE1][CENTER] = "True"
'
Game_bCanMove[ELEPHANT1][TOP] = "False"
Game_bCanMove[ELEPHANT1][TOPRIGHT] = "True"
Game_bCanMove[ELEPHANT1][RIGHT] = "False"
Game_bCanMove[ELEPHANT1][BOTTOMRIGHT] = "True"
Game_bCanMove[ELEPHANT1][BOTTOM] = "False"
Game_bCanMove[ELEPHANT1][BOTTOMLEFT] = "True"
Game_bCanMove[ELEPHANT1][LEFT] = "False"
Game_bCanMove[ELEPHANT1][TOPLEFT] = "True"
Game_bCanMove[ELEPHANT1][CENTER] = "True"
'
Game_bCanMove[HEN1][TOP] = "True"
Game_bCanMove[HEN1][TOPRIGHT] = "True"
Game_bCanMove[HEN1][RIGHT] = "True"
Game_bCanMove[HEN1][BOTTOMRIGHT] = "False"
Game_bCanMove[HEN1][BOTTOM] = "True"
Game_bCanMove[HEN1][BOTTOMLEFT] = "False"
Game_bCanMove[HEN1][LEFT] = "True"
Game_bCanMove[HEN1][TOPLEFT] = "True"
Game_bCanMove[HEN1][CENTER] = "True"
'
Game_bCanMove[CHICK1][TOP] = "True"
Game_bCanMove[CHICK1][TOPRIGHT] = "False"
Game_bCanMove[CHICK1][RIGHT] = "False"
Game_bCanMove[CHICK1][BOTTOMRIGHT] = "False"
Game_bCanMove[CHICK1][BOTTOM] = "False"
Game_bCanMove[CHICK1][BOTTOMLEFT] = "False"
Game_bCanMove[CHICK1][LEFT] = "False"
Game_bCanMove[CHICK1][TOPLEFT] = "False"
Game_bCanMove[CHICK1][CENTER] = "True"
'
Game_bCanMove[LION2][TOP] = "True"
Game_bCanMove[LION2][TOPRIGHT] = "True"
Game_bCanMove[LION2][RIGHT] = "True"
Game_bCanMove[LION2][BOTTOMRIGHT] = "True"
Game_bCanMove[LION2][BOTTOM] = "True"
Game_bCanMove[LION2][BOTTOMLEFT] = "True"
Game_bCanMove[LION2][LEFT] = "True"
Game_bCanMove[LION2][TOPLEFT] = "True"
Game_bCanMove[LION2][CENTER] = "True"
'
Game_bCanMove[GIRAFFE2][TOP] = "True"
Game_bCanMove[GIRAFFE2][TOPRIGHT] = "False"
Game_bCanMove[GIRAFFE2][RIGHT] = "True"
Game_bCanMove[GIRAFFE2][BOTTOMRIGHT] = "False"
Game_bCanMove[GIRAFFE2][BOTTOM] = "True"
Game_bCanMove[GIRAFFE2][BOTTOMLEFT] = "False"
Game_bCanMove[GIRAFFE2][LEFT] = "True"
Game_bCanMove[GIRAFFE2][TOPLEFT] = "False"
Game_bCanMove[GIRAFFE2][CENTER] = "True"
'
Game_bCanMove[ELEPHANT2][TOP] = "False"
Game_bCanMove[ELEPHANT2][TOPRIGHT] = "True"
Game_bCanMove[ELEPHANT2][RIGHT] = "False"
Game_bCanMove[ELEPHANT2][BOTTOMRIGHT] = "True"
Game_bCanMove[ELEPHANT2][BOTTOM] = "False"
Game_bCanMove[ELEPHANT2][BOTTOMLEFT] = "True"
Game_bCanMove[ELEPHANT2][LEFT] = "False"
Game_bCanMove[ELEPHANT2][TOPLEFT] = "True"
Game_bCanMove[ELEPHANT2][CENTER] = "True"
'
Game_bCanMove[HEN2][TOP] = "True"
Game_bCanMove[HEN2][TOPRIGHT] = "False"
Game_bCanMove[HEN2][RIGHT] = "True"
Game_bCanMove[HEN2][BOTTOMRIGHT] = "True"
Game_bCanMove[HEN2][BOTTOM] = "True"
Game_bCanMove[HEN2][BOTTOMLEFT] = "True"
Game_bCanMove[HEN2][LEFT] = "True"
Game_bCanMove[HEN2][TOPLEFT] = "False"
Game_bCanMove[HEN2][CENTER] = "True"
'
Game_bCanMove[CHICK2][TOP] = "False"
Game_bCanMove[CHICK2][TOPRIGHT] = "False"
Game_bCanMove[CHICK2][RIGHT] = "False"
Game_bCanMove[CHICK2][BOTTOMRIGHT] = "False"
Game_bCanMove[CHICK2][BOTTOM] = "True"
Game_bCanMove[CHICK2][BOTTOMLEFT] = "False"
Game_bCanMove[CHICK2][LEFT] = "False"
Game_bCanMove[CHICK2][TOPLEFT] = "False"
Game_bCanMove[CHICK2][CENTER] = "True"
EndSub
'
' Game | Loop while in game
Sub Game_Loop
Game_bInGame = "True"
While Game_bInGame
' Odd turn
Human_Move() ' player HUMAN
Board_Move()
GameRecord_Move()
Game_Judge()
iTurn = 3 - iTurn
Console_ShowTurn()
If Game_bInGame Then
' Even turn
Human_Move() ' player HUMAN
Board_Move()
GameRecord_Move()
Game_Judge()
iTurn = 3 - iTurn
Console_ShowTurn()
EndIf
EndWhile
Console_ShowGameResult()
EndSub
'
' Game | Judge
' in: iToX, iToY - last moved piece cell
' out: Game_bInGame - in game flag
' out: Game_bDraw - draw flag
' out: Game_iWinner - winner FOREST or SKY
Sub Game_Judge
Game_bInGame = "True"
Game_bDraw = "False"
Game_iWinner = SPACE
' Check draw (with 3 times of same board pattern)
Game_CheckSennichite()
If bSennichite Then
sMessage = "引き分け" ' draw
Console_ShowBalloon()
Game_bInGame = "False"
Game_bDraw = "True"
Else
Game_CheckCaught()
' Check catch
If bCaught Then
sMessage = "キャッチ！" ' catch!
iX = Board_iX0 + iToX * Board_idX - 20
iY = Board_iY0 + (iToY - 1) * Board_idY + 20
Console_ShowBalloon()
Game_bInGame = "False"
Else
' Check try (legal or illegal)
Game_CheckTried()
If bTried Then
sMessage = "トライ！" ' try!
iX = Board_iX0 + iToX * Board_idX - 20
iY = Board_iY0 + (iToY - 1) * Board_idY + 20
Console_ShowBalloon()
Game_bInGame = "False"
ElseIf bTryFailed Then
sMessage = "トライ失敗！" ' try failed!
iX = Board_iX0 + iToX * Board_idX - 20
iY = Board_iY0 + (iToY - 1) * Board_idY + 20
Console_ShowBalloon()
Game_bInGame = "False"
EndIf
EndIf
EndIf
EndSub
'
' Game | Check sennichite
' out: bSennichite - sennichite flag
Sub Game_CheckSennichite
' Check draw (with 3 times of same board pattern)
bSennichite = "False"
EndSub
'
' Game | Check caught lion
' in: iCaptured - captured piece
' in: iTurn - turn FOREST or SKY
' out: bCaught - caught lion flag
' out: Game_iWinner - winner FOREST or SKY
Sub Game_CheckCaught
' Check catch
bCaught = "False"
If iCaptured = LION1 Or iCaptured = LION2 Then
Game_iWinner = iTurn
bCaught = "True"
EndIf
EndSub
'
' Game | Check lion tried
' in: iTurn - turn FOREST or SKY
' out: bTried - lion tried flag
' out: bTryFailed - lion try failed flag
' out: Game_iWinner - winner FOREST or SKY
Sub Game_CheckTried
' Check catch
bTried = "False"
bTryFailed = "False"
For iX = 1 To 3
iY = 1
If Board_iCell[iX][iY] = LION1 Then
Game_CheckNoMark()
If bNoMark Then
bTried = "True"
Game_iWinner = iTurn
Goto lExitTried
EndIf
EndIf
iY = 4
If Board_iCell[iX][iY] = LION2 Then
Game_CheckNoMark()
If bNoMark Then
bTried = "True"
Game_iWinner = iTurn
Goto lExitTried
EndIf
EndIf
EndFor
lExitTried:
EndSub
'
' Game | Check point (iX,iY) is no mark
' in: iTurn - turn FOREST or SKY
' in: iX, iY - point to check
' out: bNoMark - flag (iX, iY) is no mark
Sub Game_CheckNoMark
bNoMark = "True"
For iDir = DIRMIN To DIRMAX
If iDir <> CENTER Then
iCX = iX + iDirX[iDir] ' X to check
iCY = iY + iDirY[iDir] ' Y to check
If iCX >= 1 And iCX <= Board_iRoX And iCY >= 1 And iCY <= Board_iRoY Then
iCheck = Board_iCell[iCX][iCY]
If iCheck > (2 - iTurn) * 5 And iCheck < 6 + (2 - iTurn) * 5 Then
' opposite team piece found
Game_CalcOpposite() ' calc iOpposite from iDir
If Game_bCanMove[iCheck][iOpposite] Then
bNoMark = "False"
EndIf
EndIf
EndIf
EndIf
EndFor
EndSub
'
' Game | Calculate opposite direction
' in: iDir - original direction
' out: iOpposite - opposite direction
Sub Game_CalcOpposite
If iDir = TOP Then
iOpposite = BOTTOM
ElseIf iDir = TOPRIGHT Then
iOpposite = BOTTOMLEFT
ElseIf iDir = RIGHT Then
iOpposite = LEFT
ElseIf iDir = BOTTOMRIGHT Then
iOpposite = TOPLEFT
ElseIf iDir = BOTTOM Then
iOpposite = TOP
ElseIf iDir = BOTTOMLEFT Then
iOpposite = TOPRIGHT
ElseIf iDir = LEFT Then
iOpposite = RIGHT
ElseIf iDir = TOPLEFT Then
iOpposite = BOTTOMRIGHT
EndIf
EndSub
'
' Game | Is movable piece?
' in: iX, iY - next move
' in: i, j - next piece in captured if bFromCaptured
' in: iTurn - turn forest or sky
' out: Game_bIsMovablePiece - is movable
' out: iPiece - piece if movable
' out: iFromX, iFromY - position of the piece
Sub Game_IsMovablePiece
If bFromCaptured Then
iPiece = Board_iCaptured[i][j]
Else
iPiece = Board_iCell[iX][iY]
EndIf
Game_bIsMovablePiece = "False"
If iPiece > (iTurn - 1) * 5 And iPiece < 6 + (iTurn - 1) * 5 Then
If bFromCaptured Then
Game_bIsMovablePiece = "True"
Goto lExitMovable
EndIf
iFromX = iX
iFromY = iY
' iPiece is a member of iTurn team and
For i = DIRMIN To DIRMAX ' nine directions
If Game_bCanMove[iPiece][i] Then
iToX = iFromX + iDirX[i]
iToY = iFromY + iDirY[i]
iToPiece = Board_iCell[iToX][iToY]
If iToPiece = SPACE Or (iToPiece > (2 - iTurn) * 5 And iToPiece < 6 + (2 - iTurn) * 5) Then
' iToX, iToY is movable position for iPiece
Game_bIsMovablePiece = "True"
EndIf
EndIf
EndFor
EndIf
lExitMovable:
EndSub
'
' Game | Is possible move?
' in: iFromX, iFromY - piece position (if not bFromCaptured)
' in: iToX, iToY - next move
' in: iPiece - piece to move
' out: Game_bIsPossibleMove - flag if possible move
' out: Game_bCapture - flag if capture
Sub Game_IsPossibleMove
If bFromCaptured Then
If Board_iCell[iToX][iToY] = SPACE Then
Game_bIsPossibleMove = "True"
Game_bCapture = "False"
Else
Game_bIsPossibleMove = "False"
Game_bCapture = "False"
EndIf
Else
idX = iToX - iFromX
idY = iToY - iFromY
If idX >= -1 And idX <= 1 And idY >= -1 And idY <= 1 Then
i = (idY + 1) * 3 + (idX + 1)
If Game_bCanMove[iPiece][i] Then
' iToX, iToY is movable position for iPiece
If Board_iCell[iToX][iToY] = SPACE Then
Game_bIsPossibleMove = "True"
Game_bCapture = "False"
ElseIf Board_iCell[iToX][iToY] > (2 - iTurn) * 5 And Board_iCell[iToX][iToY] < 6 + (2 - iTurn) * 5 Then
' opposite team piece already exists ... capture it
Game_bIsPossibleMove = "True"
Game_bCapture = "True"
Else
Game_bIsPossibleMove = "False"
Game_bCapture = "False"
EndIf
Else
Game_bIsPossibleMove = "False"
Game_bCapture = "False"
EndIf
Else
Game_bIsPossibleMove = "False"
Game_bCapture = "False"
EndIf
EndIf
' ask promotion if needed
bPromote = "False"
If Game_bIsPossibleMove Then
If iPiece = CHICK1 And iToY = 1 Then
bPromote = "True"
ElseIf iPiece = CHICK2 And iToY = 4 Then
bPromote = "True"
EndIf
EndIf
EndSub
'
' Game record | Initialization
Sub GameRecord_Init
sPiece[LION1] = "ライオン"
sPiece[ELEPHANT1] = "ぞう"
sPiece[GIRAFFE1] = "きりん"
sPiece[HEN1] = "ニワトリ"
sPiece[CHICK1] = "ひよこ"
sPiece[LION2] = "ライオン"
sPiece[ELEPHANT2] = "ぞう"
sPiece[GIRAFFE2] = "きりん"
sPiece[HEN2] = "ニワトリ"
sPiece[CHICK2] = "ひよこ"
EndSub
'
' Game record | New game
Sub GameRecord_New
GameRecord_iNum = 0
iLine = 1
EndSub
'
' Game record | Draw
Sub GameRecord_Draw
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(Record_iX0, Board_iY0, 160, Board_idY * 4)
For iRec = 1 To GameRecord_iNum
sTo = Board_sX[GameRecord_iToX[iRec]] + Board_sY[GameRecord_iToY[iRec]]
iPiece = GameRecord_iPiece[iRec]
GameRecord_DrawLine()
EndFor
EndSub
'
' Game record | Draw line
' in: iPiece - moved piece
' in: sTo - cell the piece move to
' in: iRec - number of record
' in: iLine - draw line
' out: sLine - last record
Sub GameRecord_DrawLine
If iLine <= 12 Then
If Math.Remainder(iRec, 2) = FOREST Then
GraphicsWindow.BrushColor = sForestColor
Else
GraphicsWindow.BrushColor = sSkyColor
EndIf
GraphicsWindow.FillEllipse(Record_iX0, Board_iY0 + (iLine - 1) * 30 + 2, 24, 24)
GraphicsWindow.BrushColor = "Black"
sLine = iRec + " " + sTo + " " + sPiece[iPiece]
GraphicsWindow.DrawText(Record_iX0 + 4, Board_iY0 + (iLine - 1) * 30, sLine)
iLine = iLine + 1
Else
GameRecord_Scroll()
iLine = 12
GameRecord_DrawLine()
EndIf
EndSub
'
' Game record | Scroll
Sub GameRecord_Scroll
Stack.PushValue("scroll", iPiece)
Stack.PushValue("scroll", sTo)
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(Record_iX0, Board_iY0, 160, Board_idY * 4)
iLine = 1
While iLine < 12
Stack.PushValue("scroll", iRec)
iRec = iRec - 12 + iLine
iPiece = GameRecord_iPiece[iRec]
iToX = GameRecord_iToX[iRec]
iToY = GameRecord_iToY[iRec]
sTo = Board_sX[iToX] + Board_sY[iToY]
GameRecord_DrawLine()
iRec = Stack.PopValue("scroll")
EndWhile
sTo = Stack.PopValue("scroll")
iPiece = Stack.PopValue("scroll")
EndSub
'
' Game record | Move
Sub GameRecord_Move
iRec = GameRecord_iNum + 1
GameRecord_iPiece[iRec] = iPiece
GameRecord_iToX[iRec] = iToX
GameRecord_iToY[iRec] = iToY
GameRecord_iNum = iRec
sTo = Board_sX[iToX] + Board_sY[iToY]
GameRecord_DrawLine()
TextWindow.WriteLine(sLine)
EndSub
'
' Graphics | Draw dotted line
' in: Dotted_iX0, Dotted_iY0 - line start point
' in: Dotted_iX1, Dotted_iY1 - line end point
Sub Graphics_DrawDottedLine
iLen = 10
iSqX = (Dotted_iX1 - Dotted_iX0) * (Dotted_iX1 - Dotted_iX0)
iSqY = (Dotted_iY1 - Dotted_iY0) * (Dotted_iY1 - Dotted_iY0)
For rLen = 0 To Math.SquareRoot(iSqX + iSqY) - iLen Step iLen * 2
rRatio = rLen / Math.SquareRoot(iSqX + iSqY)
iDX0 = Dotted_iX0 + rRatio * (Dotted_iX1 - Dotted_iX0)
iDY0 = Dotted_iY0 + rRatio * (Dotted_iY1 - Dotted_iY0)
rRatio = (rLen + iLen) / Math.SquareRoot(iSqX + iSqY)
iDX1 = Dotted_iX0 + rRatio * (Dotted_iX1 - Dotted_iX0)
iDY1 = Dotted_iY0 + rRatio * (Dotted_iY1 - Dotted_iY0)
GraphicsWindow.DrawLine(iDX0, iDY0, iDX1, iDY1)
EndFor
EndSub
'
' Graphics | Fill round rectangle
' in: RoundRect_iX, RoundRect_iY - left top point
' in: RoundRect_iWidth, RoundRect_iHeight - width and height
' in: RoundRect_iR - corner radius
Sub Graphics_FillRoundRect
GraphicsWindow.FillRectangle(RoundRect_iX + RoundRect_iR, RoundRect_iY, RoundRect_iWidth - RoundRect_iR * 2, RoundRect_iHeight)
GraphicsWindow.FillRectangle(RoundRect_iX, RoundRect_iY + RoundRect_iR, RoundRect_iWidth, RoundRect_iHeight - RoundRect_iR * 2)
GraphicsWindow.FillEllipse(RoundRect_iX, RoundRect_iY, RoundRect_iR * 2, RoundRect_iR * 2)
GraphicsWindow.FillEllipse(RoundRect_iX + RoundRect_iWidth - RoundRect_iR * 2, RoundRect_iY, RoundRect_iR * 2, RoundRect_iR * 2)
GraphicsWindow.FillEllipse(RoundRect_iX, RoundRect_iY + RoundRect_iHeight - RoundRect_iR * 2, RoundRect_iR * 2, RoundRect_iR * 2)
GraphicsWindow.FillEllipse(RoundRect_iX + RoundRect_iWidth - RoundRect_iR * 2, RoundRect_iY + RoundRect_iHeight - RoundRect_iR * 2, RoundRect_iR * 2, RoundRect_iR * 2)
EndSub
'
' Player HUMAN | Move
' out: iPiece - piece to move
' out: iFromX, iFromY - piece position in board
' out: i, j - piece position in captured slot
' out: iToX, iToY - position to move
Sub Human_Move
' get movable piece as iPiece and get the position
While "True"
Human_bOutOfBoard = "True"
While Human_bOutOfBoard
GraphicsWindow.MouseDown = Human_OnMouseDown
Human_bNotClicked = "True"
While Human_bNotClicked
Program.Delay(200)
EndWhile
GraphicsWindow.MouseDown = Human_DoNothing
Human_GetPosition()
bFromCaptured = bInCaptured
EndWhile
Game_IsMovablePiece()
If Game_bIsMovablePiece Then
Goto lMovablePiece
Else
Sound.PlayChime()
EndIf
EndWhile
lMovablePiece:
' erase the piece
If bFromCaptured Then
Board_HideCaptured()
Else
Stack.PushValue("human", iPiece)
iPiece = SPACE
iToX = iX
iToY = iY
Board_iCell[iFromX][iFromY] = SPACE
Board_DrawCell()
iPiece = Stack.PopValue("human")
Board_iCell[iFromX][iFromY] = iPiece
EndIf
' Set the piece as shape for mouse animation
oPiece = Shapes.AddImage(uPiece[iPiece])
Shapes.ShowShape(oPiece)
Shapes.HideShape(oPiece)
If bFromCaptured Then
Shapes.Move(oPiece, Human_iMX - 40, Human_iMY - 40)
Else
Shapes.Move(oPiece, Board_iX0 + isX + (iFromX - 1) * Board_idX , Board_iY0 + isY + (iFromY - 1) * Board_idY)
EndIf
Shapes.ShowShape(oPiece)
GraphicsWindow.MouseMove = Human_OnMouseMove
' Get possible move
While "True"
Human_bOutOfBoard = "True"
While Human_bOutOfBoard
GraphicsWindow.MouseDown = Human_OnMouseDown
Human_bNotClicked = "True"
While Human_bNotClicked
Program.Delay(200)
EndWhile
GraphicsWindow.MouseDown = Human_DoNothing
Human_GetPosition()
iToX = iX
iToY = iY
EndWhile
Game_IsPossibleMove()
If Game_bIsPossibleMove Then
Goto lPossibleMove
Else
Sound.PlayChime()
EndIf
EndWhile
lPossibleMove:
Shapes.Remove(oPiece)
GraphicsWindow.MouseMove = Human_DoNothing
EndSub
'
' Player HUMAN | Get board position from mouse position
' out: iX, iY - next move position
' out: i, j - next piece slot if bFromCaptured
' out: Human_bOutOfBoard - mouse clicked out of board / captured slot
' out: bInCaptured - next piece from captured slot
Sub Human_GetPosition
iX = Math.Floor((Human_iMX - Board_iX0) / Board_idX) + 1
iY = Math.Floor((Human_iMY - Board_iY0) / Board_idY) + 1
Human_bOutOfBoard = "False"
If iX < 1 Or iX > Board_iRoX Or iY < 1 Or iY > Board_iRoY Then
bInCaptured = "True"
iX = Math.Floor((Human_iMX - Captured_iX0) / Captured_idX) + 1
iY = Math.Floor((Human_iMY - Captured_iY0) / Captured_idY) + 1
i = SKY
j = (iX - 1) * 2 + iY
If iX < 1 Or iX > Captured_iRoX Or iY < 1 Or iY > Captured_iRoY Then
iY = Math.Floor((Human_iMY - Captured_iY2) / Captured_idY) + 1
i = FOREST
j = (iX - 1) * 2 + (3 - iY)
If iX < 1 Or iX > Captured_iRoX Or iY < 1 Or iY > Captured_iRoY Then
Human_bOutOfBoard = "True"
EndIf
EndIf
Else
bInCaptured = "False"
EndIf
EndSub
'
' Player HUMAN | Get mouse position
' out: Human_iMX, Human_iMY - clicked mouse position
' out: Human_bNotClicked - flag
' GraphicsWindow.MouseDown = Human_DoNothing
Sub Human_OnMouseDown
Human_iMX = GraphicsWindow.MouseX
Human_iMY = GraphicsWindow.MouseY
Human_bNotClicked = "False"
EndSub
'
' Player HUMAN | Move piece with mouse
Sub Human_OnMouseMove
iMX = GraphicsWindow.MouseX
iMY = GraphicsWindow.MouseY
Shapes.Move(oPiece, iMX - 40, iMY - 40)
EndSub
'
' Player HUMAN | Do nothing
Sub Human_DoNothing
EndSub
'
' Sound | Lion march
Sub Sound_LionMarch
For i = 1 To 1
Sound.PlayMusic("O4 G2 G4 A4 G2 E2 C2 D2 E1 F2 F4 F4 E2 E4 E4 D4 D4 D4 D4 G1 A4 A4 A4 A4 G4 G4 G4 G4 F2 O3 B2 O4 C1")
EndFor
EndSub