diff --git a/c/xlib/pixel.c b/c/xlib/pixel.c index 04094b3..7f06472 100644 --- a/c/xlib/pixel.c +++ b/c/xlib/pixel.c @@ -11,7 +11,18 @@ s48_value scx_White_Pixel(s48_value Xdisplay) { return SCX_ENTER_PIXEL( WhitePixel(dpy, DefaultScreen(dpy)) ); } +s48_value scx_Free_Pixel(s48_value Xpixel, s48_value Xdisplay, s48_value Xcolormap) { + unsigned long pixels[1]; + pixels[0] = SCX_EXTRACT_PIXEL(Xpixel); + + XFreeColors(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_COLORMAP(Xcolormap), + pixels, 1, 0); + + return S48_UNSPECIFIC; +} + void scx_init_pixel(void) { S48_EXPORT_FUNCTION(scx_Black_Pixel); S48_EXPORT_FUNCTION(scx_White_Pixel); + S48_EXPORT_FUNCTION(scx_Free_Pixel); } diff --git a/scheme/xlib/pixel-type.scm b/scheme/xlib/pixel-type.scm index 418a411..3761f78 100644 --- a/scheme/xlib/pixel-type.scm +++ b/scheme/xlib/pixel-type.scm @@ -1,18 +1,37 @@ (define-record-type pixel :pixel - (really-make-pixel tag Xpixel) + (really-make-pixel tag Xpixel colormap) pixel? (tag pixel-tag pixel-set-tag!) - (Xpixel pixel-Xpixel pixel-set-Xpixel!)) + (Xpixel pixel-Xpixel pixel-set-Xpixel!) + (colormap pixel-colormap pixel-set-colormap!)) -(define (make-pixel Xpixel) +;; Attention: colormap can be #f if finalize? is #f +(define (make-pixel Xpixel colormap finalize?) (let ((maybe-pixel (pixel-list-find Xpixel))) (if maybe-pixel - maybe-pixel - (let ((pixel (really-make-pixel #f Xpixel))) - (add-finalizer! pixel pixel-list-delete!) + (begin + ;; now free the Xpixel if it has been allocated + (if finalize? + (%free-pixel Xpixel + (display-Xdisplay (colormap-display colormap)) + (colormap-Xcolormap colormap))) + maybe-pixel) + (let ((pixel (really-make-pixel #f Xpixel colormap))) + (if finalize? + (add-finalizer! pixel free-pixel) + (add-finalizer! pixel pixel-list-delete!)) (pixel-list-set! Xpixel pixel) pixel)))) +(define (free-pixel pixel) + (%free-pixel (pixel-Xpixel pixel) + (display-Xdisplay (colormap-display (pixel-colormap pixel))) + (colormap-Xcolormap (pixel-colormap pixel))) + (pixel-list-delete! pixel)) + +(import-lambda-definition %free-pixel (Xpixel Xdisplay Xcolormap) + "scx_Free_Pixel") + ;; All pixel records need to be saved in a weak-list, to have only one record ;; for the same XLib pixel diff --git a/scheme/xlib/pixel.scm b/scheme/xlib/pixel.scm index c12f67d..425e8db 100644 --- a/scheme/xlib/pixel.scm +++ b/scheme/xlib/pixel.scm @@ -1,13 +1,15 @@ (define pixel-value pixel-Xpixel) (define (black-pixel display) - (make-pixel (%black-pixel (display-Xdisplay display)))) + (make-pixel (%black-pixel (display-Xdisplay display)) + #f #f)) (import-lambda-definition %black-pixel (Xdisplay) "scx_Black_Pixel") (define (white-pixel display) - (make-pixel (%white-pixel (display-Xdisplay display)))) + (make-pixel (%white-pixel (display-Xdisplay display)) + #f #f)) (import-lambda-definition %white-pixel (Xdisplay) "scx_White_Pixel") \ No newline at end of file