Compare commits

...

3 commits

Author SHA1 Message Date
5b17332500 1. modify libharfbuzz and the .so, and modify libharu interface file. add a plugin for uahgi2
Some checks are pending
CI / Build on Racket 'stable' (BC) (push) Waiting to run
CI / Build on Racket 'stable' (CS) (push) Waiting to run
CI / Build on Racket 'current' (BC) (push) Waiting to run
CI / Build on Racket 'current' (CS) (push) Waiting to run
2025-10-07 22:46:13 +08:00
09228a8b7e 1. modify libharfbuzz and the .so, and modify libharu interface file. add a plugin for uahgi2 2025-10-07 22:41:18 +08:00
895d0d343f 1. modify libharfbuzz and the .so, and modify libharu interface file. add a plugin for uahgi2 2025-10-07 22:40:53 +08:00
9 changed files with 80 additions and 30 deletions

1
3rdparty/libharfbuzz-icu.so vendored Symbolic link
View file

@ -0,0 +1 @@
libharfbuzz-icu.so.0

1
3rdparty/libharfbuzz-icu.so.0 vendored Symbolic link
View file

@ -0,0 +1 @@
libharfbuzz-icu.so.0.61210.0

BIN
3rdparty/libharfbuzz-icu.so.0.61210.0 vendored Executable file

Binary file not shown.

View file

@ -1 +0,0 @@
libharfbuzz-subset.so.0

View file

@ -1 +0,0 @@
libharfbuzz-subset.so.0.61151.0

Binary file not shown.

View file

@ -1,6 +1,7 @@
(module uahgi2 racket/base (module uahgi2 racket/base
(require racket/dict) (require racket/dict)
(require racket/list)
(define main-config (make-hash (define main-config (make-hash
'(["paper-width". 2480] '(["paper-width". 2480]
["paper-height". 3508] ["paper-height". 3508]
@ -13,9 +14,9 @@
))) )))
(define main-frame (make-hash (define main-frame (make-hash
'(["id" . 1] `(["id" . 1]
["font-family" . (dict-ref main-config "font-family")] ["font-family" . ,(dict-ref main-config "font-family")]
["class" . frame] ["class" . "frame"]
["width" . 2000] ["width" . 2000]
["height" . 3000] ["height" . 3000]
["x" . 200] ["x" . 200]
@ -24,14 +25,6 @@
(define (set-main-config attr val) (define (set-main-config attr val)
(dict-set! main-config attr val)) (dict-set! main-config attr val))
(define (main-text txt)
(begin
(dict-set! main-frame "content" txt)
(for/list ([p plugin-list])
[if (memq (dict-ref p "lang") (dict-ref main-config "lang"))
[let ([tmp ((dict-ref p "body") (dict-ref main-frame "content"))])
(dict-set! main-frame "content" tmp)] #f])))
(define-syntax text-series (define-syntax text-series
(syntax-rules () (syntax-rules ()
@ -42,16 +35,36 @@
`('text ,(caar `(x ...)) ,(cdar `(x ...))))])) `('text ,(caar `(x ...)) ,(cdar `(x ...))))]))
(define plugin-list '()) (define plugin-list '())
(define plugin-test (make-hash `(["lang" . "zh"] (define [two-newlines-into-par-aux cont]
["body" . ,(lambda (x) "result:foo")]))) (display (list-ref cont 1))
(define (sexp-processing res remain)
[cond
[(eq? remain '()) (reverse res)]
[(and (equal? (car remain) "\n") (equal? (car res) "\n")) (sexp-processing (cons '(par) (cdr res)) [cdr remain])]
[else (sexp-processing(cons (car remain) res) [cdr remain])]])
(list-set cont 1 (sexp-processing '() (list-ref cont 1))))
(set! plugin-list (reverse (cons plugin-test (reverse plugin-list)))) (define two-newlines-into-par (make-hash `(["lang" . "all"] ; for all languages
["body" . ,two-newlines-into-par-aux])))
(define-syntax append-plugin!
(syntax-rules ()
[(_ ls plugin) (set! ls (reverse (cons plugin (reverse ls))))]))
[append-plugin! plugin-list two-newlines-into-par]
(define (main-text txt)
(begin
(dict-set! main-frame "content" txt)
(display plugin-list)
(for/list ([p plugin-list])
[if [or (memq (dict-ref p "lang") (dict-ref main-config "lang"))
(eq? (dict-ref p "lang") "all")]
[let ([tmp ((dict-ref p "body") (dict-ref main-frame "content"))])
(dict-set! main-frame "content" tmp)] #f])))
(provide text-series main-text main-frame main-config set-main-config set! (provide text-series main-text main-frame main-config set-main-config set!

View file

@ -2,8 +2,7 @@
(require ffi/unsafe) (require ffi/unsafe)
; don't use the complete lib. It will crash. (define libhb (ffi-lib "../3rdparty/libharfbuzz-icu"))
(define libhb (ffi-lib "../3rdparty/libharfbuzz-subset"))
(define-cpointer-type _hb_face_t) (define-cpointer-type _hb_face_t)
(define-cpointer-type _hb_font_t) (define-cpointer-type _hb_font_t)
@ -99,10 +98,40 @@
(define (create-hb-buffer) (hb-buffer-create-raw)) (define (create-hb-buffer) (hb-buffer-create-raw))
(define (get-string-box-x-and-y-adv string font-path pt)
(define buf (create-hb-buffer))
(hb-buffer-add-utf8-raw buf string -1 0 -1)
(define blob (hb-blob-create-from-file-raw font-path))
(define NULL (cast 0 _int64 _pointer))
(define face (hb-face-create-raw blob 0))
(define font (hb-font-create-raw face))
(hb-buffer-guess-segment-properties-raw buf)
(hb-shape-raw font buf NULL 0)
(define-values (glyph-pos glyph-length) (hb-buffer-get-glyph-positions-raw buf))
(define x-adv-sum 0)
(define y-adv-sum 0)
(for ([i glyph-length])
(let [[ith (ptr-ref glyph-pos _hb_glyph_position_t i)]]
(set! x-adv-sum [+ x-adv-sum (hb_glyph_position_t-x_advance (ptr-ref glyph-pos _hb_glyph_position_t i))])
(set! y-adv-sum [+ y-adv-sum (hb_glyph_position_t-y_advance (ptr-ref glyph-pos _hb_glyph_position_t i))]))
)
(let
[(ret-x-adv (* (/ x-adv-sum 1000.0) pt (/ 4.0 3.0)))
(ret-y-adv (* (/ y-adv-sum 1000.0) pt (/ 4.0 3.0)))]
`(,ret-x-adv ,ret-y-adv)))
(define (get-string-box-x-adv string font-path pt)
(list-ref (get-string-box-x-and-y-adv string font-path pt) 0))
(define (get-string-box-y-adv string font-path pt)
(list-ref (get-string-box-x-and-y-adv string font-path pt) 1))
(provide get-string-box-x-adv get-string-box-y-adv)
(module+ test
(require rackunit)
; test area ; test area
(define buf (create-hb-buffer)) (define buf (create-hb-buffer))
(hb-buffer-add-utf8-raw buf "123abc" -1 0 -1) (hb-buffer-add-utf8-raw buf "123ABCabcmn̂gMMMMMM" -1 0 -1)
(define font-path "/usr/share/fonts/truetype/freefont/FreeSansBold.ttf") (define font-path "/usr/share/fonts/truetype/freefont/FreeSansBold.ttf")
(define blob (hb-blob-create-from-file-raw font-path)) (define blob (hb-blob-create-from-file-raw font-path))
(define NULL (cast 0 _int64 _pointer)) (define NULL (cast 0 _int64 _pointer))
@ -110,13 +139,17 @@
(define font (hb-font-create-raw face)) (define font (hb-font-create-raw face))
(hb-buffer-guess-segment-properties-raw buf) (hb-buffer-guess-segment-properties-raw buf)
(hb-shape-raw font buf NULL 0) (hb-shape-raw font buf NULL 0)
(define-values (glyph-info glyph-length) (hb-buffer-get-glyph-infos-raw buf))
(define-values (glyph-pos glyph-length2) (hb-buffer-get-glyph-positions-raw buf)) (define-values (glyph-pos glyph-length) (hb-buffer-get-glyph-positions-raw buf))
(printf "has pos ?: ~a" (hb-buffer-has-positions-raw buf)) (printf "has pos ?: ~a" (hb-buffer-has-positions-raw buf))
(define x-adv-sum 0)
(define y-adv-sum 0)
(for ([i glyph-length]) (for ([i glyph-length])
(displayln (hb_glyph_info_t-cluster (ptr-ref glyph-info _hb_glyph_info_t i)))) (let [[ith (ptr-ref glyph-pos _hb_glyph_position_t i)]]
(for ([i glyph-length2]) (set! x-adv-sum [+ x-adv-sum (hb_glyph_position_t-x_advance (ptr-ref glyph-pos _hb_glyph_position_t i))])
(displayln (hb_glyph_position_t-x_advance (ptr-ref glyph-pos _hb_glyph_position_t i)))) (set! y-adv-sum [+ y-adv-sum (hb_glyph_position_t-y_advance (ptr-ref glyph-pos _hb_glyph_position_t i))]))
)
x-adv-sum
y-adv-sum)

View file

@ -56,7 +56,7 @@
(define (new-pdf) (pdf-new-raw 0 0)) (define (new-pdf) (pdf-new-raw 0 0))
(define (save-pdf pdf path) (pdf-save-raw pdf path)) (define (save-pdf pdf path) (pdf-save-raw pdf path))
(define (new-page pdf) (add-page-raw pdf)) (define (new-page pdf) (add-page-raw pdf))
(define (free-pdf p) (pdf-free-raw p)) ; Error invalid memory reference. Some debugging context lost (define (free-pdf p) (pdf-free-raw p))
(define (new-ttf-font p font) (define (new-ttf-font p font)
(define ttf-loaded (load-ttf-raw p font #t)) (define ttf-loaded (load-ttf-raw p font #t))
@ -72,6 +72,9 @@
(page-end-text-raw page) (page-end-text-raw page)
) )
(provide new-pdf save-pdf new-page free-pdf new-ttf-font use-utf8 set-font-size put-text)
(module+ test
(require rackunit)
; 以下是測試區 ; 以下是測試區
(define doc (new-pdf)) (define doc (new-pdf))
(define pg (new-page doc)) (define pg (new-page doc))
@ -80,4 +83,5 @@
(set-font-size pg ian-sui 15.0) (set-font-size pg ian-sui 15.0)
(put-text pg 140.0 150.0 "天地人123abc") (put-text pg 140.0 150.0 "天地人123abc")
(save-pdf doc "/tmp/a.pdf") (save-pdf doc "/tmp/a.pdf")
(free-pdf doc) (void? (free-pdf doc))
)