Dan Knapp <[EMAIL PROTECTED]> writes:
> Well, I can do that right enough. I can create a bitmap; I can even
> use it as the clip mask. What I can't do is actually draw into the bitmap. (Thus,
> since it's uninitialized, the drawing results look like
> garbage - but the same garbage for the duration of each run, you see,
> so I know it's working.)
>
> If I try to use (put-image), no matter how carefully I prepare the image and
> ensure that it only has one bit of depth, and no matter whether I use the image-x,
> image-xy, or image-z formats, it results
> in a match-error.
>
> I also get a match-error, oddly, on any other attempted drawing operation into the
> bitmap. At first I suspected that this was due to
> the gcontext specifying a foreground color which the bitmap couldn't
> handle; but I can't imagine what it should be, in that case. I
> tried (screen-black-value), 0, and 1.
>
> I did a long search looking for any CLX code anywhere which uses
> this technique, but actually, I couldn't find a single example. I
> did have no trouble finding C programs which use it...
> ...
> Any suggestions?
You might look at the source code for READ-BITMAP-FILE in the CMUCL
source directory src/clx/image.lisp.
I had trouble finding simple example programs to call PUT-IMAGE so
I stripped this out of a larger program of mine.
====== showbm.lisp ======
;;;; showbm.lisp - simple load bitmap into window
;;;; Commentary
;;; Simple hack to load a bitmap into a window.
#+:cmu
(require :clx)
;;; Keep general x connection info global
(defparameter *display* nil
"X11 Display object when connection is active.")
(defparameter *screen* nil
"X11 Screen object when connection is active.")
(defparameter *root* nil
"Root window on display when connection is active.")
(defparameter *gremblin* nil
"Image displayed in window")
(defun open-x-display ()
"Open default \":0.0\" display"
(setf *display* (xlib:open-display "" :display 0))
(setf *screen* (car (xlib:display-roots *display*)))
(setf *root* (xlib:screen-root *screen*))
(unless *root*
(error "Failed to open display~%"))
*root*)
(defun close-x-display ()
(xlib:close-display *display*)
(setf *display* nil))
(defun show-image (win gcon image)
"Display image. Called on exposure events."
;; (format t "-- Exposure --~%")
(xlib:put-image win gcon image :x 0 :y 0
:width (xlib:image-width image)
:height (xlib:image-height image)
:bitmap-p t)
(xlib:display-force-output *display*))
(defun handle-events (refresh-image)
"Process events, passing function to refresh image on window"
(xlib:event-case (*display*)
(:button-press (code window)
(case code
(3 t)))
(:selection-notify (window selection target property)
nil)
(:key-press (code window)
(case (xlib:keycode->keysym *display* code 0)
;; 'q' keycode causes exit
(#o161 t)))
(:exposure (count window)
(if (= 0 count)
(funcall refresh-image window))
nil) ))
(defun dump-data (image)
"Dump pixmap data as grid"
(let ((data (xlib::image-x-data image))
(width (xlib:image-width image))
(height (xlib:image-height image))
(bytes-per-line (xlib::image-x-bytes-per-line image)))
(format t "Bitmap :width ~A :height ~A :bytes-per-line ~A~%"
width height bytes-per-line)
(dotimes (yc height)
(format t "|")
(let ((rowpos (* bytes-per-line yc)))
(dotimes (xc width)
(multiple-value-bind (byte-offset bit-offset)
(floor xc 8)
(format t "~A" (if (/= (logand (aref data (+ rowpos byte-offset))
(expt 2 bit-offset))
0)
"*"
" ")))))
(format t "|~%"))))
(defun main (bmfile)
"Say using via-voice whatever pasted in its window."
;; Read in background image
(let ((bmfile (or bmfile "gremblin.xbm")))
(setf *gremblin* (or (xlib:read-bitmap-file bmfile)
(error "Cannot read bitmap file: ~A~%" bmfile))))
(format t "~A~%" *gremblin*)
; (format t "data (~S):~%~s~%" (type-of (xlib::image-x-data *gremblin*))
; (xlib::image-x-data *gremblin*))
; (dump-data *gremblin*)
(open-x-display)
;; Set up background pixmap
(let* ((width (xlib:image-width *gremblin*))
(height (xlib:image-height *gremblin*))
(black-pixel (xlib:screen-black-pixel *screen*))
(win (xlib:create-window :parent *root* :x 10 :y 10
:width width :height height
:background black-pixel
:event-mask '(:button-press
:key-press
:exposure)))
;; Try for an appropriate color
(color (xlib:alloc-color (xlib:window-colormap win)
"Light Green"))
(gcon (xlib:create-gcontext :drawable win
:foreground color)))
(setf (xlib:wm-name win) "Gremblin")
(xlib:map-window win)
(xlib:display-finish-output *display*)
;; Process event loop
(handle-events (lambda (win) (show-image win gcon *gremblin*)))
;; Done
(xlib:unmap-window win)
(xlib:destroy-window win))
(close-x-display))
#-cmu
(main (car *ARGS*))
====== END OF showbm.lisp ======
--
Barry Fishman
