basic/app/tetris.bas · 21036 字节 · 下载原文

' tetris.bas —— 俄罗斯方块（VML 的 BASIC 前端）

' tetris.bas -- Tetris (the BASIC frontend of VML)

'

' 界面与几何都走**共享调用库** Lib/shared/src/vmlui.c（编成 vmlui.vml，由 vmltool.config.xml

' Both the UI and the geometry go through the **shared call library** Lib/shared/src/vmlui.c (compiled into vmlui.vml

' 挂到 basic 的 Libs 上）。BASIC 声明外部库函数用 `NATIVE SUB/FUNCTION`（这份**照旧**这么写）；

' and attached to the basic Libs by vmltool.config.xml). BASIC declares external library functions with `NATIVE SUB/FUNCTION` (this file **still** writes it that way);

' ⚠ 当年只有带 NATIVE 才是**裸标签**（否则会被加上 sub_/func_ 前缀、链接期找不到）；

' ⚠ Back then only NATIVE made it a **bare label** (otherwise it got a sub_/func_ prefix and the link failed);

' **2026-10-04 复验已不必**（链接期会认领库侧符号，实测不写 `NATIVE` 的 `FUNCTION ui_scr_get_w()` 照样得真值 480）。

' **re-checked 2026-10-04: no longer needed** (the linker claims the library-side symbol; measured: `FUNCTION ui_scr_get_w()` without `NATIVE` still returns the real value 480).

'

' 几条实测出来的前端限制（**2026-10-04 逐条复验**），本程序是绕开它们写的：

' A few frontend limits measured in practice (**each re-checked on 2026-10-04**); this program is written to work around them:

'   1. ~~**数组不可靠**~~（`DIM a(10)` 之后 `a(5)` 读出来是野值）—— ✅ **已修好**：

'   1. ~~**Arrays are unreliable**~~ (after `DIM a(10)`, reading `a(5)` gave garbage) — ✅ **fixed**:

'      现在 `DIM a(10) AS INTEGER` 与不带类型的 `DIM b(10)` 下标读写都对（顶层与 SUB 里都验过，

'      indexed reads/writes now work in both `DIM a(10) AS INTEGER` and untyped `DIM b(10)`, at the top level and inside a SUB

'      见 `scripts/vml-basic-probe` 的 06/11 号用例）⇒ 棋盘**仍**走共享库的整数网格

'      (see probe cases 06/11 in `scripts/vml-basic-probe`) => the board **still** uses the shared library integer grid

'      ui_grid_set/ui_grid_get（能跑就别动；新写的代码可以用 BASIC 数组）。

'      ui_grid_set/ui_grid_get (if it runs, leave it alone; newly written code may use BASIC arrays).

'   2. **没有移位/取位**（只有 AND/OR）—— ⚠ **2026-10-04 复验仍成立**（`1 SHL 3` 报「未定义的函数 'func_shl'」）⇒

'   2. **No shifts and no bit extraction** (only AND/OR) — ⚠ **still holds on 2026-10-04** (`1 SHL 3` reports 「undefined function 'func_shl'」) =>

'      方块旋转不在 BASIC 里算，用 ui_piece_get_cell(pid, rot, which) 直接问 C 要格子的坐标。

'      piece rotation is not computed in BASIC; it asks C for the cell coordinates directly through ui_piece_get_cell(pid, rot, which).

'   3. 外部函数写 NATIVE 声明 + **空体**（NATIVE ... / END SUB）。⚠ 当年是**必须**的，**2026-10-04 复验已不必**

'   3. External functions are written with a NATIVE declaration + **an empty body** (NATIVE ... / END SUB). ⚠ Back then this was **required**; **re-checked 2026-10-04: no longer needed**

'      （链接期会认领库侧符号，实测不写 `NATIVE` 也照样链接）。这份**照旧**按老写法写（能跑就别动）。

'      (the linker claims the library-side symbol; measured: it links even without `NATIVE`). This file **still** uses the old form (if it runs, leave it alone).

'

' 操作（触摸）：点屏幕左 1/3 左移、右 1/3 右移、中间**旋转**；点最下面那条**直落到底**。

' Controls (touch): tap the left 1/3 of the screen to move left, the right 1/3 to move right, the middle to **rotate**; tap the bottom strip to **drop all the way down**.

' 返回箭头退出。

' The back arrow exits.

'

' ⚠⚠ **本文件曾经跑不起来** —— 当年的拦路虎是 BASIC 前端的**第四个**缺陷：

' ⚠⚠ **This file once did not run** -- the blocker back then was the **fourth** bug in the BASIC frontend:

'   **SUB 里读不到模块级变量**。当年实测：模块级 `DIM BW / BW = 10`，在 SUB 里 `PRINT BW` 得到 **0**

'   **a SUB could not see module-level variables**. Measured back then: with module-level `DIM BW / BW = 10`, `PRINT BW` inside a SUB gave **0**

'   —— SUB 遇到不认识的标识符会**自动登记成局部变量**（未初始化即 0），于是

'   -- a SUB **registered any unknown identifier as a local variable** (0 while uninitialized), so

'   `cell = (sh - 70) \ BH` 的分母成了 0，运行时"整数除零"。

'   the denominator of `cell = (sh - 70) \ BH` became 0 and the run died with "integer divide by zero".

'   （另三个当年已修：`\` 整除不生效、数组读写方向反了、光秃秃的 `#` 行打挂预处理。）

'   (The other three were already fixed back then: `\` integer division did not work, array reads/writes went the wrong direction, and a bare `#` line broke the preprocessor.)

'

'   ✅ **2026-10-04 复验：这条也已修好，本文件现在能跑** —— 主循环一直跑到 `--timeout 6` 的墙钟停表为止，

'   ✅ **Re-checked 2026-10-04: that one is fixed too, and this file runs now** — the main loop keeps going until the `--timeout 6` wall clock stops it,

'   没有再出现"整数除零"。实测：模块级 `DIM BW AS INTEGER / BW = 10`，在 SUB 里 `PRINT BW` 得 **10**，

'   with no more "integer divide by zero". Measured: module-level `DIM BW AS INTEGER / BW = 10`, `PRINT BW` inside a SUB gives **10**,

'   从 SUB 里写回模块级变量也有效（写 99，顶层读回 99）。

'   and writing a module-level variable from inside a SUB works too (write 99, read back 99 at the top level).

'   （当年记下的"临时绕法"= 把量都当参数传进 SUB / 干脆全内联 —— **仍然不需要**，本文件本来就是正常写的。）

'   (The "temporary workaround" recorded back then -- pass everything as parameters / inline everything -- is **still not needed**; this file was written normally all along.)

'

' 保留下来的价值：① 它记下了"BASIC 调 C 共享库"的**正确写法**

' The value of keeping it around: ① it records the **correct way** for "BASIC calling a C shared library"

' （`NATIVE SUB/FUNCTION` + 空体 = 裸标签；2026-10-04 复验已不必，见文件头）；

' (`NATIVE SUB/FUNCTION` + empty body = a bare label; re-checked on 2026-10-04, no longer required -- see the top of the file);

' ② 它记下了踩到的前端缺陷与绕法（那些缺陷现在都已修好）。

' ② it records the frontend bugs hit along the way and the workarounds (those bugs are all fixed now).


' ── UI 接口：引用**库侧**的声明文件（原先这里是一屏 NATIVE 声明）────────────────

' ── UI interface: include the **library-side** declaration file (this used to be a screenful of NATIVE declarations)

'$INCLUDE: 'vml_ui.bas'


' ── 常量与全局变量 ─────────────────────────────────────

' ── Constants and global variables ─────────────────────────────────────

' ⚠ **DIM 排在赋值之前**（这份照旧这么写）。当年 `BW = 10` 写在 `DIM BW AS INTEGER` 之前时，

' ⚠ **DIM comes before the assignment** (this file still writes it that way). Back then, with `BW = 10` written before `DIM BW AS INTEGER`,

' 那个赋值不会落到整型变量上（症状是后面 `\ BH` 直接整数除零）；**2026-10-04 复验该现象已不再出现**

' the value did not land on the integer variable (the symptom was an integer divide by zero at the later `\ BH`); **re-checked 2026-10-04: that no longer happens**

' （实测 `BH = 20` 写在 `DIM BH AS INTEGER` 之前，读回 `BH=20`、`100 \ BH`=5，SUB 里也一样）。

' (measured: with `BH = 20` written before `DIM BH AS INTEGER`, `BH` reads back 20 and `100 \ BH`=5, the same inside a SUB).

DIM BW AS INTEGER
DIM BH AS INTEGER
DIM TICK AS INTEGER
DIM C_BG AS INTEGER
DIM C_GRID AS INTEGER
DIM C_WALL AS INTEGER
DIM C_TEXT AS INTEGER
DIM C_SCORE AS INTEGER
DIM C_BLOCK AS INTEGER
DIM C_CUR AS INTEGER
DIM score AS INTEGER
DIM over AS INTEGER
DIM pid AS INTEGER
DIM rot AS INTEGER
DIM px AS INTEGER
DIM py AS INTEGER
DIM sw AS INTEGER
DIM sh AS INTEGER
DIM t AS INTEGER
DIM tx AS INTEGER
DIM ty AS INTEGER
DIM i AS INTEGER
DIM j AS INTEGER
DIM k AS INTEGER
DIM v AS INTEGER
DIM cell AS INTEGER
DIM ox AS INTEGER
DIM oy AS INTEGER
DIM bwid AS INTEGER
DIM bhei AS INTEGER
DIM full AS INTEGER
DIM hit AS INTEGER
DIM cx AS INTEGER
DIM cy AS INTEGER
DIM packed AS INTEGER
DIM accStep AS INTEGER     ' 墙钟补步累加器（按墙钟补步，用户 2026-10-04 口径：游戏时钟取系统毫秒数）

                           ' Wall-clock catch-up accumulator (the game clock reads system milliseconds; user ruling 2026-10-04)

DIM LASTMS AS INTEGER

' ── 界面语言（0 = 中文 / 1 = 英文，跟随系统语言）──────────────────────

' ── UI language (0 = Chinese / 1 = English, following the system language)──────────────────────

' `ui_scr_get_language()` 是一次 syscall ⇒ **开局查一次存进 LANG**，文案也在这里一次算好，

' `ui_scr_get_language()` is a syscall => **query it once at startup and store it in LANG**; the strings are computed here once too,

' 之后每帧绘制只用变量（别在绘制路径上再调它）。

' and every later frame only uses the variables (do not call it again on the draw path).

' ⚠ 这段**必须待在 SUB 里、模块级只留一句调用** —— 实测（whack.bas 同款写法）把 IF/ELSE

' ⚠ This block **must stay inside a SUB, with a single call left at module level** -- measured (same shape as whack.bas): spreading the IF/ELSE

'   摊到模块级之后，模块级代码流里那条 `ui_2d_rect … 0, 3, 8` 的后两个实参被读成垃圾、

'   across module level made the last two arguments of `ui_2d_rect ... 0, 3, 8` in the module-level code stream read as garbage,

'   整屏画花（与基线帧比 diff_px 0 → 130571）；搬进 SUB 后与改动前**逐像素相同**。

'   scribbling the whole screen (diff_px 0 -> 130571 against the baseline frame); moved into a SUB it is **pixel-identical** to before the change.

DIM LANG AS INTEGER
DIM sTitle AS STRING
DIM sHead AS STRING
DIM sOver AS STRING
DIM sRestart AS STRING

SUB initLang()
    LANG = ui_scr_get_language()
    IF LANG = 0 THEN sTitle = "俄罗斯方块" ELSE sTitle = "Tetris"
    IF LANG = 0 THEN sHead = "俄罗斯方块(BASIC)" ELSE sHead = "Tetris (BASIC)"
    IF LANG = 0 THEN sOver = "游戏结束" ELSE sOver = "Game Over"
    IF LANG = 0 THEN sRestart = "点任意处重开" ELSE sRestart = "Tap to restart"
END SUB

BW = 10
BH = 20
TICK = 450

C_BG = -16120744            ' 0xFF101018

C_GRID = -14009032          ' 0xFF2A2A38

C_WALL = -12961116          ' 0xFF3A3A4C

C_TEXT = -1184270           ' 0xFFEDEDF2   （负数就是 0xAARRGGBB 的有符号读法）

                            ' (a negative number is the signed reading of 0xAARRGGBB)

C_SCORE = -11842944         ' 0xFF4ADE80

C_BLOCK = -10975745         ' 0xFF58A6FF

C_CUR = -996807             ' 0xFFF0B429


' ── 棋盘读写（棋盘在共享库网格里；越界当"墙"）────────────

' ── Board access (the board lives in the shared library grid; out of range counts as a wall)────────────

FUNCTION bget(x AS INTEGER, y AS INTEGER) AS INTEGER
    IF x < 0 OR x >= BW OR y < 0 OR y >= BH THEN
        bget = 1
    ELSE
        bget = ui_grid_get(y * BW + x)
    END IF
END FUNCTION

SUB bset(x AS INTEGER, y AS INTEGER, v AS INTEGER)
    IF x >= 0 AND x < BW AND y >= 0 AND y < BH THEN
        ui_grid_set(y * BW + x, v)
    END IF
END SUB

SUB board_clear()
    DIM n AS INTEGER
    n = 0
    WHILE n < BW * BH
        ui_grid_set(n, 0)
        n = n + 1
    WEND
END SUB

' 方块当前落点是否与墙/已有块冲突

' Does the piece at its current position collide with a wall or an already locked block

FUNCTION collide(p AS INTEGER, rr AS INTEGER, fx AS INTEGER, fy AS INTEGER) AS INTEGER
    DIM q AS INTEGER
    DIM pk AS INTEGER
    DIM gx AS INTEGER
    DIM gy AS INTEGER
    collide = 0
    q = 0
    WHILE q < 4
        pk = ui_piece_get_cell(p, rr, q)
        IF pk >= 0 THEN
            gx = fx + pk \ 16
            gy = fy + (pk - (pk \ 16) * 16)
            IF bget(gx, gy) <> 0 THEN
                collide = 1
            END IF
        END IF
        q = q + 1
    WEND
END FUNCTION

SUB lock_piece(p AS INTEGER, rr AS INTEGER, fx AS INTEGER, fy AS INTEGER)
    DIM q AS INTEGER
    DIM pk AS INTEGER
    q = 0
    WHILE q < 4
        pk = ui_piece_get_cell(p, rr, q)
        IF pk >= 0 THEN
            bset(fx + pk \ 16, fy + (pk - (pk \ 16) * 16), 1)
        END IF
        q = q + 1
    WEND
END SUB

' 消行，返回消掉的行数

' Clear full lines and return how many lines were cleared

FUNCTION clear_lines() AS INTEGER
    DIM n AS INTEGER
    DIM yy AS INTEGER
    DIM xx AS INTEGER
    DIM allf AS INTEGER
    n = 0
    yy = BH - 1
    WHILE yy >= 0
        allf = 1
        xx = 0
        WHILE xx < BW
            IF bget(xx, yy) = 0 THEN
                allf = 0
            END IF
            xx = xx + 1
        WEND
        IF allf = 1 THEN
            n = n + 1
            DIM mv AS INTEGER
            mv = yy
            WHILE mv > 0
                xx = 0
                WHILE xx < BW
                    bset(xx, mv, bget(xx, mv - 1))
                    xx = xx + 1
                WEND
                mv = mv - 1
            WEND
            xx = 0
            WHILE xx < BW
                bset(xx, 0, 0)
                xx = xx + 1
            WEND
        ELSE
            yy = yy - 1
        END IF
    WEND
    clear_lines = n
END FUNCTION

' ── 绘制 ──────────────────────────────────────────────

' ── Drawing ──────────────────────────────────────────────

SUB draw_board()
    sw = ui_scr_get_w()
    sh = ui_scr_get_h()
    IF sw <= 0 THEN
        sw = 360
    END IF
    IF sh <= 0 THEN
        sh = 620
    END IF

    IF (sh - 70) / BH < (sw - 20) / BW THEN
        cell = (sh - 70) \ BH
    ELSE
        cell = (sw - 20) \ BW
    END IF
    IF cell < 4 THEN
        cell = 4
    END IF

    bwid = cell * BW
    bhei = cell * BH
    ox = (sw - bwid) \ 2
    oy = 44

    ui_2d_clear(C_BG)
    ui_2d_rect(ox, oy, bwid, bhei, C_WALL, 1, 0, 4)

    i = 1
    WHILE i < BW
        ui_2d_line(ox + i * cell, oy, ox + i * cell, oy + bhei, C_GRID, 1)
        i = i + 1
    WEND
    i = 1
    WHILE i < BH
        ui_2d_line(ox, oy + i * cell, ox + bwid, oy + i * cell, C_GRID, 1)
        i = i + 1
    WEND

    ' 已固定的块

    ' Locked blocks

    j = 0
    WHILE j < BH
        i = 0
        WHILE i < BW
            IF bget(i, j) <> 0 THEN
                ui_2d_rect(ox + i * cell + 1, oy + j * cell + 1, cell - 2, cell - 2, C_BLOCK, 1, 0, 2)
            END IF
            i = i + 1
        WEND
        j = j + 1
    WEND

    ' 当前方块

    ' Current piece

    k = 0
    WHILE k < 4
        packed = ui_piece_get_cell(pid, rot, k)
        IF packed >= 0 THEN
            cx = ox + (px + packed \ 16) * cell + 1
            cy = oy + (py + (packed - (packed \ 16) * 16)) * cell + 1
            ui_2d_rect(cx, cy, cell - 2, cell - 2, C_CUR, 1, 0, 2)
        END IF
        k = k + 1
    WEND

    ui_text_set_font(15, 1, C_TEXT, 0)
    ui_2d_text_cur(ox, 12, sHead)
    ui_text_set_font(14, 0, C_SCORE, 2)
    ui_2d_text_cur(ox + bwid, 12, STR$(score))

    IF over = 1 THEN
        ui_text_set_font(20, 3, -1146901, 0)
        ui_2d_text_cur(ox + bwid \ 2, oy + bhei \ 2, sOver)
        ui_text_set_font(14, 0, C_TEXT, 0)
        ui_2d_text_cur(ox + bwid \ 2, oy + bhei \ 2 + 28, sRestart)
    END IF

    ui_2d_present()
END SUB

' ── 主程序 ────────────────────────────────────────────

' ── Main program ────────────────────────────────────────────

initLang
ui_piece_init()
board_clear()

score = 0
over = 0
pid = 0
rot = 0
px = 3
py = 0

ui_win_open(sTitle, 0, 0)
' ⚠ 重力**必须走定时器**（用户 2026-10-04 的口径：「不应该是间隔多久绘制，

' ⚠ Gravity **must go through the timer** (user ruling 2026-10-04: 「you should not draw at a fixed interval,

' 而是空闲了就绘制」）。老写法把 `ui_msg_fetch_wait(TICK)` 的**超时**当成

' draw whenever you are idle」). The old code treated the **timeout** of `ui_msg_fetch_wait(TICK)` as

' "下落一拍" —— 那是把**帧率当玩法**：宿主改成一帧跟着显示走之后，

' "one drop step" -- that makes **frame rate part of the game**: once the host paces drawing to the display,

' 每一帧都变成"一拍"，方块会每 ~16ms 掉一格，**不可玩**。

' every frame becomes a "step" and a block falls every ~16ms, **unplayable**.

tid = ui_timer_set(TICK, 0)
accStep = 0
LASTMS = ui_time_get_ms()      ' 墙钟起点（进主循环时取）

                               ' Wall-clock origin (taken on entering the main loop)

draw_board()

WHILE ui_win_is_closed() = 0
    t = ui_msg_fetch_wait(TICK)

    IF t = 10 THEN
        EXIT WHILE
    END IF

    ' 按墙钟补步，用户 2026-10-04 口径：游戏时钟取系统毫秒数

    ' Catch up by wall clock; user ruling 2026-10-04: the game clock reads system milliseconds

    now2 = ui_time_get_ms()
    accStep = accStep + (now2 - LASTMS)
    LASTMS = now2
    IF accStep > TICK * 8 THEN accStep = 0        ' 卡太久别一次补一大串

                                                  ' Stuck too long: do not catch up a huge burst at once

    DO WHILE accStep >= TICK
        accStep = accStep - TICK
        IF over = 0 THEN
            IF collide(pid, rot, px, py + 1) = 0 THEN
                py = py + 1
            ELSE
                lock_piece(pid, rot, px, py)
                score = score + clear_lines() * 100
                pid = (pid + 1) MOD 7
                rot = 0
                px = 3
                py = 0
                IF collide(pid, rot, px, py) <> 0 THEN
                    over = 1
                END IF
            END IF
        END IF
    LOOP

    IF t = 6 THEN
        tx = ui_msg_get_a()
        ty = ui_msg_get_b()
        sw = ui_scr_get_w()
        sh = ui_scr_get_h()

        IF over = 1 THEN
            board_clear()
            score = 0
            over = 0
            pid = 0
            rot = 0
            px = 3
            py = 0
        ELSEIF ty > sh * 3 \ 4 THEN
            WHILE collide(pid, rot, px, py + 1) = 0
                py = py + 1
            WEND
            lock_piece(pid, rot, px, py)
            score = score + clear_lines() * 100
            pid = (pid + 1) MOD 7
            rot = 0
            px = 3
            py = 0
            IF collide(pid, rot, px, py) <> 0 THEN
                over = 1
            END IF
        ELSEIF tx < sw \ 3 THEN
            IF collide(pid, rot, px - 1, py) = 0 THEN
                px = px - 1
            END IF
        ELSEIF tx > sw * 2 \ 3 THEN
            IF collide(pid, rot, px + 1, py) = 0 THEN
                px = px + 1
            END IF
        ELSE
            IF collide(pid, rot + 1, px, py) = 0 THEN
                rot = (rot + 1) MOD 4
            END IF
        END IF
    ELSE
        ' 其它消息（触摸/按键/**定时器唤醒**/等待超时）：只重画，不动重力。

        ' Any other message (touch/key/**timer wake**/timeout): just redraw, do not advance gravity.

        ' 定时器只做唤醒（按墙钟补步，用户 2026-10-04 口径：游戏时钟取系统毫秒数），

        ' The timer only wakes the loop (catch up by wall clock; user ruling 2026-10-04: the game clock reads system milliseconds),

        ' 重力步进在上面的墙钟补步块里，与帧率/拍数无关。

        ' The timer only wakes; gravity steps in the wall-clock catch-up block above.

    END IF

    draw_board()
WEND

ui_win_close()