;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define draw-pool '())

(define (round-rect x y width height br)
  (define-values (tlrx tlry trrx trry brrx brry blrx blry)
    (match br
	   [((tlrx tlry) (trrx trry) (brrx brry) (blrx blry))
	    (values tlrx tlry trrx trry brrx brry blrx blry)]
	   [else
	    (values 0 0 0 0 0 0 0 0)]))

	   (draw-bg)
	   (with-cairo (mi-cr)
		       (set-source-color bg-color)
		       (fill)))
     
	   (draw-path))))

(define (text-get-char-index-from-offset text)
  
  (define font-size (mi-font-size))
  (define font-family (mi-font-family))
  (define font-style (mi-font-style))
  (define font-weight (mi-font-weight))
  (define text-align (mi-text-align))
  (define color (mi-color))

  (check-arg string? text text-get-char-index-from-offset)

  )
  
(define (text-extents text)
  (define font-size (mi-font-size))
  (define font-family (mi-font-family))
  (define font-style (mi-font-style))
  (define font-weight (mi-font-weight))
  (define text-align (mi-text-align))
  (define color (mi-color))

  (check-arg string? text text-extents)

  (let ([extents (cairo-text-extents-create)])
    (cairo-set-font-size (mi-cr) font-size)
    (cairo-select-font-face  (mi-cr) (string-append font-family (string #\nul))
					    (cairo-font-slant font-style) ;; normal|italic|oblique
					    (cairo-font-weight font-weight)) ;; normal|bold
    (cairo-text-extents (mi-cr) text extents)
    (let-struct extents cairo-text-extents-t 
		(width height x-bearing y-bearing x-advance y-advance)
		(list width height x-bearing y-bearing x-advance y-advance))))

(define-syntax cast
  (syntax-rules ()
    [(_ ftype fptr)
     (make-ftype-pointer ftype
			 (ftype-pointer-address fptr))]))

(define (*int ptr) (ftype-ref int () ptr))

(define (get-text-glyphs cr text)
  (define glyphs* (cairo-glyph*-create))
  (define glyph-count (cairo-int-create))
  (define clusters* (cairo-text-cluster*-create))
  (define cluster-count (cairo-int-create))
  (define clusterflags (cairo-text-cluster-flags-create))
  (define scaled-face (cairo-get-scaled-font cr))
  (define clusters #f)
  (define glyphs #f)
  
  (ftype-set! void* () (cast void* clusters*) 0)
  (ftype-set! void* () (cast void* glyphs*) 0)

  ;; THIS COULD BE CACHED SOMEWHERE?
  (unless (eq? 'success
	       (cairo-scaled-font-text-to-glyphs
		scaled-face 0 0  text (string-length text)
		glyphs* glyph-count
		clusters* cluster-count
		clusterflags))
	  (raise (error 'show-text "stat error" stat)))

  (values (cairo-guard-pointer (ftype-&ref cairo-text-cluster-t* (*) clusters*))
	  (*int cluster-count)
	  (cairo-guard-pointer (ftype-&ref cairo-glyph-t* (*) glyphs*))
	  (*int glyph-count)
	  scaled-face))


(define (get-text-char-index-from-offset cr text offset)
  (define-values (clusters cluster-count glyphs glyph-count scaled-face)
    (get-text-glyphs cr text))
  
  (let loop ([glyph-index 0] [byte-index 0] [i 0] [x-pos 0])
    (if (< i cluster-count)
	(let* ([cluster       (ftype-&ref cairo-text-cluster-t () clusters i)]
	       [clusterglyphs (ftype-&ref cairo-glyph-t () glyphs glyph-index)]
	       [extents (cairo-text-extents-create)])
	  (let-struct cluster cairo-text-cluster-t (num-glyphs num-bytes)
		      (cairo-scaled-font-glyph-extents scaled-face clusterglyphs num-glyphs extents)
		      (let ([ w (ftype-ref cairo-text-extents-t (x-advance) extents)])
			(if  (and (< (+ x-pos (/ w 2)) offset ))
			     (loop (+ glyph-index num-glyphs)
				   (+ byte-index num-bytes)
				   (+ i 1)
				   (+ x-pos w))
			     i))))
	i)))

(define (show-text cr text)
  (define-values (clusters cluster-count glyphs glyph-count scaled-face)
    (get-text-glyphs cr text))
  
  ;; we use cairo-show-glyphs instead of the below loop.
  ;; if not special glyph spacing / kerning is needed... (at least by now)
  (cairo-show-glyphs cr glyphs glyph-count)
  #;
  (let loop ([glyph-index 0] [byte-index 0] [i 0])
  (when (< i cluster-count)
  (let* ([cluster       (ftype-&ref cairo-text-cluster-t () clusters i)]
  [clusterglyphs (ftype-&ref cairo-glyph-t () glyphs glyph-index)]
  [extents (cairo-text-extents-create)])
  (let-struct
  cluster cairo-text-cluster-t (num-glyphs num-bytes)
  (cairo-scaled-font-glyph-extents scaled-face clusterglyphs glyph-count extents)
  ;;(printf "extents: status: ~d num-glyphs: ~d num-bytes: ~d~n" (cairo-status cr) num-glyphs num-bytes) ;
  (with-cairo cr
  (glyph-path clusterglyphs num-glyphs)
  (set-line-width 0)
  (fill-preserve)
  (stroke))
  (loop (+ glyph-index num-glyphs)
  (+ byte-index num-bytes)
  (+ i 1)))))))


(define (draw-text text x y w h)
  (define font-size (mi-font-size))
  (define font-family (mi-font-family))
  (define font-style (mi-font-style))
  (define font-weight (mi-font-weight))

			[center
			 (cairo-translate (mi-cr) (- (+ x (/ w 2)) (/ width 2)) (+ y height))]
			[right
			 (cairo-translate (mi-cr) (- (+ x w) width x-bearing) (+ y height))]
			[else
			 (cairo-translate (mi-cr) x (+ y height))])
		      
		      (show-text (mi-cr) text)
		      
		      (cairo-identity-matrix (mi-cr))))
		   
		   (list x-advance height))))

(define (draw-text/padding text x y w h)
  (draw-text text 

		    #t]
		   [else #f])))))))


(import (only (srfi s14 char-sets) char-set char-set:digit char-set-contains?)
	(only (thunder-utils) string-split string-replace))





(define (line-editor el id text validator)
  (create-element 
   el id #t
   (lambda ()
     (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h)))
     (define (cursor-pos) (mi-wget id 'cursor-pos 0))
     (define (cursor-pos-move dir)
       (let ([cp (cursor-pos)])
	 (cond
	  [(and (< dir 0) (> cp 0))
	   (mi-wset id 'cursor-pos (- cp 1))]
	  [(and (> dir 0) (< cp (string-length (text))))
	   (mi-wset id 'cursor-pos (+ cp 1))])))
     ;;(draw-rect x y w h)
     (when (and (mi-active-item) (mi-mouse-down?) (eq? (mi-hot-item) id) (eq? (mi-state) 'ready))
	   (mi-wset id 'cursor-pos (get-text-char-index-from-offset (mi-cr) (text) (- (mi-mouse-x) x (mi-padding))))
	   (printf "cursor-pos: ~d mouse-x: ~d x: ~d\n" (cursor-pos) (mi-mouse-x) x))
     (if (> (cursor-pos) (string-length (text)))
	 (mi-wset id 'cursor-pos (string-length (text))))

     (when (eq? (mi-kbd-item) id)
       (let ([txt (text)]
	     [txt-len (string-length (text))])
	 (case (mi-key)