scheme/test/catch.scm · 13893 字节 · 下载原文
#include "../../../Lib/scheme/vml_ui.scm"
;; 接方块 —— 用 **Scheme** 写的手机游戏
;; Catch -- a mobile game written in **Scheme**
;;
;; 玩法：左右方向键移动底部挡板，把落下来的球弹回去；没接住就结束。每接住一次 +10 分。
;; Gameplay: the left/right arrow keys move the paddle at the bottom and bounce the falling ball back; missing it ends the round. Each catch = +10 points.
;;
;; ◆ 手机那套 UI
;; ◆ The mobile UI set
;;
;; 开窗 / 绘图 / 输入 / 定时器是 C 写的（`Lib/shared/src/vmlui.c` → `vmlui.vml`），
;; Window opening / drawing / input / timers are written in C (`Lib/shared/src/vmlui.c` -> `vmlui.vml`),
;; 由 `vmltool.config.xml` 的 `<Language Name="scheme" Libs="vmlui.vml">` 挂上来。
;; pulled in by `<Language Name="scheme" Libs="vmlui.vml">` in `vmltool.config.xml`.
;;
;; ◆ 写法要求
;; ◆ Style requirements
;;
;; · ~~**全局状态一律留在顶层**：本前端的用户函数**看不见顶层变量**~~ ✅ **已修好（2026-10-04 复验）** ——
;; · ~~**Global state always stays at the top level**: this frontend's user functions **cannot see top-level variables**~~ ✅ **fixed (re-checked 2026-10-04)** --
;; 当时二者都按 `R12 + (12 - off)` 寻址，函数里的 `R12` 是自己的帧指针，实测
;; at the time both were addressed by `R12 + (12 - off)` and inside a function `R12` was its own frame pointer, measured:
;; `(define g 0) (define (w1) (set! g 5))` 调 `(w1)` 直接踩坏保存的 R12
;; `(define g 0) (define (w1) (set! g 5))` called as `(w1)` directly clobbered the saved R12
;; （`R12(BP)` 变成 8，紧接着 `[R12-48]` 越界）；函数里**读**顶层变量同样读错。
;; (`R12(BP)` became 8, immediately followed by an out-of-range `[R12-48]`); **reading** a top-level variable inside a function was just as wrong.
;; 2026-10-04 复验：函数现在**读得到也写得了**顶层变量 —— `(define g 0) (define (w1) (set! g 5))` 调 `(w1)` 后 `g` 得 5；
;; Re-checked 2026-10-04: a function can now **read and write** top-level variables -- after `(define g 0) (define (w1) (set! g 5))` then `(w1)`, `g` is 5;
;; 两变量各调两次得 `G=2 H=4`，纯读 `(+ x base)` 得 `R=105`，14 个顶层变量都对。
;; two variables bumped twice give `G=2 H=4`, a pure read `(+ x base)` gives `R=105`, and all 14 top-level variables work.
;; ⇒ 本份仍是**扁平顶层程序**，只是因为它已经写好、跑通了 —— 能跑就别动；
;; ⇒ This file is still a **flat top-level program** only because it is already written and working -- existing code is fine as is;
;; 新写的代码里函数可以直接读写顶层变量，「参数全传」不再是纯函数的前提。
;; in new code a function may read/write top-level variables directly, so "pass everything in" is no longer a precondition for pure functions.
;; · 颜色写**负数十进制**（词法器只认十进制，`0x…` 会被切成 0 + 符号）。
;; · Colors are written as **negative decimals** (the lexer is decimal-only; `0x...` is split into 0 + a sign).
;; · `display`/`print` 只取**第一个**实参、且**不补换行** ⇒ 本份不用控制台。
;; · `display`/`print` take only the **first** argument and **add no newline** => this file does not use the console.
;; · `(- 0 x)` 写负号：`-` 只在**两个实参**时才编成减法指令。
;; · Write negation as `(- 0 x)`: `-` compiles to a subtraction instruction only with **two arguments**.
;; · `remainder` / `quotient` 在库里没有对应标签（链接期报「未找到标签」）⇒ 取整用 `/`。
;; · `remainder` / `quotient` have no matching labels in the library (link time reports "label not found") => use `/` for integer division.
;; · `(let …)` / 命名 `let` **只在语句位受理**（放表达式位不生成任何代码）⇒ 循环用 `do`。
;; · `(let ...)` / named `let` are **accepted only in statement position** (in expression position they generate no code) => use `do` for loops.
;;
;; ◆ 本份踩过、已修的六个前端缺陷（2026-09-17）
;; ◆ Six frontend defects this file hit, all already fixed (2026-09-17)
;; ↳ 2026-10-04 复验：①②③④ 逐条复现仍是已修状态（① 12 个顶层变量求和得 78；② `(pick 11 22)` 得 22；
;; ↳ Re-checked 2026-10-04: (1)(2)(3)(4) still measure as fixed (1) twelve top-level variables sum to 78; (2) `(pick 11 22)` gives 22;
;; ③ 用户函数尾位置调库函数正常；④ 函数体取最后一个形式）。⑤⑥ 未单测（骨架照不出来）。
;; (3) a library call in tail position inside a user function works; (4) the function body takes its last form). (5)(6) not individually re-measured.
;;
;; ① **顶层变量只能放 3 个** —— `main` 不 `sub R13`，而顶层绑定走 `R12+(12-off)`
;; ① **Only 3 top-level variables could be held** -- `main` did not `sub R13`, while top-level bindings go through `R12+(12-off)`
;; （`R12+8 / +4 / +0` 之后继续往下到 `R12-4 …`），正好是**压栈区**。
;; (after `R12+8 / +4 / +0` it continues down to `R12-4 ...`), which is exactly the **push area**.
;; 实测 12 个顶层变量求和得 24（应 78）、5 个变量夹几次调用后得 65536。
;; Measured: 12 top-level variables summed to 24 (should be 78), and 5 variables around a few calls gave 65536.
;; 现在 `main` 也占帧 —— 本份用了 14 个顶层变量。
;; Now `main` occupies a frame too -- this file uses 14 top-level variables.
;; ② **≥2 个形参的函数读错实参** —— 形参槽原先按 `--varOff*4` 递减分配，
;; ② **A function with 2 or more formal parameters read the wrong arguments** -- the parameter slots used to be allocated downward by `--varOff*4`,
;; 只在单参数时恰好对；`(define (pick a b) b)` 调 `(pick 11 22)` 得 11。
;; which happened to be right only for a single parameter; `(define (pick a b) b)` called as `(pick 11 22)` returned 11.
;; ③ **从用户函数里调库函数必崩** —— 尾位置一律编成 `jmp <名>_body`
;; ③ **Calling a library function from a user function always crashed** -- a tail position was always compiled to `jmp <name>_body`
;; （跳进被调者的函数体、跳过它的序言），对自递归是对的、对库函数是错的。
;; (jumping into the callee's body and skipping its prologue), which is right for self-recursion and wrong for library functions.
;; ④ **函数体 / `let` body 只编译第一个形式**，第二个起被静默丢掉。
;; ④ **A function body / `let` body compiled only its first form**; the second onward was silently dropped.
;; ↳ 2026-10-04 复验仍为已修：`(define (f) 1 2)` 调 `(f)` 得 2、`(define (g) 10 20 30)` 得 30（取最后一个形式，正确）。
;; ↳ Still fixed as of 2026-10-04: `(define (f) 1 2)` called as `(f)` gives 2 and `(define (g) 10 20 30)` gives 30 (the last form wins, which is correct).
;; ⑤ **命名 `let` 完全不占帧**，体内局部量直接写进压栈区。
;; ⑤ **A named `let` occupied no frame at all**; its local variables were written straight into the push area.
;; ⑥ **帧大小按生成结束时的 varOff 算**，而 `let`/`do` 收尾会把 varOff 还原 ⇒ 低估。
;; ⑥ **The frame size was computed from varOff at the end of generation**, while the `let`/`do` epilogue restored varOff => underestimated.
;;
;; 骨架 `skel.scm` 只有单参数函数、且循环全在顶层，上面六条一条都照不出来。
;; The `skel.scm` skeleton has only single-parameter functions and all its loops at the top level, so not one of the six above shows up there.
(define w 360)
(define h 620)
(define bx 0)
(define px 0)
(define py 70)
(define dx 3)
(define dy 5)
(define sc 0)
(define hi 0)
(define alive 1)
(define tid 0)
(define t 0)
(define k 0)
(define quit 0)
(define lang 0)
(define ans 0)
;; 唯一允许抽出去的形态：**参数全传、不读全局**的纯函数。
;; The only shape allowed to be extracted: a pure function with **all parameters passed in and no globals read**.
;; 三个形参 —— 正好吃到 ② 那条修复（修前 p0 会读到返回地址槽）。
;; Three formal parameters -- exactly exercising fix ② (before it, p0 read the return-address slot).
(define (clamp v lo cap)
(if (< v lo)
lo
(if (> v cap) cap v)))
(set! lang (ui_scr_get_language))
;; ⚠ **先开窗、再问尺寸**：开窗前 `ui_scr_get_w/h` 只能按**默认 chrome**（假设要手柄）估算，
;; 与真正开出来的画布对不上（见 E141）。⇒ 开窗尺寸传 0 交给宿主，**开完再问**真实可用绘图区。
;; ⚠ **Open the window first, then ask for the size**: before the window exists `ui_scr_get_w/h`
;; can only estimate from the **default chrome** (which assumes a gamepad) and will not match the
;; real canvas (see E141). So pass 0 here and ask for the real usable area **after** opening.
(if lang (ui_win_open "Catch" 0 0) (ui_win_open "接方块" 0 0))
(set! w (ui_scr_get_w))
(set! h (ui_scr_get_h))
(if (< w 1) (set! w 360) 0)
(if (< h 1) (set! h 620) 0)
(ui_scr_set_keep_on 1)
(set! tid (ui_timer_set 40 0))
;; 开局状态（`reset` 那几行的内联版；函数版本看不见顶层变量，见文件头）
;; Start state (the inline version of the `reset` lines; a function version cannot see top-level variables, see the file header)
(set! bx (- (/ w 2) 40))
(set! px (/ w 2))
(set! py 70)
(set! dx 3)
(set! dy 5)
(set! sc 0)
(set! alive 1)
(do ()
((= quit 1))
(if (= (ui_win_is_closed) 1) (set! quit 1) 0)
;; ── draw ──
(ui_2d_clear -15724520)
(if lang (ui_2d_text 8 8 "Score" -6643536 13 0) (ui_2d_text 8 8 "得分" -6643536 13 0))
(ui_2d_rect 58 11 sc 10 -11409298 1 0 0)
(if lang (ui_2d_text (/ w 2) 8 "Best" -6643536 13 1) (ui_2d_text (/ w 2) 8 "最高" -6643536 13 1))
(ui_2d_rect (+ (/ w 2) 46) 11 hi 10 -63488 1 0 0)
(ui_2d_rect bx (- h 40) 80 12 -63488 1 0 6)
(ui_2d_circle px py 9 -131246 1 0)
(if (= alive 0)
(if lang (ui_2d_text (/ w 2) (/ h 2) "Press Enter to restart" -131246 16 1) (ui_2d_text (/ w 2) (/ h 2) "按回车重开" -131246 16 1))
0)
(ui_2d_present)
(set! t (ui_msg_fetch_wait 0))
(if (= t 10) (set! quit 1) 0)
;; ── 定时器一拍（t=9）：球走一步 ──
;; -- One timer tick (t=9): the ball moves one step --
(if (= t 9)
(begin
(if (= alive 1)
(begin
(set! px (+ px dx))
(set! py (+ py dy))
(if (< px 10) (begin (set! px 10) (set! dx (- 0 dx))) 0)
(if (> px (- w 10)) (begin (set! px (- w 10)) (set! dx (- 0 dx))) 0)
(if (< py 30) (begin (set! py 30) (set! dy (- 0 dy))) 0)
;; 接住：球落到挡板带上、横向也在挡板范围内。
;; Catch: the ball lands on the paddle band and is horizontally within the paddle.
;; 多条件用**嵌套 if** —— `and` 本前端有分支但没验过。
;; Multiple conditions use **nested if** -- this frontend has a branch for `and` but it was never verified.
(if (> py (- h 52))
(if (< py (- h 30))
(if (> px (- bx 9))
(if (< px (+ bx 89))
(begin
(set! dy (- 0 dy))
(set! py (- h 52))
(set! sc (+ sc 10))
(if (> sc hi) (set! hi sc) 0)
(ui_audio_beep 880 30))
0)
0)
0)
0)
;; 没接住：本局结束
;; Missed: the round ends
;; 选「否/拒绝」→ quit 置 1，主循环下一拍退出（ui_dlg_msg 返回 0=是 / 1=否）
;; Choosing "No / reject" -> quit is set to 1 and the main loop exits on the next tick (ui_dlg_msg returns 0=yes / 1=no)
(if (> py h)
(begin
(set! alive 0)
(ui_audio_beep 220 260)
(if lang (set! ans (ui_dlg_msg "Catch" "Missed. Round over. Play again? (choose No to quit)" 0)) (set! ans (ui_dlg_msg "接方块" "没接住，这一局结束。\n再来一局？（选「否」退出）" 0)))
(if (= ans 0)
(begin
(set! bx (- (/ w 2) 40))
(set! px (/ w 2))
(set! py 70)
(set! dx 3)
(set! dy 5)
(set! sc 0)
(set! alive 1))
(set! quit 1)))
0))
0)
)
0)
;; ── 按键（t=1）──
;; -- Key press (t=1) --
(if (= t 1)
(begin
(set! k (ui_msg_get_a))
(if (= k 27) (set! quit 1) 0)
(if (= k 37) (set! bx (clamp (- bx 20) 4 (- w 84))) 0)
(if (= k 39) (set! bx (clamp (+ bx 20) 4 (- w 84))) 0)
(if (= k 13)
(begin
(set! bx (- (/ w 2) 40))
(set! px (/ w 2))
(set! py 70)
(set! dx 3)
(set! dy 5)
(set! sc 0)
(set! alive 1))
0))
0))
(ui_timer_kill tid)
(ui_scr_set_keep_on 0)
(ui_win_close)