diff --git a/scheme/xlib/color-type.scm b/scheme/xlib/color-type.scm index 98e12cb..4d517e7 100644 --- a/scheme/xlib/color-type.scm +++ b/scheme/xlib/color-type.scm @@ -11,7 +11,7 @@ (if maybe-color maybe-color (let ((color (really-make-color #f Xcolor))) - (add-finalizer! color finalize-color) + (add-finalizer! color color-list-delete!) (color-list-set! Xcolor color) color)))) @@ -32,20 +32,25 @@ (import-lambda-definition %extract-rgb-values (XColor) "Extract_RGB_Values") -;; finalize-color is called, when the garbage collector removes the last -;; reference to the color from the heap. Then we can savely close the color -;; and remove the weak-pointer from our list. - -(define (finalize-color color) - (let ((Xcolor (color-Xcolor color))) - ;;(destroy-color color) - (color-set-Xcolor! color 'already-destroyed) - (color-list-delete! Xcolor))) - ;; All color records need to be saved in a weak-list, to have only one record ;; for the same r,g,b value in the heap. -(define *weak-color-list* (make-integer-table)) +;; A color is generate with S48_MAKE_VALUE, thus it is a byte-vector that cannot +;; be kept in an integer-table like the other datatypes. So let's create a +;; byte-vector table. + +(define make-byte-vector-table + (make-table-maker eq? + (lambda (bv) + (let loop ((i (byte-vector-length bv)) + (bytes '())) + (if (= i 0) + (apply + bytes) + (loop (- i 1) + (cons (byte-vector-ref bv (- i 1)) + bytes))))))) + +(define *weak-color-list* (make-byte-vector-table)) (define (color-list-find Xcolor) (let ((r (table-ref *weak-color-list* Xcolor))) @@ -60,7 +65,7 @@ (let ((color (weak-pointer-ref value))) (if (equal? (list r g b) (extract-rgb-values color)) - (return key)))) + (return color)))) *weak-color-list*) #f))) @@ -68,5 +73,6 @@ (let ((p (make-weak-pointer color))) (table-set! *weak-color-list* Xcolor p))) -(define (color-list-delete! Xcolor) - (table-set! *weak-color-list* Xcolor #f)) +(define (color-list-delete! color) + (table-set! *weak-color-list* + (color-Xcolor color) #f))