DECLARE FUNCTION jian$ (s%)        '获得按键并延时的函数
DECLARE FUNCTION xialuo% ()        '拼块下落一行的函数
DECLARE SUB zhuan ()               '旋转拼块的子程序
DECLARE SUB hua ()                 '画出拼块的子程序
DECLARE SUB kuai (x%, y%, c%)      '画或擦除小方块的子程序
DECLARE SUB yidong (p%)            '左右移动拼块的子程序
DECLARE SUB ca ()                  '擦除拼块的子程序
' 说明程序中使用的一些子程序(SUB)和函数(FUNCTION)

DEFINT A-Z
' 说明变量A-Z均为整型变量

DIM SHARED fk(7, 4, 2) AS INTEGER
' 定义数组 FK,此数组存放7种拼块的形状

' 下段程序段读入拼块形状数据
FOR i = 1 TO 7            '从1到7块
  FOR j = 1 TO 4          '每个拼块由4个小方块组成
    FOR k = 1 TO 2        '各小方块的坐标是两个值(X,Y)
      READ fk(i, j, k)    '读入一个数
    NEXT k                '下一个数
  NEXT j                  '下一个小方块
NEXT i                    '下一个拼块

DIM SHARED tong(12, 24) AS INTEGER
' 定义数组TONG, 此数组

DIM SHARED kx(4) AS INTEGER, ky(4) AS INTEGER
'定义数组KX和KY,这两个数组存放正在下落的拼块中各小方块的X和Y坐标

CONST x0 = 40          '说明常量X0, X0为桶的显示位置(列数)

' 以下程序段显示游戏说明
CLS
LOCATE 5, 13: PRINT "俄罗斯方块"
LOCATE 7, 10: PRINT "程序设计: 刘红石"
LOCATE 9, 2: PRINT "--------------------------------"
LOCATE 11, 12: PRINT "键盘操作说明"
LOCATE 13, 7: PRINT "J 左移方块, L 右移方块"
LOCATE 15, 5: PRINT "K 旋转方块, 空格键快速下落"
LOCATE 17, 7: PRINT "E 结束游戏, S 暂停游戏"

DO
LOOP UNTIL INKEY$ <> ""        '循环,直到按下任意键为止

' 以下程序段显示空桶
FOR i = 1 TO 24                             '桶的深度为24
  LOCATE i, x0 + 1                          '光标定位
  PRINT "|                        |";       '显示一行
NEXT i                                      '继续显示下一行
LOCATE 25, x0 + 1                           '光标定位于桶底
PRINT "+------------------------+";         '显示桶底

RANDOMIZE TIMER                   '用时间函数对随机函数随机化

' 以下程序段是游戏的核心程序,主程序主要是一个循环,
' 在循环中不断判断按键状态并处理之
DO                              '循环开始
  m = INT(RND * 7 + 1)          '随机产生一个数,这个数是拼块的编号
  FOR i = 1 TO 4                '将拼块的4小块的X坐标加5,作用是在桶中央放入
    kx(i) = fk(m, i, 1) + 5     'X坐标加5
    ky(i) = fk(m, i, 2)         'Y坐标不变
  NEXT i
  t = 1                    'T是一个标志, 拼块还能下落时为1
  FOR i = 1 TO 4           '依次判断组成拼块的四小块所占位置是否有其它的块
    IF tong(kx(i), ky(i)) = 1 THEN END   '如果有其它的块,则桶满,游戏结束
  NEXT i
  CALL hua                 '画出拼块
  s = 0                    'S是一个标志, 指示是否按了空格键,未按时S=0
  DO                       '循环,在拼块还能下落时一直进行下去
    IF s = 0 THEN          '判断是否按了空格键
       k$ = jian$(500)     '未按, 延时间500毫秒并将按键键码赋给K$
    ELSE
      k$ = jian$(0)        '已按, 不延时并将按键键码赋给K$
    END IF
    k$ = UCASE$(k$)        '将小写字母转换为大写字母
    SELECT CASE k$         '根据按键做对应的处理
      CASE IS = "K"
        CALL zhuan         '按K旋转拼块
      CASE IS = "J"
        CALL yidong(-1)    '按J左移拼块
      CASE IS = "L"
        CALL yidong(1)     '按L右移拼块
      CASE IS = "S"        '按S暂游戏
        DO
        LOOP UNTIL INKEY$ <> ""  '循环,直到按任意键为止
     CASE IS = "E"
       END                 '按E结束游戏
     CASE IS = " "
       s = 1               '按空格键,将标志S置成1
     CASE ELSE
       t = xialuo   '如果未按以上任何键,则拼块下移一行,并返回拼块下移成功否
   END SELECT
LOOP UNTIL t = 0   '如果拼块不能再下移,则结果循环

i = 24                   '从桶底到桶顶依次检查是否有填满的行
DO
   p = 0                  'P为此行方块数
   FOR j = 1 TO 12        '计算此行的方块数
     p = p + tong(j, i)
   NEXT j
   IF p = 12 THEN '如果此行填满(方块数为12),则奏乐、清除此行、上面的行下移一行
     PLAY "mbc16d16g16"   '奏乐
     k = i                '从上一行至桶顶依次下移一行
     DO
       q = 0              'Q为当前行的方块数
       FOR j = 1 TO 12    '依次将上一行的1至12块移至当前行
         IF tong(j, k) <> tong(j, k - 1) THEN
           CALL kuai(j, k, tong(j, k - 1))
           tong(j, k) = tong(j, k - 1)
         END IF
         q = q + tong(j, k)   '累计当前行的方块数
       NEXT j
       k = k - 1                  '下移上一行
     LOOP UNTIL q = 0 OR k = 1    '直到处理到桶顶或空行
   ELSE
     i = i - 1                    '检查上一行是否填满
   END IF
LOOP UNTIL i < 1 OR p = 0        '直到桶顶或空行为止
LOOP

END            '主程序结束

DATA 1,1,1,2,1,3,1,4
DATA 1,1,1,2,1,3,2,3
DATA 2,1,2,2,2,3,1,3
DATA 1,1,1,2,2,1,2,2
DATA 2,1,1,2,2,2,1,3
DATA 1,1,1,2,2,2,2,3
DATA 1,1,1,2,2,2,1,3

'   以上是七种方块形状数据,这七块的形状是:
'
'  []    []      []   [][]     []   []     []
'  []    []      []   [][]   [][]   [][]   [][]
'  []    [][]  [][]          []       []   []
'  []
'  (1)    (2)   (3)    (4)    (5)    (6)   (7)

DEFSNG A-Z
' 擦除拼块
SUB ca
  DIM i AS INTEGER
  FOR i = 1 TO 4
    CALL kuai(kx(i), ky(i), 0)
  NEXT i
END SUB

' 画出拼块
SUB hua
  DIM i AS INTEGER
  FOR i = 1 TO 4
    CALL kuai(kx(i), ky(i), 1)
  NEXT i
END SUB

' 延时S%毫秒并返回所按的键的ASCII码
FUNCTION jian$ (s%)
  dt = s% / 1000
  oldt = TIMER
  DO
    a$ = INKEY$
  LOOP UNTIL TIMER - oldt >= dt OR a$ <> ""  '循环终止的条件是时间到或按了键
  jian$ = a$
END FUNCTION

' 画或擦除方块: 当C%等于1时画方块,否则擦方块
SUB kuai (x%, y%, c%)
  IF c% = 1 THEN LET cc$ = "[]" ELSE LET cc$ = "  "
  LOCATE y%, x% * 2 + x0: PRINT cc$;
END SUB

' 拼块下落一格
FUNCTION xialuo%
  DIM t AS INTEGER, i AS INTEGER

  CALL ca                  '擦除拼块
  t = 1                    '先设拼块还能下落
  i = 0
  DO                       '依次检查组成拼块的各个方块的位置
    i = i + 1
    IF ky(i) = 24 THEN     '如果方块到桶底则不能再下落
      t = 0
    ELSE
      IF tong(kx(i), ky(i) + 1) = 1 THEN
         t = 0             '如果方块下面已有方块则也不能下落
      END IF
    END IF
  LOOP UNTIL i = 4 OR t = 0
  IF t = 1 THEN            '如果拼块能下落时,拼块下落一格
    FOR i = 1 TO 4
      ky(i) = ky(i) + 1
    NEXT i
  ELSE                     '拼块不能下落了,则将拼块放入桶中
    FOR i = 1 TO 4
      tong(kx(i), ky(i)) = 1
    NEXT i
  END IF
  CALL hua                 '画出此时的拼块
    xialuo% = t            '返回拼块能否下落的情况
END FUNCTION

' 移动拼块的位置: P%为-1时左移,为1时右移
SUB yidong (p%)
  DIM t AS INTEGER, i AS INTEGER

  CALL ca              '擦除拼块
  t = 1                '先设拼块能够移动
  i = 0
  DO                   '依次检查组成拼块的各个方块是否能够移动
    i = i + 1
    IF (kx(i) = 1) AND (p% = -1) THEN t = 0  '如果方块在左边界则不能再左移
    IF (kx(i) = 12) AND (p% = 1) THEN t = 0  '如果方块在右边界则不能再右移
    IF t = 1 THEN
      IF tong(kx(i) + p%, ky(i)) = 1 THEN
         t = 0          '如果方块移动方向上已有方块,则也不能移动
      END IF
    END IF
  LOOP UNTIL i = 4 OR t = 0
  IF t = 1 THEN               '如果拼块能移动则移动之
    FOR i = 1 TO 4
      kx(i) = kx(i) + p%
    NEXT i
  END IF
  CALL hua                    '画出此时的拼块
END SUB

' 转动拼块
SUB zhuan
  DIM kx1(4) AS INTEGER, ky1(4) AS INTEGER  '定义暂时存放拼块状态的数组
  DIM x AS INTEGER, y AS INTEGER
  DIM i AS INTEGER, t AS INTEGER

  CALL ca                     '擦除拼块
  x = kx(2): y = ky(2)        '以组成拼块的第2个方块为中心旋转
  FOR i = 1 TO 4              '依次计算旋转后各个方块的位置
    kx1(i) = x + y - ky(i)
    ky1(i) = y - x + kx(i)
  NEXT i
  t = 1                       '设拼块能够旋转
  i = 0
  DO                          '依次检查各方块是否能够旋转
    i = i + 1
    IF kx1(i) < 1 OR kx1(i) > 12 OR ky1(i) > 24 OR ky1(i) < 1 THEN
      t = 0                   '如果旋转后的方块出了桶的边界,则不能旋转拼块
    END IF
    IF t = 1 THEN
      IF tong(kx1(i), ky1(i)) = 1 THEN
        t = 0                 '如果旋转后的方块与已有方块重叠,则不能旋转拼块
      END IF
    END IF
  LOOP UNTIL i = 4 OR t = 0
  IF t = 1 THEN               '如果拼块能够旋转,则给出旋转后方块的位置
    FOR i = 1 TO 4
      kx(i) = kx1(i)
      ky(i) = ky1(i)
    NEXT i
  END IF
  CALL hua                    '画出此时的拼块
END SUB