#lang racket/base

(require ffi/unsafe)

(define libhb (ffi-lib "../3rdparty/libharfbuzz-icu"))

(define-cpointer-type _hb_face_t)
(define-cpointer-type _hb_font_t)

(define-cstruct _hb_glyph_info_t
  ([codepoint _uint32] ;_hb_codepoint_t=_uint32_t
   [mask _uint32] ; priv. var.
   [cluster _uint32]
   [var1  _uint32] ; priv. var.
   [var2 _uint32] ; priv. var.
   ))

(define-cstruct _hb_glyph_position_t
  ([x_advance _int32] ;_hb_position_t=_int32_t
   [y_advance _int32]
   [x_offset _int32]
   [y_offset _int32]
   [var _int32] ; priv. var.
   ))


;hb_buffer_t *
;hb_buffer_create (void);
(define hb-buffer-create-raw
  (get-ffi-obj "hb_buffer_create" libhb
               (_fun -> _pointer)))

;void
;hb_buffer_add_utf8 (hb_buffer_t *buffer,
;                    const char *text,
;                    int text_length,
;                    unsigned int item_offset,
;                    int item_length);
(define hb-buffer-add-utf8-raw
  (get-ffi-obj "hb_buffer_add_utf8" libhb
               (_fun _pointer _string/utf-8 _int _uint _int -> _void)))

; not implemented for now. maybe implemented in the future.
;      // If you know the direction, script, and language
;      hb_buffer_set_direction(buf, HB_DIRECTION_LTR)
;      hb_buffer_set_script(buf, HB_SCRIPT_LATIN);
;      hb_buffer_set_language(buf, hb_language_from_string("en", -1));

;hb_blob_t *
;hb_blob_create_from_file (const char *file_name);
(define hb-blob-create-from-file-raw
  (get-ffi-obj "hb_blob_create_from_file" libhb
               (_fun _string/utf-8 -> _pointer)))

;hb_face_t *
;hb_face_create (hb_blob_t *blob,
;                unsigned int index);
(define hb-face-create-raw
  (get-ffi-obj "hb_face_create" libhb
               (_fun _pointer _uint -> _hb_face_t)))
; hb_font_t *
; hb_font_create (hb_face_t *face);
(define hb-font-create-raw
  (get-ffi-obj "hb_font_create" libhb
               (_fun _hb_face_t -> _hb_font_t)))
;void
;hb_shape (hb_font_t *font,
;          hb_buffer_t *buffer,
;          const hb_feature_t *features,
;          unsigned int num_features);
(define hb-shape-raw
  (get-ffi-obj "hb_shape" libhb
               (_fun _hb_font_t _pointer _pointer _uint -> _void)))
;void
;hb_buffer_guess_segment_properties (hb_buffer_t *buffer)
(define hb-buffer-guess-segment-properties-raw
  (get-ffi-obj "hb_buffer_guess_segment_properties" libhb
               (_fun _pointer -> _void)))

(define hb-buffer-get-glyph-infos-raw
  (get-ffi-obj "hb_buffer_get_glyph_infos" libhb
  (_fun 
        [buf : _pointer]
        [glyph-length : (_ptr o _uint)]
        -> [glyph-info : _pointer]
        -> (values glyph-info glyph-length))))

(define hb-buffer-get-glyph-positions-raw
  (get-ffi-obj "hb_buffer_get_glyph_positions" libhb
  (_fun 
        [buf : _pointer]
        [glyph-length : (_ptr o _uint)]
        -> [glyph-position : _pointer]
        -> (values glyph-position glyph-length))))
(define hb-buffer-has-positions-raw
   (get-ffi-obj "hb_buffer_has_positions" libhb
                (_fun [buf : _pointer] -> _bool)))

(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
(define buf (create-hb-buffer))
(hb-buffer-add-utf8-raw buf "123ABCabcmn̂gMMMMMM" -1 0 -1)
(define font-path "/usr/share/fonts/truetype/freefont/FreeSansBold.ttf")
(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))

(printf "has pos ?: ~a" (hb-buffer-has-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))]))
 )
   x-adv-sum
   y-adv-sum)