Microsoft Small Basic

Program Listing:
Embed this in your website
' Tic-tac-toe v1.1 - Copyright (c) 2011 Nonki Takahashi
'
' History
' v1.1 2011/01/18 Created, can play HUMAN vs HUMAN only (505 lines LBW762-0)
'
' Reference
' [1] en.wikipedia.org/wiki/Tic-tac-toe
'
' Constant
'
SPACE = 0 ' for Board
CROSS = 1 ' X for Board
NOUGHT = 2 ' O for Board
DRAW = 3 ' for Winner
UPPERA = Text.GetCharacterCode("A") ' for Parse
UPPERZ = Text.GetCharacterCode("Z") ' for Parse
LETTER0 = Text.GetCharacterCode("0") ' for Parse
LETTER9 = Text.GetCharacterCode("9") ' for Parse
REPLAY = "4" ' Webdings replay mark
SAVE = "=" ' Windings save mark
'
' Main
'
GraphicsWindow.BackgroundColor = "LightGray"
GraphicsWindow.Title = "Tic-tac-toe v1.0"
Board_Clear()
Console_Init()
Controls.ButtonClicked = Console_OnButtonClicked
While "True"
  ' Game start
  Controls.HideControl(Console_oReplay)
  Controls.HideControl(Console_oSave)
  Game_iWinner = SPACE
  Board_Clear()
  Lamp_iOn = CROSS
  Lamp_Draw()
  While Game_iWinner = SPACE
    Player_bOutOfBoard = "True"
    While Player_bOutOfBoard
      Player_Human()
      Lamp_iOn = 3 - iTurn
      Lamp_Draw()
      Score_Write()
      Game_Judge()
    EndWhile
  EndWhile
  ' Game end
  Controls.ShowControl(Console_oReplay)
  Controls.ShowControl(Console_oSave)
  Console_bSave = "False"
  While Console_bSave = "False"
    While Console_bButtonClicked = "False"
      Program.Delay(100)
    EndWhile
    Console_bButtonClicked = "False"
    If Console_bReplay Then
      Board_Clear()
      Score_Read()
      Score_Replay()
    EndIf
  EndWhile
  Board_Clear()
  Score_Clear()
EndWhile
'
Sub Player_Human
  GraphicsWindow.MouseDown = Player_OnMouseDown
  While "True"
    Player_bOutOfBoard = "True"
    While Player_bOutOfBoard
      Player_bNotClicked = "True"
      While Player_bNotClicked
        Program.Delay(200)
      EndWhile
      Player_GetPosition()
    EndWhile
    Game_IsPossibleMove()
    If Game_bIsPossibleMove Then
        Goto lPossibleMove
    Else
      Sound.PlayChimeAndWait()
    EndIf
  EndWhile
lPossibleMove:
  iTurn = Math.Remainder((Board_iMove - 1), 2) + 1
  Board_Move()
  Score_Record()
EndSub
'
Sub Player_OnMouseDown
  Player_iMX = GraphicsWindow.MouseX
  Player_iMY = GraphicsWindow.MouseY
  Player_bNotClicked = "False"
EndSub
'
Sub Player_GetPosition
  iX = Math.Floor((Player_iMX - Board_iX0) / Board_idX) + 1
  iY = Math.Floor((Player_iMY - Board_iY0) / Board_idY) + 1
  If iX < 1 Or iX > Board_iRo Or iY < 1 Or iY > Board_iRo Then
    Player_bOutOfBoard = "True"
  Else
    Player_bOutOfBoard = "False"
  EndIf
EndSub
'
Sub Game_IsPossibleMove
  If Board_iCell[iX][iY] = SPACE Then
    Game_bIsPossibleMove = "True"
  Else
    Game_bIsPossibleMove = "False"
  EndIf
EndSub
'
Sub Game_Judge
  GraphicsWindow.PenColor = "Magenta"
  GraphicsWindow.PenWidth = 5
  Game_iWinner = SPACE
  iTurn = Board_iCell[1][1] ' \
  If iTurn = SPACE Then
    Goto lLine2
  EndIf
  For i = 2 To Board_iRo
    If Board_iCell[i][i] <> iTurn Then
      Goto lLine2
    EndIf
  EndFor
  GraphicsWindow.DrawLine(Board_iX0, Board_iY0, Board_iX1, Board_iY1)
  Game_iWinner = iTurn
lLine2:
  iTurn = Board_iCell[Board_iRo][1] ' /
  If iTurn = SPACE Then
    Goto lLine3
  EndIf
  For i = 2 To Board_iRo
    If Board_iCell[Board_iRo + 1 - i][i] <> iTurn Then
      Goto lLine3
    EndIf
  EndFor
  GraphicsWindow.DrawLine(Board_iX1, Board_iY0, Board_iX0, Board_iY1)
  Game_iWinner = iTurn
lLine3:
  For iY = 1 To Board_iRo
    iTurn = Board_iCell[1][iY]
    If iTurn = SPACE Then
      Goto lLine4
    EndIf
    For iX = 2 To Board_iRo
      If Board_iCell[iX][iY] <> iTurn Then
        Goto lLine4
      EndIf
    EndFor
    GraphicsWindow.DrawLine(Board_iX0, Board_iY0 + (iY - 1 / 2) * Board_idY, Board_iX1, Board_iY0 + (iY - 1 / 2) * Board_idY)
    Game_iWinner = iTurn
lLine4:
  EndFor
  For iX = 1 To Board_iRo
    iTurn = Board_iCell[iX][1]
    If iTurn = SPACE Then
      Goto lLine5
    EndIf
    For iY = 2 To Board_iRo
      If Board_iCell[iX][iY] <> iTurn Then
        Goto lLine5
      EndIf
    EndFor
    GraphicsWindow.DrawLine(Board_iX0 + (iX - 1 / 2) * Board_idX, Board_iY0, Board_iX0 + (iX - 1 / 2) * Board_idX, Board_iY1)
    Game_iWinner = iTurn
lLine5:
  EndFor
  If Board_iMove = 9 And Game_iWinner = SPACE Then
    Game_iWinner = DRAW
  EndIf
  If Game_iWinner <> SPACE Then
    Console_ShowWinner()
  EndIf
EndSub
'
Sub Console_OnButtonClicked
  If Controls.LastClickedButton = Console_oReplay Then
    Console_bReplay = "True"
  Else
    Console_bReplay = "False"
  EndIf
  If Controls.LastClickedButton = Console_oSave Then
    Console_bSave = "True"
  Else
    Console_bSave = "False"
  EndIf
  If Console_bReplay Or Console_bSave Then
    Console_bButtonClicked = "True"
  Else
    Console_bButtonClicked = "False"
  EndIf
EndSub
'
Sub Board_Clear
  Board_iRo = 3
  Board_iMove = 0
  For iY = 1 To Board_iRo
    For iX = 1 To Board_iRo
      Board_iCell[iX][iY] = SPACE
    EndFor
  EndFor
  Board_idX = 90
  Board_idY = 90
  Board_isX = 20
  Board_isY = 20
  Board_iX0 = 65
  Board_iY0 = 60
  Board_iX1 = Board_iX0 + Board_idX * Board_iRo
  Board_iY1 = Board_iY0 + Board_idY * Board_iRo
  Board_cX[1] = "A"
  Board_cX[2] = "B"
  Board_cX[3] = "C"
  Board_cY[1] = "1"
  Board_cY[2] = "2"
  Board_cY[3] = "3"
  Board_Draw()
  Console_HideWinner()
EndSub
'
Sub Board_Draw
  GraphicsWindow.BrushColor = "DarkGreen"
  GraphicsWindow.FillRectangle(Board_iX0 - Board_isX, Board_iY0 - Board_isY, Board_iRo * Board_idX + 2 * Board_isX, Board_iRo * Board_idY + 2 * Board_isY)
  GraphicsWindow.PenColor = "Khaki"
  GraphicsWindow.PenWidth = 5
  For i = 1 To Board_iRo - 1
    iX = Board_iX0 + Board_idX * i
    iY = Board_iY0 + Board_idY * i
    GraphicsWindow.DrawLine(Board_iX0, iY, Board_iX1, iY)
    GraphicsWindow.DrawLine(iX, Board_iY0, iX, Board_iY1)
  EndFor
  GraphicsWindow.BrushColor = "Black"
  GraphicsWindow.FontSize = 20
  For i = 1 To Board_iRo
    iX = Board_iX0 + Board_idX * (i - 1) + Board_idX / 2
    GraphicsWindow.DrawText(iX, Board_iY0 - 2.5 * Board_isY, Board_cX[i])
    iY = Board_iY0 + Board_idY * (i - 1) + Board_idY / 2
    GraphicsWindow.DrawText(Board_iX0 - 2.5 * Board_isX, iY, Board_cY[i])
  EndFor
EndSub
'
Sub Board_Move
  Game_IsPossibleMove()
  If Game_bIsPossibleMove Then
    Board_iMove = Board_iMove + 1
    iTurn = Math.Remainder((Board_iMove - 1), 2) + 1
    Board_iCell[iX][iY] = iTurn
    GraphicsWindow.PenColor = "White"
    GraphicsWindow.PenWidth = 10
    If iTurn = CROSS Then
      GraphicsWindow.DrawLine(Board_iX0 + (iX - 1) * Board_idX + Board_isX, Board_iY0 + (iY - 1) * Board_idY + Board_isY, Board_iX0 + iX * Board_idX - Board_isX, Board_iY0 + iY * Board_idY - Board_isY)
      GraphicsWindow.DrawLine(Board_iX0 + iX * Board_idX - Board_isX, Board_iY0 + (iY - 1) * Board_idY + Board_isY, Board_iX0 + (iX - 1) * Board_idX + Board_isX, Board_iY0 + iY * Board_idY - Board_isY)
    ElseIf iTurn = NOUGHT Then
      GraphicsWindow.DrawEllipse(Board_iX0 + (iX - 1) * Board_idX + Board_isX, Board_iY0 + (iY - 1) * Board_idY + Board_isY, Board_idX - 2 * Board_isX, Board_idY - 2 * Board_isY)
    EndIf
    GraphicsWindow.BrushColor = "Khaki"
    GraphicsWindow.DrawText(Board_iX0 + (iX - 1) * Board_idX + Board_isX / 3, Board_iY0 + (iY - 1) * Board_idY + Board_isY / 3, Board_iMove)
    Sound.PlayClickAndWait()
  EndIf
EndSub
'
Sub Console_Init
  GraphicsWindow.BrushColor = "Black"
  GraphicsWindow.FontSize = 20
  GraphicsWindow.DrawText(Board_iX1 + Board_isX * 2, Board_iY0, "X (CROSS)")
  GraphicsWindow.DrawText(Board_iX1 + Board_isX * 2, Board_iY0 + Board_iRo * Board_idY / 3, "O (NOUGHT)")
  Lamp_iCount = 2
  Lamp_iX[CROSS] = Board_iX1 + Board_idX * 2
  Lamp_iY[CROSS] = Board_iY0
  Lamp_iX[NOUGHT] = Board_iX1 + Board_idX * 2
  Lamp_iY[NOUGHT] = Board_iY0 + Board_iRo * Board_idY / 3
  Lamp_iOn = CROSS
  Lamp_Draw()
  Console_oCross = Controls.AddTextBox(Board_iX1 + Board_isX * 2 + 70, Board_iY0 + 30)
  Controls.SetTextBoxText(Console_oCross, "HUMAN")
  Console_oNought = Controls.AddTextBox(Board_iX1 + Board_isX * 2 + 70, Board_iY0 + Board_iRo * Board_idY / 3 + 30)
  Controls.SetTextBoxText(Console_oNought, "HUMAN")
  GraphicsWindow.DrawText(Board_iX0 - Board_isX * 2.5, Board_iY1 + Board_isY * 3, "GAME RECORD")
  Console_oScore = Controls.AddTextBox(Board_iX0 - Board_isX * 2 + 150, Board_iY1 + Board_isY * 3)
  Controls.SetSize(Console_oScore, 12 * 27, 30)
  sFontName = GraphicsWindow.FontName
  GraphicsWindow.FontName = "Webdings"
  Console_oReplay = Controls.AddButton(REPLAY, Board_iX0 + 12 * 37, Board_iY1 + Board_isY * 3)
  Console_bReplay = "False"
  GraphicsWindow.BrushColor = "Red"
  Console_oSave = Controls.AddButton(SAVE, Board_iX0 + 12 * 40, Board_iY1 + Board_isY * 3)
  Console_bSave = "False"
  GraphicsWindow.FontName = sFontName
EndSub
'
Sub Console_ShowWinner
  iX = Board_iX1 + Board_isX * 2
  iY = Board_iY0 + 30
  GraphicsWindow.BrushColor = "Black"
  If Game_iWinner = CROSS Then
    GraphicsWindow.DrawText(iX, iY, "WIN")
  ElseIf Game_iWinner = NOUGHT Then
    GraphicsWindow.DrawText(iX, iY, "LOSE")
  ElseIf Game_iWinner = DRAW Then
    GraphicsWindow.DrawText(iX, iY, "DRAW")
  EndIf
  iY = iY + Board_iRo * Board_idY / 3
  If Game_iWinner = NOUGHT Then
    GraphicsWindow.DrawText(iX, iY, "WIN")
  ElseIf Game_iWinner = CROSS Then
    GraphicsWindow.DrawText(iX, iY, "LOSE")
  ElseIf Game_iWinner = DRAW Then
    GraphicsWindow.DrawText(iX, iY, "DRAW")
  EndIf
EndSub
'
Sub Console_HideWinner
  iX = Board_iX1 + Board_isX * 2
  iY = Board_iY0 + 30
  GraphicsWindow.BrushColor = "LightGray"
  GraphicsWindow.FillRectangle(iX, iY, 80, 30)
  iY = iY + Board_iRo * Board_idY / 3
  GraphicsWindow.FillRectangle(iX, iY, 80, 30)
EndSub
'
Sub Lamp_Draw
  For Lamp_iIndex = 1 To Lamp_iCount
    GraphicsWindow.BrushColor = "White"
    GraphicsWindow.FillRectangle(Lamp_iX[Lamp_iIndex] + 1, Lamp_iY[Lamp_iIndex] + 1, 21, 7)
    GraphicsWindow.BrushColor = "DimGray"
    GraphicsWindow.FillRectangle(Lamp_iX[Lamp_iIndex] - 2, Lamp_iY[Lamp_iIndex] - 2, 21, 7)
    If Lamp_iIndex = Lamp_iOn Then
      GraphicsWindow.BrushColor = "Lime"
    Else
      GraphicsWindow.BrushColor = "Black"
    EndIf
    GraphicsWindow.FillRectangle(Lamp_iX[Lamp_iIndex], Lamp_iY[Lamp_iIndex], 20, 6)
  EndFor
EndSub
'
Sub Score_Clear
  Score_iMove = 0
  Controls.SetTextBoxText(Console_oScore, "")
EndSub
'
Sub Score_Replay
  For iMove = 1 To Score_iMove
    iX = Score_iX[iMove]
    iY = Score_iY[iMove]
    iTurn = Score_iTurn[iMove]
    Lamp_iOn = iTurn
    Lamp_Draw()
    Board_Move()
    Game_Judge()
  EndFor
EndSub
'
Sub Score_Read
  Score_iMove = 0
  Parse_sBuf = Controls.GetTextBoxText(Console_oScore)
  Parse_iBufPtr = 1
  Parse_iBufLen = Text.GetLength(Parse_sBuf)
  While Parse_iBufPtr <= Parse_iBufLen
    Parse_Move()
    If Parse_bError Then
      Parse_iBufPtr = Parse_iBufPtr + 1
    EndIf
  EndWhile
EndSub
'
Sub Score_Write
  Score_sBuf = ""
  For iMove = 1 To Score_iMove
    Score_sBuf = Score_sBuf + Text.GetSubText("ABCD", Score_iX[iMove], 1)
    Score_sBuf = Score_sBuf + Text.GetSubText("1234", Score_iY[iMove], 1)
    If iMove < Score_iMove Then
      Score_sBuf = Score_sBuf + " "
    EndIf
  EndFor
  Controls.SetTextBoxText(Console_oScore, Score_sBuf)
EndSub
'
Sub Score_Record
  Score_iMove = Score_iMove + 1
  iTurn = Math.Remainder(Score_iMove - 1, 2) + 1
  Score_iTurn[Score_iMove] = iTurn
  Score_iX[Score_iMove] = iX
  Score_iY[Score_iMove] = iY
EndSub
'
Sub Parse_Move
  Parse_Upper()
  If Parse_bError = "False" Then
    iX = Text.GetIndexOf("ABCD", Parse_c)
    Parse_Digit()
    If Parse_bError = "False" Then
      iY = Text.GetIndexOf("1234", Parse_c)
      Score_Record()
    EndIf
  EndIf
EndSub
'
Sub Parse_Upper
  Parse_c = Text.GetSubText(Parse_sBuf,Parse_iBufPtr, 1)
  iCode = Text.GetCharacterCode(Parse_c)
  If iCode >= UPPERA And iCode <= UPPERZ Then
    Parse_bError = "False"
    Parse_iBufPtr = Parse_iBufPtr + 1
  Else
    Parse_bError = "True"
  EndIf
EndSub
'
Sub Parse_Digit
  Parse_c = Text.GetSubText(Parse_sBuf,Parse_iBufPtr, 1)
  iCode = Text.GetCharacterCode(Parse_c)
  If iCode >= LETTER0 And iCode <= LETTER9 Then
    Parse_bError = "False"
    Parse_iBufPtr = Parse_iBufPtr + 1
  Else
    Parse_bError = "True"
  EndIf
EndSub
' Board_Clear ... 26, 34, 57, 62, 196
' Board_cX ... 212, 213, 214, 237
' Board_cY ... 215, 216, 217, 239
' Board_Draw ... 218, 222
' Board_iCell ... 107, 118, 123, 130, 135, 143, 148, 157, 162, 201, 248
' Board_idX ... 97, 166, 166, 204, 210, 224, 228, 236, 236, 252, 252, 253, 253, 255, 255, 258, 269, 271
' Board_idY ... 98, 152, 152, 205, 211, 224, 229, 238, 238, 252, 252, 253, 253, 255, 255, 258, 267, 272, 277, 303, 318
' Board_iMove ... 85, 170, 198, 246, 246, 247, 258
' Board_iRo ... 99, 99, 122, 130, 134, 135, 142, 147, 156, 161, 197, 199, 200, 210, 211, 224, 224, 227, 235, 267, 272, 277, 303, 318
' Board_isX ... 206, 224, 224, 239, 252, 252, 253, 253, 255, 255, 258, 266, 267, 275, 277, 279, 280, 293, 314
' Board_isY ... 207, 224, 224, 237, 252, 252, 253, 253, 255, 255, 258, 279, 280, 284, 287
' Board_iX0 ... 97, 127, 139, 152, 166, 166, 208, 210, 224, 228, 230, 236, 239, 252, 252, 253, 253, 255, 258, 279, 280, 284, 287
' Board_iX1 ... 127, 139, 152, 210, 230, 266, 267, 269, 271, 275, 277, 293, 314
' Board_iY0 ... 98, 127, 139, 152, 152, 166, 209, 211, 224, 229, 231, 237, 238, 252, 252, 253, 253, 255, 258, 266, 267, 270, 272, 275, 277, 294, 315
' Board_iY1 ... 127, 139, 166, 211, 231, 279, 280, 284, 287
' Board_Move ... 86, 243, 349
' c ... 1, 214
' Console_bButtonClicked ... 52, 55, 190, 192
' Console_bReplay ... 56, 180, 182, 189, 285
' Console_bSave ... 50, 51, 185, 187, 189, 288
' Console_HideWinner ... 219, 313
' Console_Init ... 27, 263
' Console_oCross ... 275, 276
' Console_OnButtonClicked ... 28, 178
' Console_oNought ... 277, 278
' Console_oReplay ... 31, 48, 179, 284
' Console_oSave ... 32, 49, 184, 287
' Console_oScore ... 280, 281, 339, 356, 376
' Console_ShowWinner ... 174, 292
' CROSS ... 12, 35, 251, 266, 269, 270, 273, 296, 306
' DRAW ... 14, 171, 300, 301, 308, 309
' Game_bIsPossibleMove ... 78, 108, 110, 245
' Game_IsPossibleMove ... 77, 106, 244
' Game_iWinner ... 33, 37, 117, 128, 140, 153, 167, 170, 171, 173, 296, 298, 300, 304, 306, 308
' Game_Judge ... 44, 114, 350
' iCode ... 401, 402, 402, 412, 413, 413
' iMove ... 343, 344, 345, 346, 369, 370, 371, 372
' iTurn ... 41, 85, 118, 119, 123, 128, 130, 131, 135, 140, 143, 144, 148, 153, 157, 158, 162, 167, 247, 248, 251, 254, 346, 347, 381, 382
' iX ... 97, 99, 99, 107, 147, 148, 156, 157, 162, 166, 166, 200, 201, 228, 231, 231, 236, 237, 248, 252, 252, 253, 253, 255, 258, 293, 297, 299, 301, 305, 307, 309, 314, 317, 319, 344, 383, 390
' iY ... 98, 99, 99, 107, 142, 143, 148, 152, 152, 161, 162, 199, 201, 229, 230, 230, 238, 239, 248, 252, 252, 253, 253, 255, 258, 294, 297, 299, 301, 303, 303, 305, 307, 309, 315, 317, 318, 318, 319, 345, 384, 393
' Lamp_Draw ... 36, 42, 274, 322, 348
' Lamp_iCount ... 268, 323
' Lamp_iIndex ... 323, 325, 325, 327, 327, 328, 333, 333
' Lamp_iOn ... 35, 41, 273, 328, 347
' Lamp_iX ... 269, 271, 325, 327, 333
' Lamp_iY ... 270, 272, 325, 327, 333
' LETTER0 ... 17, 413
' LETTER9 ... 18, 413
' lLine2 ... 120, 124, 129
' lLine3 ... 132, 136, 141
' lLine4 ... 145, 149, 154
' lLine5 ... 159, 163, 168
' lPossibleMove ... 79, 84
' NOUGHT ... 13, 254, 267, 271, 272, 298, 304
' Parse_bError ... 361, 389, 392, 403, 406, 414, 417
' Parse_c ... 390, 393, 400, 401, 411, 412
' Parse_Digit ... 391, 410
' Parse_iBufLen ... 358, 359
' Parse_iBufPtr ... 357, 359, 362, 362, 400, 404, 404, 411, 415, 415
' Parse_Move ... 360, 387
' Parse_sBuf ... 356, 358, 400, 411
' Parse_Upper ... 388, 399
' Player_bNotClicked ... 71, 72, 93
' Player_bOutOfBoard ... 38, 39, 69, 70, 100, 102
' Player_GetPosition ... 75, 96
' Player_Human ... 40, 66
' Player_iMX ... 91, 97
' Player_iMY ... 92, 98
' Player_OnMouseDown ... 67, 90
' RECORD ... 279
' REPLAY ... 19, 19, 284
' SAVE ... 20, 20, 287
' Score_Clear ... 63, 337
' Score_iMove ... 338, 343, 355, 369, 372, 380, 380, 381, 382, 383, 384
' Score_iTurn ... 346, 382
' Score_iX ... 344, 370, 383
' Score_iY ... 345, 371, 384
' Score_Read ... 58, 354
' Score_Record ... 87, 379, 394
' Score_Replay ... 59, 342
' Score_sBuf ... 368, 370, 370, 371, 371, 373, 373, 376
' Score_Write ... 43, 367
' sFontName ... 282, 289
' SPACE ... 11, 33, 37, 107, 117, 119, 131, 144, 158, 170, 173, 201
' UPPERA ... 15, 402
' UPPERZ ... 16, 402
Copyright (c) Microsoft Corporation. All rights reserved.