;;; ekp.el --- Knuth-Plass line breaking for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2024 ;; Author: emacs-kp contributors ;; Keywords: text, typesetting, CJK ;; Package-Requires: ((emacs "27.1")) ;;; Commentary: ;; Implementation of the Knuth-Plass optimal line breaking algorithm ;; with support for CJK text and hyphenation. ;; ;; Reference: Knuth & Plass, "Breaking Paragraphs into Lines" (1981) ;; ;; Usage: ;; (ekp-pixel-justify "Your text here" 600) ;; (ekp-pixel-range-justify "Text" 500 700) ;;; Code: (require 'cl-lib) (require 'ekp-utils) (require 'ekp-hyphen) (defconst ekp--load-file (or load-file-name (buffer-file-name)) "Path to this file, for locating dictionaries.") (defvar ekp-latin-lang "en_US" "Language code for hyphenation (e.g., 'en_US', 'de_DE').") (defvar ekp-use-c-module t "When non-nil, use C dynamic module for DP computation if available. The C module provides significant performance improvement for large texts. Set to nil to force pure Elisp implementation.") ;;;; Glue Parameters ;; Glue = flexible space between boxes (Knuth-Plass terminology) ;; lws = Latin Word Space, mws = Mixed (Latin-CJK), cws = CJK (defvar ekp-lws-ideal-pixel nil "Ideal Latin word spacing (pixels).") (defvar ekp-lws-stretch-pixel nil "Max stretch for Latin spacing.") (defvar ekp-lws-shrink-pixel nil "Max shrink for Latin spacing.") (defvar ekp-mws-ideal-pixel nil "Ideal mixed (Latin-CJK) spacing.") (defvar ekp-mws-stretch-pixel nil "Max stretch for mixed spacing.") (defvar ekp-mws-shrink-pixel nil "Max shrink for mixed spacing.") (defvar ekp-cws-ideal-pixel nil "Ideal CJK character spacing.") (defvar ekp-cws-stretch-pixel nil "Max stretch for CJK spacing.") (defvar ekp-cws-shrink-pixel nil "Max shrink for CJK spacing.") ;; Derived limits (computed from above) (defvar ekp-lws-max-pixel nil) (defvar ekp-lws-min-pixel nil) (defvar ekp-mws-max-pixel nil) (defvar ekp-mws-min-pixel nil) (defvar ekp-cws-max-pixel nil) (defvar ekp-cws-min-pixel nil) ;;;; K-P Algorithm Parameters (defvar ekp-line-penalty 10 "Penalty for each line break. Higher = fewer lines. Default 10.") (defvar ekp-hyphen-penalty 50 "Penalty for hyphenated breaks. Higher = avoid hyphenation. Default 50.") (defvar ekp-adjacent-fitness-penalty 100 "Penalty when adjacent lines differ in tightness by >1 class.") (defvar ekp-last-line-min-ratio 0.5 "Minimum fill ratio for last line (0.0-1.0).") (defvar ekp-looseness 0 "Target line count offset: 0=optimal, +1=looser, -1=tighter.") ;;;; Paragraph Cache Structure ;; ;; All paragraph data is stored in a flat struct for O(1) access. ;; Cache key: sxhash of (string, fonts, spacing params) (cl-defstruct (ekp-para (:constructor ekp-para--create)) "Preprocessed paragraph data." string latin-font cjk-font boxes boxes-widths boxes-types glues-types hyphen-pixel hyphen-positions ideal-prefixs min-prefixs max-prefixs (dp-cache nil :type hash-table)) (defvar ekp--para-cache nil "Cache: hash-key → ekp-para struct.") (defvar ekp--use-default-params t "Internal flag for parameter initialization.") ;;;; Initialization (defun ekp-root-dir () "Return directory containing ekp.el." (when ekp--load-file (file-name-directory ekp--load-file))) (defun ekp--load-dicts () "Load hyphenation dictionaries." (ekp-hyphen-load-languages (expand-file-name "dictionaries" (ekp-root-dir)))) (ekp--load-dicts) ;;;; Parameter Management (defun ekp--params-set-p () "Return non-nil if all spacing parameters are set." (and ekp-lws-ideal-pixel ekp-lws-stretch-pixel ekp-lws-shrink-pixel ekp-mws-ideal-pixel ekp-mws-stretch-pixel ekp-mws-shrink-pixel ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel)) (defun ekp-param-set-default (string) "Set default spacing parameters based on STRING's font." (let* ((lws (ekp-word-spacing-pixel string)) (mws (- lws 1))) (ekp-param-set lws (ceiling (/ (float lws) 2)) (ceiling (/ (float lws) 3)) mws (ceiling (/ (float mws) 2)) (ceiling (/ (float mws) 3)) 0 3 0))) (defun ekp-param-set (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--) "Set all spacing parameters. LWS = Latin word space, MWS = mixed, CWS = CJK. Each takes ideal, stretch (+), and shrink (-) values." (setq ekp-lws-ideal-pixel lws-i ekp-lws-stretch-pixel lws-+ ekp-lws-shrink-pixel lws-- ekp-mws-ideal-pixel mws-i ekp-mws-stretch-pixel mws-+ ekp-mws-shrink-pixel mws-- ekp-cws-ideal-pixel cws-i ekp-cws-stretch-pixel cws-+ ekp-cws-shrink-pixel cws--) (unless (ekp--params-set-p) (error "All spacing parameters must be non-nil")) (setq ekp-lws-max-pixel (+ lws-i lws-+) ekp-lws-min-pixel (- lws-i lws--) ekp-mws-max-pixel (+ mws-i mws-+) ekp-mws-min-pixel (- mws-i mws--) ekp-cws-max-pixel (+ cws-i cws-+) ekp-cws-min-pixel (- cws-i cws--)) (setq ekp--use-default-params nil)) ;;;; Text Analysis (defconst ekp--latin-regexp "[A-Za-z'\\-\u00C0-\u00D6\u00D8-\u00F6\u00F8-\u00FF\u0100-\u024F\u1E00-\u1EFF]" "Regexp matching Latin characters including accented forms.") (defun ekp--split-with-hyphen (string) "Split STRING into boxes with hyphenation points marked. Returns (boxes-vector . hyphen-positions-vector)." (let* ((boxes (ekp-split-to-boxes string)) (idx 0) new-boxes hyphen-idxs) (dolist (box (append boxes nil)) (if (string-match (format "^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$" ekp--latin-regexp) box) ;; Latin word: apply hyphenation (let* ((left (match-string 1 box)) (word (match-string 2 box)) (right (match-string 3 box)) (parts (ekp-hyphen-boxes (ekp-hyphen-create ekp-latin-lang) word)) (n (length parts))) (when left (setcar parts (concat left (car parts)))) (when right (setcar (last parts) (concat (car (last parts)) right))) (push parts new-boxes) (dotimes (i n) (when (< i (1- n)) (push idx hyphen-idxs)) (cl-incf idx))) ;; Non-Latin: single box (push (list box) new-boxes) (cl-incf idx))) (cons (vconcat (apply #'append (nreverse new-boxes))) (vconcat (nreverse hyphen-idxs))))) (defun ekp--str-type (str) "STR should be single letter string." (cond ;; Whitespace (space, tab, etc.) or zero-width characters ((or (string-blank-p str) (= (string-width str) 0)) 'space) ;; a half-width cjk punct ((or (string= "“" str) (string= "”" str)) 'cjk) ((= (string-width str) 1) 'latin) ((= (string-width str) 2) (if (ekp-cjk-fw-punct-p str) 'cjk-punct 'cjk)) (t (error "Abnormal string width %s for %s" (string-width str) str)))) (defun ekp--box-type (box) (unless (or (null box) (string-empty-p box)) ;; Space/zero-width boxes: type is (space . space) (if (or (string-blank-p box) (= (string-width box) 0)) '(space . space) (cons (ekp--str-type (substring box 0 1)) (ekp--str-type (substring box -1)))))) (defun ekp--glue-type (prev-box-type curr-box-type) "Lws means whitespace between latin words; cws means whitespace between cjk words; mws means whitespace between cjk and latin words; nws means no whitespace. Space boxes (preserved whitespace) need no additional glue." (let ((before (cdr prev-box-type)) (after (car curr-box-type))) (if before (cond ;; Space boxes: no additional glue needed ((or (eq before 'space) (eq after 'space)) 'nws) ((and (eq before 'latin) (eq after 'latin)) 'lws) ((and (eq before 'cjk) (eq after 'cjk)) 'cws) ((or (and (eq before 'cjk) (eq after 'latin)) (and (eq before 'latin) (eq after 'cjk))) 'mws) ((or (eq before 'cjk-punct) (eq after 'cjk-punct)) 'cws)) 'nws))) (defun ekp--compute-glue-types (boxes boxes-types hyphen-positions) "Compute glue types for BOXES. Positions after HYPHEN-POSITIONS are 'nws." (let* ((n (length boxes)) (glues (make-vector n nil)) prev-type) (dolist (i (append hyphen-positions nil)) (aset glues (1+ i) 'nws)) (dotimes (i n) (unless (aref glues i) (let ((curr-type (aref boxes-types i))) (aset glues i (ekp--glue-type prev-type curr-type)) (setq prev-type curr-type)))) glues)) (defun ekp-glue-ideal-pixel (type) (cond ((or (null type) (eq 'nws type)) 0) ((eq 'lws type) ekp-lws-ideal-pixel) ((eq 'mws type) ekp-mws-ideal-pixel) ((eq 'cws type) ekp-cws-ideal-pixel))) (defun ekp-glue-min-pixel (type) (cond ((or (null type) (eq 'nws type)) 0) ((eq 'lws type) ekp-lws-min-pixel) ((eq 'mws type) ekp-mws-min-pixel) ((eq 'cws type) ekp-cws-min-pixel))) (defun ekp-glue-max-pixel (type) (cond ((or (null type) (eq 'nws type)) 0) ((eq 'lws type) ekp-lws-max-pixel) ((eq 'mws type) ekp-mws-max-pixel) ((eq 'cws type) ekp-cws-max-pixel))) ;;; ============================================================ ;;; Cache Implementation: Fast Hash + Flat Structure ;;; ============================================================ (defun ekp--para-hash (string) "Compute fast hash key for STRING. Uses sxhash instead of MD5 for performance." (let ((latin-font (ekp-latin-font string)) (cjk-font (ekp-cjk-font string))) ;; Combine: string identity + fonts + spacing params ;; sxhash is O(n) but much faster than MD5 (sxhash (list (sxhash string) (object-intervals string) latin-font cjk-font ekp-lws-ideal-pixel ekp-lws-stretch-pixel ekp-lws-shrink-pixel ekp-mws-ideal-pixel ekp-mws-stretch-pixel ekp-mws-shrink-pixel ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel)))) (defun ekp--make-para (string) "Create and fully initialize ekp-para struct for STRING. Computes ALL data in one pass: text, params, and prefix arrays." ;; Ensure params are set (when (or ekp--use-default-params (null (ekp--params-set-p))) (ekp-param-set-default string)) (setq ekp--use-default-params t) ;; Extract fonts (let* ((latin-font (ekp-latin-font string)) (cjk-font (ekp-cjk-font string)) ;; Split into boxes with hyphenation (split-result (ekp--split-with-hyphen string)) (boxes (car split-result)) (hyphen-positions (cdr split-result)) (n (length boxes)) ;; Compute box properties (boxes-widths (vconcat (mapcar #'string-pixel-width boxes))) (boxes-types (vconcat (mapcar #'ekp--box-type boxes))) (glues-types (ekp--compute-glue-types boxes boxes-types hyphen-positions)) (hyphen-pixel (string-pixel-width "-")) ;; Compute prefix arrays in one pass (ideal-prefixs (make-vector (1+ n) 0)) (min-prefixs (make-vector (1+ n) 0)) (max-prefixs (make-vector (1+ n) 0))) ;; Single loop for all prefix computations (dotimes (i n) (let ((box-w (aref boxes-widths i)) (glue-type (aref glues-types i))) (aset ideal-prefixs (1+ i) (+ (aref ideal-prefixs i) box-w (ekp-glue-ideal-pixel glue-type))) (aset min-prefixs (1+ i) (+ (aref min-prefixs i) box-w (ekp-glue-min-pixel glue-type))) (aset max-prefixs (1+ i) (+ (aref max-prefixs i) box-w (ekp-glue-max-pixel glue-type))))) ;; Create struct with all data (ekp-para--create :string string :latin-font latin-font :cjk-font cjk-font :boxes boxes :boxes-widths boxes-widths :boxes-types boxes-types :glues-types glues-types :hyphen-pixel hyphen-pixel :hyphen-positions hyphen-positions :ideal-prefixs ideal-prefixs :min-prefixs min-prefixs :max-prefixs max-prefixs :dp-cache (make-hash-table :test 'eql :size 20)))) (defun ekp--get-para (string) "Get or create ekp-para struct for STRING. This is the main entry point for cached paragraph data." (unless ekp--para-cache (setq ekp--para-cache (make-hash-table :test 'eql :size 100))) (let ((key (ekp--para-hash string))) (or (gethash key ekp--para-cache) (let ((para (ekp--make-para string))) (puthash key para ekp--para-cache) para)))) (defun ekp-clear-caches () "Clear all paragraph caches." (interactive) (setq ekp--para-cache nil)) ;;;; Paragraph Accessors (defun ekp--boxes (string) (ekp-para-boxes (ekp--get-para string))) (defun ekp--boxes-widths (string) (ekp-para-boxes-widths (ekp--get-para string))) (defun ekp--glues-types (string) (ekp-para-glues-types (ekp--get-para string))) (defun ekp--ideal-prefixs (string) (ekp-para-ideal-prefixs (ekp--get-para string))) (defun ekp--min-prefixs (string) (ekp-para-min-prefixs (ekp--get-para string))) (defun ekp--max-prefixs (string) (ekp-para-max-prefixs (ekp--get-para string))) (defun ekp--hyphen-pixel (string) (ekp-para-hyphen-pixel (ekp--get-para string))) (defun ekp--hyphen-positions (string) (ekp-para-hyphen-positions (ekp--get-para string))) (defun ekp--hyphen-str (_string) "Return hyphen character." "-") ;;;; K-P Badness and Demerits ;; 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) "Count gaps by type: (latin-gaps mix-gaps cjk-gaps)." (list (seq-count (lambda (it) (eq 'lws it)) glues-types) (seq-count (lambda (it) (eq 'mws it)) glues-types) (seq-count (lambda (it) (eq 'cws it)) glues-types))) (defun ekp--compute-stretch-capacity (gaps-list) "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)) (gaps-list (ekp--gaps-list glues-types)) (adjustment (- line-pixel ideal-pixel)) (flexibility (if (> adjustment 0) (ekp--compute-stretch-capacity gaps-list) (ekp--compute-shrink-capacity gaps-list))) (badness (ekp--compute-badness adjustment flexibility)) (fitness (ekp--compute-fitness-class adjustment flexibility))) (list :badness badness :fitness fitness :gaps gaps-list :adjustment adjustment :flexibility flexibility))) (defun ekp--hyphenate-p (hyphen-positions n) "Return non-nil if position N ends with hyphenation. HYPHEN-POSITIONS is a vector of indices where hyphenation can occur." (and hyphen-positions (cl-find n hyphen-positions))) ;;;; Dynamic Programming Line Breaking (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 hyphen-positions 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 hyphen-positions 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))))) (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-result) "Store DP-RESULT for STRING at LINE-PIXEL in para's dp-cache." (let ((para (ekp--get-para string))) (puthash line-pixel dp-result (ekp-para-dp-cache para)))) (defun ekp--dp-get-cached (para line-pixel) "Get cached DP result from PARA for LINE-PIXEL, or nil." (gethash line-pixel (ekp-para-dp-cache para))) (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 `ekp-use-c-module' is non-nil and C module is available, uses it." (let* ((para (ekp--get-para string)) (cached (ekp--dp-get-cached para line-pixel))) (if cached cached ;; Try C module first (if enabled and available) (if (and ekp-use-c-module (boundp 'ekp-c-module-loaded) ekp-c-module-loaded (fboundp 'ekp-c-break-with-arrays)) (ekp--dp-cache-via-c para string line-pixel) ;; Fallback to Elisp implementation (ekp--dp-cache-elisp para string line-pixel))))) (defun ekp--glue-type-to-int (type) "Convert glue TYPE symbol to integer for C module. 0=nws, 1=lws, 2=mws, 3=cws." (pcase type ('lws 1) ('mws 2) ('cws 3) (_ 0))) ; nws or nil (defun ekp--dp-cache-via-c (para string line-pixel) "Compute breaks using C module with Elisp's pre-computed prefix arrays. C module receives ALL font-dependent data from Elisp's para struct: prefix sums, glue values, hyphen info. C only does pure DP." (ignore string) ; Use para's data instead (let* ((ideal-prefixs (ekp-para-ideal-prefixs para)) (min-prefixs (ekp-para-min-prefixs para)) (max-prefixs (ekp-para-max-prefixs para)) (glues-types (ekp-para-glues-types para)) (hyphen-positions (ekp-para-hyphen-positions para)) (hyphen-pixel (ekp-para-hyphen-pixel para)) (n (length (ekp-para-boxes para))) ;; Build glue value arrays for C (glue-ideals (make-vector n 0)) (glue-shrinks (make-vector n 0)) (glue-stretches (make-vector n 0))) ;; Extract glue values from type symbols (dotimes (i n) (let ((type (aref glues-types i))) (aset glue-ideals i (ekp-glue-ideal-pixel type)) (aset glue-shrinks i (- (ekp-glue-ideal-pixel type) (ekp-glue-min-pixel type))) (aset glue-stretches i (- (ekp-glue-max-pixel type) (ekp-glue-ideal-pixel type))))) ;; Call C module with all Elisp-computed arrays (let* ((result (ekp-c-break-with-arrays ideal-prefixs min-prefixs max-prefixs glue-ideals glue-shrinks glue-stretches hyphen-positions hyphen-pixel line-pixel)) (c-breaks (car result)) (c-cost (cdr result))) (if (null c-breaks) ;; C module failed, fallback to Elisp (ekp--dp-cache-elisp para string line-pixel) ;; C module succeeded: compute rests and gaps from breaks (let* ((breaks c-breaks) (start 0) lines-rests lines-gaps) ;; Compute rests and gaps for each line (dolist (end breaks) (let* ((leading-glue-type (aref glues-types start)) (end-with-hyphenp (ekp--hyphenate-p hyphen-positions (1- end))) (ideal-pixel (- (aref ideal-prefixs end) (aref ideal-prefixs start) (ekp-glue-ideal-pixel leading-glue-type)))) (when end-with-hyphenp (cl-incf ideal-pixel hyphen-pixel)) (push (- line-pixel ideal-pixel) lines-rests) (push (ekp--gaps-list (seq-drop (cl-subseq glues-types start end) 1)) lines-gaps) (setq start end))) (let ((dp-result (list :rests (nreverse lines-rests) :gaps (nreverse lines-gaps) :breaks breaks :cost c-cost :line-count (length breaks)))) (puthash line-pixel dp-result (ekp-para-dp-cache para)) dp-result)))))) (defun ekp--dp-cache-elisp (para string line-pixel) "Pure Elisp DP implementation." (ignore string) ; para already contains all needed data ;; Get data directly from struct (O(1) access) (let* ((glues-types (ekp-para-glues-types para)) (boxes (ekp-para-boxes para)) (hyphen-pixel (ekp-para-hyphen-pixel para)) (hyphen-positions (ekp-para-hyphen-positions para)) (n (length boxes)) (ideal-prefixs (ekp-para-ideal-prefixs para)) (min-prefixs (ekp-para-min-prefixs para)) (max-prefixs (ekp-para-max-prefixs para)) (arrays (ekp--dp-init-arrays n)) (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))) ;; Main DP loop: for each reachable position i (dotimes (i (1+ n)) (when (aref demerits i) (let ((prev-hyphen-count (aref hyphen-counts i)) (prev-fitness (aref fitness-classes i)) (prev-line-count (aref line-counts i))) (catch 'break ;; Try extending line to each position k > i (dotimes (j (- n i)) (let* ((k (+ i j 1)) (is-last (= k n)) ;; k is the break position (exclusive), k-1 is the last box index (end-with-hyphenp (ekp--hyphenate-p hyphen-positions (1- k))) (metrics (ekp--dp-line-metrics i k glues-types ideal-prefixs min-prefixs max-prefixs)) (ideal-pixel (nth 0 metrics)) (min-pixel (nth 1 metrics)) (max-pixel (nth 2 metrics))) ;; Add hyphen width if line ends with hyphen (when end-with-hyphenp (cl-incf ideal-pixel hyphen-pixel) (cl-incf max-pixel hyphen-pixel) (cl-incf min-pixel hyphen-pixel)) ;; Check if line is too long (when (or (> min-pixel line-pixel) (and is-last (> ideal-pixel line-pixel))) (when (null (aref demerits (1- k))) (ekp--dp-force-break i k arrays glues-types hyphen-positions ideal-prefixs hyphen-pixel line-pixel)) (throw 'break nil)) ;; Valid break point: compute demerits (when (or (<= min-pixel line-pixel max-pixel) (and is-last (<= ideal-pixel line-pixel))) (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen) (ekp--dp-compute-line-demerits j is-last end-with-hyphenp ideal-pixel line-pixel glues-types i k prev-hyphen-count prev-fitness))) (let ((total-dem (+ (aref demerits i) dem))) (when (or (null (aref demerits k)) (< total-dem (aref demerits k))) (aset rests k (- line-pixel ideal-pixel)) (aset gaps k line-gaps) (aset demerits k total-dem) (aset backptrs k i) (aset fitness-classes k fitness) (aset hyphen-counts k new-hyphen) (aset line-counts k (1+ prev-line-count)))))))))))) ;; Extract optimal solution (let* ((breaks (ekp--dp-trace-breaks-with-looseness backptrs line-counts n (aref line-counts n))) (lines-rests (mapcar (lambda (i) (aref rests i)) breaks)) (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks)) (dp-result (list :rests lines-rests :gaps lines-gaps :breaks breaks :cost (aref demerits n) :line-count (aref line-counts n)))) (puthash line-pixel dp-result (ekp-para-dp-cache para)) dp-result))) (defun ekp-dp-data (string line-pixel &optional key) "Return the data plist of dp cache. If KEY is non-nil, return the value of KEY in plist." (let ((data (ekp-dp-cache string line-pixel))) (if key (plist-get data key) data))) (defun ekp-total-cost (string line-pixel) "Return the COST of kp algorithm." (ekp-dp-data string line-pixel :cost)) (defun ekp-line-breaks (string line-pixel) "Return the break points of kp algorithm." (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) "Compute glue pixels for each line after breaking STRING at LINE-PIXEL. 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)) (boxes-num (length (ekp--boxes string))) (glues-types (ekp--glues-types string)) (hyphen-positions (ekp--hyphen-positions string)) (ideal-prefixs (ekp--ideal-prefixs string)) (max-prefixs (ekp--max-prefixs string)) (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)) (start 0)) (dotimes (i (length breaks)) (let* ((end (nth i breaks)) (line-boxes-widths (cl-subseq boxes-widths start end)) (line-glues-types (seq-drop (cl-subseq glues-types start end) 1)) (is-last (>= end boxes-num)) ;; end is exclusive, end-1 is the last box index (hyphen-p (ekp--hyphenate-p hyphen-positions (1- end))) (ideal-pixel (- (aref ideal-prefixs end) (aref ideal-prefixs start) (ekp-glue-ideal-pixel (aref glues-types start)))) (max-pixel (+ (- (aref max-prefixs end) (aref max-prefixs start) (ekp-glue-max-pixel (aref glues-types start))) (if hyphen-p hyphen-pixel 0))) glue-list) (setq glue-list (cond ;; Single box: just trailing space ((= 1 (length line-boxes-widths)) (ekp--line-glue-single-box line-pixel (aref line-boxes-widths 0) hyphen-p hyphen-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) (mapcar #'ekp-glue-max-pixel line-glues-types) (list (- line-pixel max-pixel)))) ;; Normal justified line (t (ekp--line-glue-normal line-glues-types (nth i lines-rests) (nth i lines-gaps))))) (aset line-glues i (vconcat glue-list)) (setq start end))) line-glues)) (defun ekp--box-space-p (box) "Return non-nil if BOX is a whitespace-only box." (and box (not (string-empty-p box)) (or (string-blank-p box) (= (string-width box) 0)))) (defun ekp--interleave (list1 list2) "Interleave elements of LIST1 and LIST2." (let (result) (while (or list1 list2) (when list1 (push (pop list1) result)) (when list2 (push (pop list2) result))) (nreverse result))) (defun ekp--combine-glues-and-boxes (glues boxes) "Combine GLUES (n+1 elements) and BOXES (n elements) into string." (let* ((glues (append glues nil)) (last-glue (car (last glues))) (glues (butlast glues)) (boxes (append boxes nil))) (if (= (length glues) (length boxes)) (string-join (append (ekp--interleave glues boxes) (list last-glue))) (error "Glues count (%d) must equal boxes count (%d) + 1" (1+ (length glues)) (length boxes))))) (defun ekp--pixel-spacing-width (spacing) "Extract pixel width from a SPACING created by `ekp-pixel-spacing'." (if (string-empty-p spacing) 0 (let ((display (get-text-property 0 'display spacing))) (if (and display (eq (car display) 'space)) (let ((width-spec (plist-get (cdr display) :width))) (if (listp width-spec) (car width-spec) (or width-spec 0))) 0)))) (defun ekp--redistribute-extra-width (glues extra-width) "Redistribute EXTRA-WIDTH across GLUES proportionally. GLUES is a list of pixel spacing strings. Returns adjusted list. The extra width is distributed to all glues except leading (first) glue." (when (and glues (> extra-width 0)) (let* ((inner-glues (butlast (cdr glues))) ; glues between boxes (not leading/trailing) (n (length inner-glues))) (if (= n 0) ;; No inner glues, add all to trailing (let* ((trailing (car (last glues))) (old-width (ekp--pixel-spacing-width trailing)) (new-width (+ old-width extra-width))) (setf (car (last glues)) (ekp-pixel-spacing new-width))) ;; Distribute across inner glues (let ((per-glue (/ extra-width n)) (remainder (% extra-width n)) (idx 0)) (setq glues (cons (car glues) ; leading glue unchanged (append (mapcar (lambda (g) (let* ((old-w (ekp--pixel-spacing-width g)) (extra (+ per-glue (if (< idx remainder) 1 0))) (new-w (+ old-w extra))) (cl-incf idx) (ekp-pixel-spacing new-w))) inner-glues) (last glues)))))))) ; trailing glue unchanged glues) (defun ekp--strip-line-spaces (line-boxes line-glues line-boxes-widths) "Strip leading/trailing space boxes from LINE-BOXES. Returns (stripped-boxes . adjusted-glues) with extra width redistributed. LINE-BOXES-WIDTHS is the pixel widths corresponding to LINE-BOXES. The removed space width is redistributed to remaining glues for proper justification." (let* ((boxes (append line-boxes nil)) (glues (append line-glues nil)) (widths (append line-boxes-widths nil)) (removed-width 0)) ; Track total width of removed space boxes (when (> (length boxes) 0) ;; Strip trailing space boxes (while (and boxes (ekp--box-space-p (car (last boxes)))) ;; Accumulate width of removed space box (cl-incf removed-width (car (last widths))) (setq boxes (butlast boxes)) (setq widths (butlast widths)) ;; Remove second-to-last glue (the one before the trailing space box) ;; Keep the last glue which is trailing space for the line (when (> (length glues) 1) (setq glues (append (butlast (butlast glues)) (last glues))))) ;; Strip leading space boxes (while (and boxes (ekp--box-space-p (car boxes))) ;; Accumulate width of removed space box (cl-incf removed-width (car widths)) (setq boxes (cdr boxes)) (setq widths (cdr widths)) ;; Remove the second glue (the one after the leading glue) (when (> (length glues) 1) (setq glues (cons (car glues) (cddr glues)))))) ;; Redistribute removed width to remaining glues for proper justification (when (> removed-width 0) (setq glues (ekp--redistribute-extra-width glues removed-width))) (cons (vconcat boxes) glues))) (defun ekp--pixel-justify (string line-pixel) "Justify single STRING to LINE-PIXEL." (let* ((boxes (ekp--boxes string)) (boxes-widths (ekp--boxes-widths string)) (hyphen (ekp--hyphen-str string)) (breaks (ekp-line-breaks string line-pixel)) (num (length breaks)) (lines-glues (ekp-line-glues string line-pixel)) (hyphen-positions (ekp--hyphen-positions string)) (start 0) strings) (dotimes (i num) (let* ((end (nth i breaks)) (line-boxes (cl-subseq boxes start end)) (line-boxes-widths (cl-subseq boxes-widths start end)) (line-glues-raw (mapcar #'ekp-pixel-spacing (aref lines-glues i))) ;; Strip leading/trailing space boxes, adjust trailing glue (stripped (ekp--strip-line-spaces line-boxes line-glues-raw line-boxes-widths)) (line-boxes (car stripped)) (line-glues (cdr stripped)) ;; Check if last box of this line needs hyphen (last-box-idx (1- end)) (need-hyphen (and (< i (1- num)) ; not last line (ekp--hyphenate-p hyphen-positions last-box-idx)))) (when (and need-hyphen (> (length line-boxes) 0)) (setf (aref line-boxes (1- (length line-boxes))) (concat (aref line-boxes (1- (length line-boxes))) hyphen))) (when (> (length line-boxes) 0) (push (ekp--combine-glues-and-boxes line-glues line-boxes) strings)) (setq start end))) (mapconcat 'identity (nreverse strings) "\n"))) (defun ekp-pixel-justify (string line-pixel) "Justify multiline STRING to LINE-PIXEL. USE-CACHE is ignored; caching is always enabled via ekp--para-cache." (let ((strs (split-string string "\n"))) (mapconcat (lambda (str) (if (string-blank-p str) "" (ekp--pixel-justify str line-pixel))) strs "\n"))) ;;; Optimal Width Search ;; ;; Uses ternary search with aggressive caching. ;; The key optimization: reuse box/glue preprocessing across all widths. (defun ekp--compute-avg-cost (strings pixel) "Compute average cost for STRINGS at PIXEL width." (let ((total-cost 0) (count 0)) (dolist (s strings) (unless (string-blank-p s) (cl-incf total-cost (abs (ekp-total-cost s pixel))) (cl-incf count))) (if (> count 0) (/ (float total-cost) count) most-positive-fixnum))) (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) iterations (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) "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL. Returns (justified-text . optimal-pixel). Uses ternary search for O(log n) width evaluations. All preprocessing is cached via ekp--para-cache." (let* ((strings (split-string string "\n")) ;; Pre-warm caches (_ (dolist (s strings) (unless (string-blank-p s) (ekp--get-para s)))) (best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel))) (cons (ekp-pixel-justify string best-pixel) best-pixel))) (provide 'ekp) ;;; ekp.el ends here