Some changes.
This commit is contained in:
parent
2d06f4576b
commit
374158d3a3
|
@ -16,7 +16,7 @@
|
||||||
color))))
|
color))))
|
||||||
|
|
||||||
;; r, g, b should be integers from 0 to 65535
|
;; 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)))
|
(let ((maybe-color (color-list-find* r g b)))
|
||||||
(if maybe-color
|
(if maybe-color
|
||||||
maybe-color
|
maybe-color
|
||||||
|
@ -29,7 +29,7 @@
|
||||||
|
|
||||||
;; returns a list of r,g,b as integers
|
;; returns a list of r,g,b as integers
|
||||||
(define (extract-rgb-values color)
|
(define (extract-rgb-values color)
|
||||||
(%extract-rgb-values (color-Xcolor)))
|
(%extract-rgb-values (color-Xcolor color)))
|
||||||
|
|
||||||
(import-lambda-definition %extract-rgb-values (XColor)
|
(import-lambda-definition %extract-rgb-values (XColor)
|
||||||
"Extract_RGB_Values")
|
"Extract_RGB_Values")
|
||||||
|
|
|
@ -4,17 +4,24 @@
|
||||||
(really-make-colormap tag Xcolormap display)
|
(really-make-colormap tag Xcolormap display)
|
||||||
colormap?
|
colormap?
|
||||||
(tag colormap-tag colormap-set-tag!)
|
(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!))
|
(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)
|
(define (make-colormap Xcolormap display)
|
||||||
|
(if (none-resource? Xcolormap)
|
||||||
|
'none
|
||||||
(let ((maybe-colormap (colormap-list-find Xcolormap)))
|
(let ((maybe-colormap (colormap-list-find Xcolormap)))
|
||||||
(if maybe-colormap
|
(if maybe-colormap
|
||||||
maybe-colormap
|
maybe-colormap
|
||||||
(let ((colormap (really-make-colormap #f Xcolormap display)))
|
(let ((colormap (really-make-colormap #f Xcolormap display)))
|
||||||
(add-finalizer! colormap finalize-colormap)
|
(add-finalizer! colormap finalize-colormap)
|
||||||
(colormap-list-set! Xcolormap colormap)
|
(colormap-list-set! Xcolormap colormap)
|
||||||
colormap))))
|
colormap)))))
|
||||||
|
|
||||||
(define-exported-binding "colormap-record-type" :colormap)
|
(define-exported-binding "colormap-record-type" :colormap)
|
||||||
|
|
||||||
|
@ -25,7 +32,6 @@
|
||||||
(define (finalize-colormap colormap)
|
(define (finalize-colormap colormap)
|
||||||
(let ((Xcolormap (colormap-Xcolormap colormap)))
|
(let ((Xcolormap (colormap-Xcolormap colormap)))
|
||||||
(free-colormap colormap)
|
(free-colormap colormap)
|
||||||
(colormap-set-Xcolormap! colormap 'already-destroyed)
|
|
||||||
(colormap-list-delete! Xcolormap)))
|
(colormap-list-delete! Xcolormap)))
|
||||||
|
|
||||||
(define (free-colormap colormap)
|
(define (free-colormap colormap)
|
||||||
|
|
|
@ -4,11 +4,11 @@
|
||||||
(tag pixel-tag pixel-set-tag!)
|
(tag pixel-tag pixel-set-tag!)
|
||||||
(Xpixel pixel-Xpixel pixel-set-Xpixel!))
|
(Xpixel pixel-Xpixel pixel-set-Xpixel!))
|
||||||
|
|
||||||
(define (make-pixel Xpixel display)
|
(define (make-pixel Xpixel)
|
||||||
(let ((maybe-pixel (pixel-list-find Xpixel)))
|
(let ((maybe-pixel (pixel-list-find Xpixel)))
|
||||||
(if maybe-pixel
|
(if maybe-pixel
|
||||||
maybe-pixel
|
maybe-pixel
|
||||||
(let ((pixel (really-make-pixel #f Xpixel display)))
|
(let ((pixel (really-make-pixel #f Xpixel)))
|
||||||
(add-finalizer! pixel finalize-pixel)
|
(add-finalizer! pixel finalize-pixel)
|
||||||
(pixel-list-set! Xpixel pixel)
|
(pixel-list-set! Xpixel pixel)
|
||||||
pixel))))
|
pixel))))
|
||||||
|
|
|
@ -4,24 +4,43 @@
|
||||||
(really-make-window tag Xwindow display)
|
(really-make-window tag Xwindow display)
|
||||||
window?
|
window?
|
||||||
(tag window-tag window-set-tag!)
|
(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!))
|
(display window-display window-set-display!))
|
||||||
|
|
||||||
(define (make-window tag Xwindow 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)))
|
(let ((maybe-window (window-list-find Xwindow)))
|
||||||
(if maybe-window
|
(if maybe-window
|
||||||
maybe-window
|
maybe-window
|
||||||
(let ((window (really-make-window tag Xwindow display)))
|
(let ((window (really-make-window #f Xwindow display)))
|
||||||
(add-finalizer! window finalize-window)
|
(add-finalizer! window finalize-window)
|
||||||
(window-list-set! Xwindow window)
|
(window-list-set! Xwindow window)
|
||||||
window))))
|
window)))))
|
||||||
|
|
||||||
(define-exported-binding "window-record-type" :window)
|
(define-exported-binding "window-record-type" :window)
|
||||||
|
|
||||||
|
;; abstractions for a "drawable" which is a window or a pixmap.
|
||||||
|
|
||||||
(define (drawable? object)
|
(define (drawable? object)
|
||||||
(or (window? object)
|
(or (window? object)
|
||||||
(pixmap? 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
|
;; 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
|
;; reference to the window from the heap. Then we can savely close the window
|
||||||
;; and remove the weak-pointer from our list.
|
;; and remove the weak-pointer from our list.
|
||||||
|
|
Loading…
Reference in New Issue