changed integer-table into byte-vector-table. fixed color-list-find.
This commit is contained in:
parent
def9eb131a
commit
40f33cd2f3
|
@ -11,7 +11,7 @@
|
||||||
(if maybe-color
|
(if maybe-color
|
||||||
maybe-color
|
maybe-color
|
||||||
(let ((color (really-make-color #f Xcolor)))
|
(let ((color (really-make-color #f Xcolor)))
|
||||||
(add-finalizer! color finalize-color)
|
(add-finalizer! color color-list-delete!)
|
||||||
(color-list-set! Xcolor color)
|
(color-list-set! Xcolor color)
|
||||||
color))))
|
color))))
|
||||||
|
|
||||||
|
@ -32,20 +32,25 @@
|
||||||
(import-lambda-definition %extract-rgb-values (XColor)
|
(import-lambda-definition %extract-rgb-values (XColor)
|
||||||
"Extract_RGB_Values")
|
"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
|
;; 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.
|
;; 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)
|
(define (color-list-find Xcolor)
|
||||||
(let ((r (table-ref *weak-color-list* Xcolor)))
|
(let ((r (table-ref *weak-color-list* Xcolor)))
|
||||||
|
@ -60,7 +65,7 @@
|
||||||
(let ((color (weak-pointer-ref value)))
|
(let ((color (weak-pointer-ref value)))
|
||||||
(if (equal? (list r g b)
|
(if (equal? (list r g b)
|
||||||
(extract-rgb-values color))
|
(extract-rgb-values color))
|
||||||
(return key))))
|
(return color))))
|
||||||
*weak-color-list*)
|
*weak-color-list*)
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
@ -68,5 +73,6 @@
|
||||||
(let ((p (make-weak-pointer color)))
|
(let ((p (make-weak-pointer color)))
|
||||||
(table-set! *weak-color-list* Xcolor p)))
|
(table-set! *weak-color-list* Xcolor p)))
|
||||||
|
|
||||||
(define (color-list-delete! Xcolor)
|
(define (color-list-delete! color)
|
||||||
(table-set! *weak-color-list* Xcolor #f))
|
(table-set! *weak-color-list*
|
||||||
|
(color-Xcolor color) #f))
|
||||||
|
|
Loading…
Reference in New Issue