scx/scheme/xlib/pixmap.scm

71 lines
2.2 KiB
Scheme

;; author -> Norbert Freudemann
;; creation date : 16/07/2001
;; last change : 16/07/2001
; ---
(define (create-pixmap drawable width height depth)
(let* ((display (drawable-display drawable))
(pixmap (%create-pixmap (display-Xdisplay display)
(drawable-Xobject drawable)
width height depth)))
(make-pixmap pixmap display #t)))
(import-lambda-definition %create-pixmap (Xdisplay Xdrawable w h depth)
"Create_Pixmap")
; ---
(define (create-bitmap-from-data window data width height)
(let* ((display (window-display window))
(Xpixmap (%create-bitmap-from-data (display-Xdisplay display)
(window-Xwindow window)
data width height)))
(make-pixmap Xpixmap display #t)))
(import-lambda-definition %create-bitmap-from-data (Xdisplay Xdrawable data w h)
"Create_Bitmap_From_Data")
; ---
(define (create-pixmap-from-bitmap-data win data widht height
foregrnd backgrnd depth)
(let* ((display (window-display window))
(pixmap (create-pixmap-from-bitmap-data (display-Xdisplay display)
(window-Xwindow window)
data widht height foregrnd
backgrd depth)))
(make-pixmap pixmap display #t)))
(import-lambda-definition %create-pixmap-from-bitmap-data
(Xdisplay Xdrawabel data w h f b depth)
"Create_Pixmap_From_Bitmap_Data")
; Returns a list of five elements: (pixmap widht heigth x y)
(define (read-bitmap-file drawable filename)
(let ((res (%read-bitmap-file (display-Xdisplay (drawable-display drawable))
(drawable-Xobject drawable)
filename)))
(set-car! res (make-pixmap (drawable-display drawable) (car res) #t))))
(import-lambda-definition %read-bitmap-file (Xdisplay Xdrawable file)
"Read_Bitmap_File")
; --- coord is optional. It should be the empty list or (x-hot y-hot)
(define (write-bitmap-file filename pixmap width height . coord)
(let ((dpy (display-Xdisplay (pixmap-display pixmap)))
(xy-hot (cond
((null? coord) (list -1 -1))
((null? (cdr coord))
(error "zero or both coordinates must be defined"))
(else coord))))
(%write-bitmap-file dpy filename pixmap widht height
(car xy-hot) (cadr xy-hot))))
(import-lambda-definition %write-bitmap-file (Xdisplay file Xpixmap w h x y)
"Write_Bitmap_File")