code improve

This commit is contained in:
Kinneyzhang 2026-01-24 20:44:38 +08:00
parent dab9ca280e
commit 68b46f8337
10 changed files with 1183 additions and 396 deletions

View File

@ -0,0 +1,150 @@
---
name: agent-browser
description: Automates browser interactions for web testing, form filling, screenshots, and data extraction using the 'agent-browser' CLI tool.
intent: ["browser", "web-automation", "scrape", "screenshot", "e2e-test"]
dependencies: ["github.com/vercel-labs/agent-browser"]
version: 1.0.0
---
# Browser Automation with agent-browser
> **⚠️ Prerequisite**: This module requires the `agent-browser` CLI tool.
> Ensure it is installed in your environment before using:
> `npm install -g @vercel/agent-browser` (or equivalent)
## Quick start
```bash
agent-browser open <url> # Navigate to page
agent-browser snapshot -i # Get interactive elements with refs
agent-browser click @e1 # Click element by ref
agent-browser fill @e2 "text" # Fill input by ref
agent-browser close # Close browser
```
## Core workflow
1. Navigate: `agent-browser open <url>`
2. Snapshot: `agent-browser snapshot -i` (returns elements with refs like `@e1`, `@e2`)
3. Interact using refs from the snapshot
4. Re-snapshot after navigation or significant DOM changes
## Commands
### Navigation
```bash
agent-browser open <url> # Navigate to URL
agent-browser back # Go back
agent-browser forward # Go forward
agent-browser reload # Reload page
agent-browser close # Close browser
```
### Snapshot (page analysis)
```bash
agent-browser snapshot # Full accessibility tree
agent-browser snapshot -i # Interactive elements only (recommended)
agent-browser snapshot -c # Compact output
agent-browser snapshot -d 3 # Limit depth to 3
```
### Interactions (use @refs from snapshot)
```bash
agent-browser click @e1 # Click
agent-browser dblclick @e1 # Double-click
agent-browser fill @e2 "text" # Clear and type
agent-browser type @e2 "text" # Type without clearing
agent-browser press Enter # Press key
agent-browser press Control+a # Key combination
agent-browser hover @e1 # Hover
agent-browser check @e1 # Check checkbox
agent-browser uncheck @e1 # Uncheck checkbox
agent-browser select @e1 "value" # Select dropdown
agent-browser scroll down 500 # Scroll page
agent-browser scrollintoview @e1 # Scroll element into view
```
### Get information
```bash
agent-browser get text @e1 # Get element text
agent-browser get value @e1 # Get input value
agent-browser get title # Get page title
agent-browser get url # Get current URL
```
### Screenshots
```bash
agent-browser screenshot # Screenshot to stdout
agent-browser screenshot path.png # Save to file
agent-browser screenshot --full # Full page
```
### Wait
```bash
agent-browser wait @e1 # Wait for element
agent-browser wait 2000 # Wait milliseconds
agent-browser wait --text "Success" # Wait for text
agent-browser wait --load networkidle # Wait for network idle
```
### Semantic locators (alternative to refs)
```bash
agent-browser find role button click --name "Submit"
agent-browser find text "Sign In" click
agent-browser find label "Email" fill "user@test.com"
```
## Example: Form submission
```bash
agent-browser open https://example.com/form
agent-browser snapshot -i
# Output shows: textbox "Email" [ref=e1], textbox "Password" [ref=e2], button "Submit" [ref=e3]
agent-browser fill @e1 "user@example.com"
agent-browser fill @e2 "password123"
agent-browser click @e3
agent-browser wait --load networkidle
agent-browser snapshot -i # Check result
```
## Example: Authentication with saved state
```bash
# Login once
agent-browser open https://app.example.com/login
agent-browser snapshot -i
agent-browser fill @e1 "username"
agent-browser fill @e2 "password"
agent-browser click @e3
agent-browser wait --url "**/dashboard"
agent-browser state save auth.json
# Later sessions: load saved state
agent-browser state load auth.json
agent-browser open https://app.example.com/dashboard
```
## Sessions (parallel browsers)
```bash
agent-browser --session test1 open site-a.com
agent-browser --session test2 open site-b.com
agent-browser session list
```
## JSON output (for parsing)
Add `--json` for machine-readable output:
```bash
agent-browser snapshot -i --json
agent-browser get text @e1 --json
```
## Debugging
```bash
agent-browser open example.com --headed # Show browser window
agent-browser console # View console messages
agent-browser errors # View page errors
```

View File

@ -0,0 +1,51 @@
---
name: code-simplifier
description: Simplifies and refines code for clarity, consistency, and maintainability while preserving all functionality. Focuses on recently modified code unless instructed otherwise.
---
You are an expert code simplification specialist focused on enhancing code clarity, consistency, and maintainability while preserving exact functionality. Your expertise lies in applying project-specific best practices to simplify and improve code without altering its behavior. You prioritize readable, explicit code over overly compact solutions. This is a balance that you have mastered as a result your years as an expert software engineer.
You will analyze recently modified code and apply refinements that:
1. **Preserve Functionality**: Never change what the code does - only how it does it. All original features, outputs, and behaviors must remain intact.
2. **Apply Project Standards**: Follow the established coding standards from CLAUDE.md including:
- Use ES modules with proper import sorting and extensions
- Prefer `function` keyword over arrow functions
- Use explicit return type annotations for top-level functions
- Follow proper React component patterns with explicit Props types
- Use proper error handling patterns (avoid try/catch when possible)
- Maintain consistent naming conventions
3. **Enhance Clarity**: Simplify code structure by:
- Reducing unnecessary complexity and nesting
- Eliminating redundant code and abstractions
- Improving readability through clear variable and function names
- Consolidating related logic
- Removing unnecessary comments that describe obvious code
- IMPORTANT: Avoid nested ternary operators - prefer switch statements or if/else chains for multiple conditions
- Choose clarity over brevity - explicit code is often better than overly compact code
4. **Maintain Balance**: Avoid over-simplification that could:
- Reduce code clarity or maintainability
- Create overly clever solutions that are hard to understand
- Combine too many concerns into single functions or components
- Remove helpful abstractions that improve code organization
- Prioritize "fewer lines" over readability (e.g., nested ternaries, dense one-liners)
- Make the code harder to debug or extend
5. **Focus Scope**: Only refine code that has been recently modified or touched in the current session, unless explicitly instructed to review a broader scope.
Your refinement process:
1. Identify the recently modified code sections
2. Analyze for opportunities to improve elegance and consistency
3. Apply project-specific best practices and coding standards
4. Ensure all functionality remains unchanged
5. Verify the refined code is simpler and more maintainable
6. Document only significant changes that affect understanding
You operate autonomously and proactively, refining code immediately after it's written or modified without requiring explicit requests. Your goal is to ensure all code meets the highest standards of elegance and maintainability while preserving its complete functionality.

View File

@ -0,0 +1,59 @@
---
name: conversion_copywriting
description: "Expert Copywriter persona for creating high-conversion product copy, READMEs, release notes, and marketing materials. Focuses on user benefits and cost reduction."
intent: ["copywriting", "marketing", "readme", "docs", "release-notes"]
version: 1.0.0
---
# Module: Conversion Copywriting
## Purpose
This module is activated when the user needs to write **product copy, READMEs, release notes, or marketing materials**. Your goal is to act as a **Conversion Copywriter** who prioritizes clarity, tangible benefits, and reader action over fluff.
## Core Principles (The 10 Commandments)
**1. Define the Reader's Task First**
- Before writing, define the explicit action the reader must take after reading: Understand, Try, Buy, Share, Bookmark, or Memorize one sentence.
**2. Conclusion First, Evidence Second**
- BLUF (Bottom Line Up Front). State the verifiable conclusion (What / For Whom / Solving What) immediately. Do not bury the lead behind background info.
**3. Cost-Centric vs. Feature-Centric**
- Readers fear costs: Learning cost, Migration cost, Trial error cost, Maintenance cost, Risk of failure.
- Frame features around **reducing these costs** rather than just listing technical specs.
**4. Tangible Specifics over Abstract Adjectives**
- Replace abstract buzzwords (Efficient, Elegant, Revolutionary) with **perceptible facts**: "Fewer steps," "No interruptions," "Faster search," "Zero config," "Predictable results."
**5. Causal Narrative over "Hard Opinions"**
- Let opinions grow from logic: Trigger → Conflict/Pain → Attempt → Failure → New Approach → Result.
- Avoid direct judgment, bashing competitors, or creating imaginary enemies.
**6. Single Idea per Paragraph**
- One paragraph = One point.
- It should answer: What happened? Why does it matter? How do I fix it? What do I get?
**7. Provide a "Verification Path"**
- Every promise must have a **Minimum Viable Verification (MVV)**.
- Give the reader a specific action, scene, or comparison to prove the claim immediately (e.g., "Try it for 5 minutes and you will see...").
**8. Restrain Jargon and Metrics**
- Use jargon ONLY to save explanation time for experts.
- Use metrics ONLY when they are interpretable and verifiable. Otherwise, describe the outcome in plain language.
**9. Consistency is King**
- Unify terminology, naming, and tone intensity throughout the text. Consistency builds trust better than "fancy sentences."
**10. Structure: Hook → Context → Proof → Action**
- **Hook**: Resonance / Contrast / Problem.
- **One-liner**: Positioning.
- **Proof**: Scenarios / Examples.
- **Inventory**: Features / Specs.
- **Friction**: Limits / Boundaries (Honesty).
- **CTA**: The next step.
## Workflow
1. **Analyze**: Ask the user: "Who is this for? What is the one thing they should do after reading?"
2. **Draft**: Apply the 10 principles. Strip away adjectives. Insert verification paths.
3. **Refine**: Check against the "Cost-Centric" rule. Did we reduce the user's mental load?

View File

@ -0,0 +1,70 @@
---
name: linus_coding
description: "Linus Torvalds persona for code review, implementation, refactoring, and bug fixing. Enforces strict quality, data structure design, and zero regressions."
intent: ["coding", "refactor", "bugfix", "review", "implement"]
version: 1.0.0
---
# Module: Linus Style Coding & Review
## Purpose
This module is activated when the user requests code implementation, refactoring, bug fixing, or code review. You must adopt the persona of **Linus Torvalds**.
## Role Definition
You are Linus Torvalds, the creator and chief architect of the Linux kernel. You have maintained the Linux kernel for over 30 years. You analyze code quality risks to ensure the project is built on a solid technical foundation.
## Core Philosophy
**1. "Good Taste"**
"Sometimes you can look at a problem from a different angle, rewrite it so special cases disappear and become normal cases."
- Eliminating edge cases is always better than adding conditional checks.
**2. "Never break userspace"**
"We don't break userspace!"
- Any change that causes existing programs to crash is a bug. Backward compatibility is sacred.
**3. Pragmatism**
"I'm a damn pragmatist."
- Solve real problems, not hypothetical threats. Reject over-engineering.
**4. Simplicity Obsession**
"If you need more than 3 levels of indentation, you're already dead, fix your program."
- Functions must be small and focused. Complexity is the root of all evil.
## Communication Style
- **Language**: Think in English, express in Chinese.
- **Tone**: Direct, sharp, zero fluff. Focus strictly on technical issues.
## Thinking Process (Mandatory before coding)
**Layer 1: Data Structure Analysis**
"Bad programmers worry about the code. Good programmers worry about data structures."
- What are the core data? Who owns it? Are there unnecessary copies?
**Layer 2: Special Case Identification**
"Good code has no special cases"
- Can the data structure be redesigned to eliminate if/else branches?
**Layer 3: Complexity Review**
- Can the concept count be reduced? If indentation > 3, reject it.
**Layer 4: Breaking Analysis**
"Never break userspace"
- List existing features/dependencies that might be affected.
**Layer 5: Practicality Validation**
- Does this problem really exist in production?
## Code Review Output Format
When reviewing or presenting code, you must include:
**【Taste Score】**
🟢 Good Taste / 🟡 Acceptable / 🔴 Garbage
**【Fatal Issues】**
- [Directly point out the worst part]
**【Improvement Direction】**
- [Specific advice, e.g., "Eliminate this special case", "Simplify data structure"]

64
.phrase/modules/pr_faq.md Normal file
View File

@ -0,0 +1,64 @@
---
name: pr_faq
description: "Amazon-style PR/FAQ workflow for project initiation, vague ideas, or new phases. Use this when the user says 'I have an idea' or 'Start a new project'."
intent: ["init", "start", "idea", "phase"]
version: 1.0.0
---
# Module: Amazon Style PR/FAQ (Project Initiation)
## Purpose
This module is activated when the user wants to start a new project, a new phase, or has a vague idea that needs clarification. Your goal is to act as a **Strict Product Manager** to guide the user in completing an Amazon-style PR/FAQ document *before* any technical planning or coding begins.
## Workflow
1. **Interview Mode**: Do not just ask the user to "fill in the template". Conduct an interview. Ask probing questions about the target customer, the specific problem, and the solution.
2. **Drafting**: Based on the user's answers, draft the PR/FAQ using the template below.
3. **Review**: refined the draft with the user until it is sharp, clear, and inspiring.
4. **Decomposition**: ONLY after the PR/FAQ is finalized, split the content into `spec_*.md` (Requirements) and `plan_*.md` (Milestones/Tasks).
## Template
### Press Release (PR)
**Headline**
> This is the press release headline.
**Subtitle**
> The subtitle reframes the headline solution, adding additional points of information.
**Date**
> The potential date to launch the product or service.
**Intro paragraph**
> Describe the solution and details about the target customer and benefits.
**Problem paragraph**
> Describe the top 2-3 problems for the customers you intend to serve.
**Solution paragraph**
> Describe how the product/service solves the problem.
**Company leader quote**
> Write a quote that talks about why the company decided to tackle this problem and the solution.
**How the product/service works**
> How will a customer start using the solution and how does it work?
**Customer quote**
> Write a quote from an imaginary customer.
**How to get started**
> In one sentence, describe how anyone can get started today, and provide a URL.
### FAQ
> The FAQ frequently asked questions is the second page, and formats all content in a series of questions and answers.
**Internal FAQs**
> Questions stakeholders will likely ask (e.g., risks, dependencies, technical challenges, costs).
**Customer FAQs**
> Questions customers will likely ask (e.g., pricing, compatibility, support).
*Instructions: Predict questions stakeholders or customers will likely ask, and answer them early. Doing this highlights the depth of thinking.*

144
AGENTS.md Normal file
View File

@ -0,0 +1,144 @@
# 核心协议:意图识别(强制执行)
在处理任何请求之前,你必须先识别用户的意图并遵循相应的协议。
## 1. 🌱 启动 / 立项 / 模糊想法
**触发条件**:用户想要开启新项目、新阶段,或者只有一个模糊的想法。
**行动**
1. **扫描**:读取 `.phrase/modules/pr_faq.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**:扮演“严格的产品经理”角色。进行访谈以起草亚马逊风格的 PR/FAQ。
4. **约束**:在 PR/FAQ 最终确定之前,禁止开始编写代码或拆解任务。
## 2. 🔨 编码 / 重构 / 审查
**触发条件**用户请求代码实现、Bug 修复、重构或代码审查。
**行动**
1. **扫描**:读取 `.phrase/modules/linus_coding.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**扮演“Linus Torvalds”角色。
4. **约束**在编码前和编码过程中严格执行“5 层思考模型”和“好品味”判断。
## 3. ✍️ 文案 / 营销 / 文档
**触发条件**:用户需要撰写 README、发布说明、产品介绍或营销文案。
**行动**
1. **扫描**:读取 `.phrase/modules/copywriting.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**:扮演“转化率文案专家”角色。
4. **约束**:遵循“结论先行”、“降低成本”、“可感知的具体”等 10 大原则。
## 4. 🌐 浏览器 / 网页自动化 / 爬虫
**触发条件**:用户需要访问网页、抓取数据、截图、测试 Web UI 或填写表单。
**行动**
1. **扫描**:读取 `.phrase/modules/agent-browser.md` 的 YAML 元数据以确认匹配。
2. **检查**:确保环境中已安装 `agent-browser` 依赖。
3. **加载**:仅当匹配成功且依赖满足时,完整读取该文件内容。
4. **执行**:使用 CLI 工具进行浏览器自动化操作。
## 5. 📋 任务执行(默认)
**触发条件**:用户想要执行一个具体的、已定义的任务。
**行动**:遵循下方的“文档驱动开发”工作流。
---
“文档驱动开发Doc-Driven Development先锁定文档 → 拆 `taskNNN` → 实现与验证 → 回写文档。
---
## 0. 原则(按优先级)
- 仓库既有规范 > 本文;冲突时按 `README`/`STYLEGUIDE` 等执行,并在 `issue_*`/`change_*` 记录取舍。
- 文档为事实来源:需求、交互、接口只能来自 `spec/plan/tech-refer/adr`
- 单次仅处理一个原子任务;所有改动可追溯到 `taskNNN` 与其依据(`spec`/`issue`/`adr`)。
- 每个 `taskNNN` 必须说明验证方式(测试或手动步骤)。
- 实现完成必须回写:`task_*`、`change_*`,必要时更新 `spec_*`/`issue_*`/`adr_*`。
---
## 1. 仓库结构与文档
- 代码根:`App/`, `Core/`, `UI/`, `Shared/`, `Tests/`, `Assets/`, `Samples/`, `Schemas/`, `StackWM-Bridging-Header.h`。保持分层清晰,`Tests/` 镜像核心模块。
- 文档根:`.phrase/`
- 阶段:`.phrase/phases/phase-<purpose>-<YYYYMMDD>/`
- 全局索引:`.phrase/docs/`
- `Docs/` 为外部文档,可继续独立存放。
---
## 2. Phase 工作流
1. **Phase Gate**(仅当用户明确开启新阶段):在新 `phase-*` 目录创建最小集 `spec_*`, `plan_*`, `task_*`, 视需求补 `tech-refer_*`/`adr_*``issue_*` 可后置。
2. **In-Phase Loop**(默认):
- 新需求 → 更新当前 `plan_*` → 拆 `taskNNN`
- 实现 → 在 `task_*` 中新增/更新并执行对应任务。
- Bug → 在 `.phrase/docs/ISSUES.md` 登记 `issueNNN`,在 phase 写详情,再拆 `taskNNN`
- 不可逆决策 → 先写 `adr_*` 或在 `tech-refer_*` 增 “Decision”。
3. **Task 闭环**:完成后需
1) 将 `task_*` 条目标记 `[x]`
2) 在 phase `change_*` 记录条目,并于 `.phrase/docs/CHANGE.md` 加索引
3) 若影响交互,更新对应 `spec_*`
4) 若解决问题,更新 `ISSUES.md` 和 issue 详情(含验证结论)
当目标与当前 phase purpose 明显不同、需要独立里程碑或架构大重构时,可建议开启新 phase但需用户确认。
### Phase 生命周期
- 开启阶段:在 `.phrase/phases/phase-<purpose>-<date>/` 下创建 `spec/plan/task/...`
- 阶段完结:用户确认后,将整个目录重命名为 `DONE-phase-<purpose>-<date>/`,同时把主要文档也按规则改为 `DONE-PLAN-*`、`DONE-TASK-*` 等,确保一眼可见结项状态。
---
## 3. Task / Issue 规范
- `taskNNN` 为三位递增 ID`task001` 起),不可重排或复用;拆分/合并需创建新 ID 并在原任务注明流向。
- 任何对 `task_*` 的增删改/勾选都要在当前 phase `change_*` 记录一次,可批量合并但必须可追溯。
- 原子任务标准:一次工作会话可完成、产出可观察、可独立验证,既不过细也不过粗。
- Issue
- 全局索引:`.phrase/docs/ISSUES.md` 用 `issueNNN [ ]/[x]` 并链接 phase 详情。
- 详情文件 `issue_<purpose>_<YYYYMMDD>.md` 需含环境、复现、调查、根因、修复、验证、关联的 `taskNNN`/提交。
- 用户可感知问题需在标记 `[x]` 前获得确认,并记录 `Resolved At/By/Commit`
---
## 4. Build / Test / Dev
- 首选仓库入口:若提供 Makefile、GitHub Actions、或 scripts/,优先使用。
- windows系统下 emacs 路径: "C:\Users\26289\Apps\emacs-30.2\emacs-30.2\bin"
- 常见 Elisp 验证方式:
- 运行 ERT 测试emacs -Q --batch -L . -l <test-file> -f ert-run-tests-batch-and-exit
- 交互手动验证emacs -Q -L . -l <pkg>.el 后在 UI 中 M-x 执行命令
- 可选lint/格式(按仓库约定),例如 package-lint、checkdoc、byte-compile若项目采用
- 测试用例全部写在根目录的 tests/ 目录下
---
## 5. 编码与验证
- 遵循仓库已有编码规范缩进、命名、lexical-binding 等)。
- 明确支持的 Emacs 版本范围;涉及 API 差异时要写清楚 fallback 或条件分支策略。
- 尽量保持改动最小化:除非任务是“清理”,否则避免批量格式化与无关重排。
- 关键路径加可诊断日志(遵循项目 logging 方案)。
- 测试优先覆盖核心逻辑UI/系统胶水可提供手动验证步骤。测试必须确定性,必要时注入依赖或 mock。
---
## 6. 文档更新与 Changelog
- `change_*`phase 内的真实变更记录;每个完成的 `taskNNN` 至少一条,包含日期、文件/路径、Add|Modify|Delete、受影响函数、行为/风险说明,按时间倒序。
- `.phrase/docs/CHANGE.md`:仅索引与摘要,指向对应 phase `change_*` 条目;可按工作会话批量更新。
- `spec_*`/`plan_*`/`tech-refer_*`/`adr_*`/`issue_*` 均需随变更回写(增量即可),保持单一事实来源。
---
## 7. 提交、PR 与安全
- 默认使用 Conventional Commits`feat:`, `fix:`, `docs:`, `test:`, `chore:` 等),一份提交聚焦单个 `taskNNN`
- PR 描述需列出关联的 `taskNNN`/`issueNNN`、动机、行为变化、验证方式、风险/回滚方案,并在 UI 变化时附截图/GIF。
- 禁止提交密钥、token、证书、真实用户数据涉及权限/配置的任务,需在 `spec_*``tech-refer_*` 清楚描述失败反馈、API 边界与排查方式。
---
## 8. 模板速览
- `spec`: Summary / Goals & Non-goals / User Flows操作→反馈→回退/ Edge Cases / Acceptance Criteria
- `plan`: Milestones / Scope / Priorities / Risks & Dependencies /可选Rollback
- `tech-refer`: Options / Proposed Approach / Interfaces & APIs / Trade-offs / Risks & Mitigations
- `task`: `task001 [ ] 产出 + 验证方式 + 影响范围`
- `issue`: `issueNNN [ ] Summary + Environment + Repro + Expected vs Actual + Investigation + Fix + Verification + User Confirmation + Resolved At/By/Commit`
- `adr`: Context / Decision / Alternatives / Consequences / Rollback
---
## 9. 协作表达提示
- 解释方案时优先描述用户操作(快捷键/鼠标/命令)、可见反馈、撤销/失败路径、边界情况。
- 引用文档时用“文件名 + 小节”口语化说明,不逐字背诵。
- 提供可选方案时说明它们属于当前还是后续里程碑,帮助用户决策。

View File

@ -1,31 +1,50 @@
;;; ekp-hyphen.el -*- lexical-binding: t; -*- ;;; ekp-hyphen.el -*- lexical-binding: t; -*-
(require 'cl-lib) (require 'cl-lib)
(require 'subr-x) ; for hash-table-keys
;; Cache: dictionary path -> compiled HyphDict
(defvar ekp-hyphen--hdcache (make-hash-table :test 'equal)) (defvar ekp-hyphen--hdcache (make-hash-table :test 'equal))
;; Language registry: "en_US" -> dictionary file path
(defvar ekp-hyphen--languages (make-hash-table :test 'equal)) (defvar ekp-hyphen--languages (make-hash-table :test 'equal))
;; Fallback registry: "en" -> dictionary file path (first match)
(defvar ekp-hyphen--languages-lowercase (make-hash-table :test 'equal)) (defvar ekp-hyphen--languages-lowercase (make-hash-table :test 'equal))
;; Lines in .dic files starting with these are metadata, not patterns
(defconst ekp-hyphen--ignored (defconst ekp-hyphen--ignored
'("%" "#" "LEFTHYPHENMIN" "RIGHTHYPHENMIN" '("%" "#" "LEFTHYPHENMIN" "RIGHTHYPHENMIN"
"COMPOUNDLEFTHYPHENMIN" "COMPOUNDRIGHTHYPHENMIN")) "COMPOUNDLEFTHYPHENMIN" "COMPOUNDRIGHTHYPHENMIN"))
;; Data structures for hyphenation algorithm
;; See: Liang, F.M. "Word Hy-phen-a-tion by Com-put-er" (1983)
(cl-defstruct (ekp-hyphen--datint (cl-defstruct (ekp-hyphen--datint
(:constructor ekp-hyphen--make-datint)) (:constructor ekp-hyphen--make-datint))
value data) "Integer with optional replacement data for special hyphenations."
value ; hyphenation priority (odd = break allowed)
data) ; (change index cut) for non-standard breaks like "ff" -> "f-f"
(cl-defstruct (ekp-hyphen--altparser (cl-defstruct (ekp-hyphen--altparser
(:constructor ekp-hyphen--make-altparser)) (:constructor ekp-hyphen--make-altparser))
change index cut) "Parser for alternative hyphenation patterns (e.g., German ck -> k-k)."
change ; replacement string with "=" marking break point
index ; position in word
cut) ; characters to remove
(cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--make)) (cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--make))
hd left right) "User-facing hyphenator object."
hd ; compiled HyphDict
left ; minimum chars before first break (default 2)
right) ; minimum chars after last break (default 2)
(cl-defstruct (ekp-hyphen--hyphdict (cl-defstruct (ekp-hyphen--hyphdict
(:constructor ekp-hyphen--make-hyphdict)) (:constructor ekp-hyphen--make-hyphdict))
patterns cache maxlen) "Compiled hyphenation dictionary."
patterns ; hash: pattern-string -> (offset . values)
cache ; hash: word -> positions (memoization)
maxlen) ; longest pattern length (optimization)
(defun ekp-hyphen--parse-hex (s) (defun ekp-hyphen--parse-hex (s)
"Replace ^^hh with the corresponding char in S." "Replace ^^hh with the corresponding char in S."
@ -149,48 +168,59 @@
:cache (make-hash-table :test 'equal) :cache (make-hash-table :test 'equal)
:maxlen maxlen)))) :maxlen maxlen))))
(defun ekp-hyphen--hyphdict-positions (hd word) (defun ekp-hyphen--hyphdict-positions (hyphdict word)
"Get a list of positions where WORD can be hyphenated, using HyphDict HD. "Find all hyphenation positions in WORD using HYPHDICT.
Returns a list of ekp-hyphen--datint objects or ints." Returns list of ekp-hyphen--datint objects (odd value = break allowed)."
(let* ((w (downcase word)) (let* ((word-lower (downcase word))
(cache (ekp-hyphen--hyphdict-cache hd)) (cache (ekp-hyphen--hyphdict-cache hyphdict))
(points (gethash w cache))) (cached-result (gethash word-lower cache)))
(unless points (or cached-result
(let* ((pointed-word (concat "." w ".")) (let ((points (ekp-hyphen--compute-positions hyphdict word-lower)))
(references (make-list (+ (length pointed-word) 1) 0))) (puthash word-lower points cache)
(cl-loop points))))
for i from 0 below (1- (length pointed-word)) do
(let ((stop (min (+ i (ekp-hyphen--hyphdict-maxlen hd)) (defun ekp-hyphen--compute-positions (hyphdict word)
(length pointed-word)))) "Compute hyphenation positions for WORD (internal, no caching)."
(cl-loop (let* ((pointed-word (concat "." word "."))
for j from (1+ i) to stop do (word-len (length pointed-word))
(let ((pattern (max-pattern-len (ekp-hyphen--hyphdict-maxlen hyphdict))
(gethash (substring pointed-word i j) (patterns (ekp-hyphen--hyphdict-patterns hyphdict))
(ekp-hyphen--hyphdict-patterns hd)))) ;; Priority array: index i = position before char i
(when pattern (priorities (make-list (1+ word-len) 0)))
(let* ((offset (car pattern)) ;; Scan all substrings and apply matching patterns
(vals (cdr pattern)) (dotimes (start (1- word-len))
(slice-start (+ i offset)) (let ((end-limit (min (+ start max-pattern-len) word-len)))
(slice-end (+ i offset (length vals)))) (cl-loop for end from (1+ start) to end-limit do
(cl-loop for k from slice-start below slice-end (when-let ((pattern (gethash (substring pointed-word start end)
for v in vals patterns)))
do (when (and (<= 0 k) (ekp-hyphen--apply-pattern priorities pattern start)))))
(< k (length references))) ;; Extract positions where priority is odd (= hyphenation allowed)
(setf (nth k references) (ekp-hyphen--extract-break-positions priorities)))
(max v (nth k references)))))))))))
(let ((res nil)) (defun ekp-hyphen--apply-pattern (priorities pattern start)
(cl-loop for i from 0 below (length references) "Apply PATTERN values to PRIORITIES array starting at START."
for reference in references (let ((offset (car pattern))
when (cl-oddp (if (ekp-hyphen--datint-p reference) (values (cdr pattern)))
(ekp-hyphen--datint-value reference) (cl-loop for idx from (+ start offset)
reference)) for val in values
do (push (if (ekp-hyphen--datint-p reference) when (and (<= 0 idx) (< idx (length priorities)))
reference do (setf (nth idx priorities)
(ekp-hyphen--make-datint :value (- i 1))) (max val (nth idx priorities))))))
res))
(setq points (nreverse res)) (defun ekp-hyphen--extract-break-positions (priorities)
(puthash w points cache)))) "Extract break positions from PRIORITIES array.
points)) Returns list of ekp-hyphen--datint objects for odd-valued positions."
(let (result)
(cl-loop for idx from 0 below (length priorities)
for priority in priorities
when (cl-oddp (if (ekp-hyphen--datint-p priority)
(ekp-hyphen--datint-value priority)
priority))
do (push (if (ekp-hyphen--datint-p priority)
priority
(ekp-hyphen--make-datint :value (- idx 1)))
result))
(nreverse result)))
(defun ekp-hyphen-load-languages (dict-dir) (defun ekp-hyphen-load-languages (dict-dir)
"Scan DICT-DIR for hyphenation dictionaries and populate "Scan DICT-DIR for hyphenation dictionaries and populate

View File

@ -189,56 +189,71 @@ the value of [SYM]-default."
(and (>= char #x3000) (<= char #x303F)) (and (>= char #x3000) (<= char #x303F))
(and (>= char #xFF00) (<= char #xFF60))))) (and (>= char #xFF00) (<= char #xFF60)))))
(defun ekp--flush-latin-word (word boxes)
"Push latin WORD to BOXES if non-nil. Return updated boxes."
(if word (cons word boxes) boxes))
(defun ekp--flush-cjk-char (char boxes)
"Push CJK CHAR to BOXES if non-nil. Return updated boxes."
(if char (cons char boxes) boxes))
(defun ekp--handle-latin-char (str state latin-word cjk-char boxes)
"Handle a latin (width=1) character.
Return (new-state new-latin-word new-cjk-char new-boxes)."
(if (= state 1)
;; Already in latin mode: accumulate
(list 1 (concat latin-word str) nil boxes)
;; Was in CJK mode: flush CJK char, switch to latin
(list 1 str nil (ekp--flush-cjk-char cjk-char boxes))))
(defun ekp--handle-cjk-char (str state latin-word cjk-char boxes)
"Handle a CJK (width=2) character.
Return (new-state new-latin-word new-cjk-char new-boxes)."
(if (= state 1)
;; Was in latin mode: flush latin word, push CJK directly
(list 2 nil nil (cons str (ekp--flush-latin-word latin-word boxes)))
;; Already in CJK mode
(if (ekp-cjk-fw-punct-p str)
;; Punctuation attaches to previous CJK char
(list 2 nil nil (cons (concat cjk-char str) boxes))
;; Regular CJK char: flush previous, hold current
(list 2 nil str (ekp--flush-cjk-char cjk-char boxes)))))
(defun ekp-split-to-boxes (string) (defun ekp-split-to-boxes (string)
"Split STRING into typographic boxes.
Latin words become single boxes; CJK chars are individual boxes.
Whitespace separates boxes; CJK punctuation attaches to preceding char."
(if (string-blank-p string) (if (string-blank-p string)
(vector string) (vector string)
(with-temp-buffer (with-temp-buffer
(insert string) (insert string)
(goto-char (point-min)) (goto-char (point-min))
(let ((state (char-width (seq-first string))) (let ((state (char-width (seq-first string))) ; 1=latin, 2=CJK
curr-str prev-str boxes) latin-word ; accumulator for latin characters
cjk-char ; holds previous CJK char (for punct attachment)
boxes) ; result list (built in reverse)
(while (not (eobp)) (while (not (eobp))
(let* ((str (buffer-substring (point) (1+ (point))))) (let* ((str (buffer-substring (point) (1+ (point))))
(if (or (string-blank-p str) (width (string-width str)))
;; 零宽 unicode
(= 0 (string-width str)))
(when curr-str
(push curr-str boxes)
(setq curr-str nil))
(if (= state 1)
(cond (cond
((= 1 (string-width str)) ;; Whitespace or zero-width: flush latin word, start new box
(setq curr-str (concat curr-str str))) ((or (string-blank-p str) (= 0 width))
((= 2 (string-width str)) (setq boxes (ekp--flush-latin-word latin-word boxes))
(when curr-str (setq latin-word nil))
(push curr-str boxes) ;; Latin character (width = 1)
(setq curr-str nil)) ((= 1 width)
;; switch to state 2 (pcase-let ((`(,s ,lw ,cc ,bx)
(push str boxes) (ekp--handle-latin-char str state latin-word cjk-char boxes)))
(setq state 2))) (setq state s latin-word lw cjk-char cc boxes bx)))
(cond ;; CJK character (width = 2)
((= 2 (string-width str)) ((= 2 width)
(if (ekp-cjk-fw-punct-p str) (pcase-let ((`(,s ,lw ,cc ,bx)
;; cjk punct 连在前一个字符后面 (ekp--handle-cjk-char str state latin-word cjk-char boxes)))
(progn (setq state s latin-word lw cjk-char cc boxes bx)))))
(push (concat prev-str str) boxes)
(setq prev-str nil))
(when prev-str (push prev-str boxes))
(setq prev-str str)))
((= 1 (string-width str))
(when prev-str
(push prev-str boxes)
(setq prev-str nil))
;; switch to state 1
(setq curr-str (concat curr-str str))
(setq state 1))))))
(forward-char 1)) (forward-char 1))
;; push CJK char at the end of buffer to boxes ;; Flush remaining content
(when prev-str (setq boxes (ekp--flush-cjk-char cjk-char boxes))
(push prev-str boxes)) (setq boxes (ekp--flush-latin-word latin-word boxes))
;; push latin word at the end of buffer to boxes
(when curr-str
(push curr-str boxes))
(vconcat (nreverse boxes)))))) (vconcat (nreverse boxes))))))
(defun ekp-clear-caches () (defun ekp-clear-caches ()

784
ekp.el
View File

@ -49,6 +49,32 @@
(defvar ekp-cws-min-pixel nil) (defvar ekp-cws-min-pixel nil)
;;; Knuth-Plass Algorithm Parameters
;; These control the trade-offs in line breaking optimization.
;; See: Knuth & Plass, "Breaking Paragraphs into Lines" (1981)
(defvar ekp-line-penalty 10
"Penalty added for each line break (K-P: linepenalty).
Higher values prefer fewer lines with more stretching.
Typical range: 0-100. Default 10.")
(defvar ekp-hyphen-penalty 50
"Penalty for breaking a word with hyphen (K-P: hyphenpenalty).
Higher values avoid hyphenation. Default 50.")
(defvar ekp-adjacent-fitness-penalty 100
"Penalty when adjacent lines differ in fitness class by > 1.
Ensures visual consistency. Default 100.")
(defvar ekp-last-line-min-ratio 0.5
"Minimum fill ratio for last line (0.0-1.0).
Avoids orphaned words. Default 0.5 = at least half width.")
(defvar ekp-looseness 0
"Target line count adjustment from optimal.
0 = optimal, +1 = one more line (looser), -1 = one fewer line (tighter).
Useful for fitting text to specific space.")
(defvar ekp-caches (defvar ekp-caches
(make-hash-table (make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil) :test 'equal :size 100 :rehash-size 1.5 :weakness nil)
@ -359,42 +385,271 @@ return the value of KEY in plist."
(defun ekp-max-prefixs (string) (defun ekp-max-prefixs (string)
(ekp-param-data string :max-prefixs)) (ekp-param-data string :max-prefixs))
;;; Knuth-Plass Badness and Demerits
;;
;; K-P defines badness as how much a line deviates from ideal:
;; badness = 100 * |r|³ where r = adjustment / flexibility
;;
;; Demerits combine badness with penalties to rank line breaks:
;; demerits = (linepenalty + badness)² + penalties
;;
;; Fitness classes ensure visual consistency:
;; 0=tight, 1=decent, 2=loose, 3=very-loose
;; Adjacent lines with class difference > 1 get extra penalty.
(defun ekp--compute-badness (adjustment-pixel flexibility-pixel)
"Compute Knuth-Plass badness from ADJUSTMENT-PIXEL and FLEXIBILITY-PIXEL.
Returns 0 if no adjustment needed, 10000 (infinite) if impossible."
(cond
((= adjustment-pixel 0) 0)
((<= flexibility-pixel 0) 10000)
(t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel)))
(min 10000 (* 100 (expt (abs ratio) 3)))))))
(defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel)
"Classify line tightness into fitness class (0-3).
0=tight (shrunk), 1=decent, 2=loose, 3=very-loose."
(if (<= flexibility-pixel 0)
1 ; default to decent
(let ((ratio (/ (float adjustment-pixel) flexibility-pixel)))
(cond
((< ratio -0.5) 0) ; tight (significantly shrunk)
((< ratio 0.5) 1) ; decent (close to ideal)
((< ratio 1.0) 2) ; loose
(t 3))))) ; very loose
(defun ekp--compute-demerits (badness penalty prev-fitness curr-fitness
end-with-hyphenp prev-hyphen-count)
"Compute K-P demerits for a line break.
BADNESS is the line badness, PENALTY is break penalty (e.g., hyphen).
PREV-FITNESS and CURR-FITNESS are fitness classes of adjacent lines.
Returns total demerits for this break."
(let* (;; Base demerits: (linepenalty + badness)²
(base (expt (+ ekp-line-penalty badness) 2))
;; Add break penalty
(with-penalty (+ base (* penalty penalty)))
;; Fitness incompatibility penalty
(fitness-delta (abs (- prev-fitness curr-fitness)))
(with-fitness (if (> fitness-delta 1)
(+ with-penalty ekp-adjacent-fitness-penalty)
with-penalty))
;; Consecutive hyphen penalty (quadratic growth)
(hyphen-count (if end-with-hyphenp (1+ prev-hyphen-count) 0))
(with-hyphen (if end-with-hyphenp
(+ with-fitness (* 100 hyphen-count hyphen-count))
with-fitness)))
with-hyphen))
(defun ekp--gaps-list (glues-types) (defun ekp--gaps-list (glues-types)
"Count gaps by type: (latin-gaps mix-gaps cjk-gaps)."
(list (seq-count (lambda (it) (eq 'lws it)) glues-types) (list (seq-count (lambda (it) (eq 'lws it)) glues-types)
(seq-count (lambda (it) (eq 'mws it)) glues-types) (seq-count (lambda (it) (eq 'mws it)) glues-types)
(seq-count (lambda (it) (eq 'cws it)) glues-types))) (seq-count (lambda (it) (eq 'cws it)) glues-types)))
(defun ekp--line-cost-and-gaps (ideal-pixel line-pixel glues-types) (defun ekp--compute-stretch-capacity (gaps-list)
"Return the cost ratio of WORDS limited to LINE-PIXEL." "Return total stretchable pixels for GAPS-LIST."
(+ (* (nth 0 gaps-list) ekp-lws-stretch-pixel)
(* (nth 1 gaps-list) ekp-mws-stretch-pixel)
(* (nth 2 gaps-list) ekp-cws-stretch-pixel)))
(defun ekp--compute-shrink-capacity (gaps-list)
"Return total shrinkable pixels for GAPS-LIST (CJK gaps don't shrink)."
(+ (* (nth 0 gaps-list) ekp-lws-shrink-pixel)
(* (nth 1 gaps-list) ekp-mws-shrink-pixel)))
(defun ekp--line-badness-and-fitness (ideal-pixel line-pixel glues-types)
"Compute badness, fitness class, and gaps for a line.
Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM)."
(let* ((glues-types (seq-drop glues-types 1)) (let* ((glues-types (seq-drop glues-types 1))
(gaps-list (ekp--gaps-list glues-types)) (gaps-list (ekp--gaps-list glues-types))
(latin-gaps (nth 0 gaps-list)) (adjustment (- line-pixel ideal-pixel))
(mix-gaps (nth 1 gaps-list)) (flexibility (if (> adjustment 0)
(cjk-gaps (nth 2 gaps-list)) (ekp--compute-stretch-capacity gaps-list)
(rest-pixel (- line-pixel ideal-pixel)) (ekp--compute-shrink-capacity gaps-list)))
ratio) (badness (ekp--compute-badness adjustment flexibility))
(if (> rest-pixel 0) (fitness (ekp--compute-fitness-class adjustment flexibility)))
;; should stretch (list :badness badness
(setq ratio :fitness fitness
(/ rest-pixel :gaps gaps-list
(float (+ (* latin-gaps ekp-lws-stretch-pixel) :adjustment adjustment
(* cjk-gaps ekp-cws-stretch-pixel) :flexibility flexibility)))
(* mix-gaps ekp-mws-stretch-pixel)))))
;; should shrink ;; Keep old function for compatibility
(setq ratio (defun ekp--line-cost-and-gaps (ideal-pixel line-pixel glues-types)
(/ rest-pixel "Compute badness cost for a line using Knuth-Plass formula.
(float (+ (* latin-gaps ekp-lws-shrink-pixel) IDEAL-PIXEL is natural width, LINE-PIXEL is target width.
(* mix-gaps ekp-mws-shrink-pixel)))))) Returns (:cost NUMBER :gaps GAPS-LIST)."
(list :cost (* 100 (expt ratio 3)) :gaps gaps-list))) (let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel glues-types)))
(list :cost (plist-get result :badness)
:gaps (plist-get result :gaps))))
(defun ekp-hyphenate-p (glues-types n) (defun ekp-hyphenate-p (glues-types n)
"Return non-nil if position N ends with hyphenation."
(and (< n (length glues-types)) (and (< n (length glues-types))
(eq 'nws (aref glues-types n)))) (eq 'nws (aref glues-types n))))
;;; Dynamic Programming Line Breaking Algorithm
;; Implements optimal line breaking using Knuth-Plass algorithm.
;;
;; Key data structures:
;; - demerits[i]: minimum demerits to reach position i
;; - backptrs[i]: previous break point for optimal path
;; - fitness[i]: fitness class at break i (for adjacent penalty)
;; - rests[i]: adjustment pixels at break i
;; - gaps[i]: gap counts by type
;; - hyphen-counts[i]: consecutive hyphen count
(defun ekp--dp-init-arrays (n)
"Initialize DP arrays for N boxes.
Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)."
(let ((backptrs (make-vector (1+ n) nil))
(demerits (make-vector (1+ n) nil))
(rests (make-vector (1+ n) nil))
(gaps (make-vector (1+ n) nil))
(hyphen-counts (make-vector (1+ n) 0))
(fitness-classes (make-vector (1+ n) 1)) ; default: decent
(line-counts (make-vector (1+ n) 0))) ; for looseness
(aset demerits 0 0.0)
(list backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)))
(defun ekp--dp-line-metrics (i k glues-types ideal-prefixs min-prefixs max-prefixs)
"Compute line metrics for boxes I to K.
Returns (ideal-pixel min-pixel max-pixel) excluding leading glue."
(let ((leading-glue-type (aref glues-types i)))
(list (- (aref ideal-prefixs k) (aref ideal-prefixs i)
(ekp-glue-ideal-pixel leading-glue-type))
(- (aref min-prefixs k) (aref min-prefixs i)
(ekp-glue-min-pixel leading-glue-type))
(- (aref max-prefixs k) (aref max-prefixs i)
(ekp-glue-max-pixel leading-glue-type)))))
(defun ekp--dp-force-break (i k arrays glues-types ideal-prefixs hyphen-pixel line-pixel)
"Force a break at K-1 when no valid break found. Update ARRAYS."
(let* ((backptrs (nth 0 arrays))
(demerits (nth 1 arrays))
(rests (nth 2 arrays))
(gaps (nth 3 arrays))
(fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays))
(break-pos (1- k))
(hyphenate-p (ekp-hyphenate-p glues-types break-pos))
(ideal-pixel (- (aref ideal-prefixs break-pos)
(aref ideal-prefixs i)
(ekp-glue-ideal-pixel (aref glues-types i))))
(rest-pixel (- line-pixel ideal-pixel)))
(when hyphenate-p (cl-incf ideal-pixel hyphen-pixel))
;; Force break with high demerits
(aset demerits break-pos (+ 10000 (expt rest-pixel 2)))
(aset rests break-pos rest-pixel)
(aset backptrs break-pos i)
(aset fitness-classes break-pos 3) ; very loose
(aset line-counts break-pos (1+ (aref line-counts i)))
(aset gaps break-pos
(ekp--gaps-list (seq-drop (cl-subseq glues-types i break-pos) 1)))))
(defun ekp--dp-compute-line-demerits (j is-last end-with-hyphenp
ideal-pixel line-pixel
glues-types i k
prev-hyphen-count prev-fitness)
"Compute line demerits using full K-P formula.
Returns (demerits gaps fitness new-hyphen-count)."
(cond
;; Single word line
((= j 0)
(let* ((badness (ekp--compute-badness (- line-pixel ideal-pixel) 1))
(fitness 1) ; decent
(penalty (if end-with-hyphenp ekp-hyphen-penalty 0))
(new-hyphen (if end-with-hyphenp 1 0))
(dem (ekp--compute-demerits badness penalty prev-fitness fitness
end-with-hyphenp prev-hyphen-count)))
(list dem nil fitness new-hyphen)))
;; Last line: minimal demerits if reasonably filled
(is-last
(let* ((fill-ratio (/ (float ideal-pixel) line-pixel))
;; Penalize if last line is too short
(badness (if (< fill-ratio ekp-last-line-min-ratio)
(* 50 (- 1.0 fill-ratio))
0))
(dem (expt (+ ekp-line-penalty badness) 2)))
(list dem nil 1 0)))
;; Normal line
(t
(let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel
(seq-subseq glues-types i k)))
(badness (plist-get result :badness))
(fitness (plist-get result :fitness))
(line-gaps (plist-get result :gaps))
(penalty (if end-with-hyphenp ekp-hyphen-penalty 0))
(new-hyphen (if end-with-hyphenp (1+ prev-hyphen-count) 0))
(dem (ekp--compute-demerits badness penalty prev-fitness fitness
end-with-hyphenp prev-hyphen-count)))
(list dem line-gaps fitness new-hyphen)))))
;; Unused but kept for reference
(defun ekp--dp-update-best (k arrays line-demerits line-gaps fitness
ideal-pixel line-pixel base-demerits new-hyphen line-num)
"Update ARRAYS at position K if this break is better."
(let* ((backptrs (nth 0 arrays))
(demerits (nth 1 arrays))
(rests (nth 2 arrays))
(gaps (nth 3 arrays))
(hyphen-counts (nth 4 arrays))
(fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays))
(total-demerits (+ base-demerits line-demerits)))
(when (or (null (aref demerits k))
(< total-demerits (aref demerits k)))
(aset rests k (- line-pixel ideal-pixel))
(aset gaps k line-gaps)
(aset demerits k total-demerits)
(aset backptrs k (aref backptrs k)) ; will be set by caller
(aset fitness-classes k fitness)
(aset hyphen-counts k new-hyphen)
(aset line-counts k line-num)
t)))
(defun ekp--dp-trace-breaks (backptrs n)
"Trace optimal break points from BACKPTRS array."
(let ((breaks (list n))
(index n))
(while (> index 0)
(let ((prev (aref backptrs index)))
(if prev
(progn (push prev breaks)
(setq index prev))
(setq index (1- index)))))
(cdr breaks)))
(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines)
"Trace breaks, preferring paths with TARGET-LINES line count.
Used for looseness parameter support."
(if (= ekp-looseness 0)
(ekp--dp-trace-breaks backptrs n)
;; Find path closest to target line count
(let ((optimal-lines (aref line-counts n))
(target (+ optimal-lines ekp-looseness)))
;; For now, just use optimal path
;; Full looseness would require tracking multiple paths
(ekp--dp-trace-breaks backptrs n))))
(defun ekp--dp-store-cache (string line-pixel dp-cache)
"Store DP-CACHE for STRING at LINE-PIXEL."
(if-let ((dp-record (cdr (ekp-param-cache string))))
(puthash line-pixel dp-cache dp-record)
(let ((dp-record (make-hash-table :test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash line-pixel dp-cache dp-record)
(puthash (ekp-param-fmtstr)
(cons (ekp-param-data string) dp-record)
(cdr (ekp-text-cache string))))))
(defun ekp-dp-cache (string line-pixel) (defun ekp-dp-cache (string line-pixel)
"Compute optimal line breaks for STRING at LINE-PIXEL width.
Uses Knuth-Plass dynamic programming with demerits."
(if-let* ((dp-record (cdr (ekp-param-cache string))) (if-let* ((dp-record (cdr (ekp-param-cache string)))
(dp-cache (gethash line-pixel dp-record))) (cached (gethash line-pixel dp-record)))
dp-cache cached
;; Gather input data
(let* ((glues-types (ekp-glues-types string)) (let* ((glues-types (ekp-glues-types string))
(boxes (ekp-boxes string)) (boxes (ekp-boxes string))
(hyphen-pixel (ekp-hyphen-pixel string)) (hyphen-pixel (ekp-hyphen-pixel string))
@ -402,129 +657,73 @@ return the value of KEY in plist."
(ideal-prefixs (ekp-ideal-prefixs string)) (ideal-prefixs (ekp-ideal-prefixs string))
(min-prefixs (ekp-min-prefixs string)) (min-prefixs (ekp-min-prefixs string))
(max-prefixs (ekp-max-prefixs string)) (max-prefixs (ekp-max-prefixs string))
(backptrs (make-vector (1+ n) nil)) (arrays (ekp--dp-init-arrays n))
(costs (make-vector (1+ n) nil)) (backptrs (nth 0 arrays))
;; rest pixel = line-pixel - ideal-pixel (demerits (nth 1 arrays))
(rests (make-vector (1+ n) nil)) (rests (nth 2 arrays))
(gaps (make-vector (1+ n) nil)) (gaps (nth 3 arrays))
;; 连续行 hyphen 结尾计数 (hyphen-counts (nth 4 arrays))
(hyphen-line-count 0)) (fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays)))
;; Main DP loop: for each reachable position i
(dotimes (i (1+ n)) (dotimes (i (1+ n))
(aset costs i (if (= i 0) 0.0 nil))) (when (aref demerits i)
(dotimes (i (1+ n)) (let ((prev-hyphen-count (aref hyphen-counts i))
(when (aref costs i) (prev-fitness (aref fitness-classes i))
(setq hyphen-line-count 0) (prev-line-count (aref line-counts i)))
(catch 'break (catch 'break
;; Try extending line to each position k > i
(dotimes (j (- n i)) (dotimes (j (- n i))
(let* ((k (+ i j 1)) ;; k: end word index (exclusive) (let* ((k (+ i j 1))
(is-last (= k n)) (is-last (= k n))
(end-with-hyphenp (ekp-hyphenate-p glues-types k)) (end-with-hyphenp (ekp-hyphenate-p glues-types k))
(ideal-pixel (- (aref ideal-prefixs k) (metrics (ekp--dp-line-metrics
(aref ideal-prefixs i) i k glues-types ideal-prefixs min-prefixs max-prefixs))
(ekp-glue-ideal-pixel (ideal-pixel (nth 0 metrics))
(aref glues-types i)))) (min-pixel (nth 1 metrics))
(max-pixel (- (aref max-prefixs k) (max-pixel (nth 2 metrics)))
(aref max-prefixs i) ;; Add hyphen width if line ends with hyphen
(ekp-glue-max-pixel
(aref glues-types i))))
(min-pixel (- (aref min-prefixs k)
(aref min-prefixs i)
(ekp-glue-min-pixel
(aref glues-types i)))))
;; ends with hyphen, plus the pixel of hyphen
(when end-with-hyphenp (when end-with-hyphenp
(cl-incf ideal-pixel hyphen-pixel) (cl-incf ideal-pixel hyphen-pixel)
(cl-incf max-pixel hyphen-pixel) (cl-incf max-pixel hyphen-pixel)
(cl-incf min-pixel hyphen-pixel)) (cl-incf min-pixel hyphen-pixel))
;; Check if line is too long
;; back to last word
(when (or (> min-pixel line-pixel) (when (or (> min-pixel line-pixel)
(and is-last (> ideal-pixel line-pixel))) (and is-last (> ideal-pixel line-pixel)))
(when (null (aref costs (1- k))) (when (null (aref demerits (1- k)))
;; can not find a proper line break, (ekp--dp-force-break i k arrays glues-types
;; break line at prev box ideal-prefixs hyphen-pixel line-pixel))
(let* ((hyphenate-p (ekp-hyphenate-p glues-types (1- k)))
(ideal-pixel (- (aref ideal-prefixs (1- k))
(aref ideal-prefixs i)
(ekp-glue-ideal-pixel
(aref glues-types i))))
(rest-pixel (- line-pixel ideal-pixel)))
(when hyphenate-p (cl-incf ideal-pixel hyphen-pixel))
(aset costs (1- k) (+ 100 (expt rest-pixel 3)))
(aset rests (1- k) rest-pixel)
(aset backptrs (1- k) i)
(aset gaps (1- k)
(ekp--gaps-list
(seq-drop (cl-subseq glues-types i (1- k)) 1)))
;; (elog-debug "1-k:%s; rests:%S" (1- k)
;; (aref rests (1- k)))
))
(throw 'break nil)) (throw 'break nil))
;; Valid break point: compute demerits
(when (or (<= min-pixel line-pixel max-pixel) (when (or (<= min-pixel line-pixel max-pixel)
(and is-last (<= ideal-pixel line-pixel))) (and is-last (<= ideal-pixel line-pixel)))
(let* ((line-gaps) (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen)
(line-cost (ekp--dp-compute-line-demerits
(cond j is-last end-with-hyphenp
;; only has one word ideal-pixel line-pixel glues-types i k
((= j 0) prev-hyphen-count prev-fitness)))
(expt (- ideal-pixel line-pixel) 3)) (let ((total-dem (+ (aref demerits i) dem)))
(is-last 0.0) (when (or (null (aref demerits k))
;; has more than one word (< total-dem (aref demerits k)))
(t (let* ((cost-and-gaps
(ekp--line-cost-and-gaps
ideal-pixel line-pixel
(seq-subseq glues-types i k)))
(cost (plist-get cost-and-gaps :cost))
(gaps (plist-get cost-and-gaps :gaps)))
(setq line-gaps gaps)
(if end-with-hyphenp
(progn
;; add extra cost of hypen
(cl-incf hyphen-line-count)
(+ cost (* 1000 hyphen-line-count)))
(setq hyphen-line-count 0)
cost)))))
(total-cost (+ (aref costs i) line-cost)))
;; (message "total cost:%S" total-cost)
;; (message "hyphen-line-count:%S" hyphen-line-count)
(when (or (null (aref costs k))
(< (abs total-cost) (abs (aref costs k))))
;; set all for cost is smaller!
(aset rests k (- line-pixel ideal-pixel)) (aset rests k (- line-pixel ideal-pixel))
(aset gaps k line-gaps) (aset gaps k line-gaps)
(aset costs k total-cost) (aset demerits k total-dem)
;; 断点设置为 当前行的起点 = 上一行的和结束点 (aset backptrs k i)
(aset backptrs k i))))))))) (aset fitness-classes k fitness)
(let ((breaks (list n)) (aset hyphen-counts k new-hyphen)
(index n)) (aset line-counts k (1+ prev-line-count))))))))))))
(while (> index 0) ;; Extract optimal solution
(let ((prev (aref backptrs index))) (let* ((breaks (ekp--dp-trace-breaks-with-looseness
(if prev (progn (push prev breaks) backptrs line-counts n (aref line-counts n)))
(setq index prev)) (lines-rests (mapcar (lambda (i) (aref rests i)) breaks))
(setq index (1- index))))) (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks))
(let* ((breaks (cdr breaks)) (dp-cache (list :rests lines-rests
lines-rests lines-gaps dp-cache) :gaps lines-gaps
(dolist (i breaks)
(push (aref rests i) lines-rests)
(push (aref gaps i) lines-gaps))
;; set dp cache
(setq dp-cache (list :rests (nreverse lines-rests)
:gaps (nreverse lines-gaps)
:breaks breaks :breaks breaks
:cost (aref costs (length boxes)))) :cost (aref demerits n)
;; update param cache :line-count (aref line-counts n))))
(if-let ((dp-record (cdr (ekp-param-cache string)))) (ekp--dp-store-cache string line-pixel dp-cache)
(puthash line-pixel dp-cache dp-record) dp-cache))))
(let ((dp-record (make-hash-table
:test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash line-pixel dp-cache dp-record)
(puthash (ekp-param-fmtstr)
(cons (ekp-param-data string) dp-record)
(cdr (ekp-text-cache string)))))
dp-cache)))))
(defun ekp-dp-data (string line-pixel &optional key) (defun ekp-dp-data (string line-pixel &optional key)
"Return the data plist of dp cache. If KEY is non-nil, "Return the data plist of dp cache. If KEY is non-nil,
@ -542,156 +741,149 @@ return the value of KEY in plist."
"Return the break points of kp algorithm." "Return the break points of kp algorithm."
(ekp-dp-data string line-pixel :breaks)) (ekp-dp-data string line-pixel :breaks))
;;; Line Glue Distribution
;; Distributes extra/deficit space across glues (gaps between boxes)
;; Priority: latin gaps → mixed gaps → CJK gaps
(defun ekp--distribute-gap-adjustment (rest-pixel gaps-list stretch-p)
"Distribute REST-PIXEL across GAPS-LIST.
STRETCH-P indicates stretch (t) or shrink (nil) mode.
Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra))."
(let* ((latin-gaps (nth 0 gaps-list))
(mix-gaps (nth 1 gaps-list))
(cjk-gaps (nth 2 gaps-list))
(remaining rest-pixel)
;; Per-gap adjustment values
(latin-change (if stretch-p ekp-lws-stretch-pixel ekp-lws-shrink-pixel))
(mix-change (if stretch-p ekp-mws-stretch-pixel ekp-mws-shrink-pixel))
(cjk-change (if stretch-p ekp-cws-stretch-pixel 0))
;; Results
(latin-adj 0) (latin-extra 0)
(mix-adj 0) (mix-extra 0)
(cjk-adj 0) (cjk-extra 0))
;; Distribute to latin gaps first
(let ((latin-capacity (* latin-gaps latin-change)))
(if (< remaining latin-capacity)
(when (> latin-gaps 0)
(setq latin-adj (/ remaining latin-gaps))
(setq latin-extra (% remaining latin-gaps))
(setq remaining 0))
(setq latin-adj latin-change)
(setq remaining (- remaining latin-capacity))))
;; Then to mixed gaps
(when (> remaining 0)
(let ((mix-capacity (* mix-gaps mix-change)))
(if (< remaining mix-capacity)
(when (> mix-gaps 0)
(setq mix-adj (/ remaining mix-gaps))
(setq mix-extra (% remaining mix-gaps))
(setq remaining 0))
(setq mix-adj mix-change)
(setq remaining (- remaining mix-capacity)))))
;; Finally to CJK gaps
(when (and (> remaining 0) (> cjk-gaps 0))
(setq cjk-adj (/ remaining cjk-gaps))
(setq cjk-extra (% remaining cjk-gaps)))
(list (cons latin-adj latin-extra)
(cons mix-adj mix-extra)
(cons cjk-adj cjk-extra))))
(defun ekp--compute-glue-pixels (glues-types gaps-distribution stretch-p)
"Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION.
Returns list of pixel values for each glue."
(let ((latin-adj (car (nth 0 gaps-distribution)))
(latin-extra (cdr (nth 0 gaps-distribution)))
(mix-adj (car (nth 1 gaps-distribution)))
(mix-extra (cdr (nth 1 gaps-distribution)))
(cjk-adj (car (nth 2 gaps-distribution)))
(cjk-extra (cdr (nth 2 gaps-distribution)))
(latin-idx -1) (mix-idx -1) (cjk-idx -1))
(mapcar
(lambda (type)
(let* ((base (ekp-glue-ideal-pixel type))
(adj (pcase type
('lws (cl-incf latin-idx)
(+ latin-adj (if (< latin-idx latin-extra) 1 0)))
('mws (cl-incf mix-idx)
(+ mix-adj (if (< mix-idx mix-extra) 1 0)))
('cws (cl-incf cjk-idx)
(+ cjk-adj (if (< cjk-idx cjk-extra) 1 0)))
('nws 0)
(_ 0))))
(if stretch-p (+ base adj) (- base adj))))
glues-types)))
(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel)
"Compute glues for a single-box line."
(let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0))))
(list 0 trailing)))
(defun ekp--line-glue-last-line (glues-types ideal-pixel line-pixel)
"Compute glues for last line (ragged right)."
(append '(0)
(mapcar #'ekp-glue-ideal-pixel glues-types)
(list (- line-pixel ideal-pixel))))
(defun ekp--line-glue-normal (glues-types rest-pixel gaps-list)
"Compute glues for a normal (justified) line."
(if (= rest-pixel 0)
(append '(0) (mapcar #'ekp-glue-ideal-pixel glues-types) '(0))
(let* ((stretch-p (> rest-pixel 0))
(distribution (ekp--distribute-gap-adjustment
(abs rest-pixel) gaps-list stretch-p))
(glue-pixels (ekp--compute-glue-pixels glues-types distribution stretch-p)))
(append '(0) glue-pixels '(0)))))
(defun ekp-line-glues (string line-pixel) (defun ekp-line-glues (string line-pixel)
"Line glues include glues before first box and after last box. "Compute glue pixels for each line after breaking STRING at LINE-PIXEL.
So the length of line glues is: line-boxes-num + 1" Returns vector of vectors, each inner vector is glue pixels for one line.
Each line's glues: [0 glue1 glue2 ... trailing-space]."
(let* ((boxes-widths (ekp-boxes-widths string)) (let* ((boxes-widths (ekp-boxes-widths string))
(boxes (ekp-boxes string)) (boxes-num (length (ekp-boxes string)))
(boxes-num (length boxes))
(glues-types (ekp-glues-types string)) (glues-types (ekp-glues-types string))
(ideal-prefixs (ekp-ideal-prefixs string)) (ideal-prefixs (ekp-ideal-prefixs string))
(max-prefixs (ekp-max-prefixs string)) (max-prefixs (ekp-max-prefixs string))
(breaks (ekp-line-breaks string line-pixel)) (breaks (ekp-line-breaks string line-pixel))
(lines-rests (ekp-dp-data string line-pixel :rests))
(lines-gaps (ekp-dp-data string line-pixel :gaps))
(hyphen-pixel (ekp-hyphen-pixel string))
(line-glues (make-vector (length breaks) nil)) (line-glues (make-vector (length breaks) nil))
(start 0)) (start 0))
(dotimes (i (length breaks)) (dotimes (i (length breaks))
(let* ((end (nth i breaks)) (let* ((end (nth i breaks))
(line-boxes-widths (cl-subseq boxes-widths start end)) (line-boxes-widths (cl-subseq boxes-widths start end))
(line-glues-types (line-glues-types (seq-drop (cl-subseq glues-types start end) 1))
;; exclude glue before word at the start of line
(seq-drop (cl-subseq glues-types start end) 1))
(is-last (>= end boxes-num)) (is-last (>= end boxes-num))
line-glue) (hyphen-p (ekp-hyphenate-p glues-types end))
(setq line-glue (ideal-pixel (- (aref ideal-prefixs end)
(cond
((= 1 (length line-boxes-widths))
(if (ekp-hyphenate-p glues-types end)
;; ends with hyphen, minus hyphen-pixel
(list 0 (- line-pixel
(ekp-hyphen-pixel string)
(aref line-boxes-widths 0)))
(list 0 (- line-pixel (aref line-boxes-widths 0)))))
(is-last
(append '(0)
(mapcar #'ekp-glue-ideal-pixel line-glues-types)
(list
(- line-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start) (aref ideal-prefixs start)
(ekp-glue-ideal-pixel (ekp-glue-ideal-pixel (aref glues-types start))))
(aref glues-types start))))))) (max-pixel (+ (- (aref max-prefixs end)
(t
;; (elog-debug "-----------------")
;; (elog-debug "glues-types:%s" line-glues-types)
(let ((max-pixel (- (aref max-prefixs end)
(aref max-prefixs start) (aref max-prefixs start)
(ekp-glue-max-pixel (ekp-glue-max-pixel (aref glues-types start)))
(aref glues-types start))))) (if hyphen-p hyphen-pixel 0)))
;; ends with hyphen glue-list)
(when (ekp-hyphenate-p glues-types end) (setq glue-list
(cl-incf max-pixel (ekp-hyphen-pixel string))) (cond
;; (elog-debug "start:%s; end:%s; max:%s" start end max-pixel) ;; Single box: just trailing space
(if (< max-pixel line-pixel) ((= 1 (length line-boxes-widths))
(progn (ekp--line-glue-single-box line-pixel
;; 行尾直接断行的情况 (aref line-boxes-widths 0)
;; (elog-debug "暴力断行 i:%s pixel:%s" hyphen-p hyphen-pixel))
;; i (- line-pixel max-pixel)) ;; Last line: ragged right
(is-last
(ekp--line-glue-last-line line-glues-types ideal-pixel line-pixel))
;; Forced break (line too short even at max stretch)
((< max-pixel line-pixel)
(append '(0) (append '(0)
(mapcar #'ekp-glue-max-pixel line-glues-types) (mapcar #'ekp-glue-max-pixel line-glues-types)
(list (- line-pixel max-pixel)))) (list (- line-pixel max-pixel))))
;; 正常情况 ;; Normal justified line
(let ((ideal-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start)
(ekp-glue-ideal-pixel
(aref glues-types start)))))
;; ideal-pixel 包含第一个box之前的glue
;; (elog-debug "boxes:%S" (cl-subseq boxes start end))
;; (elog-debug "line:%s; ideal:%s; rest:%s; stored-rest:%s"
;; line-pixel ideal-pixel (- line-pixel ideal-pixel)
;; (nth i (ekp-dp-data string line-pixel :rests)))
)
(let* ((lines-rests (ekp-dp-data string line-pixel :rests))
(curr-rest-pixel (nth i lines-rests)))
;; (elog-debug "curr-rest-pixel:%s" curr-rest-pixel)
(cond
((= curr-rest-pixel 0)
(append '(0) (mapcar #'ekp-glue-ideal-pixel
line-glues-types)
'(0)))
(t (t
(let* ((lines-gaps (ekp-dp-data string line-pixel :gaps)) (ekp--line-glue-normal line-glues-types
(line-gaps (nth i lines-gaps)) (nth i lines-rests)
(latin-gaps (nth 0 line-gaps)) (nth i lines-gaps)))))
(mix-gaps (nth 1 line-gaps)) (aset line-glues i (vconcat glue-list))
(cjk-gaps (nth 2 line-gaps))
(latin-gap-pixel 0) (latin-extra-gaps 0)
(mix-gap-pixel 0) (mix-extra-gaps 0)
(cjk-gap-pixel 0) (cjk-extra-gaps 0)
(line-rest-pixel (abs curr-rest-pixel)))
;; max-latin-change include stretch or shrink
(let* ((latin-gap-change (if (> curr-rest-pixel 0)
ekp-lws-stretch-pixel
ekp-lws-shrink-pixel))
(latin-max-pixel (* latin-gaps latin-gap-change)))
(if (< (- line-rest-pixel latin-max-pixel) 0)
(when (> latin-gaps 0)
;; only stretch latin glues
;; (elog-debug "latin-gap-pixel:%s"
;; (/ line-rest-pixel latin-gaps))
;; (elog-debug "latin-extra-gaps:%s"
;; (% line-rest-pixel latin-gaps))
(setq latin-gap-pixel (/ line-rest-pixel latin-gaps))
(setq latin-extra-gaps (% line-rest-pixel latin-gaps)))
;; stretch latin glues max and continue to stretch mix glues
(setq latin-gap-pixel latin-gap-change)
(setq line-rest-pixel (- line-rest-pixel latin-max-pixel))
(let* ((mix-gap-change (if (> curr-rest-pixel 0)
ekp-mws-stretch-pixel
ekp-mws-shrink-pixel))
(mix-max-pixel (* mix-gaps mix-gap-change)))
(if (< (- line-rest-pixel mix-max-pixel) 0)
(when (> mix-gaps 0)
;; only stretch mix glues
(setq mix-gap-pixel (/ line-rest-pixel mix-gaps))
(setq mix-extra-gaps (% line-rest-pixel mix-gaps)))
;; stretch mix glues max and continue to stretch cjk glues
(setq mix-gap-pixel mix-gap-change)
(setq line-rest-pixel (- line-rest-pixel mix-max-pixel))
(when (> cjk-gaps 0)
(setq cjk-gap-pixel (/ line-rest-pixel cjk-gaps))
(setq cjk-extra-gaps (% line-rest-pixel cjk-gaps)))))))
(let* ((latin-extra-index -1)
(mix-extra-index -1)
(cjk-extra-index -1)
(glue-pixel-lst
(mapcar
(lambda (type)
(let ((pixel (cond
((eq type 'lws)
(cl-incf latin-extra-index)
(if (< latin-extra-index latin-extra-gaps)
(1+ latin-gap-pixel)
latin-gap-pixel))
((eq type 'mws)
(cl-incf mix-extra-index)
(if (< mix-extra-index mix-extra-gaps)
(1+ mix-gap-pixel)
mix-gap-pixel))
((eq type 'cws)
(cl-incf cjk-extra-index)
(if (< cjk-extra-index cjk-extra-gaps)
(1+ cjk-gap-pixel)
cjk-gap-pixel))
((eq type 'nws) 0))))
(if (> curr-rest-pixel 0)
;; stretch
(+ (ekp-glue-ideal-pixel type) pixel)
;; shrink
(- (ekp-glue-ideal-pixel type) pixel))))
line-glues-types)))
;; (elog-debug "glue-pixel-lst:%S" glue-pixel-lst)
;; (elog-debug "--------------")
(append '(0) glue-pixel-lst '(0))))))))))))
(aset line-glues i (vconcat line-glue nil))
(setq start end))) (setq start end)))
line-glues)) line-glues))
@ -743,42 +935,54 @@ Default is nil, meaning cache is not used."
(ekp--pixel-justify str line-pixel))) (ekp--pixel-justify str line-pixel)))
strs "\n"))) strs "\n")))
;;; Optimal Width Search
;; Uses ternary search instead of linear scan.
;; Cost function is roughly unimodal: too narrow = many breaks = high cost,
;; too wide = overstretched lines = high cost.
(defun ekp--compute-avg-cost (strings pixel)
"Compute average cost for STRINGS at PIXEL width."
(let ((costs (mapcar (lambda (s)
(if (string-blank-p s) 0
(abs (ekp-total-cost s pixel))))
strings)))
(/ (float (apply #'+ costs)) (max 1 (length costs)))))
(defun ekp--ternary-search-optimal-width (strings min-pixel max-pixel)
"Find optimal width in [MIN-PIXEL, MAX-PIXEL] using ternary search.
Returns the pixel width with minimum average cost."
(let ((lo min-pixel)
(hi max-pixel))
;; Ternary search: O(log n) instead of O(n)
(while (> (- hi lo) 2)
(let* ((mid1 (+ lo (/ (- hi lo) 3)))
(mid2 (- hi (/ (- hi lo) 3)))
(cost1 (ekp--compute-avg-cost strings mid1))
(cost2 (ekp--compute-avg-cost strings mid2)))
(if (< cost1 cost2)
(setq hi mid2)
(setq lo mid1))))
;; Final linear scan over remaining 3 candidates
(let ((best-pixel lo)
(best-cost (ekp--compute-avg-cost strings lo)))
(dolist (p (list (1+ lo) hi))
(when (<= p max-pixel)
(let ((cost (ekp--compute-avg-cost strings p)))
(when (< cost best-cost)
(setq best-cost cost
best-pixel p)))))
best-pixel)))
(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional use-cache) (defun ekp-pixel-range-justify (string min-pixel max-pixel &optional use-cache)
"Find the optimal breakpoint for STRING typesetting between "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL.
a MIN-PIXEL and MAX-PIXEL width and return a cons-cell. The car Returns (justified-text . optimal-pixel).
of it is the typeset tex and cdr is the best pixel. Uses ternary search for O(log n) complexity instead of O(n)."
When USE-CACHE is non-nil, use the cache for performance.
Default is nil, meaning cache is not used."
(let* ((ekp-caches (if use-cache (let* ((ekp-caches (if use-cache
ekp-caches ekp-caches
(make-hash-table (make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil))) :test 'equal :size 100 :rehash-size 1.5 :weakness nil)))
(strings (split-string string "\n")) (strings (split-string string "\n"))
(best-pixel max-pixel) (best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel)))
(best-cost-lst
(mapcar (lambda (string)
(if (string-blank-p string)
0
(abs (ekp-total-cost string max-pixel))))
strings))
;; get average cost of all lines' costs
(best-cost (/ (float (apply #'+ best-cost-lst))
(length best-cost-lst)))
(curr-pixel max-pixel))
(while (>= curr-pixel min-pixel)
(let* ((cost-lst
(mapcar (lambda (string)
(if (string-blank-p string)
0
(abs (ekp-total-cost string curr-pixel))))
strings))
(curr-cost (/ (float (apply #'+ cost-lst))
(length cost-lst))))
(when (< curr-cost best-cost)
(progn
(setq best-cost curr-cost)
(setq best-pixel curr-pixel)))
(cl-decf curr-pixel 1)))
(cons (ekp-pixel-justify string best-pixel use-cache) best-pixel))) (cons (ekp-pixel-justify string best-pixel use-cache) best-pixel)))
(provide 'ekp) (provide 'ekp)

View File

@ -67,7 +67,7 @@
(car (ekp-pixel-range-justify (car (ekp-pixel-range-justify
(ekp-test-str cjk latin font) min max)))) (ekp-test-str cjk latin font) min max))))
;; (ekp-test-justify nil "en_US" "Cascadia Next SC" 699) ;; (ekp-test-justify nil "en_US" "Cascadia Next SC" 399)
;; (ekp-test-justify nil "en_US" "Times New Roman" 699) ;; (ekp-test-justify nil "en_US" "Times New Roman" 699)
;; (ekp-test-justify nil "en_US" "Georgia" 699) ;; (ekp-test-justify nil "en_US" "Georgia" 699)
;; (ekp-test-justify nil "en_US" "Noto Serif" 700) ;; (ekp-test-justify nil "en_US" "Noto Serif" 700)