[Scsh-checkins] CVS: scx/scheme/xlib color-type.scm,1.2,1.3

[David Frese <frese@users.sourceforge.net>]

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

Modified Files:
        color-type.scm 
Log Message:
changed integer-table into byte-vector-table. fixed color-list-find.


Index: color-type.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/color-type.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** color-type.scm      2001/07/16 13:06:20     1.2
--- color-type.scm      2001/07/30 14:27:35     1.3
***************
*** 12,16 ****
        maybe-color
        (let ((color (really-make-color #f Xcolor)))
!         (add-finalizer! color finalize-color)
          (color-list-set! Xcolor color)
          color))))
--- 12,16 ----
        maybe-color
        (let ((color (really-make-color #f Xcolor)))
!         (add-finalizer! color color-list-delete!)
          (color-list-set! Xcolor color)
          color))))
***************
*** 33,50 ****
    "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))
  
  (define (color-list-find Xcolor)
--- 33,55 ----
    "Extract_RGB_Values")
  
  ;; 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.
+ 
+ ;; 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)
***************
*** 61,65 ****
                     (if (equal? (list r g b)
                                 (extract-rgb-values color))
!                        (return key))))
                 *weak-color-list*)
       #f)))
--- 66,70 ----
                     (if (equal? (list r g b)
                                 (extract-rgb-values color))
!                        (return color))))
                 *weak-color-list*)
       #f)))
***************
*** 69,72 ****
      (table-set! *weak-color-list* Xcolor p)))
  
! (define (color-list-delete! Xcolor)
!   (table-set! *weak-color-list* Xcolor #f))
--- 74,78 ----
      (table-set! *weak-color-list* Xcolor p)))
  
! (define (color-list-delete! color)
!   (table-set! *weak-color-list* 
!             (color-Xcolor color) #f))