scheme/ui/demo_ui.scm · 15963 字节 · 下载原文

#include "../../../Lib/scheme/vml_ui.scm"
; demo_ui.scm —— **第 4 层：最新 UI 接口**（`ui_*`）

; demo_ui.scm -- **layer 4: the newest UI interface** (`ui_*`)

;

; 这一层和第 3 层（BGI）正好相反：

; This layer is the exact opposite of layer 3 (BGI):

;

;   · **没有固定分辨率**。画布多大由宿主给（`ui_scr_get_w` / `ui_scr_get_h`），

;   · **There is no fixed resolution**. The canvas size is given by the host (`ui_scr_get_w` / `ui_scr_get_h`),

;     程序按拿到的尺寸现排版 —— 手机上还有手柄区收放、横竖屏切换会让它变。

;     and the program lays itself out for the size it gets -- on a phone the collapsible gamepad area and screen rotation change it.

;   · **颜色是真彩**（`0xAARRGGBB`），不是 16 个索引色。

;   · **Colors are true color** (`0xAARRGGBB`), not 16 indexed colors.

;   · **有消息循环**。触摸、按键、定时器、窗口被关 / 被转屏都从 `ui_msg_fetch_wait` 出来，

;   · **There is a message loop**. Touch, keys, timers, the window being closed or rotated all come out of `ui_msg_fetch_wait`,

;     程序按返回值分派 —— 这是"能交互的程序"和"画完就死"的分水岭。

;     and the program dispatches on the return value -- the watershed between "an interactive program" and "draw then die".

;

; ## 这个 demo 演示什么

; ## What this demo shows

;

;   ① **开窗前先问屏幕方向**（`ui_scr_get_orientation`）—— 程序据此决定排版。

;   ① **Ask the screen orientation before opening the window** (`ui_scr_get_orientation`) -- the program lays out accordingly.

;      方向是**设备**的属性，别拿 `ui_scr_get_w > ui_scr_get_h` 去推（那是可用绘图区，

;      Orientation is a property of the **device**; do not infer it from `ui_scr_get_w > ui_scr_get_h` (that is the usable drawing area,

;      手柄收起/展开会变）。

;      which changes when the gamepad is collapsed or expanded).

;   ② 开窗 → 拿画布尺寸 → 按尺寸现排（**没有写死的坐标**）。

;   ② Open the window -> get the canvas size -> lay out for that size (**no hard-coded coordinates**).

;   ③ 画图元：矩形 / 圆角矩形 / 圆 / 椭圆 / 直线 / 文字，位置全部由 w/h 算出来。

;   ③ Draw primitives: rectangle / rounded rectangle / circle / ellipse / line / text, all positioned from w/h.

;   ④ `ui_2d_present` 交帧 —— 它是"这一帧画完了"的唯一信号。

;   ④ `ui_2d_present` hands over the frame -- it is the only signal that says "this frame is done".

;   ⑤ **消息循环**：定时器驱动重画、按键 / 触摸有响应、**有界退出**

;   ⑤ **A message loop**: the timer drives redraws, keys / touches respond, and the exit is **bounded**

;      （收够 N 帧 或 按任意键 / 点任意处）。

;      (after N frames, or on any key / tap).

;

; ## ⚠ 本前端的四条限制（决定了这份为什么完全平铺）

; ## ⚠ Four limitations of this frontend (they explain why this file is completely flat)

;

;   · **用户函数里不能调库函数**（尾调用优化会跳过被调者的序言）⇒ `ui_*` 这些调用

;   · **A user function cannot call a library function** (tail-call optimization skips the callee's prologue) => the `ui_*` calls

;     **一律写在顶层**，本份一个 `define (f …)` 都没有；主循环用**顶层的 `do`**

;     are **all written at the top level**; this file has not a single `define (f ...)`, and the main loop is a **top-level `do`**

;     （`let` / 命名 `let` 只在语句位受理，放表达式位不生成代码）。

;     (`let` / named `let` are accepted only in statement position; in expression position they generate no code).

;   · **没有 `break`** ⇒ 退出走一个 `quit` 标志，由 `do` 的**终止条件**结束。

;   · **There is no `break`** => exiting goes through a `quit` flag, ended by the `do`'s **termination condition**.

;   · **`remainder` / `quotient` 在库里没有对应标签**、`%` 也没有 ⇒

;   · **`remainder` / `quotient` have no matching labels in the library**, and there is no `%` either =>

;     取模手算 `(- i (* (/ i n) n))`（本前端 `/` 就是整数除）。

;     compute modulo by hand as `(- i (* (/ i n) n))` (in this frontend `/` is integer division).

;   · **字符串字面量里没有任何转义**、`int->string` 也链不到 ⇒ 数字没法拼进字符串。

;   · **String literals contain no escapes at all**, and `int->string` cannot be linked either => numbers cannot be joined into a string.

;     所以计数器**不画数字**，画**长度随计数增长的条**；收尾的统计行用

;     So the counters **do not draw digits** but a **bar whose length grows with the count**; the closing statistics line uses

;     `(display "x=")` + `(display x)` 分次打。

;     `(display "x=")` + `(display x)` printed separately.

;   · 颜色写**负数十进制**（词法器只认十进制，`0x…` 会被切成 `0` + 符号）：

;   · Colors are written as **negative decimals** (the lexer is decimal-only; `0x...` is split into `0` + a sign):

;     `0xFF101018` = `-15724520`。

;

; 跑法：

; How to run:

;   手机    vml run examples/scheme/demo_ui.scm

;   phone    vml run examples/scheme/demo_ui.scm

;   桌面    vmlcli Examples/scheme/demo_ui.scm --screen 640x480 --frames /tmp/fr

;   desktop  vmlcli Examples/scheme/demo_ui.scm --screen 640x480 --frames /tmp/fr

;   喂输入  … --input 脚本（一行一条，如 `200 touchdown 300 200` / `150 keydown 13`）

;   input    ... --input <script> (one per line, e.g. `200 touchdown 300 200` / `150 keydown 13`)


(define c_bg -15724520)        ; 0xFF101018

(define c_panel -15066588)     ; 0xFF1A1A24

(define c_title -1513232)      ; 0xFFE8E8F0

(define c_ok -11409298)        ; 0xFF51E86E

(define c_dim -6643536)        ; 0xFF9AA0B0

(define c_blue -11890471)      ; 0xFF4A90D9

(define c_orange -2069424)     ; 0xFFE06C50

(define c_gold -2509750)       ; 0xFFD9B44A

(define c_green -11483016)     ; 0xFF50C878

(define c_mark -8096)          ; 0xFFFFE060


(define orient 0)
(define w 360)
(define h 620)
(define gy 0)
(define tid 0)
(define fr 0)
(define keys 0)
(define touches 0)
(define tx -1)
(define ty 0)
(define quit 0)
(define t 0)
(define pad 0)
(define cx 0)
(define bw 0)
(define i 0)
(define cc 0)
(define lang 0)

; ── ① 开窗**之前**就问方向：程序据此决定排版 ──

; -- ① Ask the orientation **before** opening the window: the program lays out accordingly --

(set! lang (ui_scr_get_language))
(set! orient (ui_scr_get_orientation))

; 开窗：尺寸传 0 ⇒ **交给宿主用真实可用区**。开窗**之前** `ui_scr_get_w/h` 只能估算，而估算与

; Open the window: pass size 0 ⇒ **the host uses the real available area**. **Before** the open,

; 实际总有出入（这就是"内容偏上"的根因）⇒ 所以尺寸改在**开窗之后**问（那时才是真实画布）。

; `ui_scr_get_w/h` can only estimate and the estimate differs from reality (exactly why the content sat high) ⇒ the size is now queried **after** the open, when it is the real canvas.

(ui_win_open "demo_ui (Scheme)" 0 0)
(ui_scr_set_keep_on 1)

; 尺寸：开窗之后再问一次（拿不到就退到竖屏默认值）

; Size: re-queried after the open (falling back to the portrait default if unavailable)

(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)

; 内容整块**在画布内垂直居中**（用户 2026-10-07 报的「很多程序文字没居中、很靠上」）：

; 这一份的控件是**从 y=12 往下逐项堆**的：最后一项（8 格真彩色带）落在 y=384..398，下面那行

; "触摸"文字在 y=396 ⇒ 整块从标题字形顶（≈ 0）到最后约 399 ⇒ 按 **400** 算。

; 下面每一条 y 都加 `gy`（`h` 是**画布**高）。⚠ 下限保 0：画布特别矮时别把内容推出上边缘。

; ⚠ 最后两行（`(- h 60)` / `(- h 36)`）是**钉在底部的**，不动 —— 与样板 `c/ui/demo_ui.c` 的

;   `SH - 44` / `SH - 24` 同理；触摸标记画在**用户自己点的那个坐标**上，更不能加偏移。

; Center the whole block vertically (user report, 2026-10-07): the widgets are stacked downward from

; y=12 and the last item (the 8-cell band) sits at y=384..398 with the "touches" row at y=396, so the

; block runs from the title's ascender (~0) to ~399 => use **400**. Every y below is offset by `gy`

; (`h` is the **canvas** height); clamp at 0 so a short canvas cannot push the content off the top.

; The two footer rows (`(- h 60)` / `(- h 36)`) stay pinned to the bottom (same idea as `SH - 44` /

; `SH - 24` in the `c/ui/demo_ui.c` model), and the touch marker uses the user's own tap coordinates.

(set! gy (/ (- h 400) 2))
(if (< gy 0) (set! gy 0) 0)

; 定时器：每 60ms 一拍，驱动重画（也是"没输入也能自己停"的那个节拍源）

; Timer: one tick every 60ms, driving redraws (also the tick source that lets it stop on its own with no input)

(set! tid (ui_timer_set 60 1))

; ── ⑤ 消息循环：定时器驱动重画，有界退出 ──

; -- ⑤ Message loop: the timer drives redraws, the exit is bounded --

; 退出**只靠 `do` 的终止条件** `(= quit 1)`（本前端没有 `break`）。

; Exiting relies **only on the `do`'s termination condition** `(= quit 1)` (this frontend has no `break`).

(do ()
    ((= quit 1))

  (set! t (ui_msg_fetch_wait 0))     ; 阻塞等一条（有定时器在 ⇒ 一定会返回）

  ; Block for one message (a timer is running => it always returns)


  (if (= t 9)
      (begin
        (set! fr (+ fr 1))
        (if (> fr 29) (set! quit 1) 0))     ; ← 有界：到点自己停

        ; <- Bounded: it stops by itself once the frame count is reached

      0)
  (if (= t 1)
      (begin
        (set! keys (+ keys 1))
        (set! quit 1))                      ; ← 有界：收到键就退

        ; <- Bounded: exit on a key press

      0)
  (if (= t 6)
      (begin
        (set! touches (+ touches 1))
        (set! tx (ui_msg_get_a))                ; A = x

        (set! ty (ui_msg_get_b))                ; B = y

        (set! quit 1))                      ; ← 有界：点到就退

        ; <- Bounded: exit on a tap

      0)
  (if (= t 4)
      (begin
        (set! touches (+ touches 1))
        (set! tx (ui_msg_get_a))
        (set! ty (ui_msg_get_b))
        (set! quit 1))
      0)
  (if (= t 10) (set! quit 1) 0)             ; 用户把窗口关了

  ; The user closed the window

  (if (= (ui_win_is_closed) 1) (set! quit 1) 0)

  ; ── 画这一帧（每个位置都由 w / h 现算，没有写死的坐标）──

  ; -- Draw this frame (every position is computed from w / h; no hard-coded coordinates) --

  (set! pad (/ w 16))
  (set! cx (/ w 2))

  (ui_2d_clear c_bg)

  (if lang (ui_2d_text cx (+ gy 12) "UI interface / demo_ui (Scheme)" c_title 16 1) (ui_2d_text cx (+ gy 12) "UI 接口 / demo_ui (Scheme)" c_title 16 1))
  (if (= orient 1)
      (if lang (ui_2d_text cx (+ gy 36) "Orientation = LANDSCAPE" c_ok 13 1) (ui_2d_text cx (+ gy 36) "屏幕方向 = 横屏 (LANDSCAPE)" c_ok 13 1))
      (if lang (ui_2d_text cx (+ gy 36) "Orientation = PORTRAIT" c_ok 13 1) (ui_2d_text cx (+ gy 36) "屏幕方向 = 竖屏 (PORTRAIT)" c_ok 13 1)))
  (if lang (ui_2d_text cx (+ gy 56) "Canvas laid out from the host size" c_dim 12 1) (ui_2d_text cx (+ gy 56) "画布按宿主给的尺寸现排" c_dim 12 1))

  ; 一个跟随尺寸的方框（转屏后它会跟着变宽变矮 —— 这就是"不写死坐标"的证明）

  ; A box that follows the size (after rotating it becomes wider and shorter -- proof of "no hard-coded coordinates")

  (ui_2d_rect pad (+ gy 76) (- w (* pad 2)) 84 c_panel 1 0 10)
  (ui_2d_rect (+ pad 6) (+ gy 82) (- (- w (* pad 2)) 12) 28 c_blue 1 0 6)
  (if lang (ui_2d_text (+ pad 16) (+ gy 88) "rect / rounded rect (follows width)" c_bg 12 0) (ui_2d_text (+ pad 16) (+ gy 88) "rect / 圆角矩形（随屏宽伸缩）" c_bg 12 0))

  ; 圆 / 椭圆 / 直线：三个基本形

  ; Circle / ellipse / line: the three basic shapes

  (ui_2d_circle (- cx (/ w 6)) (+ gy 200) (/ w 12) c_orange 1 0)
  (ui_2d_ellipse (+ cx (/ w 6)) (+ gy 200) (/ w 9) (/ w 18) c_gold 1 0)
  (ui_2d_line pad (+ gy 250) (- w pad) (+ gy 250) c_green 3)

  ; 一条 8 格真彩色带（这些是 RGB，不是调色板索引）

  ; An 8-cell true-color band (these are RGB, not palette indexes)

  ; `i % 2` 手算成 `(- i (* (/ i 2) 2))`（没有 remainder/%）

  ; `i % 2` is computed by hand as `(- i (* (/ i 2) 2))` (there is no remainder/%)

  (set! bw (/ (- w (* pad 2)) 8))
  (set! i 0)
  (do ((k 0 (+ k 1)))
      ((> k 7))
    (set! i k)
    (set! cc c_blue)
    (if (= (- i (* (/ i 2) 2)) 1) (set! cc c_orange) 0)
    (ui_2d_rect (+ pad (* i bw)) (+ gy 266) (- bw 2) 18 cc 1 0 2))
  (if lang (ui_2d_text cx (+ gy 296) "true color 0xAARRGGBB (not indexed)" c_dim 12 1) (ui_2d_text cx (+ gy 296) "真彩 0xAARRGGBB（不是索引色）" c_dim 12 1))

  ; 事件计数：不画数字，画**长度随计数增长的条**（数字拼不进字符串，见文件头）

  ; Event counts: no digits are drawn, but a **bar whose length grows with the count** (digits cannot be joined into a string, see the file header)

  (if lang (ui_2d_text pad (+ gy 336) "frames" c_dim 12 0) (ui_2d_text pad (+ gy 336) "帧" c_dim 12 0))
  (set! bw (* fr 6))
  (if (> bw (- (- w (* pad 2)) 40)) (set! bw (- (- w (* pad 2)) 40)) 0)
  (ui_2d_rect (+ pad 40) (+ gy 324) bw 14 c_blue 1 0 3)

  (if lang (ui_2d_text pad (+ gy 366) "keys" c_dim 12 0) (ui_2d_text pad (+ gy 366) "按键" c_dim 12 0))
  (set! bw (* keys 30))
  (if (> bw (- (- w (* pad 2)) 60)) (set! bw (- (- w (* pad 2)) 60)) 0)
  (ui_2d_rect (+ pad 60) (+ gy 354) bw 14 c_orange 1 0 3)

  (if lang (ui_2d_text pad (+ gy 396) "touches" c_dim 12 0) (ui_2d_text pad (+ gy 396) "触摸" c_dim 12 0))
  (set! bw (* touches 30))
  (if (> bw (- (- w (* pad 2)) 60)) (set! bw (- (- w (* pad 2)) 60)) 0)
  (ui_2d_rect (+ pad 60) (+ gy 384) bw 14 c_gold 1 0 3)

  ; 触摸标记：点哪儿就在哪儿留一个圈（证明坐标真的能用）

  ; Touch marker: a circle is left wherever you tap (proving the coordinates really work)

  (if (> tx 0)
      (begin
        (ui_2d_circle tx ty 18 c_mark 0 2)
        (ui_2d_circle tx ty 4 c_mark 1 0)
        (if lang (ui_2d_text cx (- h 60) "touch coordinates in use" c_mark 12 1) (ui_2d_text cx (- h 60) "触摸坐标已经用上了" c_mark 12 1)))
      (if lang (ui_2d_text cx (- h 60) "Tap anywhere / any key to exit" c_dim 12 1) (ui_2d_text cx (- h 60) "点一下屏幕 / 按任意键退出" c_dim 12 1)))

  (if lang (ui_2d_text cx (- h 36) "Exit: any key or any tap (or wait for N frames)" c_dim 12 1) (ui_2d_text cx (- h 36) "退出：按任意键或点任意处（或等 N 帧到点）" c_dim 12 1))

  (ui_2d_present))

; ── 收尾：定时器要杀，屏幕常亮要还回去 ──

; -- Wrap-up: kill the timer and give back keep-screen-on --

(ui_timer_kill tid)
(ui_scr_set_keep_on 0)
(ui_win_close)

; 给无头验证留几行**确定性**的判据（图形部分只能肉眼看，这几个数能自动比）

; A few **deterministic** checks are left for headless verification (the graphics can only be eyeballed; these numbers can be compared automatically)

(display "demo_ui: orient=")
(display orient)
(newline)
(display "demo_ui: canvas=")
(display w)
(display " x ")
(display h)
(newline)
(display "demo_ui: frames=")
(display fr)
(display " keys=")
(display keys)
(display " touches=")
(display touches)
(newline)
(display "demo_ui: done")
(newline)