From a55d007131f0c346b6d75015069040acb71cd050 Mon Sep 17 00:00:00 2001 From: frese Date: Wed, 11 Jul 2001 14:09:47 +0000 Subject: [PATCH] Has moved to main scheme-dir. --- scheme/xlib/type/color-type.scm | 73 -------------------------- scheme/xlib/type/colormap-type.scm | 65 ----------------------- scheme/xlib/type/display-type.scm | 61 ---------------------- scheme/xlib/type/pixel-type.scm | 43 ---------------- scheme/xlib/type/window-type.scm | 83 ------------------------------ 5 files changed, 325 deletions(-) delete mode 100644 scheme/xlib/type/color-type.scm delete mode 100644 scheme/xlib/type/colormap-type.scm delete mode 100644 scheme/xlib/type/display-type.scm delete mode 100644 scheme/xlib/type/pixel-type.scm delete mode 100644 scheme/xlib/type/window-type.scm diff --git a/scheme/xlib/type/color-type.scm b/scheme/xlib/type/color-type.scm deleted file mode 100644 index f18d610..0000000 --- a/scheme/xlib/type/color-type.scm +++ /dev/null @@ -1,73 +0,0 @@ -;; the color-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-record-type color :color - (really-make-color tag Xcolor) - color? - (tag color-tag color-set-tag!) - (Xcolor color-Xcolor color-set-Xcolor!)) - -(define (internal-make-color Xcolor) - (let ((maybe-color (color-list-find Xcolor))) - (if maybe-color - maybe-color - (let ((color (really-make-color #f Xcolor))) - (add-finalizer! color finalize-color) - (color-list-set! Xcolor color) - color)))) - -;; r, g, b should be integers from 0 to 65535 -(define (create-color r g b) - (let ((maybe-color (color-list-find* r g b))) - (if maybe-color - maybe-color - (internal-make-color (%create-color r g b))))) - -(import-lambda-definition %create-color (r g b) - "Create_Color") - -(define-exported-binding "color-record-type" :color) - -;; returns a list of r,g,b as integers -(define (extract-rgb-values color) - (%extract-rgb-values (color-Xcolor color))) - -(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)) - -(define (color-list-find Xcolor) - (let ((r (table-ref *weak-color-list* Xcolor))) - (if r - (weak-pointer-ref r) - r))) - -(define (color-list-find* r g b) ;; r,g,b as integers - (call/cc (lambda (return) - (table-walk (lambda (key value) - (let ((color (weak-pointer-ref value))) - (if (equal? (list r g b) - (extract-rgb-values color)) - (return key)))) - *weak-color-list*) - #f))) - -(define (color-list-set! Xcolor color) - (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)) diff --git a/scheme/xlib/type/colormap-type.scm b/scheme/xlib/type/colormap-type.scm deleted file mode 100644 index 3b8a039..0000000 --- a/scheme/xlib/type/colormap-type.scm +++ /dev/null @@ -1,65 +0,0 @@ -;; the colormap-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-record-type colormap :colormap - (really-make-colormap tag Xcolormap display) - colormap? - (tag colormap-tag colormap-set-tag!) - (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) - (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) - -;; finalize-colormap is called, when the garbage collector removes the last -;; reference to the colormap from the heap. Then we can savely close the -;; colormap and remove the weak-pointer from our list. - -(define (finalize-colormap colormap) - (let ((Xcolormap (colormap-Xcolormap colormap))) - (free-colormap colormap) - (colormap-list-delete! Xcolormap))) - -(define (free-colormap colormap) - (let ((Xcolormap (colormap-Xcolormap))) - (if (integer? Xcolormap) - (begin - (%free-colormap Xcolormap - (display-Xdisplay (colormap-display colormap))) - (colormap-set-Xcolormap! colormap 'already-freed))))) - -(import-lambda-definition %free-colormap (Xcolormap Xdisplay) - "Free_Colormap") - -;; All colormap records need to be saved in a weak-list, to have only one record -;; for the same XLib colormap - -(define *weak-colormap-list* (make-integer-table)) - -(define (colormap-list-find Xcolormap) - (let ((r (table-ref *weak-colormap-list* Xcolormap))) - (if r - (weak-pointer-ref r) - r))) - -(define (colormap-list-set! Xcolormap colormap) - (let ((p (make-weak-pointer colormap))) - (table-set! *weak-colormap-list* Xcolormap p))) - -(define (colormap-list-delete! Xcolormap) - (table-set! *weak-colormap-list* Xcolormap #f)) - diff --git a/scheme/xlib/type/display-type.scm b/scheme/xlib/type/display-type.scm deleted file mode 100644 index de9fa01..0000000 --- a/scheme/xlib/type/display-type.scm +++ /dev/null @@ -1,61 +0,0 @@ -;; the display-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-record-type display :display - (really-make-display after-function Xdisplay) - display? - (after-function display-after-function display-set-after-function!) - (Xdisplay display-Xdisplay display-set-Xdisplay!)) - -(define (make-display Xdisplay) - (let ((maybe-display (display-list-find Xdisplay))) - (if maybe-display - maybe-display - (let ((display (really-make-display #f Xdisplay))) - (add-finalizer! display finalize-display) - (display-list-set! Xdisplay display) - display)))) - -(define-exported-binding "display-record-type" :display) - -;; finalize-display is called, when the garbage collector removes the last -;; reference to the display from the heap. Then we can savely close the display -;; and remove the weak-pointer from our list. - -(define (finalize-display display) - (let ((Xdisplay (display-Xdisplay display))) - (close-display display) - (display-list-delete! Xdisplay))) - -;; close-display closes the corresponding Xlib-display struct, by calling a -;; c-function and marks the scheme-record to be invalid (with the -;; 'already-closed symbol). Calling close-display more than once has no -;; effects. - -(define (close-display display) - (let ((Xdisplay (display-Xdisplay display))) - (if (integer? Xdisplay) - (begin - ((display-after-function display) display) - (%close-display Xdisplay) - (display-set-Xdisplay display 'already-closed))))) - -(import-lambda-definition %close-display (Xdisplay) "Close_Display") - -;; All display records need to be saved in a weak-list, to have only one record -;; for the same Xlib display-structure in the heap. - -(define *weak-display-list* (make-integer-table)) - -(define (display-list-find Xdisplay) - (let ((r (table-ref *weak-display-list* Xdisplay))) - (if r - (weak-pointer-ref r) - r))) - -(define (display-list-set! Xdisplay display) - (let ((p (make-weak-pointer display))) - (table-set! *weak-display-list* Xdisplay p))) - -(define (display-list-delete! Xdisplay) - (table-set! *weak-display-list* Xdisplay #f)) - diff --git a/scheme/xlib/type/pixel-type.scm b/scheme/xlib/type/pixel-type.scm deleted file mode 100644 index 51ea5ce..0000000 --- a/scheme/xlib/type/pixel-type.scm +++ /dev/null @@ -1,43 +0,0 @@ -(define-record-type pixel :pixel - (really-make-pixel tag Xpixel) - pixel? - (tag pixel-tag pixel-set-tag!) - (Xpixel pixel-Xpixel pixel-set-Xpixel!)) - -(define (make-pixel Xpixel) - (let ((maybe-pixel (pixel-list-find Xpixel))) - (if maybe-pixel - maybe-pixel - (let ((pixel (really-make-pixel #f Xpixel))) - (add-finalizer! pixel finalize-pixel) - (pixel-list-set! Xpixel pixel) - pixel)))) - -(define-exported-binding "pixel-record-type" :pixel) - -;; finalize-pixel is called, when the garbage collector removes the last -;; reference to the pixel from the heap. Then we can savely close the -;; pixel and remove the weak-pointer from our list. - -(define (finalize-pixel pixel) - (let ((Xpixel (pixel-Xpixel pixel))) - (pixel-set-Xpixel! pixel 'already-destroyed) - (pixel-list-delete! Xpixel))) - -;; All pixel records need to be saved in a weak-list, to have only one record -;; for the same XLib pixel - -(define *weak-pixel-list* (make-integer-table)) - -(define (pixel-list-find Xpixel) - (let ((r (table-ref *weak-pixel-list* Xpixel))) - (if r - (weak-pointer-ref r) - r))) - -(define (pixel-list-set! Xpixel pixel) - (let ((p (make-weak-pointer pixel))) - (table-set! *weak-pixel-list* Xpixel p))) - -(define (pixel-list-delete! Xpixel) - (table-set! *weak-pixel-list* Xpixel #f)) \ No newline at end of file diff --git a/scheme/xlib/type/window-type.scm b/scheme/xlib/type/window-type.scm deleted file mode 100644 index 20d453b..0000000 --- a/scheme/xlib/type/window-type.scm +++ /dev/null @@ -1,83 +0,0 @@ -;; the window-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-record-type window :window - (really-make-window tag Xwindow display) - window? - (tag window-tag window-set-tag!) - (Xwindow real-window-Xwindow window-set-Xwindow!) - (display window-display window-set-display!)) - -(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. - -(define (finalize-window window) - (let ((Xwindow (window-Xwindow window))) - (destroy-window window) - (window-list-delete! Xwindow))) - -;; ... - -(define (destroy-window window) - (let ((Xdisplay (display-Xdisplay (window-display window))) - (Xwindow (window-Xwindow window))) - (if (integer? Xwindow) - (begin - (%destroy-window Xdisplay Xwindow) - (window-set-Xwindow! window 'already-destroyed))))) - -(import-lambda-definition %destroy-window (Xdisplay Xwindow) - "Destroy_Window") - -;; All window records need to be saved in a weak-list, to have only one record -;; for the same Xlib window-structure in the heap. - -(define *weak-window-list* (make-integer-table)) - -(define (window-list-find Xwindow) - (let ((r (table-ref *weak-window-list* Xwindow))) - (if r - (weak-pointer-ref r) - r))) - -(define (window-list-set! Xwindow window) - (let ((p (make-weak-pointer window))) - (table-set! *weak-window-list* Xwindow p))) - -(define (window-list-delete! Xwindow) - (table-set! *weak-window-list* Xwindow #f)) -