[Scsh-checkins] CVS: scx/scheme/xlib text.scm,NONE,1.1

[Norbert Freudemann <nofreude@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv4578

Added Files:
        text.scm 
Log Message:
First Implementation of Text Metrics


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


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

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

; --- format is a number: 1 or 2. Make sure to call "change-format" before
;     useing this function!

(define (vec-format? text-vec format)
  (let ((len (vector-length text-vec))
        (pred (cond ((and (number? format) (= 1 format))
                     1-byte?)
                    ((and (number? format) (= 2 format))
                     2-byte?)
                    (else (error "Wrong format-type" vec-format?)))))
    (let loop ((i 0))
      (if (= i len) 
          #t
          (if (pred (vector-ref text-vec i))
              (loop (+ i 1))
              #f)))))

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

(define (change-format format)
  (cond ((symbol? format)
         (cond ((eq? '1-byte) 1)
               ((eq? '2-byte) 2)
               (else (error "Wrong format-type" change-format))))
        ((number? format)
         (if  (or (= 1 format) (= 2 format))
              format
              (error "Wrong format-type" change-format)))
        (else "Wrong format-type" change-format)))
      

; --- 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)
  (let ((int-format (change-format format)))
    (if (vec-format? text format)
        (%text-width (font-Xfontstruct font) text int-format)
        (error "Wrong format for text"))))
  
(import-lambda-definition %text-width (Xfontstruct text format)
  "Text_Width")

; --- Each extents-...-functions returns an 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 (extends-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?)
  (let ((int-format (change-format format)))
    (if (vec-format? text int-format)
        (%extents (font-Xfontstruct font)
                  text int-format which?)
        (error "Wrong format for text!"))))

(import-lambda-definition %extents-text (Xfontstruct text format which)
  "Extents_Text")                         
      
; --- draw-image-text get's a mixed vector (text) with integer and
;     font-type inside. 

(define (draw-image-text drawable gcontext x y text format)
  (let ((int-format (change-format format)))
    (if (vec-format? text int-format)
        (%draw-image-text (display-Xdisplay (drawable-display drawable))
                          (drawable-Xobject drawable)
                          (gcontext-Xgcontext gcontext)
                          x y text int-format)
        (error "Wrong format for text!"))))
                    

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

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

(define (draw-poly-text drawable gcontext x y text format)
  (let ((vec-text (transform-text text))
        (int-format (change-format format))
    (if (check-format? vec-text int-format)
        (%draw-poly-text (display-Xdisplay (drawable-display drawable))
                         (drawable-Xobject drawable) (gcontext-Xgcontext 
gcontext)
                         x y vec-text (change-format! format)))

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




; --- Extracts the Xfont from the scheme48-font-record and makes vectors
;     from formerly integer vector entries...
;     [13 24 35 font 3 5 34] -> [[13 24 35] Xfont [3 5 34]]

(define (transform-text text)
  (let ((len (vector-length text)))
    (let loop ((i 0)
               (res '())
               (tmp '()))
      (if (= i len)
          (if (not (null? tmp))
              (list->vector (append res (list (list->vector tmp))))
              (list->vector res))
          (let ((item (vector-ref text i)))
            (if (font? item)
                (if (not (null? tmp))
                    (loop (+ i 1)
                          (append res (list (list->vector tmp))
                                  (list (font-Xfont item)))
                          '())
                    (loop (+ i 1)
                          (append res (list font-Xfont item))
                          '()))
                (loop (+ i 1)
                      res
                      (append tmp (list item)))))))))



; --- Translates a string to it's representation (as a vector of int)
;     for the other text proedures like text-width, ... .
;     The format is '1-byte.

(define (translate-text string)
  (if (string? string)
      (let* ((len (string-length string))
             (res-vec (make-vector len)))
        (let loop ((i 0))
          (if (= i len)
              res-vec
              (begin
               (vector-set! res-vec i (char->integer (string-ref string i)))
               (loop (+ i 1))))))
      (error "the parameter istn't a string" translate-string)))