diff --git a/scheme/xlib/type/color-type.scm b/scheme/xlib/type/color-type.scm index 2faf61b..f18d610 100644 --- a/scheme/xlib/type/color-type.scm +++ b/scheme/xlib/type/color-type.scm @@ -16,7 +16,7 @@ color)))) ;; r, g, b should be integers from 0 to 65535 -(define (make-color r g b) +(define (create-color r g b) (let ((maybe-color (color-list-find* r g b))) (if maybe-color maybe-color @@ -29,7 +29,7 @@ ;; returns a list of r,g,b as integers (define (extract-rgb-values color) - (%extract-rgb-values (color-Xcolor))) + (%extract-rgb-values (color-Xcolor color))) (import-lambda-definition %extract-rgb-values (XColor) "Extract_RGB_Values") diff --git a/scheme/xlib/type/colormap-type.scm b/scheme/xlib/type/colormap-type.scm index 8c3e766..3b8a039 100644 --- a/scheme/xlib/type/colormap-type.scm +++ b/scheme/xlib/type/colormap-type.scm @@ -4,17 +4,24 @@ (really-make-colormap tag Xcolormap display) colormap? (tag colormap-tag colormap-set-tag!) - (Xcolormap colormap-Xcolormap colormap-set-Xcolormap!) + (Xcolormap real-colormap-Xcolormap colormap-set-Xcolormap!) (display colormap-display colormap-set-display!)) +(define (colormap-Xcolormap colormap) + (if (eq? colormap 'none) + none-resource + (real-colormap-Xcolormap colormap))) + (define (make-colormap Xcolormap display) - (let ((maybe-colormap (colormap-list-find Xcolormap))) - (if maybe-colormap - maybe-colormap - (let ((colormap (really-make-colormap #f Xcolormap display))) - (add-finalizer! colormap finalize-colormap) - (colormap-list-set! Xcolormap colormap) - colormap)))) + (if (none-resource? Xcolormap) + 'none + (let ((maybe-colormap (colormap-list-find Xcolormap))) + (if maybe-colormap + maybe-colormap + (let ((colormap (really-make-colormap #f Xcolormap display))) + (add-finalizer! colormap finalize-colormap) + (colormap-list-set! Xcolormap colormap) + colormap))))) (define-exported-binding "colormap-record-type" :colormap) @@ -25,7 +32,6 @@ (define (finalize-colormap colormap) (let ((Xcolormap (colormap-Xcolormap colormap))) (free-colormap colormap) - (colormap-set-Xcolormap! colormap 'already-destroyed) (colormap-list-delete! Xcolormap))) (define (free-colormap colormap) diff --git a/scheme/xlib/type/pixel-type.scm b/scheme/xlib/type/pixel-type.scm index 7795745..51ea5ce 100644 --- a/scheme/xlib/type/pixel-type.scm +++ b/scheme/xlib/type/pixel-type.scm @@ -4,11 +4,11 @@ (tag pixel-tag pixel-set-tag!) (Xpixel pixel-Xpixel pixel-set-Xpixel!)) -(define (make-pixel Xpixel display) +(define (make-pixel Xpixel) (let ((maybe-pixel (pixel-list-find Xpixel))) (if maybe-pixel maybe-pixel - (let ((pixel (really-make-pixel #f Xpixel display))) + (let ((pixel (really-make-pixel #f Xpixel))) (add-finalizer! pixel finalize-pixel) (pixel-list-set! Xpixel pixel) pixel)))) diff --git a/scheme/xlib/type/window-type.scm b/scheme/xlib/type/window-type.scm index 65ce496..20d453b 100644 --- a/scheme/xlib/type/window-type.scm +++ b/scheme/xlib/type/window-type.scm @@ -4,24 +4,43 @@ (really-make-window tag Xwindow display) window? (tag window-tag window-set-tag!) - (Xwindow window-Xwindow window-set-Xwindow!) + (Xwindow real-window-Xwindow window-set-Xwindow!) (display window-display window-set-display!)) -(define (make-window tag Xwindow display) - (let ((maybe-window (window-list-find Xwindow))) - (if maybe-window - maybe-window - (let ((window (really-make-window tag Xwindow display))) - (add-finalizer! window finalize-window) - (window-list-set! Xwindow window) - window)))) +(define (window-Xwindow window) + (if (eq? window 'none) + none-resource + (real-window-Xwindow window))) + +(define (make-window Xwindow display) + (if (null-resource? Xwindow) + 'null + (let ((maybe-window (window-list-find Xwindow))) + (if maybe-window + maybe-window + (let ((window (really-make-window #f Xwindow display))) + (add-finalizer! window finalize-window) + (window-list-set! Xwindow window) + window))))) (define-exported-binding "window-record-type" :window) +;; abstractions for a "drawable" which is a window or a pixmap. + (define (drawable? object) (or (window? object) (pixmap? object))) +(define (drawable-abstraction pixmap-fun window-fun) + (lambda (drawable) + (cond + ((pixmap? drawable) (pixmap-fun drawable)) + ((window? drawable) (window-fun drawable)) + (else (error "expected a drawable object" drawable))))) + +(define drawable-display (drawable-abstraction pixmap-display window-display)) +(define drawable-Xobject (drawable-abstraction pixmap-Xpixmap window-Xwindow)) + ;; finalize-window is called, when the garbage collector removes the last ;; reference to the window from the heap. Then we can savely close the window ;; and remove the weak-pointer from our list.