basic/app/calendar.bas · 23068 字节 · 下载原文
' calendar.bas —— 常用小程序①：**日历**（第 4 层：`ui_*` 图形界面）—— 由 `Examples/c/app/calendar.c` 移植
' calendar.bas -- Everyday utility #1: a **calendar** (layer 4: the `ui_*` graphical interface), ported from `Examples/c/app/calendar.c`
'
' 一扇窗口里的月历：**今天高亮**，`←`/`→` 翻月、`↑`/`↓` 翻年，**点某一天**也能选中它，
' A month calendar in a window: **today is highlighted**; Left/Right change the month, Up/Down the year,
' `Esc` 退出。手机上就是"点屏幕"，桌面上是键盘或鼠标 —— 同一份程序两个平台都跑。
' and **tapping a day** selects it; Esc quits. On a phone that is a tap, on the desktop a key or a mouse.
'
' ## 第 4 层的三条规矩（不守就会"手机上行、桌面上歪"）
' ## Three rules of layer 4 (break them and it works on the phone but drifts on the desktop)
'
' · **尺寸从宿主问**：`ui_scr_get_w()/_h()`，别写死。窗口是按宿主给的尺寸开的。
' · **Ask the host for the size**: `ui_scr_get_w()/_h()`, never hard-code it. The window opens at whatever
' 手机上竖屏 ~395 宽、桌面上是另一套数，写死就一边挤一边空。
' size the host gives; a phone in portrait is about 395 wide while the desktop is something else entirely.
' · **颜色是真彩 `0xAARRGGBB`**（不是索引色）：`0xFF101018` = 不透明的深灰。
' · **Colours are true colour `0xAARRGGBB`** (not palette indexes): `0xFF101018` is opaque near-black.
' · **画完必须 `ui_2d_present()`**：它是"把这一帧交上去"那一步，漏了就是黑屏。
' · **Always finish with `ui_2d_present()`**: that is the "hand this frame over" step; skip it and you get a black screen.
'
' ## 为什么"空闲 8 秒就自己退出"
' ## Why it exits by itself after 8 seconds of idling
'
' 例程要能被**自动验收**（`scripts/vmlcli` 加 `--frame` 出一张图就够了），所以循环必须有界：
' Samples have to be **automatically verifiable** (one `scripts/vmlcli` run with `--frame` is enough), so the loop must be bounded:
' 空闲超过 8 秒就退出。**写真正的程序时把 `IDLE_EXIT_MS` 去掉**。
' it exits after 8 s of idling. **Drop `IDLE_EXIT_MS` when you write a real program.**
'
' ## BASIC 这一门独有的三条坑（每条都实测过，照抄本文件的写法就绕开了）
' ## Three BASIC-only traps (each measured; copy the shapes in this file and they are all avoided)
'
' ① **循环终结符是 `LOOP`**（`DO WHILE … LOOP`），写 `END DO` **不报错**、控制流静默歪掉。
' ① **The loop terminator is `LOOP`** (`DO WHILE ... LOOP`); writing `END DO` reports nothing and silently skews control flow.
' 本文件一律用 `WHILE … WEND`，两个词都写全，不留歧义。
' This file always uses `WHILE ... WEND`, both words spelled out, leaving no ambiguity.
' ② **有返回值 + 当语句裸调的函数会被解析器静默丢弃**（症状：只有对话框、没有窗口）。
' ② **A bare call to a function that has a return value is silently dropped by the parser** (symptom: only a dialog, no window).
' 所以本文件**每一个有返回值的库函数都把结果赋给一个变量再用** —— 例如
' So here **every library function with a return value has its result assigned to a variable first** -- for example
' `dt = vml_get_date()`，绝不写 `vml_get_date()` 单独成句。
' `dt = vml_get_date()`, never a bare `vml_get_date()` as a statement.
' ③ **单行 `IF … THEN …` 与多行块的行为不同**：把单行 IF（尤其带 `EXIT`）嵌在
' ③ **A single-line `IF ... THEN ...` does not behave like a block**: nesting an inline IF (especially one carrying `EXIT`)
' 块 IF 的 THEN 分支里、后面再跟 `ELSE`，会让整个外层循环**当场退出**（实测：本该跑 13 轮、
' inside the THEN branch of a block IF followed by an `ELSE` makes the whole outer loop **exit on the spot** (measured:
' 只跑了 1 轮）。⇒ 本文件**所有分支一律写成多行块**（`IF … THEN` / `…` / `END IF`），
' a loop that should run 13 times ran once). => **every branch here is written as a multi-line block**
' 退出循环一律用 `done` 标志位，不用 `EXIT WHILE`。
' (`IF ... THEN` / body / `END IF`), and the loop is always left through a `done` flag, never through `EXIT WHILE`.
'
' 界面文字跟着宿主语言走（`ui_scr_get_language()`），与 `Examples/basic/ui/demo_ui.bas` 同一套做法。
' The on-screen text follows the host language (`ui_scr_get_language()`), exactly as `Examples/basic/ui/demo_ui.bas` does it.
' ── UI 接口：引用**库侧**的声明文件 ────────────────────────────────
' ── UI interface: include the **library-side** declaration file ────────────────────────────────
'$INCLUDE: 'vml_ui.bas'
' 日期来自共享库 `vmlsys`（`Lib/basic/device.bas` 里那一族），返回 "YYYY-MM-DD"。
' The date comes from the shared library `vmlsys` (the family in `Lib/basic/device.bas`) as "YYYY-MM-DD".
NATIVE FUNCTION vml_get_date() AS STRING
' ══ 常量 ══════════════════════════════════════════════════════
' ══ Constants ══════════════════════════════════════════════════════
DIM IDLE_EXIT_MS AS INTEGER
' 配色（真彩 AA RRGGBB），与 C 版逐项相同。
' Colours (true colour AARRGGBB), item for item the same as the C version.
DIM C_BG AS INTEGER
DIM C_CARD AS INTEGER
DIM C_TITLE AS INTEGER
DIM C_DIM AS INTEGER
DIM C_ACCENT AS INTEGER
DIM C_TODAY AS INTEGER
DIM C_WEEKEND AS INTEGER
DIM C_DAY AS INTEGER
' ══ 全局状态 ══════════════════════════════════════════════════
' ══ Global state ══════════════════════════════════════════════════
DIM SW AS INTEGER
DIM SH AS INTEGER
DIM lang AS INTEGER
DIM g_pad AS INTEGER
DIM g_cell AS INTEGER
DIM g_top AS INTEGER
DIM cur_y AS INTEGER
DIM cur_m AS INTEGER
DIM sel_d AS INTEGER
DIM today_y AS INTEGER
DIM today_m AS INTEGER
DIM today_d AS INTEGER
DIM dt AS STRING
DIM msg_t AS INTEGER
DIM msg_a AS INTEGER
DIM msg_b AS INTEGER
DIM done AS INTEGER
DIM t0 AS INTEGER
' 文案（开局按宿主语言算一次，绘制路径上只用变量）。
' Strings (computed once at startup from the host language; the render path only reads variables).
DIM sWin AS STRING
DIM sToday AS STRING
DIM sSel AS STRING
DIM sHint AS STRING
DIM sW0 AS STRING
DIM sW1 AS STRING
DIM sW2 AS STRING
DIM sW3 AS STRING
DIM sW4 AS STRING
DIM sW5 AS STRING
DIM sW6 AS STRING
SUB initLang()
lang = ui_scr_get_language()
IF lang = 0 THEN
sWin = "日历（BASIC）"
sToday = "黄底 = 今天"
sSel = "已选中（点一天 / 用方向键翻月）"
sHint = "← → 翻月 ↑ ↓ 翻年 点一天选中 Esc 退出"
sW0 = "日"
sW1 = "一"
sW2 = "二"
sW3 = "三"
sW4 = "四"
sW5 = "五"
sW6 = "六"
ELSE
sWin = "Calendar (BASIC)"
sToday = "yellow = today"
sSel = "selected (tap a day / arrows change month)"
sHint = "Left/Right month Up/Down year tap a day Esc quits"
sW0 = "Su"
sW1 = "Mo"
sW2 = "Tu"
sW3 = "We"
sW4 = "Th"
sW5 = "Fr"
sW6 = "Sa"
END IF
END SUB
' ── 历法：闰年 / 月长 / 某月 1 号是星期几（蔡勒公式，0=周日）──────
' ── Calendar maths: leap year / month length / weekday of the 1st (Zeller, 0 = Sunday) ──────
FUNCTION is_leap(y AS INTEGER) AS INTEGER
' 顺序是**四百年 → 一百年 → 四年**：先给"能被 4 整除"打上 1，再让整百年把它抹掉，
' The order is **400 years -> 100 years -> 4 years**: first set 1 for "divisible by 4", then let a whole
' 最后让四百年把 2000 那一种再放回来（1900 不是闰年、2000 是）。
' century clear it, and finally let 400 put 2000 back (1900 is not a leap year, 2000 is).
is_leap = 0
IF y MOD 4 = 0 THEN
is_leap = 1
END IF
IF y MOD 100 = 0 THEN
is_leap = 0
END IF
IF y MOD 400 = 0 THEN
is_leap = 1
END IF
END FUNCTION
FUNCTION days_in_month(y AS INTEGER, m AS INTEGER) AS INTEGER
' 2 月看闰年；4/6/9/11 是 30 天；其余 31 天。
' February follows the leap year; 4/6/9/11 have 30 days; everything else has 31.
days_in_month = 31
IF m = 2 THEN
days_in_month = 28
IF is_leap(y) = 1 THEN
days_in_month = 29
END IF
END IF
IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN
days_in_month = 30
END IF
END FUNCTION
FUNCTION weekday_of_first(y AS INTEGER, m AS INTEGER) AS INTEGER
DIM yy AS INTEGER
DIM mm AS INTEGER
DIM k AS INTEGER
DIM j AS INTEGER
DIM h AS INTEGER
yy = y
mm = m
' 1、2 月算作上一年的 13、14 月。
' January and February count as months 13 and 14 of the year before.
IF mm < 3 THEN
mm = mm + 12
yy = yy - 1
END IF
k = yy MOD 100
j = yy \ 100
' ⚠ 这里必须是**整数除法**（`\`），写成 `/` 会拿到浮点、蔡勒公式就不成立了。
' ⚠ This must be **integer division** (`\`); with `/` the result is a float and Zeller no longer holds.
h = (1 + (13 * (mm + 1)) \ 5 + k + k \ 4 + j \ 4 + 5 * j) MOD 7
' h: 0=周六 ⇒ 换成 0=周日，与 `localtime` 的 tm_wday 一致。
' h: 0 = Saturday => shift to 0 = Sunday, matching `localtime`'s tm_wday.
weekday_of_first = (h + 6) MOD 7
END FUNCTION
FUNCTION month_en(m AS INTEGER) AS STRING
IF m = 1 THEN
month_en = "January"
END IF
IF m = 2 THEN
month_en = "February"
END IF
IF m = 3 THEN
month_en = "March"
END IF
IF m = 4 THEN
month_en = "April"
END IF
IF m = 5 THEN
month_en = "May"
END IF
IF m = 6 THEN
month_en = "June"
END IF
IF m = 7 THEN
month_en = "July"
END IF
IF m = 8 THEN
month_en = "August"
END IF
IF m = 9 THEN
month_en = "September"
END IF
IF m = 10 THEN
month_en = "October"
END IF
IF m = 11 THEN
month_en = "November"
END IF
IF m = 12 THEN
month_en = "December"
END IF
END FUNCTION
' 两位日号（补零，7×7 的格子里对齐才好看）。
' A two-digit day number (zero padded, which keeps the 7x7 grid aligned).
' ⚠ 这里**不用 `STR$`**：`STR$` 不给个位数补零（`day 7` 会画成 ` 7`，格子里的数字就偏一边）。
' ⚠ `STR$` is **not** used here: it does not zero-pad single digits, so the numbers would sit off-centre.
' ⚠ 两个数字先各自落进 `hi`/`lo` 再拼 —— 直接把两次 `CHR$` 写进一个表达式会落到同一块拼接缓冲上。
' ⚠ The two digits land in `hi`/`lo` first and are then joined -- two `CHR$` calls in one expression share one buffer.
FUNCTION day2(v AS INTEGER) AS STRING
DIM hi AS STRING
DIM lo AS STRING
hi = CHR$(48 + ((v \ 10) MOD 10))
lo = CHR$(48 + (v MOD 10))
day2 = hi + lo
END FUNCTION
FUNCTION num2s(v AS INTEGER) AS STRING
' 不补零的整数转串（年、月都用它）：借库里的 `STR$`，去掉正数前面那个空格即可。
' Integer to string without padding (used for the year and month): borrow `STR$` and strip the leading space.
num2s = LTRIM$(STR$(v))
END FUNCTION
' ── 版式：**画与命中判定共用这一份几何** ────────────────────────
' ── Layout: **drawing and hit testing share this one copy of the geometry** ────────────────────────
SUB layout()
DIM grid_h AS INTEGER
DIM block_h AS INTEGER
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
g_pad = SW \ 18
IF g_pad < 6 THEN
g_pad = 6
END IF
g_cell = (SW - g_pad * 2) \ 7
IF g_cell < 18 THEN
g_cell = 18
END IF
' ⚠ **行数固定 6**：月历最长 6 行（31 天且 1 号在周六时）。按"这个月实际几行"算的话，
' ⚠ **Always six rows**: a month spans at most six rows. Sizing by the actual row count makes the
' 翻月时整块会上下跳（实测过：5 行与 6 行来回切，日历像在抖）。
' whole block jump when you change month (measured: flipping between five and six rows makes it shake).
grid_h = 6 * g_cell
block_h = 64 + grid_h
g_top = (SH - block_h) \ 2 + 64
IF g_top < 80 THEN
g_top = 80
END IF
END SUB
FUNCTION cell_x(idx AS INTEGER) AS INTEGER
cell_x = g_pad + (idx MOD 7) * g_cell
END FUNCTION
FUNCTION cell_y(idx AS INTEGER) AS INTEGER
cell_y = g_top + (idx \ 7) * g_cell
END FUNCTION
' ── 绘制（**全部绘图都在 SUB 里**，模块级只留调用）───────────────
' ── Drawing (**all drawing lives inside SUBs**; module level only calls them) ───────────────
' ⚠ 这一条是实测的：把 IF/ELSE 摊到**模块级**代码流里之后，同一条 `ui_2d_rect` 的后两个实参
' ⚠ This one is measured: once IF/ELSE was spread across **module-level** code, the last two arguments of a
' 会被读成垃圾、整屏画花（与基线帧比 diff_px 0 → 130571）。搬进 SUB 逐像素相同。
' `ui_2d_rect` call read as garbage and smeared the whole screen (diff_px 0 -> 130571 vs the baseline frame).
SUB render()
DIM first AS INTEGER
DIM nd AS INTEGER
DIM cx AS INTEGER
DIM i AS INTEGER
DIM d AS INTEGER
DIM idx AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
DIM by AS INTEGER
DIM is_today AS INTEGER
DIM is_sel AS INTEGER
DIM col AS INTEGER
DIM tcol AS INTEGER
DIM wd AS STRING
DIM head AS STRING
DIM num AS STRING
first = weekday_of_first(cur_y, cur_m)
nd = days_in_month(cur_y, cur_m)
cx = SW \ 2
ui_2d_clear(C_BG)
' 标题：中文走**字符串拼接**，绝不逐字节赋 `char`（一个汉字三个字节，写进去就是截断）。
' Title: Chinese goes through **string concatenation**, never byte-by-byte assignment (a CJK glyph is 3 bytes).
IF lang = 0 THEN
num = num2s(cur_y)
head = num + " 年 "
num = num2s(cur_m)
head = head + num + " 月"
ELSE
head = month_en(cur_m)
num = num2s(cur_y)
head = head + " " + num
END IF
ui_2d_text_styled(cx, g_top - 64, head, C_TITLE, 18, VML_ANCHOR_CENTER, VML_FONT_BOLD)
' 星期表头：一格一个词，位置与下面的格子**同一套算式**。
' Weekday header: one word per cell, positioned by the **same formula** the cells below use.
i = 0
WHILE i < 7
wd = sW0
IF i = 1 THEN
wd = sW1
END IF
IF i = 2 THEN
wd = sW2
END IF
IF i = 3 THEN
wd = sW3
END IF
IF i = 4 THEN
wd = sW4
END IF
IF i = 5 THEN
wd = sW5
END IF
IF i = 6 THEN
wd = sW6
END IF
col = C_DIM
IF i = 0 OR i = 6 THEN
col = C_WEEKEND
END IF
ui_2d_text(g_pad + i * g_cell + g_cell \ 2, g_top - 28, wd, col, 13, VML_ANCHOR_CENTER)
i = i + 1
WEND
' 日期格：先铺底，再写日号。
' Day cells: background first, then the number.
d = 1
WHILE d <= nd
idx = first + d - 1
x = cell_x(idx)
y = cell_y(idx)
is_today = 0
IF cur_y = today_y AND cur_m = today_m AND d = today_d THEN
is_today = 1
END IF
is_sel = 0
IF d = sel_d THEN
is_sel = 1
END IF
col = C_CARD
IF is_today = 1 THEN
col = C_TODAY
END IF
IF is_sel = 1 THEN
col = C_ACCENT
END IF
ui_2d_rect(x + 3, y + 3, g_cell - 6, g_cell - 6, col, 1, 0, g_cell \ 4)
tcol = C_DAY
IF idx MOD 7 = 0 OR idx MOD 7 = 6 THEN
tcol = C_WEEKEND
END IF
IF is_sel = 1 OR is_today = 1 THEN
tcol = C_BG
END IF
num = day2(d)
ui_2d_text(x + g_cell \ 2, y + g_cell \ 2 - 7, num, tcol, 15, VML_ANCHOR_CENTER)
d = d + 1
WEND
' 底部：高亮说明 + 操作提示。
' Bottom: what is highlighted, plus the controls.
by = g_top + ((first + nd - 1) \ 7 + 1) * g_cell + 12
IF by > SH - 40 THEN
by = SH - 40
END IF
IF sel_d > 0 THEN
ui_2d_text(cx, by, sSel, C_ACCENT, 12, VML_ANCHOR_CENTER)
ELSE
ui_2d_text(cx, by, sToday, C_TODAY, 12, VML_ANCHOR_CENTER)
END IF
ui_2d_text(cx, by + 22, sHint, C_DIM, 11, VML_ANCHOR_CENTER)
ui_2d_present()
END SUB
' 点在某一天的格子里？返回日号，没点中返回 0。
' Did the tap land in a day cell? Returns the day number, or 0 when it missed.
' ⚠ **必须与 `render` 用同一套几何**（`cell_x`/`cell_y`）。
' ⚠ **It must use the same geometry as `render`** (`cell_x`/`cell_y`).
FUNCTION hit_day(px AS INTEGER, py AS INTEGER) AS INTEGER
DIM first AS INTEGER
DIM nd AS INTEGER
DIM d AS INTEGER
DIM idx AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
first = weekday_of_first(cur_y, cur_m)
nd = days_in_month(cur_y, cur_m)
hit_day = 0
d = 1
WHILE d <= nd
idx = first + d - 1
x = cell_x(idx)
y = cell_y(idx)
IF px >= x AND px < x + g_cell AND py >= y AND py < y + g_cell THEN
hit_day = d
END IF
d = d + 1
WEND
END FUNCTION
SUB shift_month(delta AS INTEGER)
cur_m = cur_m + delta
IF cur_m < 1 THEN
cur_m = 12
cur_y = cur_y - 1
END IF
IF cur_m > 12 THEN
cur_m = 1
cur_y = cur_y + 1
END IF
sel_d = 0
END SUB
' ══ 主程序 ════════════════════════════════════════════════════
' ══ Main program ════════════════════════════════════════════════════
IDLE_EXIT_MS = 8000
C_BG = &HFF101018
C_CARD = &HFF1A1A24
C_TITLE = &HFFE8E8F0
C_DIM = &HFF9AA0B0
C_ACCENT = &HFF4A90D9
C_TODAY = &HFFFFC64A
C_WEEKEND = &HFFE06C50
C_DAY = &HFFD8DCE8
initLang
' 今天：`vml_get_date()` 回 "YYYY-MM-DD"，按**位**取出来（全是 ASCII，逐字节安全）。
' Today: `vml_get_date()` returns "YYYY-MM-DD"; the parts are taken by position (all ASCII, byte-safe).
dt = vml_get_date()
cur_y = VAL(MID$(dt, 1, 4))
cur_m = VAL(MID$(dt, 6, 2))
today_y = cur_y
today_m = cur_m
today_d = VAL(MID$(dt, 9, 2))
sel_d = 0
' 开窗：**先问尺寸再开窗**，窗口与画布才是一套坐标系。
' Open the window: **ask for the size first**, so the window and the canvas share one coordinate space.
' 竖屏 + 不要手柄区（日历全靠点，用不到摇杆）。可旋转。
' Portrait plus no gamepad area (a calendar is all tapping). Rotatable.
layout()
ui_win_open_ex(sWin, 0, 0, VML_WIN_ROTATABLE, VML_WIN_NO_GAMEPAD)
layout()
render()
t0 = ui_time_get_ms()
done = 0
WHILE done = 0
IF ui_win_is_closed() <> 0 THEN
done = 1
END IF
IF done = 0 THEN
msg_t = ui_msg_fetch_wait(200)
IF msg_t = VML_MSG_NONE THEN
' 空闲超时（自动验收用）：没有任何消息就一直等，等够 8 秒就收工。
' Idle timeout (for automated checks): with no message at all, wait until 8 seconds have passed.
IF ui_time_get_ms() - t0 > IDLE_EXIT_MS THEN
done = 1
END IF
END IF
IF msg_t <> VML_MSG_NONE THEN
t0 = ui_time_get_ms()
IF msg_t = VML_MSG_KEYDOWN THEN
msg_a = ui_msg_get_a()
IF msg_a = VML_KEY_ESCAPE OR msg_a = 113 OR msg_a = 81 THEN
done = 1
END IF
IF msg_a = VML_KEY_LEFT THEN
shift_month(-1)
render()
END IF
IF msg_a = VML_KEY_RIGHT THEN
shift_month(1)
render()
END IF
IF msg_a = VML_KEY_UP THEN
cur_y = cur_y - 1
sel_d = 0
render()
END IF
IF msg_a = VML_KEY_DOWN THEN
cur_y = cur_y + 1
sel_d = 0
render()
END IF
END IF
IF msg_t = VML_MSG_TOUCHDOWN OR msg_t = VML_MSG_MOUSEDOWN THEN
msg_a = hit_day(ui_msg_get_a(), ui_msg_get_b())
IF msg_a > 0 THEN
sel_d = msg_a
render()
END IF
END IF
IF msg_t = VML_MSG_WINDOWORIENT OR msg_t = VML_MSG_WINDOWRESIZE THEN
layout()
render()
END IF
IF msg_t = VML_MSG_WINDOWCLOSE THEN
done = 1
END IF
END IF
END IF
WEND
' ⚠ **不调 `ui_win_close()`**：桌面脚手架的 `--frame` 是"退出后合成一张图"，
' ⚠ **`ui_win_close()` is not called**: the desktop scaffold's `--frame` composites the picture **after** the program exits,
' 而关窗会把整个场景置空 ⇒ 那一刀就没有场景可取、只会打一行"没有可导出的帧"。
' and closing the window nulls the whole scene => that snapshot has nothing left to take.
' C 版的四份都是同样的写法（循环结束直接返回）。
' All four C versions do exactly the same (the loop ends and the program returns).
PRINT "calendar done (BASIC)"