Dim Board(12, 16) As Boolean
Dim Block(24, 10) As Boolean
Dim RockPX(4, 28) As Integer
Dim RockPY(4, 28) As Integer
Dim X, Y, X1, Y1, T, P, M As Integer
Dim RockX, RockY, RX, RY, RS As Integer
Dim RockN, RockC, RockR, RR As Integer
Dim Playing As Boolean

Sub Init()
  Dim XStng, YStng As String
  Dim T As Integer
  
  XStng = "0112011200110000001200120112001100110011012300010111000101120112001100000122012201120011001100110123011100010111"
  YStng = "1122212121210123122212112122121001122121111101200012012111222121212101231112222111211210011221212222201201221012"
  T = 1
  For Y = 0 To 27
    For X = 0 To 3
      RockPX(X, Y) = Int(Val(Mid(XStng, T, 1)))
      RockPY(X, Y) = Int(Val(Mid(YStng, T, 1)))
      T = T + 1
    Next
  Next
  
  RS = 3
  RockN = Int(Rnd * 6)
  ClearBoard
End Sub

Sub ClearBoard()
  For X = 1 To 12
    For Y = 1 To 16
      If X = 1 Or X = 12 Or Y = 16 Then
        Board(X, Y) = True
      Else
        Board(X, Y) = False
      End If
    Next
  Next
End Sub

Sub Begin()
  Randomize
  Init
  Setup
  NewRock
  Playing = True
  Play
End Sub

Sub Play()
  While (Playing)
    For P = 1 To RS
      EraseRock
      RockR = RR
      RockX = RX
      DrawRock
      SendKeys "%h"
      DoEvents
    Next
    
    If DropRock Then
      CheckLine
      CheckDead
      NewRock
    End If
  Wend
  
  GameOver
End Sub

Sub StopGame()
  Playing = False
End Sub

Sub SpeedDown()
  RS = RS + 1
  If RS > 5 Then
    RS = 5
  End If
  
  ActiveDocument.Tables(1).Cell(16, 19).Select
  Selection.Text = 6 - RS
End Sub

Sub SpeedUp()
  RS = RS - 1
  If RS < 1 Then
    RS = 1
  End If
  
  ActiveDocument.Tables(1).Cell(16, 19).Select
  Selection.Text = 6 - RS
End Sub

Sub CheckLine()
  For Y = 0 To 3
    M = 0
    For X = 2 To 11
      If RockY + Y < 16 And RockY + Y > 0 Then
        If Board(X, RockY + Y) Then
          M = M + 1
        End If
      End If
    Next
    If M = 10 Then
      RemoveLine
    End If
  Next
End Sub

Sub RemoveLine()
  For Y1 = RockY + Y To 2 Step -1
    For X1 = 2 To 11
      Beep
      Board(X1, Y1) = Board(X1, Y1 - 1)
      ActiveDocument.Tables(1).Cell(Y1, X1).Select
      If Board(X1, Y1) Then
        Selection.Text = "X"
      Else
        Selection.Text = ""
      End If
    Next
  Next
End Sub

Sub CheckDead()
  If RockY < 1 Then
    Playing = False
  End If
End Sub

Sub GameOver()
  ActiveDocument.Tables(1).Cell(8, 2).Select
  Selection.Text = "G"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "A"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "M"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = ""
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = ""
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "O"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "V"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  
  Selection.EndOf wdStory
End Sub

Sub NewRock()
  RockX = 5
  RX = RockX
  RockY = -2
  RockR = 0
  RR = RockR
  RockC = RockN
  RockN = Int(Rnd * 6)
  DrawNext
  DrawNext
End Sub

Sub EraseRock()
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      ActiveDocument.Tables(1).Cell(RockPY(T, (7 * RockR) + RockC) + RockY, RockPX(T, (7 * RockR) + RockC) + RockX).Select
      Selection.Text = ""
    End If
  Next
End Sub

Sub DrawRock()
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      ActiveDocument.Tables(1).Cell(RockPY(T, (7 * RockR) + RockC) + RockY, RockPX(T, (7 * RockR) + RockC) + RockX).Select
      Selection.Text = "X"
    End If
  Next
End Sub

Sub DrawNext()
  For X = 0 To 3
    For Y = 0 To 3
      ActiveDocument.Tables(1).Cell(6 + Y, 15 + X).Select
      Selection.Text = ""
    Next
  Next
  
  For T = 0 To 3
    ActiveDocument.Tables(1).Cell(6 + RockPY(T, RockN), 15 + RockPX(T, RockN)).Select
    Selection.Text = "X"
  Next
End Sub

Sub HoldRock()
  Selection.EndOf wdStory
  Selection.Text = " "
  Selection.Text = ""
End Sub

Sub PutRock()
  Beep
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      Board(RockPX(T, (7 * RockR) + RockC) + RockX, RockPY(T, (7 * RockR) + RockC) + RockY) = True
    End If
  Next
End Sub

Function DropRock() As Boolean
  EraseRock
  DropRock = False
  
  For T = 0 To 3
    Y = RockPY(T, (7 * RockR) + RockC) + RockY + 1
    If Y > 0 Then
      If Board(RockPX(T, (7 * RockR) + RockC) + RockX, Y) Then
        DropRock = True
      End If
    End If
  Next
  
  If Not DropRock Then
    RockY = RockY + 1
  Else
    PutRock
  End If
  
  DrawRock
End Function

Sub RotateRock()
  RR = RockR + 1
  If RR > 3 Then
    RR = 0
  End If
  
  For T = 0 To 3
    X = RockPX(T, (7 * RR) + RockC) + RockX
    Y = RockPY(T, (7 * RR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        RR = RockR
      End If
    End If
  Next
End Sub

Sub RockDown()
  P = RS
End Sub

Sub RockLeft()
  M = 1
  
  For T = 0 To 3
    X = RockPX(T, (7 * RockR) + RockC) + RockX - M
    Y = RockPY(T, (7 * RockR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        M = 0
      End If
    End If
  Next
  
  RX = RockX - M
End Sub

Sub RockRight()
  M = 1
  
  For T = 0 To 3
    X = RockPX(T, (7 * RockR) + RockC) + RockX + M
    Y = RockPY(T, (7 * RockR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        M = 0
      End If
    End If
  Next
  
  RX = RockX + M
End Sub

Sub Setup()
  Selection.WholeStory
  Selection.Delete Unit:=wdCharacter, Count:=1
  
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=16, NumColumns:=20
  ActiveDocument.Tables(1).Borders(wdBorderBottom).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderLeft).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderRight).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderTop).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderHorizontal).ColorIndex = wdWhite
  ActiveDocument.Tables(1).Borders(wdBorderVertical).ColorIndex = wdWhite

  ActiveDocument.Tables(1).Select
  Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(0.2), RulerStyle:=wdAdjustNone
  Selection.Rows.SpaceBetweenColumns = InchesToPoints(0)
  Selection.Paragraphs.Alignment = wdAlignParagraphCenter
  
  ActiveDocument.Tables(1).Cell(16, 1).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=11, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderVertical).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue
  
  ActiveDocument.Tables(1).Cell(1, 1).Select
  Selection.MoveDown Unit:=wdLine, Count:=15, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderHorizontal).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue
  
  ActiveDocument.Tables(1).Cell(1, 12).Select
  Selection.MoveDown Unit:=wdLine, Count:=15, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderHorizontal).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue
  
  ActiveDocument.Tables(1).Cell(1, 2).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=9, Extend:=wdExtend
  Selection.MoveDown Unit:=wdLine, Count:=14, Extend:=wdExtend
  Selection.Font.Bold = True
  
  ActiveDocument.Tables(1).Cell(1, 13).Select
  Selection.Text = "W"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "O"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "D"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "T"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "I"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "S"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  
  ActiveDocument.Tables(1).Cell(5, 15).Select
  Selection.Text = "N"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "X"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "T"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Cell(6, 15).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
  Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderTop).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderBottom).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderLeft).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderRight).ColorIndex = wdDarkBlue
  Selection.Font.Bold = True
  
  ActiveDocument.Tables(1).Cell(16, 14).Select
  Selection.Text = "S"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "P"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "D"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = 6 - RS
  Selection.Font.ColorIndex = wdBlack
  
  Selection.EndOf wdStory
  Selection.Text = vblfcr & "Coded by Robert Walsh" & vbCrLf & "MonkeyFighter.com" & vbCrLf
  Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub