;; author -> Norbert Freudemann
;; creation date : 16/07/2001
;; last change   : 19/07/2001

; --- Dimension-Predicates

(define (1-byte? int)
  (and (< 0 int) (> 255 int)))

(define (2-byte? int)
  (and (< 0 int) (> 65535 int)))

; --- verify-format checks wheather the text-vec elements are between correct 
; dimensions.

(define (verify-format text format)
  (let ((pred (if (eq? format '1-byte)
		  1-byte?
		  2-byte?)))
    (let loop ((t text))
      (cond
       ((null? t) #f)
       ((pred (car t)) (loop (cdr t)))
       (else (error "text doesnt' match format" text format))))))

; --- Makes a number (1 or 2) from the format-symbols '1-byte or '2-byte

(define (get-format-id format)
  (cond ((eq? format '1-byte) 0)
	((eq? format '2-byte) 1)
	(else (error "Unknown format specifier" format))))

; --- mixed-text->pure-text converts a list of integers, chars, symbols and 
;     strings into a long list of integers (= the characters)

(define (mixed-text->pure-text list)
  (if (not (list? list))
      (mixed-text->pure-text (cons list '()))
      (let loop ((list list)
		 (rev-list '()))
	(if (null? list)
	    (reverse rev-list)
	    (loop (cdr list)
		  (let loop2 ((e (car list)))
		    (cond
		     ((integer? e) (cons e rev-list))
		     ((char? e) (cons (char->ascii e) rev-list))
		     ((symbol? e) (loop2 (symbol->string e)))
		     ((string? e) 
		      (append (reverse
			       (mixed-text->pure-text (string->list e)))
			      rev-list))
		     (else (error "wrong element in text list" list e)))))))))

; --- separate-fonts converts a list of mixed types (including fonts) like this:
;     (13 "abc" font 'abc) -> ((13 "abc") font ('abc)) or
;     "abc" -> ("abc")

(define (separate-fonts lst)
  (cond
   ((null? lst) lst)
   ;; a single text-spec
   ((not (list? lst)) (list lst))
   ;; a font-spec
   ((or (font? (car lst))
	(pair? (car lst)))
    (cons (car lst) (separate-fonts (cdr lst))))
   (else (let ((r (separate-fonts (cdr lst))))
	   (cond
	    ;; first element is a font-spec:
	    ((or (null? r) (font? (car r)) (pair? (car r)))
	     (cons (list (car lst)) r))
	    ;; first element is a text-spec, so add this one
	    (else
	     (cons (cons (car lst) (car r))
		   (cdr r))))))))

; --- text->internal-text

(define (text->internal-text text format)
  (let ((t (mixed-text->pure-text text)))
    (verify-format t format)
    (list->vector t)))


; --- text-width returns the widht of the given 1- or 2-byte char-string,
;     represented by a vector of integers.

(define (text-width font text format)
  (%text-width (font-Xfontstruct font)
	       (text->internal-text text format)
	       (get-format-id format)))

(import-lambda-definition %text-width (Xfontstruct text format)
  "scx_Text_Width")

; --- Each extents-...-functions returns a number.

(define (extents-lbearing font text format)
  (extents-intern font text format 0))


(define (extents-rbearing font text format)
  (extents-intern font text format 1))


(define (extents-width font text format)
  (extents-intern font text format 2))


(define (extents-ascent font text format)
  (extents-intern font text format 3))


(define (extents-descent font text format)
  (extents-intern font text format 4))


(define (extents-intern font text format which?)
  (%extents (font-Xfontstruct font)
	    (text->internal-text text format)
	    (get-format-id format)
	    which?))

(import-lambda-definition %extents-text (Xfontstruct text format which)
  "scx_Extents_Text")			  
      
; --- draw-image-text draws the text. text is a integer, character, string 
; or symbol, or event a list of these types.

(define (draw-image-text drawable gcontext x y text format)
  (%draw-image-text (display-Xdisplay (drawable-display drawable))
		    (drawable-Xobject drawable)
		    (gcontext-Xgcontext gcontext)
		    x y 
		    (text->internal-text text format)
		    (eq? format '2-byte)))
		    

(import-lambda-definition %draw-image-text (Xdisplay Xdrawable Xgcontext
						     x y text format)
  "scx_Draw_Image_Text")

; --- text is a list of font-object and chars.

(define (draw-poly-text drawable gcontext x y text format)
  (let ((text-spec 
	 (map (lambda (text-or-font)
		(cond
		 ((font? text-or-font) 
		  (cons (font-Xfont text-or-font)
			0))
		 ((and (pair? text-or-font) 
		       (not (list? text-or-font)))
		  (cons (if (font? (car text-or-font))
			    (font-Xfont (car text-or-font))
			    'none)
			(cdr text-or-font)))
		 (else (text->internal-text text-or-font
					    format))))
	      (separate-fonts text))))
    (%draw-poly-text (display-Xdisplay (drawable-display drawable))
		     (drawable-Xobject drawable)
		     (gcontext-Xgcontext gcontext)
		     x y
		     (list->vector text-spec)
		     (eq? format '2-byte))))

(import-lambda-definition %draw-poly-text (Xdisplay Xdrawable Xgcontext
						    x y text twobyte)
  "scx_Draw_Poly_Text")