From 5e0439da94690dce92ed930c8c0b3bbffaa89dde Mon Sep 17 00:00:00 2001 From: frese Date: Tue, 21 Aug 2001 15:01:38 +0000 Subject: [PATCH] changed the text-representation from vectors to lists, added delta statements, changed the internal processing and abstractions. --- scheme/xlib/text.scm | 217 ++++++++++++++++++++++--------------------- 1 file changed, 109 insertions(+), 108 deletions(-) diff --git a/scheme/xlib/text.scm b/scheme/xlib/text.scm index 4cbb521..79ed2b1 100644 --- a/scheme/xlib/text.scm +++ b/scheme/xlib/text.scm @@ -2,6 +2,7 @@ ;; creation date : 16/07/2001 ;; last change : 19/07/2001 +; --- Dimension-Predicates (define (1-byte? int) (and (< 0 int) (> 255 int))) @@ -9,50 +10,91 @@ (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! +; --- verify-format checks wheather the text-vec elements are between correct +; dimensions. -(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))))) +(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 (change-format format) - (cond ((symbol? format) - (cond ((eq? format '1-byte) 1) - ((eq? format '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))) - +(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 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) - (let ((int-format (change-format format))) - (if (vec-format? text format) - (%text-width (font-Xfontstruct font) text int-format) - (error "Wrong format for text")))) - + (%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 an number. +; --- Each extents-...-functions returns a number. (define (extents-lbearing font text format) (extents-intern font text format 0)) @@ -75,96 +117,55 @@ (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!")))) + (%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 get's a mixed vector (text) with integer and -; font-type inside. +; --- 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) - (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!")))) + (%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 Vector of font-object and chars. +; --- text is a list 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 int-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 format) + x y text twobyte) "scx_Draw_Poly_Text") - -(define (check-format (trans-text int-format)) - (call-with-current-continuation - (lambda (return) - (for-each (lambda (obj) - (if (and (vector? obj) - (not (vec-format? obj int-format))) - (return #f))) - (vector->list trans-text)) - #t))) - - -; --- 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) - (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)))))))